FreeBasic

Простой пример создания кнопки, у которой заменен цвет фона и текста.

Платформа: Windows
Автор: Станислав Будинов

#INCLUDE "windows.bi"
Dim msg As MSG
Dim As WNDCLASSEX wc
Dim As String NameClass="MyClass"
Dim Shared Textbutton As String*20
Dim Shared As HINSTANCE Hinst:Hinst=GetModuleHandle(0)
Dim Shared As rect rect
Dim Shared As HBRUSH brush

Function wndproc(hwnd As HWND, msg As Uinteger,_
    wparam As WPARAM, lparam As LPARAM) As Integer
    Static but As HWND
    Select Case msg
        Case WM_CREATE
            but=CreateWindowEx(0,"Button","My Button",_
            WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW,10,10,80,30,hwnd,Cast(HMENU,1),Hinst,0)
        Case WM_DRAWITEM
            Dim DIS As DRAWITEMSTRUCT Ptr = Cast(DRAWITEMSTRUCT Ptr,lparam)
            Var lenstring=GetWindowText(but,@Textbutton,20)
            If DIS->CtlType = ODT_BUTTON Then
                DrawFrameControl(DIS->hdc,@DIS->rcItem,DFC_BUTTON,DFCS_BUTTONPUSH)
                Brush = CreateSolidBrush(&hffff)
                SetTextColor(DIS->hdc,&hff0ff0)
            Endif
            If  DIS->itemState And ODS_SELECTED Then
                DrawFrameControl(DIS->hdc,@DIS->rcItem,DFC_BUTTON,DFCS_BUTTONPUSH Or DFCS_PUSHED)
                Brush = CreateSolidBrush(&h000000)
                SetTextColor(DIS->hdc,&hffff)
            Endif
            SetRect(@rect,DIS->rcItem.left+2,DIS->rcItem.top+2,DIS->rcItem.right-2,DIS->rcItem.Bottom-2)
            FillRect(DIS->hdc,@Rect,Brush)
            SetBkMode(DIS->hdc,TRANSPARENT)
            DrawText(DIS->hdc,Textbutton,lenstring,@DIS->rcItem,DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
            DeleteObject(Brush)

        Case WM_DESTROY
            PostQuitMessage(0)
    End Select
    Return DefWindowProc(hwnd,msg,wparam,lparam)
End Function

With wc
    .cbSize=SizeOf(WNDCLASSEX)
    .style=CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc=@wndproc
    .hInstance=Hinst
    .hIcon=LoadIcon(0,IDI_QUESTION)
    .hCursor=LoadCursor(0,IDC_ARROW)
    .hbrBackground=Cast(HBRUSH,COLOR_WINDOW)
    .lpszClassName=StrPtr(NameClass)
    .hIconSm=.hIcon
End With

If RegisterClassEx(@wc)=0 Then
    Print "Register error, press any key"
    Sleep
    End
Endif

CreateWindowEx(0,NameClass,"Button Ownerdraw",_
WS_VISIBLE Or WS_OVERLAPPEDWINDOW,100,100,100,100,0,0,Hinst,0)

While GetMessage(@msg,0,0,0)
    TranslateMessage(@msg)
    DispatchMessage(@msg)
Wend