Code: Select all
' ******************************
' * *
' * 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