'  ******************************
'  *                            *
'  *  TEST WINDOWS API BUTTONS  *
'  *                            *
'  ******************************
'
#Include Once "WINDOWS.BI"

Declare Sub WinInit
Declare Function WinProc (ByVal Hwin As HWND, _
ByVal message As UINT, _
ByVal wParam As WPARAM, _
ByVal lParam As LPARAM) As LRESULT
Declare Sub ColorButton (ByRef PntDrawIS As DRAWITEMSTRUCT Ptr, _
ByVal ButColor As Integer, _
ByVal ButWidth As Integer, ByVal ButHeight As Integer)
Declare Function GradientFill Lib "msimg32" Alias "GradientFill"( _
ByVal hdc As HDC, _
ByVal pVertex As PTRIVERTEX, _
ByVal dwNumVertex As DWORD, _
ByVal pMesh As Const PVOID, _
ByVal dwNumMesh As DWORD, _
ByVal dwMode As DWORD) As BOOL

#DEFINE GRADIENT_FILL_RECT_H  0
#DEFINE CodeRed 1
#DEFINE CodeGreen 2
#DEFINE CodeBlue 3
#DEFINE CodeYellow 4
#DEFINE CodePurple 5
Enum
IdButRed = 101
IdButGreen
IdButBlue
IdButYellow
IdButPurple
End Enum

Dim Shared As HINSTANCE ProgInst
Dim Shared As HWND Hwin
Dim Shared As HWND HwinRed, HwinGreen, HwinBlue
Dim Shared As HWND HwinYellow, HwinPurple
Dim As MSG WinMessage

'*** Start

WinInit   '*** Initialize windows session

'*** Process windows messages

Do While GetMessage(@WinMessage, Null, 0, 0)
  TranslateMessage @WinMessage
  DispatchMessage @WinMessage
Loop

'*** End

End
'
'  ********************************
'  *  INITIALIZE WINDOWS SESSION  *
'  ********************************
'
Sub WinInit

  Dim As WNDCLASS WinClass
  Dim As String AppName

  '*** Setup window class

  ProgInst = GetModuleHandle(Null)
  AppName = "Colored Buttons"

  With WinClass
   .style         = CS_HREDRAW Or CS_VREDRAW
   .lpfnWndProc   = @WinProc
   .cbClsExtra    = 0
   .cbWndExtra    = 0
   .hInstance     = ProgInst
   .hIcon         = LoadIcon(Null, IDI_APPLICATION)
   .hCursor       = LoadCursor(Null, IDC_ARROW)
   '      .hbrBackground = GetStockObject(LTGRAY_BRUSH)
   '      .hbrBackground = GetSysColorBrush(COLOR_3DFACE)
   .hbrBackground = Cast(HBRUSH, COLOR_BACKGROUND)
   .lpszMenuName  = Null
   .lpszClassName = StrPtr(AppName)
  End With

  '*** Register the window class

  If RegisterClass(@WinClass) = False Then
   MessageBox(Null, "Failed to register the window class", AppName, _
   MB_ICONERROR)
   End
  End If

  '*** Create the window and show it

  Hwin = CreateWindowEx(0, AppName, AppName, WS_OVERLAPPEDWINDOW, _
  CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _
  Null, Null, ProgInst, Null)   '*** Create window (windows)
  ShowWindow Hwin, SW_NORMAL  '*** Show window (windows)
  UpdateWindow Hwin           '*** Update (client area) window (windows)

End Sub
'
'  ******************************
'  *  PROCESS WINDOWS MESSAGES  *
'  *  (called by Windows)       *
'  ******************************
'
Function WinProc(ByVal Hwin As HWND, _
  ByVal Message As UINT, _
  ByVal wParam As WPARAM, _
  ByVal lParam As LPARAM) As LRESULT

  Dim As DRAWITEMSTRUCT Ptr PntDrawIS

  Function = 0

  '*** Process windows messages

  Select Case Message
   Case WM_CREATE   '*** Create menus
    HwinRed = CreateWindowEx(0, "BUTTON", "RED", _
    WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 10, 100, 50, Hwin, _
    Cast(HMENU, IdButRed), ProgInst, NULL)
    HwinBlue = CreateWindowEx(0, "BUTTON", "BLUE", _
    WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 70, 100, 50, Hwin, _
    Cast(HMENU, IdButBlue), ProgInst, NULL)
    HwinGreen = CreateWindowEx(0, "BUTTON", "GREEN", _
    WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 130, 100, 50, Hwin, _
    Cast(HMENU, IdButGreen), ProgInst, NULL)
    HwinYellow = CreateWindowEx(WS_EX_CLIENTEDGE, "BUTTON", "YELLOW", _
    WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 190, 100, 50, Hwin, _
    Cast(HMENU, IdButYellow), ProgInst, NULL)
    HwinPurple = CreateWindowEx(WS_EX_CLIENTEDGE, "BUTTON", "PURPLE", _
    WS_VISIBLE Or WS_CHILD Or BS_OWNERDRAW, 10, 250, 100, 50, Hwin, _
    Cast(HMENU, IdButPurple), ProgInst, NULL)

   Case WM_COMMAND   '*** User selected a command

    '*** Process commands

    Select Case LoWord(wParam)
     Case IdButRed
      MessageBox(Hwin, "Red Button Pressed", "Red", MB_OK)
     Case IdButGreen
      MessageBox(Hwin, "Green Button Pressed", "Green", MB_OK)
     Case IdButBlue
      MessageBox(Hwin, "Blue Button Pressed", "Blue", MB_OK)
     Case IdButYellow
      MessageBox(Hwin, "Yellow Button Pressed", "Yellow", MB_OK)
     Case IdButPurple
      MessageBox(Hwin, "Purple Button Pressed", "Purple", MB_OK)
    End Select

   Case WM_DRAWITEM

    '*** Owner-drawn button

    PntDrawIS = Cast(DRAWITEMSTRUCT Ptr, lParam)
    Select Case PntDrawIS->CtlID
     Case IdButRed
      ColorButton (PntDrawIS, CodeRed, 100, 50)   '*** Color button
     Case IdButGreen
      ColorButton (PntDrawIS, CodeGreen, 100, 50)  '*** Color button
     Case IdButBlue
      ColorButton (PntDrawIS, CodeBlue, 100, 50)  '*** Color button
     Case IdButYellow
      ColorButton (PntDrawIS, CodeYellow, 95, 45)  '*** Color button
     Case IdButPurple
      ColorButton (PntDrawIS, CodePurple, 100, 50)  '*** Color button
    End Select

   Case WM_KEYDOWN   '*** A (nonsystem) key is pressed
    If LoByte(wParam) = 27 Then
     PostMessage Hwin, WM_CLOSE, 0, 0
    End If

    '*** Window was closed

   Case WM_DESTROY
    PostQuitMessage(0)
    Exit Function

    '*** Give message back to windows

   Case Else
    Return DefWindowProc(Hwin, Message, wParam, lParam)
  End Select
  Return 0

End Function
'
'  ******************
'  *  COLOR BUTTON  *
'  ******************
'
Sub ColorButton (ByRef PntDrawIS As DRAWITEMSTRUCT Ptr, _
  ByVal ButColor As Integer, _
  ByVal ButWidth As Integer, ByVal ButHeight As Integer)

  Dim As HWND HwinBut
  Dim As TRIVERTEX Vertex(0 To 1)
  Dim As GRADIENT_RECT GraRect
  Dim As RECT RectPnt
  Dim As UInteger RGB0, RGB1
  Dim As ZString*30 ButBuffer

  HwinBut = PntDrawIS->hwndItem   '** Get handle of button
  Vertex(0).x = 0
  Vertex(0).y = 0
  Vertex(1).x = ButWidth
  Vertex(1).y = ButHeight

  If PntDrawIS->itemState And ODS_SELECTED Then

   '*** Set colors for button pressed

   Select Case Butcolor
    Case CodeRed
     RGB0 = &HFF0000
     RGB1 = &HCC0000
    Case CodeGreen
     RGB0 = &H00FF00
     RGB1 = &H00CC00
    Case CodeBlue
     '         RGB0 = &H0000FF
     RGB0 = &H87CEEB
     RGB1 = &H0000CC
    Case CodeYellow
     RGB0 = &HFFFF00
     RGB1 = &HFFDF00
    Case Else
     RGB0 = &HE3BBFF
     RGB1 = &HC8A2C8
   End Select

  Else

   '*** Set colors for button (not pressed)

   Select Case Butcolor
    Case CodeRed
     RGB0 = &H990000
     RGB1 = &HDD0000
    Case CodeGreen
     RGB0 = &H009900
     RGB1 = &H00DD00
    Case CodeBlue
     RGB0 = &H000099
     RGB1 = &H0000DD
    Case CodeYellow
     RGB0 = &HFFBF00
     RGB1 = &HFFDB58
    Case Else
     RGB0 = &HB57ECF
     RGB1 = &H800080
   End Select
  End If

  '*** Show colors and text

  Vertex(0).Red   = (RGB0 Shr 8) And &H00FF00
  Vertex(0).Green =  RGB0 And &H00FF00
  Vertex(0).Blue  = (RGB0 Shl 8) And &H00FF00
  Vertex(1).Red   = (RGB1 Shr 8) And &H00FF00
  Vertex(1).Green =  RGB1 And &H00FF00
  Vertex(1).Blue  = (RGB1 Shl 8) And &H00FF00

  GraRect.UpperLeft = 0
  GraRect.LowerRight = 1
  GradientFill(PntDrawIS->hDC, @Vertex(0), 2, @GraRect, 1, _
  GRADIENT_FILL_RECT_H)          '*** Fill rectangle (windows)
  GetClientRect(HwinBut, @RectPnt) '*** Get client coordinates (windows)
  SetBkMode(PntDrawIS->hDC, TRANSPARENT)
  '*** Set background mode (windows)
  GetWindowText(HwinBut, ButBuffer, 30)
  '*** Get text of a control (windows)
  DrawText(PntDrawIS->hDC, ButBuffer, -1, @RectPnt, DT_CENTER Or _
  DT_VCENTER Or DT_SINGLELINE)  '*** Draw text in rectangle (windows)

End Sub