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 13 von 16

Kapitel 4.3: Speicher reservieren
Kap4.3

''' 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: 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