Notice that the instrinsic RGB function does not what we are used to see. The graddient procedure didn't work until I changed it to BGR. The Free Basic documentation warns that the C macro RGB has been renamed as BGR to avoid conflicts with the Free Basic RGB intrinsic function... But they should have chosen a less missleading name, don't you think? It does the opposite of what his name suggests.
' ########################################################################################
' Microsoft Windows
' File: CW_HelloWordGradient_HDPI.pbtpl
' Contents: CWindow Hello Word with gradient example (High DPI)
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2015 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define unicode
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx.CWindowClass
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(""), NULL, COMMAND(), SW_NORMAL)
' ========================================================================================
' Gradient fill procedure
' ========================================================================================
SUB DrawGradient (BYVAL hDC AS HDC)
DIM rcFill AS RECT
DIM rcClient AS RECT
DIM fStep AS SINGLE
DIM hBrush AS HBRUSH
DIM lOnBand AS LONG
GetClientRect WindowFromDC(hDC), @rcClient
fStep = rcClient.Bottom / 200
FOR lOnBand = 0 TO 199
SetRect @rcFill, 0, lOnBand * fStep, rcClient.Right + 1, (lOnBand + 1) * fStep
' // Note: The C macro RGB has been renamed as BGR to avoid conflicts with the Free Basic RGB intrinsic function
hBrush = CreateSolidBrush(BGR(0, 0, (255 - lOnBand)))
FillRect hDC, @rcFill, hBrush
DeleteObject hBrush
NEXT
END SUB
' ========================================================================================
' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hDC AS HDC
DIM pPaint AS PAINTSTRUCT
DIM rc AS RECT
DIM pWindow AS CWindow PTR
FUNCTION = 0
SELECT CASE AS CONST uMsg
CASE WM_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_PAINT
' // Draw the text
hDC = BeginPaint(hwnd, @pPaint)
GetClientRect hwnd, @rc
SetBkMode hDC, TRANSPARENT
SetTextColor hDC, &HFFFFFF
DrawTextW hDC, "Hello, World!", -1, @rc, DT_SINGLELINE OR DT_CENTER OR DT_VCENTER
EndPaint hwnd, @pPaint
FUNCTION = TRUE
EXIT FUNCTION
CASE WM_ERASEBKGND
' // Draw the gradient
hDC = CAST(HDC, wParam)
DrawGradient hDC
FUNCTION = TRUE
EXIT FUNCTION
CASE WM_SIZE
IF wParam <> SIZE_MINIMIZED THEN
' // Resize the buttons
pWindow = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
pWindow->MoveWindow GetDlgItem(hwnd, IDOK), pWindow->ClientWidth - 185, pWindow->ClientHeight - 35, 75, 23, TRUE
pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, TRUE
END IF
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
DIM pWindow AS CWindow
pWindow.Create(NULL, "CWindow Hello World with gradient", @WndProc)
pWindow.Brush = GetStockObject(WHITE_BRUSH)
pWindow.SetClientSize(500, 320)
pWindow.Center
' // Add two buttons without position or size (they will be resized in the WM_SIZE message).
pWindow.AddControl("Button", pWindow.hWindow, IDOK, "&Ok")
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Quit")
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================