The following example uses CreatePolygonRgn to change the appearance of the dialog to a non-rectangular shape.
' ########################################################################################
' 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
' ========================================================================================
The following example by Semen Matusovski demonstrates the use of CreatePolygonRgn.
' ########################################################################################
'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