Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Tutorial
Lutz Ifers WinAPI Tutorial
von  MOD | Seite 13 von 16 |
Kapitel 4.3: Speicher reservieren
''' Lutz Ifers WinAPI-Tutorial
''' Lizenz: WTFPL
'''
''' Kapitel 4.3 - "Speicher reservieren"
#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
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(WHITE_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 = 3 * sizeof(integer)
.lpszClassName = StrPtr(FensterName)
end with
RegisterClass @wndcls
dim as HWND hWnd = CreateWindow(_
ProgrammName, "Kapitel 4.3 - Speicher reservieren", 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 hFensterA, hFensterB, hFensterC
select case message
case WM_DESTROY
PostQuitMessage 0
return 0
case WM_CREATE
hFensterA = CreateWindow(FensterName,_
"FensterA", WS_VISIBLE or WS_CHILD or WS_BORDER,_
0, 0, 100, 100,_
hWnd, NULL, cast(LPCREATESTRUCT,lParam)->hInstance, NULL)
hFensterB = CreateWindow(FensterName,_
"FensterB", WS_VISIBLE or WS_CHILD or WS_BORDER,_
0, 100, 100, 100,_
hWnd, NULL, cast(LPCREATESTRUCT,lParam)->hInstance, NULL)
hFensterC = CreateWindow(FensterName,_
"FensterC", WS_VISIBLE or WS_CHILD or WS_BORDER,_
0, 200, 100, 100,_
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))
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
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
SetWindowLong hFensterA,_
0 * len(INTEGER),_
not GetWindowLong(hFensterA, 0 * len(INTEGER))
InvalidateRect hFensterA, NULL, TRUE
elseif (y > 40) and (y < 60) then
SetWindowLong hFensterA,_
1 * len(INTEGER),_
not GetWindowLong(hFensterA, 1 * len(INTEGER))
InvalidateRect hFensterA, NULL, TRUE
elseif (y > 70) and (y < 90) then
SetWindowLong hFensterA,_
2 * len(INTEGER),_
not GetWindowLong(hFensterA, 2 * len(INTEGER))
InvalidateRect hFensterA, NULL, TRUE
end if
if (y > 110) and (y < 130) then
SetWindowLong hFensterB,_
0 * len(INTEGER),_
not GetWindowLong(hFensterB, 0 * len(INTEGER))
InvalidateRect hFensterB, NULL, TRUE
elseif (y > 140) and (y < 160) then
SetWindowLong hFensterB,_
1 * len(INTEGER),_
not GetWindowLong(hFensterB, 1 * len(INTEGER))
InvalidateRect hFensterB, NULL, TRUE
elseif (y > 170) and (y < 190) then
SetWindowLong hFensterB,_
2 * len(INTEGER),_
not GetWindowLong(hFensterB, 2 * len(INTEGER))
InvalidateRect hFensterB, NULL, TRUE
end if
if (y > 210) and (y < 230) then
SetWindowLong hFensterC,_
0 * len(INTEGER),_
not GetWindowLong(hFensterC, 0 * len(INTEGER))
InvalidateRect hFensterC, NULL, TRUE
elseif (y > 240) and (y < 260) then
SetWindowLong hFensterC,_
1 * len(INTEGER),_
not GetWindowLong(hFensterC, 1 * len(INTEGER))
InvalidateRect hFensterC, NULL, TRUE
elseif (y > 270) and (y < 290) then
SetWindowLong hFensterC,_
2 * len(INTEGER),_
not GetWindowLong(hFensterC, 2 * len(INTEGER))
InvalidateRect hFensterC, NULL, TRUE
end if
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 WM_PAINT
dim as PAINTSTRUCT pnt
dim as HDC hDC = BeginPaint(hWnd, @pnt)
dim as INTEGER r, g, b
r = iif(GetWindowLong(hWnd, 0 * len(integer)), 255, 0)
g = iif(GetWindowLong(hWnd, 1 * len(integer)), 255, 0)
b = iif(GetWindowLong(hWnd, 2 * len(integer)), 255, 0)
dim as HBRUSH hBrush = CreateSolidBrush(RGBA(b,g,r,0))
SelectObject hDC, hBrush
Rectangle hDC, 10, 10, 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