GDI: CreatePolygonRgn Function

[José Roca]

 
The following example uses CreatePolygonRgn to change the appearance of the dialog to a non-rectangular shape.

Code Select Expand


' ########################################################################################
' Dynamic non-rectangular dialog
' Based on an example posted by Lance Edmonds.
' Concept based on Public Domain VB code, but completely rewritten so that it no longer
' resembles the original!
' http://www.powerbasic.com/support/forums/Archives/Archive-000002/HTML/20020808-7-000294.html
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

%IDOK       = 1
%IDSTATIC   = 2
%NUM_POINTS = 8

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL hWndMain    AS DWORD
   LOCAL hCtl        AS DWORD
   LOCAL hFont       AS DWORD
   LOCAL wcex        AS WNDCLASSEX
   LOCAL szClassName AS ASCIIZ * 80
   LOCAL rc          AS RECT
   LOCAL szCaption   AS ASCIIZ * 255
   LOCAL nLeft       AS LONG
   LOCAL nTop        AS LONG
   LOCAL nWidth      AS LONG
   LOCAL nHeight     AS LONG

   hFont = GetStockObject(%ANSI_VAR_FONT)

   ' Register the window class
   szClassName        = "MyClassName"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = %COLOR_3DFACE + 1
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION)
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION)
   RegisterClassEx wcex

   ' Window caption
   szCaption = "Stars in my eyes!?"

   ' Retrieve the size of the working area
   SystemParametersInfo %SPI_GETWORKAREA, 0, rc, 0

   ' Calculate the position and size of the window
   nWidth  = 540
   nHeight = 406
   nLeft   = ((rc.nRight - rc.nLeft) \ 2) - nWidth \ 2
   nTop    = ((rc.nBottom - rc.nTop) \ 2) - (nHeight \ 2)

   ' Create a window using the registered class
   hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _           ' extended style
                             szClassName, _                    ' window class name
                             szCaption, _                      ' window caption
                             %WS_CAPTION OR %WS_SYSMENU, _     ' window style
                             nLeft, _                          ' initial x position
                             nTop, _                           ' initial y position
                             nWidth, _                         ' initial x size
                             nHeight, _                        ' initial y size
                             %NULL, _                          ' parent window handle
                             0, _                              ' window menu handle
                             hInstance, _                      ' program instance handle
                             BYVAL %NULL)                      ' creation parameters

   hCtl = CreateWindowEx(0, "Static", "WOW!!! PB rocks!", _
               %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, _
               210, 179, 120, 23, hWndMain, %IDSTATIC, hInstance, BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   hCtl = CreateWindowEx(0, "Button", "OK", _
               %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_FLAT, _
               240, 203, 60, 23, hWndMain, %IDOK, hInstance, BYVAL %NULL)
   IF hFont THEN SendMessage hCtl, %WM_SETFONT, hFont, 0

   ' Show the window
   ShowWindow hWndMain, nCmdShow
   UpdateWindow hWndMain

   ' Set the timer
   SetTimer hWndMain, 0, 750, %NULL

   ' Message handler loop
   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hWndMain, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   ' Kill the timer
   KillTimer hWndMain, 0

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   SELECT CASE wMsg

      CASE %WM_TIMER
         SetRegion hWnd
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDOK, %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hWnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Sets the region.
' ========================================================================================
SUB SetRegion (BYVAL hWnd AS LONG)

   LOCAL x, y, z AS LONG
   LOCAL cx, cy, dt, th, pi AS SINGLE
   LOCAL hRgn AS DWORD
   LOCAL rc AS RECT
   STATIC NUM_POINTS AS LONG

   NUM_POINTS = RND(4,30) * 2
   REDIM w(0 TO 1) AS SINGLE
   REDIM h(0 TO 1) AS SINGLE
   REDIM rgPoints(1 TO NUM_POINTS) AS POINT

   GetWindowRect hWnd, rc
   x = rc.nRight - rc.nLeft
   y = rc.nBottom - rc.nTop

   pi = 3.1415926535!
   cx = x / 2
   cy = y / 2
   w(0) = x& * 0.15! : w(1) = x * 0.5!
   h(0) = y& * 0.15! : h(1) = y * 0.5!
   dt = 2 * pi / NUM_POINTS
   th = pi / 2!
   FOR z = 1 TO NUM_POINTS
      rgPoints(NUM_POINTS - z + 1).x = cx + w(z MOD 2) * COS(th)
      rgPoints(NUM_POINTS - z + 1).y = cy + h(z MOD 2) * SIN(th)
      th = th + dt
   NEXT
   hRgn = CreatePolygonRgn(rgPoints(1), NUM_POINTS, %ALTERNATE)
   SetWindowRgn hWnd, hRgn, %TRUE

END SUB
' ========================================================================================


[José Roca]

 
The following example by Semen Matusovski demonstrates the use of CreatePolygonRgn.

Code Select Expand


' ########################################################################################
'MESSAGE http://www.powerbasic.com/support/forums/Forum7/HTML/001944.html
'FORUM:  Source Code
'TOPIC:  'Ballon' instead of Msgbox
'NAME:   Semen Matusovski, Member
'DATE:   June 12, 2003 02:04 PM

'In alive app I process input form and there are reasons to expect a lot of user's mistake.
'I move focus to error field. In addition it's necessary to give info about error type.

'I decided that often MsgBox will be terrible in this case and made a replacement a-la 'ballon'.
'A text can have aome lines (divided by $CrLf or |).

'I used %WM_SETCURSOR in test dialog for demo purposes only (I don't want to replace tooltips).
'Ballon window is closed, if happends one of following events:
'1) WM_TIMER (2 seconds)
'2) user presses key or clicks mouse button
' ########################################################################################

#COMPILE EXE
#DIM ALL
#INCLUDE "windows.inc"

GLOBAL BallonText_hHook AS DWORD
GLOBAL BallonText_hWnd  AS DWORD

FUNCTION BallonTextGetMsgProc (BYVAL nCode AS LONG, BYVAL wParam AS DWORD, BYVAL lParam AS tagMsg PTR) AS LONG
   IF nCode = %HC_ACTION THEN
      SELECT CASE AS LONG @lParam.Message
         CASE %WM_KEYDOWN, %WM_LBUTTONDOWN, %WM_RBUTTONDOWN, %WM_MBUTTONDOWN
            SendMessage BallonText_hWnd, %WM_TIMER, 1, 0
      END SELECT
   END IF
   FUNCTION = CallNextHookEx(BallonText_hHook, nCode, wParam, BYVAL lParam)
END FUNCTION

FUNCTION BallonTextWndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   DIM szText        AS STATIC STRING
   DIM hFont         AS STATIC DWORD
   DIM hRgn(3)       AS STATIC DWORD
   DIM rcText        AS STATIC RECT

   DIM hWndCenter    AS LOCAL  DWORD
   DIM rcWnd(1)      AS LOCAL  RECT
   DIM tm            AS LOCAL  TEXTMETRIC
   DIM ps            AS LOCAL  PAINTSTRUCT
   DIM pt(2)         AS LOCAL  POINTAPI
   DIM Blank         AS LOCAL  POINTAPI
   DIM Dimension     AS LOCAL  POINTAPI
   DIM ArrowDown     AS LOCAL  DWORD
   DIM pCreateStruct AS CREATESTRUCT PTR

   DIM ncm           AS LOCAL  NONCLIENTMETRICS

   SELECT CASE wMsg

      CASE %WM_CREATE
         BallonText_hHook = SetWindowsHookEx (%WH_GETMESSAGE, CODEPTR(BallonTextGetMsgProc), 0, GetCurrentThreadId)

         DIALOG GET TEXT hWnd TO szText
         REPLACE "|" WITH $CRLF IN szText

         ps.hDC = GetDC (hWnd)
         ncm.cbSize = SIZEOF(NONCLIENTMETRICS)
         SystemParametersInfo %SPI_GETNONCLIENTMETRICS, 0, BYVAL VARPTR(ncm), 0

         hFont = CreateFontIndirect (ncm.lfMessageFont)

         SelectObject ps.hDC, hFont
         GetTextMetrics ps.hDC, tm

         RESET rcText
         DrawText ps.hDC, BYVAL STRPTR(szText), LEN(szText), rcText, %DT_CALCRECT

         Blank.Y = 0.75 * (tm.tmHeight + tm.tmExternalLeading) + 1
         Blank.X = tm.tmAveCharWidth * 3 + 1
         ArrowDown = (tm.tmHeight + tm.tmExternalLeading)
         Dimension.x = Blank.X + rcText.nRight + Blank.X
         Dimension.y = Blank.Y + rcText.nBottom + Blank.Y

         pt(0).x = Blank.X + tm.tmAveCharWidth * 0.5 - 1
         pt(0).y = Dimension.y - 1
         pt(1).x = pt(0).x
         pt(1).y = Dimension.y + ArrowDown + 1
         pt(2).x = pt(0).x + ArrowDown + 2
         pt(2).y = pt(0).y

         ReleaseDC hWnd, ps.hDC

         hRgn(0) = CreateRoundRectRgn(0, 0, Blank.X + rcText.nRight + Blank.X, _
            Blank.Y + rcText.nBottom + Blank.Y, Blank.Y, Blank.Y)
         hRgn(1) = CreatePolygonRgn(pt(0), 3, %ALTERNATE)

         hRgn(2) = CreateRectRgn (0, 0, 0, 0)
         CombineRgn hRgn(2), hRgn(1), hRgn(0), %RGN_OR

         hRgn(3) = CreateRectRgn (0, 0, 0, 0)
         CombineRgn hRgn(3), hRgn(2), 0, %RGN_COPY

         pCreateStruct = lParam
         hWndCenter = @pCreateStruct.lpCreateParams
         GetWindowRect hWndCenter, rcWnd(0)

         rcWnd(1).nRight  = Blank.X + rcText.nRight + Blank.X
         rcWnd(1).nLeft   = rcWnd(0).nLeft + MAX(0, (rcWnd(0).nRight - rcWnd(0).nLeft - rcWnd(1).nRight) \ 2)
         rcWnd(1).nBottom = Blank.Y + rcText.nBottom + Blank.Y + ArrowDown
         rcWnd(1).nTop    = rcWnd(0).nTop - rcWnd(1).nBottom + 0.75 * tm.tmHeight

         OffSetRect rcText, Blank.X, Blank.Y
         SetWindowPos hWnd, 0, rcWnd(1).nLeft, rcWnd(1).nTop, rcWnd(1).nRight,  rcWnd(1).nBottom, _
            %SWP_NOZORDER OR %SWP_NOOWNERZORDER OR %SWP_NOACTIVATE OR %SWP_SHOWWINDOW
         SetWindowRgn hWnd, hRgn(3), 0

         DeleteObject hRgn(0)
         DeleteObject hRgn(1)

         SetTimer hWnd, 1, 2000, BYVAL 0

      CASE %WM_TIMER
         DestroyWindow hWnd

      CASE %WM_PAINT
         BeginPaint hWnd, ps
         SelectObject ps.hDC, hFont
         FillRgn ps.hDC, hRgn(2), GetSysColorBrush(%COLOR_INFOBK)
         FrameRgn ps.hDC, hRgn(2), GetSysColorBrush(%COLOR_3DDKSHADOW), 1, 1
         SetBkMode ps.hDC, %TRANSPARENT
         DrawText ps.hDC, BYVAL STRPTR(szText), LEN(szText), rcText, %DT_CENTER
         EndPaint hWnd, ps

      CASE %WM_DESTROY
         KillTimer hWnd, 1
         DeleteObject hFont
         DeleteObject hRgn(2)
         UnhookWindowsHookEx BallonText_hHook

   END SELECT

   FUNCTION = DefWindowProc (hWnd, wMsg, wParam, lParam)

END FUNCTION

FUNCTION ShowBallonText (BYVAL hWndOwner AS DWORD, BYVAL hWndCenter AS DWORD, szText AS STRING) AS LONG

   DIM szClassName AS STATIC ASCIIZ * 11
   DIM wce         AS STATIC WNDCLASSEX

   IF wce.cbSize = 0 THEN
      szClassName = "BallonText"

      wce.cbSize        = SIZEOF(wce)
      wce.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_GLOBALCLASS OR %CS_SAVEBITS
      wce.lpfnWndProc   = CODEPTR(BallonTextWndProc)
    ' wce.cbClsExtra = 0
    ' wce.cbWndExtra = 0
      wce.hInstance = GetModuleHandle("")
    ' wce.hIcon = 0
      wce.hCursor = LoadCursor(0, BYVAL %IDC_ARROW)
      wce.hbrBackground = 0
    ' wce.lpszMenuName = 0
      wce.lpszClassName = VARPTR(szClassName)
    ' wce.hIconSm = 0

      RegisterClassEx wce
   END IF

   IF BallonText_hWnd THEN IF IsWindow(BallonText_hWnd) THEN DestroyWindow BallonText_hWnd
   BallonText_hWnd = CreateWindowEx (0, szClassName, BYVAL STRPTR(szText), %WS_POPUP, 0, 0, 0, 0, hWndOwner, 0, wce.hInstance, BYVAL hWndCenter)

END FUNCTION

CALLBACK FUNCTION DlgProc

   DIM i AS LONG

   SELECT CASE CBMSG
      CASE %WM_INITDIALOG
         CONTROL ADD TEXTBOX, CBHNDL, 101, "", 10, 10, 50, 15
         CONTROL ADD TEXTBOX, CBHNDL, 102, "", 10, 30, 100, 15
      CASE %WM_SETCURSOR
         DIM hWndLast AS STATIC DWORD
         IF hWndLast <> CBWPARAM THEN hWndLast = CBWPARAM: ShowBallonText CBHNDL, CBWPARAM, "hWnd = &&H" + HEX$(CBWPARAM, 8)
   END SELECT

END FUNCTION

FUNCTION PBMAIN

   DIM hDlg AS LOCAL DWORD

   DIALOG NEW 0, "Balloon Text", , , 200, 95, %DS_MODALFRAME OR %DS_SETFOREGROUND OR %DS_CENTER OR _
      %WS_VISIBLE OR %WS_OVERLAPPED OR %WS_SYSMENU OR %WS_CAPTION, 0  TO hDlg

   DIALOG SHOW MODAL hDlg CALL DlgProc

END FUNCTION