Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Tutorial
Lutz Ifers WinAPI Tutorial
von  MOD | Seite 14 von 16 |
Kapitel 4.4: Messages
''' Lutz Ifers WinAPI-Tutorial
''' Lizenz: WTFPL
'''
''' Kapitel 4.4 - "Messages"
#include "windows.bi"
const ProgrammName = "Hauptfenster"
const FensterName = "Farbfenster"
declare function WndProc(byval hWnd as HWND, byval message as UINTEGER,_
byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
declare function SubProc(byval hWnd as HWND, byval message as UINTEGER,_
byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
enum
PM_COLORSET = WM_APP + 1
PM_COLORRESET
end enum
dim as WNDCLASS wndcls
with wndcls
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = ProcPtr(WndProc)
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = GetModuleHandle(NULL)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hIcon = LoadIcon(NULL, IDI_APPLICATION)
.hbrBackground = GetStockObject(LTGRAY_BRUSH)
.lpszClassName = StrPtr(ProgrammName)
.lpszMenuName = NULL
end with
RegisterClass @wndcls
with wndcls
.style = CS_HREDRAW or CS_VREDRAW or CS_NOCLOSE
.lpfnWndProc = ProcPtr(SubProc)
.cbClsExtra = 0
.cbWndExtra = sizeof(integer)
.lpszClassName = StrPtr(FensterName)
end with
RegisterClass @wndcls
dim as HWND hWnd = CreateWindow(_
ProgrammName, "Kapitel 4.4", WS_OVERLAPPEDWINDOW,_
CW_USEDEFAULT, CW_USEDEFAULT, 200, 350,_
NULL, NULL, GetModuleHandle(NULL), NULL)
ShowWindow hWnd, SW_NORMAL
UpdateWindow hWnd
dim as MSG msg
do while getmessage(@msg, NULL, 0, 0) <> 0
DispatchMessage @msg
loop
end msg.wParam
function WndProc(byval hWnd as HWND, byval message as UINTEGER,_
byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
static as HWND hwndA, hwndB, hwndC
select case message
case WM_DESTROY
PostQuitMessage 0
return 0
case WM_CREATE
hwndA = CreateWindow(FensterName,_
"FensterA", WS_VISIBLE or WS_CHILD or WS_DLGFRAME,_
5, 5, 90, 90,_
hWnd, NULL, cast(LPCREATESTRUCT,lParam)->hInstance, NULL)
hwndB = CreateWindow(FensterName,_
"FensterB", WS_VISIBLE or WS_CHILD or WS_DLGFRAME,_
5, 105, 90, 90,_
hWnd, NULL, cast(LPCREATESTRUCT,lParam)->hInstance, NULL)
hwndC = CreateWindow(FensterName,_
"FensterC", WS_VISIBLE or WS_CHILD or WS_DLGFRAME,_
5, 205, 90, 90,_
hWnd, NULL, cast(LPCREATESTRUCT,lParam)->hInstance, NULL)
return 0
case WM_PAINT
dim as PAINTSTRUCT pnt
dim as HDC hDC = BeginPaint(hWnd, @pnt)
dim as HBRUSH hbrushR = CreateSolidBrush(RGBA(0,0,255,0))
dim as HBRUSH hbrushG = CreateSolidBrush(RGBA(0,255,0,0))
dim as HBRUSH hbrushB = CreateSolidBrush(RGBA(255,0,0,0))
dim as HBRUSH hbrushW = CreateSolidBrush(RGBA(255,255,255,0))
SelectObject hDC, hbrushR
Rectangle hDC, 120, 10, 140, 30
Rectangle hDC, 120, 110, 140, 130
Rectangle hDC, 120, 210, 140, 230
SelectObject hDC, hbrushG
Rectangle hDC, 120, 40, 140, 60
Rectangle hDC, 120, 140, 140, 160
Rectangle hDC, 120, 240, 140, 260
SelectObject hDC, hbrushB
Rectangle hDC, 120, 70, 140, 90
Rectangle hDC, 120, 170, 140, 190
Rectangle hDC, 120, 270, 140, 290
SelectObject hDC, hbrushW
Rectangle hDC, 150, 10, 170, 90
Rectangle hDC, 150, 110, 170, 190
Rectangle hDC, 150, 210, 170, 290
DeleteObject hbrushW
DeleteObject hbrushR
DeleteObject hbrushG
DeleteObject hbrushB
EndPaint(hWnd, @pnt)
return 0
case WM_LBUTTONDOWN
dim as integer x = LOWORD(lParam), y = HIWORD(lParam)
if (x > 120) and (x < 140) then
if (y > 10) and (y < 30) then
SendMessage hwndA, PM_COLORSET, &H0000ff, 0
elseif (y > 40) and (y < 60) then
SendMessage hwndA, PM_COLORSET, &H00ff00, 0
elseif (y > 70) and (y < 90) then
SendMessage hwndA, PM_COLORSET, &Hff0000, 0
end if
if (y > 110) and (y < 130) then
SendMessage hwndB, PM_COLORSET, &H0000ff, 0
elseif (y > 140) and (y < 160) then
SendMessage hwndB, PM_COLORSET, &H00ff00, 0
elseif (y > 170) and (y < 190) then
SendMessage hwndB, PM_COLORSET, &Hff0000, 0
end if
if (y > 210) and (y < 230) then
SendMessage hwndC, PM_COLORSET, &H0000ff, 0
elseif (y > 240) and (y < 260) then
SendMessage hwndC, PM_COLORSET, &H00ff00, 0
elseif (y > 270) and (y < 290) then
SendMessage hwndC, PM_COLORSET, &Hff0000, 0
end if
end if
if (x > 150) and (x < 170) then
if (y> 10)and(y< 90) then SendMessage hwndA, PM_COLORRESET, 0, 0
if (y>110)and(y<190) then SendMessage hwndB, PM_COLORRESET, 0, 0
if (y>210)and(y<290) then SendMessage hwndC, PM_COLORRESET, 0, 0
end if
return 0
end select
return DefWindowProc( hWnd, message, wParam, lParam )
end function
function SubProc(byval hWnd as HWND, byval message as UINTEGER,_
byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
select case message
case PM_COLORRESET
SetWindowLong hWnd, 0, 0
InvalidateRect hWnd, NULL, TRUE
return 0
case PM_COLORSET
SetWindowLong hWnd, 0, GetWindowLong(hWnd, 0) xor wParam
InvalidateRect hWnd, NULL, TRUE
return 0
case WM_PAINT
dim as PAINTSTRUCT pnt
dim as HDC hDC = BeginPaint(hWnd, @pnt)
dim as HBRUSH hBrush = CreateSolidBrush(GetWindowLong(hWnd, 0))
SelectObject hDC, hBrush
Rectangle hDC, 0, 0, 90, 90
DeleteObject hBrush
EndPaint(hWnd, @pnt)
return 0
end select
return DefWindowProc( hWnd, message, wParam, lParam )
end function(Die großen Felder verändern durch Klicken der kleinen ihre Farbe)
Links:
In der MSDN: ,
In der FreeBasic-Referenz: 
END, WITH, WHILE
Gehe zu Seite | Zusätzliche Informationen und Funktionen | |||||||
|---|---|---|---|---|---|---|---|
|
|||||||
Bearbeiten
Versionen