CWindow RC05

[Paul Squires]

Ah yes, probably because in the first case it is treated as a type/class initializer (constructor) whereas in the second case it is just a simple assignment.

[Paul Squires]

Is RC5 good enough now to create a full application with? Tomorrow I was going to try to create a new application somewhat similar to this one:  http://www.codeproject.com/Articles/4948/Message-Cracker-Wizard-for-Win-SDK-Developers

I was going to use that application to see if I encounter any issues with RC5.

[José Roca]

Yes, it is.

Anyway, the attached file contains the latest version. I only have removed a couple of auxiliary functions to add toolbar buttons because now that I have discovered that declaring the procedure PRIVATE unused procedures are not included in the code. Therefore, I'm going to adapt my PowerBASIC wrappers to FB.

[Paul Squires]

Jose, have you tried creating an accelerator table yet? I tried but it looks like there may be a problem.

Code Select Expand


   '  Create the accelerator table for the menu
   pWindow->AddAccelerator( FNOINVERT Or FVIRTKEY Or FALT,     VK_F4, IDM_EXIT )
   pWindow->AddAccelerator( FNOINVERT Or FVIRTKEY Or FCONTROL, VK_M,  IDM_COPYMACRO )
   pWindow->AddAccelerator( FNOINVERT Or FVIRTKEY Or FCONTROL, VK_F,  IDM_COPYFUNCTION )
   pWindow->AddAccelerator( FNOINVERT Or FVIRTKEY Or FCONTROL, VK_L,  IDM_MSGFILTERS )
   pWindow->CreateAcceleratorTable()


I think that it might have to do with ReDim'ing of the m_rgAccelEntries() type array. The ubound does not increase between calls to AddAccelerator.

I am investigating the code now.

[Paul Squires]

Looks you made a typo in your Type definition for the m_rgAccelEntries array in the CWindow definition (CWindow.inc)

You used HACCEL and it should be ACCEL

      Dim m_rgAccelEntries(Any) As ACCEL

[José Roca]

You're right. The only features that I haven't yet tested are accelerator keys and the BITMAP/ICON LABEL, BITMAP/ICON BUTTON.

[José Roca]

Now that I know that unused private procedures aren't included in the code, I'm going to begin to write useful wrappers. For Common Controls, since there are already a lot of defines in Windowsx.bi and commctrl.bi, I will only write the ones that require lenghty code instead of a call to SendMessage.

I have begin with the ones related with DPI:

Code Select Expand


' ########################################################################################
'                              *** DPI RELATED PROCEDURES ***
' ########################################################################################

' ========================================================================================
' Sets the current process as dots per inch (dpi) aware.
' Note: SetProcessDPIAware is subject to a possible race condition if a DLL caches dpi
' settings during initialization. For this reason, it is recommended that dpi-aware be set
' through the application (.exe) manifest rather than by calling SetProcessDPIAware.
' Return value: TRUE on success; FALSE on failure.
' ========================================================================================
PRIVATE FUNCTION AfxSetProcessDPIAware () AS BOOLEAN
   DIM AS ANY PTR pLib = DyLibLoad("user32.dll")
   IF pLib = 0 THEN EXIT FUNCTION
   DIM pProc AS FUNCTION () AS LONG
   pProc = DyLibSymbol(pLib, "SetProcessDPIAware")
   IF pProc = 0 THEN EXIT FUNCTION
   FUNCTION = pProc()
   DyLibFree(pLib)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Determines whether the current process is dots per inch (dpi) aware such that it adjusts
' the sizes of UI elements to compensate for the dpi setting.
' Return value: TRUE or FALSE
' ========================================================================================
PRIVATE FUNCTION AfxIsProcessDPIAware () AS BOOLEAN
   DIM AS ANY PTR pLib = DyLibLoad("user32.dll")
   IF pLib = 0 THEN EXIT FUNCTION
   DIM pProc AS FUNCTION () AS LONG
   pProc = DyLibSymbol(pLib, "IsProcessDPIAware")
   IF pProc = 0 THEN EXIT FUNCTION
   FUNCTION = pProc()
   DyLibFree(pLib)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the value of the UseDpiScaling setting (Vista/Windows 7+).
' Returns TRUE if the OS uses DPI scaling; FALSE otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxUseDpiScaling () AS BOOLEAN
   DIM hkRes AS HKEY, dwType AS DWORD, dwData AS DWORD, cbData AS DWORD
   IF RegOpenKeyExW(HKEY_CURRENT_USER, "Software\Microsoft\Windows\DWM", 0, KEY_QUERY_VALUE, @hkRes) = ERROR_SUCCESS THEN
      IF hkRes THEN
         cbData = SIZEOF(cbData)
         DIM hr AS LONG = RegQueryValueExW(hkRes, "UseDpiScaling", 0, @dwType, CPTR(BYTE PTR, @dwData), @cbData)
         RegCloseKey hkRes
         IF hr = ERROR_SUCCESS THEN FUNCTION = (dwData <> 0)
      END IF
   END IF
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the number of pixels per logical inch along the screen width of the desktop
' window. In a system with multiple display monitors, this value is the same for all monitors.
' ========================================================================================
PRIVATE FUNCTION AfxLogPixelsX () AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM dpiX AS LONG = GetDeviceCaps(hDC, LOGPIXELSX)
   ReleaseDC HWND_DESKTOP, hDC
   FUNCTION = dpiX
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the number of pixels per logical inch along the screen height of the desktop
' window. In a system with multiple display monitors, this value is the same for all monitors.
' ========================================================================================
PRIVATE FUNCTION AfxLogPixelsY () AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM dpiY AS LONG = GetDeviceCaps(hDC, LOGPIXELSY)
   ReleaseDC HWND_DESKTOP, hDC
   FUNCTION = dpiY
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the desktop horizontal scaling ratio.
' ========================================================================================
PRIVATE FUNCTION AfxScaleRatioX () AS SINGLE
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM rxRatio AS SINGLE = (GetDeviceCaps(hDC, LOGPIXELSX) / 96)
   ReleaseDC HWND_DESKTOP, hDC
   FUNCTION = rxRatio
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves the desktop vertical scaling ratio.
' ========================================================================================
PRIVATE FUNCTION AfxScaleRatioY () AS SINGLE
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM ryRatio AS SINGLE = (GetDeviceCaps(hDC, LOGPIXELSY) / 96)
   ReleaseDC HWND_DESKTOP, hDC
   FUNCTION = ryRatio
END FUNCTION
' ========================================================================================

' ========================================================================================
' Scales an horizontal coordinate according the DPI (dots per pixel) being used by the desktop.
' ========================================================================================
PRIVATE FUNCTION AfxScaleX (BYVAL cx AS SINGLE) AS SINGLE
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   FUNCTION = cx * (GetDeviceCaps(hDC, LOGPIXELSX) / 96)
   ReleaseDC HWND_DESKTOP, hDC
END FUNCTION
' ========================================================================================

' ========================================================================================
' Scales a vertical coordinate according the DPI (dots per pixel) being used by the desktop.
' ========================================================================================
PRIVATE FUNCTION AfxScaleY (BYVAL cy AS SINGLE) AS SINGLE
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   FUNCTION = cy * (GetDeviceCaps(hDC, LOGPIXELSY) / 96)
   ReleaseDC HWND_DESKTOP, hDC
END FUNCTION
' ========================================================================================

' ========================================================================================
' Unscales an horizontal coordinate according the DPI (dots per pixel) being used by the desktop.
' ========================================================================================
PRIVATE FUNCTION AfxUnscaleX (BYVAL cx AS SINGLE) AS SINGLE
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   FUNCTION = cx / (GetDeviceCaps(hDC, LOGPIXELSX) / 96)
   ReleaseDC HWND_DESKTOP, hDC
END FUNCTION
' ========================================================================================

' ========================================================================================
' Unscales a vertical coordinate according the DPI (dots per pixel) being used by the desktop.
' ========================================================================================
PRIVATE FUNCTION AfxUnscaleY (BYVAL cy AS SINGLE) AS SINGLE
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   FUNCTION = cy / (GetDeviceCaps(hDC, LOGPIXELSY) / 96)
   ReleaseDC HWND_DESKTOP, hDC
END FUNCTION
' ========================================================================================

' ========================================================================================
' Determines if screen resolution meets minimum requirements.
' Parameters:
' - cxMin = Minimum screen resolution width in pixels.
' - cxMin = Minimum screen resolution height in pixels.
' Return value: TRUE or FALSE.
' ========================================================================================
PRIVATE FUNCTION AfxIsResolutionAtLeast (BYVAL cxMin AS LONG, BYVAL cyMin AS LONG) AS BOOLEAN
   DIM ScreenWidth AS LONG = GetSystemMetrics(SM_CXSCREEN)
   DIM ScreenHeight AS LONG = GetSystemMetrics(SM_CYSCREEN)
   IF (cxMin <= ScreenWidth) AND (cyMin <= ScreenHeight) THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================

' ========================================================================================
' Determines if screen resolution meets minimum requirements in relative pixels,
' e.g. for a screen resolution of 1920x1080 pixels and a DPI of 192 (scaling ratio = 2),
' the maximum relative pixels for a DPI aware application is 960x540.
' - cxMin = Minimum screen resolution width in relative pixels.
' - cxMin = Minimum screen resolution height in relative pixels.
' Return value: TRUE or FALSE.
' ========================================================================================
PRIVATE FUNCTION AfxIsDPIResolutionAtLeast (BYVAL cxMin AS LONG, BYVAL cyMin AS LONG) AS BOOLEAN
   ' // Get de DPI values used by the desktop window
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM dpiX AS LONG = GetDeviceCaps(hDC, LOGPIXELSX)
   DIM dpiY AS LONG = GetDeviceCaps(hDC, LOGPIXELSY)
   ReleaseDC HWND_DESKTOP, hDC
   ' // Scale the values
   cxMin = cxMin * dpiX / 96
   cyMin = cyMin * dpiX / 96
   ' // Calculate the width and height of the primary display monitor, in pixels
   DIM ScreenWidth AS LONG = GetSystemMetrics(SM_CXSCREEN)
   DIM ScreenHeight AS LONG = GetSystemMetrics(SM_CYSCREEN)
   IF (cxMin <= ScreenWidth) AND (cyMin <= ScreenHeight) THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================


[José Roca]

For GDI+, I will add functions that deal with bitmaps and a function that loads textures suitable to be used with OPENGL.

For the ones that need COM, i first have to translate some headers.

We could do it faster it we had betatesters.

[José Roca]

Metric conversions.

Code Select Expand


' ########################################################################################
'                                *** METRIC CONVERSIONS ***
' ########################################################################################

' ========================================================================================
' Converts from HiMetric to Pixels
' Note: HiMetric is a scaling unit similar to twips used in computing. It is one
' thousandth of a centimeter and is independent of the screen resolution.
' HiMetric per inch = 2540   ' 1 inch = 2.54 mm
' ========================================================================================
' Horizontal resolution
PRIVATE FUNCTION AfxHiMetricToPixelsX (BYVAL hm AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM nPixelsPerLogicalInchX AS LONG = GetDeviceCaps(hDC, LOGPIXELSX)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = MulDiv(hm, nPixelsPerLogicalInchX, 2540)
END FUNCTION
' ========================================================================================
' Vertical resolution
PRIVATE FUNCTION AfxHiMetricToPixelsY (BYVAL hm AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM nPixelsPerLogicalInchY AS LONG = GetDeviceCaps(hDC, LOGPIXELSY)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = MulDiv(hm, nPixelsPerLogicalInchY, 2540)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Converts from Pixels to HiMetric
' Note: HiMetric is a scaling unit similar to twips used in computing. It is one
' thousandth of a centimeter and is independent of the screen resolution.
' HiMetric per inch = 2540   ' 1 inch = 2.54 mm
' ========================================================================================
' Horizontal resolution
PRIVATE FUNCTION AfxPixelsToHiMetricX (BYVAL cx AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM nPixelsPerLogicalInchX AS LONG = GetDeviceCaps(hDC, LOGPIXELSX)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = MulDiv(cx, 2540, nPixelsPerLogicalInchX)
END FUNCTION
' ========================================================================================
' Vertical resolution
PRIVATE FUNCTION AfxPixelsToHiMetricY (BYVAL cy AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM nPixelsPerLogicalInchY AS LONG = GetDeviceCaps(hDC, LOGPIXELSY)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = MulDiv(cy, 2540, nPixelsPerLogicalInchY)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Converts pixels to point size (1/72 of an inch).
' ========================================================================================
' Horizontal resolution
PRIVATE FUNCTION AfxPixelsToPointsX (BYVAL pix AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPX AS LONG = GetDeviceCaps(hDC, LOGPIXELSX)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = pix * 72 / LPX
END FUNCTION
' ========================================================================================
' Vertical resolution
PRIVATE FUNCTION AfxPixelsToPointsY (BYVAL pix AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPY AS LONG = GetDeviceCaps(hDC, LOGPIXELSY)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = pix * 72 / LPY
END FUNCTION
' ========================================================================================

' ========================================================================================
' Converts a point size (1/72 of an inch) to pixels. Horizontal resolution.
' ========================================================================================
' Horizontal resolution
PRIVATE FUNCTION AfxPointsToPixelsX (BYVAL pts AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPX AS LONG = GetDeviceCaps(hDC, LOGPIXELSX)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = MulDiv(pts, LPX, 72)
END FUNCTION
' ========================================================================================
' Vertical resolution
PRIVATE FUNCTION AfxPointsToPixelsY (BYVAL pts AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPY AS LONG = GetDeviceCaps(hDC, LOGPIXELSY)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = MulDiv(pts, LPY, 72)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Converts pixels to twips.
' Twips are screen-independent units to ensure that the proportion of screen elements are
' the same on all display systems. A twip is defined as being 1/1440 of an inch.
' ========================================================================================
' Horizontal resolution
PRIVATE FUNCTION AfxPixelsToTwipsX (BYVAL nPixels AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPX AS LONG = GetDeviceCaps(hDC, LOGPIXELSX)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = (nPixels * 1440) / LPX
END FUNCTION
' ========================================================================================
' Vertical resolution.
PRIVATE FUNCTION AfxPixelsToTwipsY (BYVAL nPixels AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPY AS LONG = GetDeviceCaps(hDC, LOGPIXELSY)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = (nPixels * 1440) / LPY
END FUNCTION
' ========================================================================================

' ========================================================================================
' Converts twips to pixels.
' Twips are screen-independent units to ensure that the proportion of screen elements are
' the same on all display systems. A twip is defined as being 1/1440 of an inch.
' ========================================================================================
' Horizontal resolution
PRIVATE FUNCTION AfxTwipsToPixelsX (BYVAL nTwips AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPX AS LONG = GetDeviceCaps(hDC, LOGPIXELSX)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = (nTwips / 1440) * LPX
END FUNCTION
' ========================================================================================
' Vertical resolution
PRIVATE FUNCTION AfxTwipsToPixelsY (BYVAL nTwips AS LONG) AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPY AS LONG = GetDeviceCaps(hDC, LOGPIXELSY)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = (nTwips / 1440) * LPY
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns the width of a pixel, in twips.
' Pixel dimensions can vary between systems and may not always be square, so separate
' functions for pixel width and height are required.
' ========================================================================================
' Horizontal resolution
PRIVATE FUNCTION AfxTwipsPerPixelX () AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPX AS LONG = GetDeviceCaps(hDC, LOGPIXELSX)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = 1440 / LPX
END FUNCTION
' ========================================================================================
' Vertical resolution
PRIVATE FUNCTION AfxTwipsPerPixelY () AS LONG
   DIM hDC AS HDC = GetDC(HWND_DESKTOP)
   DIM LPY AS LONG = GetDeviceCaps(hDC, LOGPIXELSY)
   ReleaseDC(HWND_DESKTOP, hDC)
   FUNCTION = 1440 / LPY
END FUNCTION
' ========================================================================================


An additional one:

Code Select Expand


' ========================================================================================
' Converts point size to DIP (device independent pixel).
' DIP is defined as 1/96 of an inch and a point is 1/72 of an inch.
' ========================================================================================
FUNCTION AfxPointSizeToDip (BYVAL ptsize AS SINGLE) AS SINGLE
   FUNCTION = (ptsize / 72) * 96
END FUNCTION
' ========================================================================================


[Paul Squires]

We could do it faster it we had beta testers.

I totally agree. 

I am writing my first application with your code. Pretty straight forward so far. I can say that I totally HATE having to position controls via code  :-)   It reminds me of the days when I first bought PB and had to hand code DDT. Certainly makes me appreciate FireFly for the visual positioning of controls.

I will continue to report any issues that I encounter. The keyboard accelerators was the only one so far but it is all working now.

[José Roca]

Clipboard functions:

Code Select Expand


' ########################################################################################
'                                    *** CLIPBOARD ***
' ########################################################################################

' ========================================================================================
' Clears the contents of the clipboard.
' Return Value
'   If the function succeeds, the return value is nonzero.
'   If the function fails, the return value is zero.
' ========================================================================================
PRIVATE FUNCTION AfxClearClipboard () AS LONG
   ' // Opens the clipboard
   IF OpenClipboard(NULL) <> 0 THEN
      ' // Empties the clipboard
      FUNCTION = EmptyClipboard
      ' // Closes the clipboard
      CloseClipboard
   END IF
END FUNCTION
' ========================================================================================

' ========================================================================================
' Retrieves data from the clipboard in the specified format.
' Parameter
'   cfFormat = Clipboard format.
' Return Value
'   If the function succeeds, the return value is the handle to the data.
'   If the function fails, the return value is NULL.
' ========================================================================================
PRIVATE FUNCTION AfxGetClipboardData (BYVAL cfFormat AS DWORD) AS HGLOBAL
   DIM hSource AS HANDLE
   ' // Opens the clipboard
   IF OpenClipboard(NULL) <> 0 THEN
      ' // Retrieves data from the clipboard in the specified format
      hSource = GetClipboardData(cfFormat)
      ' // Closes the clipboard
      CloseClipboard
      ' // Exits on failure
      IF hSource = NULL THEN EXIT FUNCTION
   END IF
   ' // Gets the size of the specified global memory object, in bytes
   DIM dwSize AS SIZE_T_ = GlobalSize(hSource)
   ' // Exits on failure
   IF dwSize = 0 THEN EXIT FUNCTION
   ' // Gets a pointer to the source memory object
   DIM pSource AS LPVOID = GlobalLock(hSource)
   ' // Exits on failure
   IF pSource = NULL THEN EXIT FUNCTION
   ' // Allocates the specified number of bytes from the heap
   DIM hDest AS HGLOBAL = GlobalAlloc(GHND_, dwSize)
   ' // Exits on failure
   IF hDest = NULL THEN
      ' // Unlocks the source memory object
      GlobalUnlock hSource
      EXIT FUNCTION
   END IF
   ' // Gets a pointer to the destination memory object
   DIM pDest AS LPVOID = GlobalLock(hDest)
   ' // Exits on failure
   IF pDest = NULL THEN
      ' // Unlocks the source memory object
      GlobalUnlock hSource
      ' // Frees the allocated memory block
      GlobalFree hDest
      EXIT FUNCTION
   END IF
   ' // Copies the data from the source to the destination
   memcpy pDest, pSource, dwSize
   ' // Unlocks the source memory object
   GlobalUnlock hSource
   ' // Unlocks the destination memory object
   GlobalUnlock hDest
   ' // Returns the handle to the data
   FUNCTION = hDest
END FUNCTION
' ========================================================================================

' ========================================================================================
' Places a data object into the clipboard.
' Parameters
'   cfFormat = Clipboard format.
'   hData    = Handle to the data in the specified format.
' Return Value
'   If the function succeeds, the return value is the handle to the data.
'   If the function fails, the return value is NULL.
' Remarks
'   The application must not use the hData handle once it has called the AfxSetClipboardData function.
' ========================================================================================
PRIVATE FUNCTION AfxSetClipboardData (BYVAL cfFormat AS DWORD, BYVAL hData AS HANDLE) AS HANDLE
   ' // Opens the clipboard
   IF OpenClipboard(NULL) <> 0 THEN
      ' // Empties the clipboard
      EmptyClipboard
      ' // Places the data object in the clipboard
      FUNCTION = SetClipboardData(cfFormat, hData)
      ' // Closes the clipboard
      CloseClipboard
    END IF
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a text string from the clipboard.
' ========================================================================================
PRIVATE FUNCTION AfxGetClipboardTextA () AS STRING
   ' // If the text format is available...
   IF IsClipboardFormatAvailable(CF_TEXT) <> 0 THEN
      ' // Opens the clipboard
      IF OpenClipboard(NULL) <> 0 THEN
         ' // Gets memory object of clipboard text
         DIM hMem AS HANDLE = GetClipboardData(CF_TEXT)
         IF hMem <> NULL THEN
            ' // Locks it and get a pointer
            DIM pMem AS HGLOBAL = GlobalLock(hMem)
            ' // Assigns the data to our function return value
            IF pMem <> NULL THEN FUNCTION = *CAST(ZSTRING PTR, pMem)
            ' // Releases the memory object
            GlobalUnlock hMem
         END IF
         ' // Closes the clipboard
         CloseClipboard
      END IF
   END IF
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a unicode text string from the clipboard.
' Usage:
' DIM pwsz AS WSTRING PTR
' pwsz = AfxGetClipboardTextW
' MessageBoxW 0, *pwsz, "", MB_OK
' IF pwsz THEN Delete(pwsz)
' ========================================================================================
PRIVATE FUNCTION AfxGetClipboardTextW () AS WSTRING PTR
   ' // If the text format is available...
   IF IsClipboardFormatAvailable(CF_UNICODETEXT) <> 0 THEN
      ' // Opens the clipboard
      IF OpenClipboard(NULL) <> 0 THEN
         ' // Gets memory object of clipboard text
         DIM hMem AS HANDLE = GetClipboardData(CF_UNICODETEXT)
         IF hMem <> NULL THEN
            ' // Locks it and get a pointer
            DIM pMem AS HGLOBAL = GlobalLock(hMem)
            ' // Assigns the data to our function return value
            IF pMem <> NULL THEN
               ' // Gets the size of the global lock
               DIM dwSize AS DWORD = GlobalSize(hMem)
               IF dwSize > 0 THEN
                  ' // Allocates a buffer and copies the contents of the clipboard to it
                  DIM pBuffer AS WSTRING PTR = CAllocate(dwSize, 1)
                  memcpy(pBuffer, pMem, dwSize)
                  FUNCTION = pBuffer
               END IF
            END IF
            ' // Releases the memory object
            GlobalUnlock hMem
         END IF
         ' // Closes the clipboard
         CloseClipboard
      END IF
   END IF
END FUNCTION
' ========================================================================================

#ifdef UNICODE
   #define AfxGetClipboardText AfxGetClipboardTextW
#else
   #define AfxGetClipboardText AfxGetClipboardTextA
#endif

' ========================================================================================
' Places a text string into the clipboard.
' Parameter
'   strText = Text to place in the clipboard.
' Return Value
'   If the function succeeds, the return value is the handle to the data.
'   If the function fails, the return value is NULL.
' ========================================================================================
PRIVATE FUNCTION AfxSetClipboardTextA (BYVAL strText AS STRING) AS HANDLE
   ' // Opens the clipboard
   IF OpenClipboard(NULL) <> 0 THEN
      ' // Empties the clipboard
      EmptyClipboard
      ' // Allocates a global memory block
      DIM hMem AS HGLOBAL = GlobalAlloc(GMEM_MOVEABLE OR GMEM_DDESHARE, LEN(strText) + 1)
      IF hMem <> NULL THEN
         ' // Locks it and gets a pointer to the memory location
         DIM pMem AS LPVOID = GlobalLock(hMem)
         ' // Copies the text into the allocated memory block
         IF pMem <> NULL THEN *CAST(ZSTRING PTR, pMem) = strText & CHR(0)
         ' // Unlocks the memory block
         GlobalUnlock hMem
         ' // Places the text in the clipboard
         DIM hData AS HANDLE = SetClipboardData(CF_TEXT, hMem)
         IF hData <> NULL THEN
            ' // Returns the handle of the data
            FUNCTION = hData
         ELSE
            ' // Frees the memory block
            GlobalFree hMem
         END IF
      END IF
      ' // Closes the clipboard
      CloseClipboard
   END IF
END FUNCTION
' ========================================================================================

' ========================================================================================
' Places a unicode text string into the clipboard.
' Parameter
'   wszText = Text to place in the clipboard.
' Return Value
'   If the function succeeds, the return value is the handle to the data.
'   If the function fails, the return value is NULL.
' ========================================================================================
PRIVATE FUNCTION AfxSetClipboardTextW (BYREF wszText AS WSTRING) AS HANDLE
   ' // Opens the clipboard
   IF OpenClipboard(NULL) <> 0 THEN
      ' // Empties the clipboard
      EmptyClipboard
      ' // Allocates a global memory block
      DIM hMem AS HGLOBAL = GlobalAlloc(GMEM_MOVEABLE OR GMEM_DDESHARE, (LEN(wszText) + 1) * 2)
      IF hMem <> NULL THEN
         ' // Locks it and gets a pointer to the memory location
         DIM pMem AS LPVOID = GlobalLock(hMem)
         ' // Copies the text into the allocated memory block
         IF pMem <> NULL THEN *CAST(WSTRING PTR, pMem) = wszText & CHR(0, 0)
         ' // Unlocks the memory block
         GlobalUnlock hMem
         ' // Places the text in the clipboard
         DIM hData AS HANDLE = SetClipboardData(CF_UNICODETEXT, hMem)
         IF hData <> NULL THEN
            ' // Returns the handle of the data
            FUNCTION = hData
         ELSE
            ' // Frees the memory block
            GlobalFree hMem
         END IF
      END IF
      ' // Closes the clipboard
      CloseClipboard
   END IF
END FUNCTION
' ========================================================================================

#ifdef UNICODE
   #define AfxSetClipboardText AfxSetClipboardTextW
#else
   #define AfxSetClipboardText AfxSetClipboardTextA
#endif


[José Roca]

I am writing my first application with your code. Pretty straight forward so far. I can say that I totally HATE having to position controls via code  :-)   It reminds me of the days when I first bought PB and had to hand code DDT.

I did not use FireFly for PB because it was not unicode aware.

I also like to code by hand because I don't write many applications and mostly of my code is testing code. If I'm doing all this work it is because I like to investigate and experiment. It is more fun than playing cards with other retirees.

[José Roca]

I only have a monitor, so I can't test this one:

Code Select Expand


' ========================================================================================
' If you use dual (or even triple/quad) displays then you have undoubtedly encountered the
' following situation: You change the physical order of your displays, or otherwise
' reconfigure the logical ordering using your display software. This sometimes has the
' side-effect of changing your desktop coordinates from zero-based to negative starting
' coordinates (i.e. the top-left coordinate of your desktop changes from 0,0 to -1024,-768).
' This effects many Windows programs which restore their last on-screen position whenever
' they are started. Should the user reorder their display configuration this can sometimes
' result in a Windows program subsequently starting in an off-screen position (i.e. at a
' location that used to be visible) - and is now effectively invisible, preventing the
' user from closing it down or otherwise moving it back on-screen.
' The ForceVisibleDisplay function can be called at program start-time right after the
' main window has been created and positioned 'on-screen'. Should the window be positioned
' in an off-screen position, it is forced back onto the nearest display to its last
' position. The user will be unaware this is happening and won't even realise to thank you
' for keeping their user-interface visible, even though they changed their display
' settings.
' Source: http://www.catch22.net/tuts/tips2
' ========================================================================================
PRIVATE SUB AfxForceVisibleDisplay (BYVAL hwnd AS HWND)
   ' // Check if the specified window-recrangle is visible on any display
   DIM rc AS RECT
   GetWindowRect(hwnd, @rc)
   IF MonitorFromRect(@rc, MONITOR_DEFAULTTONULL) <> NULL THEN EXIT SUB
   ' // Find the nearest display to the rectangle
   DIM hMonitor AS HMONITOR
   DIM mi AS MONITORINFO
   mi.cbSize = SIZEOF(mi)
   hMonitor = MonitorFromRect(@rc, MONITOR_DEFAULTTONEAREST)
   GetMonitorInfoW(hMonitor, @mi)
   ' // Center window rectangle
   rc.left = mi.rcWork.left + ((mi.rcWork.right - mi.rcWork.left) - (rc.right-rc.left)) \ 2
   rc.top = mi.rcWork.top + ((mi.rcWork.bottom - mi.rcWork.top) - (rc.bottom-rc.top)) \ 2
   SetWindowPos(hwnd, 0, rc.left, rc.top, 0, 0, SWP_NOACTIVATE OR SWP_NOZORDER OR SWP_NOSIZE)
END SUB
' ========================================================================================


[José Roca]

This one has revealed a problem that I was having. If I use DIM hwndForeground AS HWND, the compiler gives an error, but if I use DIM hwndForeground AS .HWND, it compiles fine.

Therefore, in CWindow I have changed

Code Select Expand


#ifdef USEMDI
   ' // Note: I have needed to use HANDLE instead of HWND; otherwise, the compiler
   ' // gives error 14: Branch crossing local variable definition. Don't know why.
   STATIC hwndClient AS HANDLE    ' // Handle of the MDI client window
   DIM    hwndActive AS HANDLE    ' // Active window
   DIM    hMdi AS HANDLE         ' // MDI child window handle
   ' // MDI client window handle
   IF hwndClient = NULL AND pWindow <> NULL THEN hwndClient = pWindow->hwndClient
#endif


to

Code Select Expand


#ifdef USEMDI
   STATIC hwndClient AS .HWND    ' // Handle of the MDI client window
   DIM    hwndActive AS .HWND    ' // Active window
   DIM    hMdi AS HANDLE         ' // MDI child window handle
   ' // MDI client window handle
   IF hwndClient = NULL AND pWindow <> NULL THEN hwndClient = pWindow->hwndClient
#endif


Code Select Expand


' ========================================================================================
' Brings the thread that created the specified window into the foreground and activates
' the window. Keyboard input is directed to the window, and various visual cues are changed
' for the user. The system assigns a slightly higher priority to the thread that created
' the foreground window than it does to other threads.
' Replacement for the SetForegroundWindow API function, that sometimes fails.
' ========================================================================================
SUB AfxForceSetForegroundWindow (BYVAL hwnd AS HWND)
   DIM dwProcessId AS DWORD
   DIM hwndForeground AS .HWND = GetForegroundWindow
   DIM dwThreadId AS DWORD = GetWindowThreadProcessId(hwndForeground, @dwProcessId)
   DIM dwCurThreadId AS DWORD = GetCurrentThreadId
   AttachThreadInput(dwCurThreadId, dwThreadId, CTRUE)
   SetForegroundWindow(hwnd)
   BringWindowToTop(hwnd)
   SetFocus(hwnd)
   AttachThreadInput(dwCurThreadId, dwThreadId, FALSE)
END SUB
' ========================================================================================


[José Roca]

Menu wrapper functions.

Code Select Expand


' ########################################################################################
'                                      *** MENU ***
' ########################################################################################

' ========================================================================================
' Checks a menu item.
' - hMenu = A handle to the menu that contains the menu item.
' - uItem = The identifier or position of the menu item to get information about.
'           The meaning of this parameter depends on the value of fByPosition.
' - fByPosition = The meaning of uItem. If this parameter is FALSE, uItem is a menu item
'           identifier. Otherwise, it is a menu item position.
' Return Value: The return value specifies the previous state of the menu item (either
' MF_CHECKED or MF_UNCHECKED). If the menu item does not exist, the return value is -1.
' ========================================================================================
PRIVATE FUNCTION AfxCheckMenuItem (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS DWORD
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   dwFlags = dwFlags OR MF_CHECKED
   FUNCTION = CheckMenuItem(hMenu, uItem, dwFlags)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Unchecks a menu item.
' - hMenu = A handle to the menu that contains the menu item.
' - uItem = The identifier or position of the menu item to get information about.
'           The meaning of this parameter depends on the value of fByPosition.
' - fByPosition = The meaning of uItem. If this parameter is FALSE, uItem is a menu item
'           identifier. Otherwise, it is a menu item position.
' Return Value: The return value specifies the previous state of the menu item (either
' MF_CHECKED or MF_UNCHECKED). If the menu item does not exist, the return value is -1.
' ========================================================================================
PRIVATE FUNCTION AfxUnCheckMenuItem (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS DWORD
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   dwFlags = dwFlags OR MF_UNCHECKED
   FUNCTION = CheckMenuItem(hMenu, uItem, dwFlags)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Toggles the checked state of a menu item.
' ========================================================================================
PRIVATE FUNCTION ToggleMenuItem (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS DWORD
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   IF GetMenuState(hMenu, uItem, dwFlags) AND MF_CHECKED = MF_CHECKED THEN
      dwFlags = dwFlags OR MF_UNCHECKED
   ELSE
      dwFlags = dwFlags OR MF_CHECKED
   END IF
   FUNCTION = CheckMenuItem(hMenu, uItem, dwFlags)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns TRUE if the specified menu item is checked; FALSE otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxIsMenuItemChecked (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS BOOLEAN
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   IF GetMenuState(hMenu, uItem, dwFlags) AND MF_CHECKED = MF_CHECKED THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns TRUE if the specified menu item is enabled; FALSE otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxIsMenuItemEnabled (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS BOOLEAN
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   DIM dwRes AS DWORD = GetMenuState(hMenu, uItem, dwFlags)
   IF ((dwRes AND MF_DISABLED) <> MF_DISABLED) AND ((dwRes AND MF_GRAYED) <> MF_GRAYED) THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns TRUE if the specified menu item is disabled; FALSE otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxIsMenuItemDisabled (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS BOOLEAN
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   DIM dwRes AS DWORD = GetMenuState(hMenu, uItem, dwFlags)
   IF ((dwRes AND MF_DISABLED) = MF_DISABLED) THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns TRUE if the specified menu item is grayed; FALSE otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxIsMenuItemGrayed (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS BOOLEAN
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   DIM dwRes AS DWORD = GetMenuState(hMenu, uItem, dwFlags)
   IF ((dwRes AND MF_GRAYED) = MF_GRAYED) THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns TRUE if the specified menu item is highlighted; FALSE otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxIsMenuItemHighlighted (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS BOOLEAN
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   DIM dwRes AS DWORD = GetMenuState(hMenu, uItem, dwFlags)
   IF ((dwRes AND MF_HILITE) = MF_HILITE) THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns TRUE if the specified menu item is a separator; FALSE otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxIsMenuItemSeparator (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS BOOLEAN
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   DIM dwRes AS DWORD = GetMenuState(hMenu, uItem, dwFlags)
   IF ((dwRes AND MF_SEPARATOR) = MF_SEPARATOR) THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns TRUE if the specified menu item is a submenu; FALSE otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxIsMenuItemPopup (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS BOOLEAN
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   DIM dwRes AS DWORD = GetMenuState(hMenu, uItem, dwFlags)
   IF ((dwRes AND MF_POPUP) = MF_POPUP) THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns TRUE if the specified menu item is ownerdraw; FALSE otherwise.
' ========================================================================================
PRIVATE FUNCTION AfxIsMenuItemOwnerDraw (BYVAL hMenu AS HMENU, BYVAL uItem AS DWORD, BYVAL fByPosition AS LONG = FALSE) AS BOOLEAN
   DIM dwFlags AS DWORD
   IF fByPosition THEN dwFlags = MF_BYPOSITION ELSE dwFlags = MF_BYCOMMAND
   DIM dwRes AS DWORD = GetMenuState(hMenu, uItem, dwFlags)
   IF ((dwRes AND MF_OWNERDRAW) = MF_OWNERDRAW) THEN FUNCTION = TRUE
END FUNCTION
' ========================================================================================