Free Basic: Hello World with gradient (CWindow)

[José Roca]

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.

Code Select Expand


' ########################################################################################
' 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
' ========================================================================================