Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Tutorial

Lutz Ifers WinAPI Tutorial

von RedakteurMODSeite 14 von 16

Kapitel 4.4: Messages
Kap4.4

''' 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: BefehlsreferenzeintragEND, BefehlsreferenzeintragWITH, BefehlsreferenzeintragWHILE

 

Gehe zu Seite Gehe zu Seite  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  
Zusätzliche Informationen und Funktionen
  • Das Tutorial wurde am 17.09.2009 von RedakteurMOD angelegt.
  • Die aktuellste Version wurde am 17.07.2013 von AdministratorSebastian gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen