1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
#COMPILE EXE "MiniPB.exe"
#INCLUDE "MiniPB.inc" '// Flat API declaration
%ClientW = 640
%ClientH = 480
TYPE PROP
hMain AS DWORD
MinTrackSizeW AS LONG
MinTrackSizeH AS LONG
END TYPE
GLOBAL gP AS PROP ''// Global class properties
FUNCTION WndProc(BYVAL hWnd AS DWORD, BYVAL Msg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS DWORD) AS LONG
LOCAL ps AS PAINTSTRUCT
LOCAL rc AS RECT
SELECT CASE LONG Msg
CASE %WM_GETMINMAXINFO
LOCAL pMM AS MINMAXINFO PTR
pMM = lParam
@pMM.ptMinTrackSize.x = gP.MinTrackSizeW
@pMM.ptMinTrackSize.y = gP.MinTrackSizeH
CASE %WM_SIZE
InvalidateRect(hWnd, BYVAL(%NULL), %TRUE)
CASE %WM_COMMAND
LOCAL wmId, wmEvent AS LONG
wmID = LOINT(wParam)
wmEvent = HIINT(wParam)
'//SELECT CASE LONG LOWRD(wParam)
'//
'//END SELECT
CASE %WM_PAINT
LOCAL hDC AS DWORD
hDC = BeginPaint(hWnd, ps)
'// Paint the window content here
EndPaint(hWnd, ps)
FUNCTION = 0: EXIT FUNCTION
CASE %WM_DESTROY
PostQuitMessage(0)
FUNCTION = 0: EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, Msg, wParam, lParam)
END FUNCTION
FUNCTION WinMain (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
BYVAL lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL nRet AS DWORD
LOCAL wcx AS WNDCLASSEXA
LOCAL szClass AS ASCIIZ * 16
szClass = "FLAT_API_POPUP" '// The class name of our popup window.
wcx.cbSize = SIZEOF(wcx)
LOCAL IsInitialized AS LONG
IsInitialized = GetClassInfoEx(hInstance, szClass, wcx)
IF IsInitialized& = 0 THEN
wcx.style = %CS_HREDRAW OR %CS_VREDRAW
wcx.lpfnWndProc = CODEPTR(WndProc)
wcx.cbClsExtra = 0
wcx.cbWndExtra = 0 '// %EXTEND_EXTRA * 4
wcx.hInstance = hInstance
wcx.hIcon = %NULL
wcx.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcx.hbrBackground = GetStockObject(%WHITE_BRUSH)
wcx.lpszMenuName = %NULL
wcx.lpszClassName = VARPTR(szClass)
wcx.hIconSm = wcx.hIcon
IF RegisterClassEx(wcx) THEN IsInitialized = %TRUE
END IF
IF IsInitialized THEN
LOCAL r AS RECT
LOCAL uMsg AS TagMSG
LOCAL dwExStyle, dwStyle, hMain AS DWORD
LOCAL x, y AS LONG
dwExStyle = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
dwStyle = %WS_POPUP OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN
SetRect(r, 0, 0, %ClientW, %ClientH)
AdjustWindowRectEx(r, dwStyle, %FALSE, dwExStyle)
gP.MinTrackSizeW = r.nRight - r.nLeft
gP.MinTrackSizeH = r.nBottom - r.nTop
x = MAX&((GetSystemMetrics(%SM_CXSCREEN) - gP.MinTrackSizeW) \ 2, 0)
y = MAX&((GetSystemMetrics(%SM_CYSCREEN) - gP.MinTrackSizeH) \ 2, 0)
gP.hMain = CreateWindowEx(dwExStyle, szClass, "Popup window 32-bit", dwStyle, _
x, y, gP.MinTrackSizeW, gP.MinTrackSizeH, 0, 0, hInstance, BYVAL %NULL)
IF gP.hMain THEN
ShowWindow(gP.hMain, iCmdShow)
SetForegroundWindow(gP.hMain) '// Slightly Higher Priority
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage(uMsg)
DispatchMessage(uMsg)
WEND
nRet = uMsg.wParam
END IF
END IF
FUNCTION = nRet
END FUNCTION |
Création d'une fenêtre popup avec la Flat API
Répondre avec citation
Envoyé par Patrice Terrier
Partager