Proposed changes and additions for version 1.04 of my headers

[José Roca]

- File CAfxProtableDevices changed to CAfxPortableDevices. It was a typo.

- CWindow_InputBox function (CWindow.inc file)

Added the optional parameter bPassword. If TRUE, the text will be replaced with the default password character.

[José Roca]

File: AfxWin.inc

Code Select Expand


' ========================================================================================
' Gets the token elevation type for the current process.
' Token elevation values describe the relative strength of a given token.
' A full token is a token with all groups and privileges to which the principal
' is authorized.  A limited token is one with some groups or privileges removed.
' Requires Windows Vista or superior.
' ========================================================================================
FUNCTION AfxGetTokenElevationType () AS LONG

   LOCAL hToken AS DWORD
   LOCAL elevationType AS LONG
   LOCAL dwSize AS DWORD

   IF OpenProcessToken(GetCurrentProcess, %TOKEN_QUERY, hToken) = 0 THEN EXIT FUNCTION
#IF %DEF(%USEPBDECL)
   GetTokenInformation(hToken, %TokenElevationType, BYVAL VARPTR(elevationType), 4, dwSize)
#ELSE
   GetTokenInformation(hToken, %TokenElevationType, elevationType, 4, dwSize)
#ENDIF
   CloseHandle(hToken)
   FUNCTION = elevationType

END FUNCTION
' ========================================================================================


[José Roca]

File: AfxWin.inc

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 AfxPointSizeTopDip (BYVAL ptsize AS SINGLE) AS SINGLE
   FUNCTION = (ptsize/72) * 96
END FUNCTION
' ========================================================================================


[José Roca]

File: AfxSid.inc

Code Select Expand


' ========================================================================================
' Tests whether the current user is a member of the Administrator's group.
' Caller is NOT expected to be impersonating anyone and is expected to be able to
' open its own process and process token.
' See: http://msdn.microsoft.com/en-us/library/windows/desktop/aa376389%28v=vs.85%29.aspx
' Return Value:
'   TRUE - Caller has Administrators local group.
'   FALSE - Caller does not have Administrators local group.
' Note: Replacement for the Windows API function IsUserAnAdmin because Microsoft warns
' about the use of this function and advices to call CheckTokenMembership directly.
' ========================================================================================
FUNCTION AfxIsUserAnAdmin () AS LONG

   LOCAL IsMember AS LONG
   LOCAL NtAuthority AS SID_IDENTIFIER_AUTHORITY
   LOCAL AdministratorsGroup AS DWORD

   NtAuthority.Value = $SECURITY_NT_AUTHORITY
   IF AllocateAndInitializeSid(NtAuthority, 2, %SECURITY_BUILTIN_DOMAIN_RID, _
         %DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, AdministratorsGroup) = 0 THEN EXIT FUNCTION
   IF CheckTokenMembership(%NULL, BYVAL AdministratorsGroup, IsMember) <> 0 THEN
      FUNCTION = IsMember
   END IF
   FreeSid(BYVAL AdministratorsGroup)

END FUNCTION
' ========================================================================================


[José Roca]

File: AfxSid.inc

Code Select Expand


' ========================================================================================
' Looks up the user name and domain name for the user account associated with the specified
' local process identifier.
' ========================================================================================
FUNCTION AfxGetUserNameAndDomainFromPid (BYVAL pid AS DWORD, BYREF bstrUser AS WSTRING, BYREF bstrDomain AS WSTRING) AS LONG

   LOCAL hProcess AS DWORD
   LOCAL hToken AS DWORD
   LOCAL ptiUser AS TOKEN_USER PTR
   LOCAL cbti AS DWORD
   LOCAL snu AS LONG  ' SID_NAME_USE enumeration
   LOCAL wszUser AS WSTRINGZ * 256
   LOCAL wszDomain AS WSTRINGZ * %MAX_PATH

   ' // Open the local process
   hProcess = OpenProcess(%PROCESS_ALL_ACCESS, %FALSE, pid)
   IF hProcess = %NULL THEN
      FUNCTION = GetLastError
      EXIT FUNCTION
   END IF
   ' // Get the access token associated with the process
   IF ISFALSE OpenProcessToken(hProcess, %TOKEN_QUERY, hToken) THEN
      FUNCTION = GetLastError
      GOTO LExit
   END IF
   ' // Obtain the size of the user information in the token
   IF GetTokenInformation(hToken, %TokenUser, BYVAL %NULL, 0, cbti) <> 0 THEN
      FUNCTION = GetLastError
      GOTO LExit
   END IF
   ' // Call should have failed due to zero-length buffer
   IF GetLastError <> %ERROR_INSUFFICIENT_BUFFER THEN
      FUNCTION = GetLastError
      GOTO LExit
   END IF
   ' // Allocate buffer for user information in the token
   ptiUser = HeapAlloc(GetProcessHeap, %HEAP_GENERATE_EXCEPTIONS, cbti)
   IF ptiUser = %NULL THEN
      FUNCTION = %E_OUTOFMEMORY
      GOTO LExit
   END IF
   ' // Retrieve the user information from the token
   IF ISFALSE GetTokenInformation(hToken, %TokenUser, BYVAL ptiUser, cbti, cbti) THEN
      FUNCTION = GetLastError
      GOTO LExit
   END IF
   ' // Retrieve user name and domain name based on user's SID.
   IF ISFALSE LookupAccountSidW(BYVAL %NULL, BYVAL @ptiUser.User.Sid, wszUser, SIZEOF(wszUser), _
              wszDomain, SIZEOF(wszDomain), snu) <> 0 THEN
      FUNCTION = GetLastError
      GOTO LExit
      EXIT FUNCTION
   END IF
   bstrUser = wszUser
   bstrDomain = wszDomain

LExit:

   ' // Free resources
   IF hProcess THEN CloseHandle(hProcess)
   IF hToken THEN CloseHandle(hToken)
   IF ptiUser THEN HeapFree(GetProcessHeap, 0, ptiUser)

END FUNCTION
' ========================================================================================


[José Roca]

File: CAfxMp3.inc. Plays MP3 files.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CAfxMp3.inc
' Contents: MP3 class.
' Copyright (c) 2012 Jose Roca.
' Based on Simple C++ DirectShow MP3 Player Class by Wong Shao Voon, 26 Apr 2010.
' http://www.codeproject.com/Articles/373613/Simple-Cplusplus-DirectShow-MP3-Player-Class
' 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.
' ########################################################################################

#INCLUDE THIS ONCE
%CAFXMP3_INC = 1

#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "DShow.inc"     ' // Director Show

' ########################################################################################
' CAfxMp3 class.
' ########################################################################################
CLASS CAfxMp3

   INSTANCE m_pIGraphBuilder AS IGraphBuilder
   INSTANCE m_pIMediaControl AS IMediaControl
   INSTANCE m_pIMediaEventEx AS IMediaEventEx
   INSTANCE m_pIBasicAudio AS IBasicAudio
   INSTANCE m_pIMediaSeeking AS IMediaSeeking
   INSTANCE m_ready AS LONG
   INSTANCE m_duration AS QUAD

   INTERFACE IAfxMp3 : INHERIT IAutomation

   ' =====================================================================================
   ' Cleans resources
   ' =====================================================================================
   METHOD Cleanup
      m_pIGraphBuilder = NOTHING
      m_pIMediaControl = NOTHING
      m_pIMediaEventEx = NOTHING
      m_pIBasicAudio = NOTHING
      m_pIMediaSeeking = NOTHING
   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   ' Builds a filter graph that renders the specified file.
   ' Return Value = %TRUE or %FALSE.
   ' OBJRESULT
   '   %S_OK = Success.
   '   %VFW_S_AUDIO_NOT_RENDERED = Partial success; the audio was not rendered.
   '   %VFW_S_DUPLICATE_NAME = Success; the Filter Graph Manager modified the filter name to avoid duplication.
   '   %VFW_S_PARTIAL_RENDER = Some of the streams in this movie are in an unsupported format.
   '   %VFW_S_VIDEO_NOT_RENDERED = Partial success; some of the streams in this movie are in an unsupported format.
   '   %E_ABORT = Operation aborted.
   '   %E_FAIL = Failure.
   '   %E_INVALIDARG = Argument is invalid.
   '   %E_OUTOFMEMORY = Insufficient memory.
   '   %E_POINTER = NULL pointer argument.
   '   %VFW_E_CANNOT_CONNECT = No combination of intermediate filters could be found to make the connection.
   '   %VFW_E_CANNOT_LOAD_SOURCE_FILTER = The source filter for this file could not be loaded.
   '   %VFW_E_CANNOT_RENDER = No combination of filters could be found to render the stream.
   '   %VFW_E_INVALID_FILE_FORMAT = The file format is invalid.
   '   %VFW_E_NOT_FOUND = An object or name was not found.
   '   %VFW_E_UNKNOWN_FILE_TYPE = The media type of this file is not recognized.
   '   5VFW_E_UNSUPPORTED_STREAM = Cannot play back the file: the format is not supported.
   ' =====================================================================================
   METHOD Load (BYVAL bstrFile AS WSTRING) AS LONG
      LOCAL hr AS LONG
      m_ready = %FALSE
      ME.Cleanup
      m_pIGraphBuilder = NEWCOM CLSID $CLSID_FilterGraph
      IF ISNOTHING(m_pIGraphBuilder) THEN EXIT METHOD
      m_pIMediaControl = m_pIGraphBuilder
      m_pIMediaEventEx = m_pIGraphBuilder
      m_pIBasicAudio = m_pIGraphBuilder
      m_pIMediaSeeking = m_pIGraphBuilder
      hr = m_pIGraphBuilder.RenderFile(BYCOPY bstrFile)
      IF SUCCEEDED(hr) THEN
         m_ready = %TRUE
         IF ISOBJECT(m_pIMediaSeeking) THEN
            m_pIMediaSeeking.SetTimeFormat($TIME_FORMAT_MEDIA_TIME)   ' // Reference time (100-nanosecond units).
            m_pIMediaSeeking.GetDuration(m_duration)                  ' // Returns 10,000,000 for a second.
         END IF
      END IF
      METHOD = m_ready
      IF hr THEN METHOD OBJRESULT = hr
   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   ' Runs all the filters in the filter graph.
   ' Return Value = %TRUE or %FALSE.
   ' OBJRESULT
   '   %S_FALSE The graph is preparing to run, but some filters have not completed the transition to a running state.
   '   %S_OK = All filters in the graph completed the transition to a running state.
   ' =====================================================================================
   METHOD Run () AS LONG
      IF ISTRUE(m_ready) AND ISOBJECT(m_pIMediaControl) THEN
         m_pIMediaControl.Run
         IF ISFALSE OBJRESULT THEN METHOD = %TRUE ELSE METHOD OBJRESULT = OBJRESULT
      END IF
   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   ' Pauses all the filters in the filter graph.
   ' Return Value = %TRUE or %FALSE.
   ' OBJRESULT
   '   %S_FALSE The graph paused successfully, but some filters have not completed the state transition.
   '   %S_OK = All filters in the graph completed the transition to a paused state.
   ' =====================================================================================
   METHOD Pause () AS LONG
      LOCAL hr AS LONG
      IF ISTRUE(m_ready) AND ISOBJECT(m_pIMediaControl) THEN
         m_pIMediaControl.Pause
         IF ISFALSE OBJRESULT THEN METHOD = %TRUE ELSE METHOD OBJRESULT = OBJRESULT
      END IF
   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   ' Stops all the filters in the filter graph.
   ' Return Value = %TRUE or %FALSE.
   ' OBJRESUT = Returns S_OK if successful, or an HRESULT value that indicates the cause of the error.
   ' =====================================================================================
   METHOD Stop () AS LONG
      LOCAL hr AS LONG
      IF ISTRUE(m_ready) AND ISOBJECT(m_pIMediaControl) THEN
         m_pIMediaControl.Stop
         IF ISFALSE OBJRESULT THEN METHOD = %TRUE ELSE METHOD OBJRESULT = OBJRESULT
      END IF
   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   ' Waits for the filter graph to render all available data.
   ' Parameters:
   ' msTimeout
   '   [in] Duration of the time-out, in milliseconds. Pass zero to return immediately.
   '   To block indefinitely, pass INFINITE.
   ' EvCode
   '   [out] Event that terminated the wait. This value can be one of the following:
   '   %EC_COMPLETE  = Operation completed.
   '   %EC_ERRORABORT = Error. Playback cannot continue.
   '   %EC_USERABORT  = User terminated the operation.
   '   Zero (0) = Operation has not completed.
   ' Return Value = %TRUE or %FALSE.
   ' OBJRESULT
   '   %S_OK = Success.
   '   %E_ABORT = Time-out expired.
   '   %VFW_E_WRONG_STATE = The filter graph is not running.
   ' Remarks
   ' This method blocks until the time-out expires, or one of the following events occurs:
   '   %EC_COMPLETE
   '   %EC_ERRORABORT
   '   %EC_USERABORT
   ' During the wait, the method discards all other event notifications.
   ' If the return value is S_OK, the pEvCode parameter receives the event code that ended
   ' the wait. When the method returns, the filter graph is still running. The application
   ' can pause or stop the graph, as appropriate.
   ' =====================================================================================
   METHOD WaitForCompletion (BYVAL msTimeout AS LONG, BYREF EvCode AS LONG) AS LONG
      LOCAL hr AS LONG
      IF ISTRUE(m_ready) AND ISOBJECT(m_pIMediaEventEx) THEN
         m_pIMediaEventEx.WaitForcompletion(msTimeout, EvCode)
         IF ISFALSE OBJRESULT THEN METHOD = %TRUE ELSE METHOD OBJRESULT = OBJRESULT
      END IF
   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   ' Retrieves the volume (amplitude) of the audio signal.
   ' Return Value = The volume. Divide by 100 to get equivalent decibel value.
   '                For example, â€"10,000 is â€"100 dB.
   ' OBJRESULT
   '   %E_NOTIMPL = The filter graph does not contain an audio renderer filter.
   '                (Possibly the source does not contain an audio stream.)
   '   %S_OK = Success.
   ' =====================================================================================
   PROPERTY GET Volume () AS LONG
      IF ISTRUE m_ready AND ISOBJECT(m_pIBasicAudio) THEN
         PROPERTY = m_pIBasicAudio.Volume
         IF ISFALSE OBJRESULT THEN PROPERTY = %TRUE ELSE PROPERTY OBJRESULT = OBJRESULT
      END IF
   END PROPERTY
   ' =====================================================================================

   ' =====================================================================================
   ' Sets the volume (amplitude) of the audio signal.
   ' OBJRESULT
   '   %E_FAIL = The underlying audio device returned an error.
   '   %E_INVALIDARG = The value of lVolume is invalid.
   '   %E_NOTIMPL = The filter graph does not contain an audio renderer filter.
   '                (Possibly the source does not contain an audio stream.)
   '   %S_OK = Success.
   ' =====================================================================================
   PROPERTY SET Volume (BYVAL nVol AS LONG)
      IF ISTRUE m_ready AND ISOBJECT(m_pIBasicAudio) THEN
         m_pIBasicAudio.Volume = nVol
         IF OBJRESULT THEN PROPERTY OBJRESULT = OBJRESULT
      END IF
   END PROPERTY
   ' =====================================================================================

   ' =====================================================================================
   ' Gets the duration of the stream, in 100-nanosecond units.
   ' Returns 10,000,000 for a second.
   ' =====================================================================================
   PROPERTY GET Duration () AS QUAD
      PROPERTY = m_duration
   END PROPERTY
   ' =====================================================================================

   ' =====================================================================================
   ' Gets the current position, relative to the total duration of the stream.
   ' =====================================================================================
   PROPERTY GET CurrentPosition () AS QUAD
      LOCAL hr AS LONG
      LOCAL curPos AS QUAD
      IF ISTRUE m_ready AND ISOBJECT(m_pIMediaSeeking) THEN
         m_pIMediaSeeking.GetCurrentPosition(curPos)
         IF SUCCEEDED(hr) THEN PROPERTY = curPos ELSE PROPERTY OBJRESULT = hr
      END IF
   END PROPERTY
   ' =====================================================================================

   ' =====================================================================================
   ' Sets the current position and the stop position.
   ' Return Value = %TRUE or %FALSE.
   ' Parameters:
   '   pCurrent = [in, out] Pointer to a variable that specifies the current position, in units of the current time format.
   '   pStop = [in, out] Pointer to a variable that specifies the stop time, in units of the current time format.
   '   bAbsolutePositioning = %TRUE or %FALSE. IF %TRUE, the specified position is absolute.
   '                          IF %FLASE, the specified position is relative.
   ' OBJRESULT
   '   %S_FALSE = No position change. (Both flags specify no seeking.)
   '   %S_OK = Success.
   '   %E_INVALIDARG = Invalid argument.
   '   %E_NOTIMPL = Method is not supported.
   '   %E_POINTER = NULL pointer argument.
   ' =====================================================================================
   METHOD SetPositions (BYREF pCurrent AS QUAD, BYREF pStop AS QUAD, BYVAL bAbsolutePositioning AS LONG) AS LONG
      LOCAL hr AS LONG
      LOCAL dwFlags AS DWORD
      IF ISTRUE m_ready AND ISOBJECT(m_pIMediaSeeking) THEN
         IF bAbsolutePositioning THEN
            dwFlags = %AM_SEEKING_AbsolutePositioning OR %AM_SEEKING_SeekToKeyFrame
         ELSE
            dwFlags = %AM_SEEKING_RelativePositioning OR %AM_SEEKING_SeekToKeyFrame
         END IF
         hr = m_pIMediaSeeking.SetPositions(pCurrent, dwFlags, pStop, dwFlags)
         IF SUCCEEDED(hr) THEN METHOD = %TRUE ELSE METHOD OBJRESULT = hr
      END IF
   END METHOD
   ' =====================================================================================

   END INTERFACE

END CLASS
' ########################################################################################


Usage example:

Code Select Expand


#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "CAfxMp3.inc"

FUNCTION PBMAIN () AS LONG

   ' // Create an instance of the class
   LOCAL pAfxMp3 AS IAfxMp3
   pAfxMp3 = CLASS "CAfxMp3"
   IF ISNOTHING(pAfxMp3) THEN EXIT FUNCTION

   TRY
      ' // Load the MP3 file
      pAfxMp3.Load(EXE.PATH$ & "Kalimba.mp3")   ' --> change me
      ' // Play it
      pAfxMp3.Run

      ' // ... after some time, stop it
      WAITKEY$
      pAfxMp3.Stop
   CATCH
      ? HEX$(OBJRESULT)
      WAITKEY$
   END TRY

END FUNCTION


[José Roca]

File: GdipUtils.inc.

Displays the printer dialog and prints the specified image at its real size or stretched to the paper size. Allows printing of multiframe .tif files.

Code Select Expand


' ========================================================================================
' Displays the printer dialog and prints the specified image.
' Parameters:
' - wszFileName = The name of the image file to print.
' - bStretch = %TRUE or FALSE. Stretch the image to paper size.
' - nStretchMode = Stretching mode. Deafault value = %InterpolationModeHighQualityBicubic.
'   %InterpolationModeLowQuality = 1
'   %InterpolationModeHighQuality = 2
'   %InterpolationModeBilinear = 3
'   %InterpolationModeBicubic = 4
'   %InterpolationModeNearestNeighbor = 5
'   %InterpolationModeHighQualityBilinear = 6
'   %InterpolationModeHighQualityBicubic = 7
' Return Value: Return %TRUE if the bitmap has been printed successfully, or %FALSE otherwise.
' ========================================================================================
FUNCTION GdiPlusPrintImageDlg(BYREF wszFileName AS WSTRINGZ, OPTIONAL BYVAL bStretch AS LONG, BYVAL nStretchMode AS LONG) AS LONG

   ' // Display te print dialog
   LOCAL hr AS LONG
   LOCAL ppd AS PRINTDLGAPIW
   ppd.lStructSize = SIZEOF(PRINTDLGAPIW)
   ppd.flags = %PD_RETURNDC OR %PD_ALLPAGES OR %PD_NOPAGENUMS OR %PD_NOSELECTION
   hr = PrintDlgW(ppd)
   IF hr <> %PD_RESULT_PRINT THEN EXIT FUNCTION

   LOCAL token AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput
   ' // Initialize GDI+
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN GOTO LExit

   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   ' // Create a graphics object from the printer DC
   hStatus = GdipCreateFromHDC(ppd.hDc, pGraphics)
   IF hStatus <> %S_OK OR pGraphics = 0 THEN GOTO LExit
   ' // Create a Bitmap object from a JPEG file.
   LOCAL pBitmap AS DWORD
   hStatus = GdipCreateBitmapFromFile(wszFileName, pBitmap)
   IF hStatus <> %S_OK OR pBitmap = 0 THEN GOTO LExit
   ' // Get the width and height of the bitmap
   LOCAL nWidth, nHeight AS DWORD
   GdipGetImageWidth(pBitmap, nWidth)
   GdipGetImageHeight(pBitmap, nHeight)

   ' // Stretching
   LOCAL cx, cy AS SINGLE
   IF bStretch THEN
      IF nStretchMode THEN
         ' // Set the interpolation mode
         IF nStretchMode = 0 THEN nStretchMode = %InterpolationModeHighQualityBicubic
         GdipSetInterpolationMode(pGraphics, nStretchMode)
      END IF
      ' // Get the DPIs of the printer
      LOCAL dpiX, dpiY AS SINGLE
      GdipGetDpiX(pGraphics, dpiX)
      GdipGetDpiY(pGraphics, dpiY)
      ' // Calculate the width and height according to the DPI of the printer
      cx = GetDeviceCaps(ppd.hDc, %HORZRES) / (dpiX / 100)
      cy = GetDeviceCaps(ppd.hDc, %VERTRES) / (dpiY / 100)
   END IF

   ' // How many frame dimensions does the Image object have?
   LOCAL nCount AS LONG
   hStatus = GdipImageGetFrameDimensionsCount(pBitmap, nCount)
   IF nCount THEN
      DIM dimensionIDs(0) AS GUID
      LOCAL frameCount AS DWORD
      ' // Get the list of frame dimensions from the Image object.
      REDIM dimensionIDs(nCount - 1)
      hStatus = GdipImageGetFrameDimensionsList(pBitmap, dimensionIDs(0), nCount)
      ' // Display the GUID of the first (and only) frame dimension.
      ' // Get the number of frames in the first dimension.
      hStatus = GdipImageGetFrameCount(pBitmap, dimensionIDs(0), frameCount)
      IF frameCount = 0 THEN GOTO LExit
   END IF

   ' // Frame dimension page
   LOCAL pageGuid AS GUID
   pageGuid = $FrameDimensionPage

   ' // Print the bitmap
   LOCAL di AS DOCINFOW
   di.cbSize = SIZEOF(DOCINFOW)
   di.lpszDocName = VARPTR(wszFileName)
   hr = StartDocW(ppd.hDc, di)
   IF hr <= 0 THEN GOTO LExit
   LOCAL i, x AS LONG
   FOR i = 1 TO ppd.nCopies
      FOR x = 0 TO frameCount - 1
         IF StartPage(ppd.hDc) THEN
            ' // Select the frame
            hStatus = GdipImageSelectActiveFrame(pBitmap, pageGuid, x)
            ' // Draw the image
            IF bStretch THEN
               hStatus = GdipDrawImageRect(pGraphics, pBitmap, 0, 0, cx, cy)
            ELSE
               hStatus = GdipDrawImage(pGraphics, pBitmap, 0, 0)
            END IF
            EndPage(ppd.hDc)
         END IF
      NEXT
   NEXT
   EndDoc(ppd.hDc)

LExit:

   ' // Cleanup
   IF ppd.hDc THEN DeleteDC ppd.hDc
   IF pBitmap THEN GdipDisposeImage(pBitmap)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)
   ' // Shutdown GDI+
   IF token THEN GdiplusShutdown token

END FUNCTION
' ========================================================================================


[José Roca]

File: GdipUtils.inc

This one prints the image directly to the default printer.

Code Select Expand


' ========================================================================================
' Prints the specified image using the current default printer and printer settings.
' Parameters:
' - wszFileName = The name of the image file to print.
' - bStretch = %TRUE or %FALSE. Stretch the image to paper size.
' - nStretchMode = Stretching mode. Default value = %InterpolationModeHighQualityBicubic.
'   %InterpolationModeLowQuality = 1
'   %InterpolationModeHighQuality = 2
'   %InterpolationModeBilinear = 3
'   %InterpolationModeBicubic = 4
'   %InterpolationModeNearestNeighbor = 5
'   %InterpolationModeHighQualityBilinear = 6
'   %InterpolationModeHighQualityBicubic = 7
' Return Value: Returns %TRUE if the bitmap has been printed successfully, or %FALSE otherwise.
' ========================================================================================
FUNCTION GdiPlusPrintImage (BYREF wszFileName AS WSTRINGZ, OPTIONAL BYVAL bStretch AS LONG, BYVAL nStretchMode AS LONG) AS LONG

   ' // Get the name of the default printer
   LOCAL wszPrinterName AS WSTRINGZ * %MAX_PATH
   GetProfileStringW("WINDOWS", "DEVICE", "", wszPrinterName, SIZEOF(wszPrinterName))
   wszPrinterName = PARSE$(wszPrinterName, 1)
   IF wszPrinterName = "" THEN EXIT FUNCTION

   ' // Open the printer
   LOCAL hPrinter AS DWORD
   IF OpenPrinterW(wszPrinterName, hPrinter, BYVAL %NULL) = 0 THEN EXIT FUNCTION
   ' // Allocate a buffer of the correct size
   LOCAL dwNeeded AS DWORD
   LOCAL bufferDoc AS STRING
   dwNeeded = DocumentPropertiesW(%NULL, hPrinter, wszPrinterName, BYVAL %NULL, BYVAL %NULL, 0)
   bufferDoc = SPACE$(dwNeeded)
   ' // Retrieve the printer configuration data
   LOCAL nRet AS LONG
   nRet = DocumentPropertiesW(%NULL, hPrinter, wszPrinterName, BYVAL STRPTR(bufferDoc), BYVAL %NULL, %DM_OUT_BUFFER)
   IF nRet <> %IDOK THEN GOTO LExit
   ' // Cast it to a DEVMODEW structure
   LOCAL pDevMode AS DEVMODEW PTR
   pDevMode = STRPTR(bufferDoc)
   ' // Create a device context for the printer
   LOCAL hdc AS DWORD
   hdc = CreateDCW(wszPrinterName, wszPrinterName, BYVAL %NULL, BYVAL pDevMode)
   IF hdc = %NULL THEN GOTO LExit

   ' // Initialize GDI+
   LOCAL hr AS LONG
   LOCAL token AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN GOTO LExit

   ' // Create a graphics object from the printer DC
   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   hStatus = GdipCreateFromHDC(hdc, pGraphics)
   IF hStatus <> %S_OK OR pGraphics = 0 THEN GOTO LExit
   ' // Create a Bitmap object from a file.
   LOCAL pBitmap AS DWORD
   hStatus = GdipCreateBitmapFromFile(wszFileName, pBitmap)
   IF hStatus <> %S_OK OR pBitmap = 0 THEN GOTO LExit
   ' // Get the width and height of the bitmap
   LOCAL nWidth, nHeight AS DWORD
   GdipGetImageWidth(pBitmap, nWidth)
   GdipGetImageHeight(pBitmap, nHeight)

   ' // Stretching
   LOCAL cx, cy AS SINGLE
   IF bStretch THEN
      IF nStretchMode THEN
         ' // Set the interpolation mode
         IF nStretchMode = 0 THEN nStretchMode = %InterpolationModeHighQualityBicubic
         GdipSetInterpolationMode(pGraphics, nStretchMode)
      END IF
      ' // Get the DPIs of the printer
      LOCAL dpiX, dpiY AS SINGLE
      GdipGetDpiX(pGraphics, dpiX)
      GdipGetDpiY(pGraphics, dpiY)
      ' // Calculate the width and height according to the DPIs of the printer
      cx = GetDeviceCaps(hdc, %HORZRES) / (dpiX / 100)
      cy = GetDeviceCaps(hdc, %VERTRES) / (dpiY / 100)
   END IF

   ' // How many frame dimensions does the Image object have?
   LOCAL nCount AS LONG
   hStatus = GdipImageGetFrameDimensionsCount(pBitmap, nCount)
   IF nCount THEN
      DIM dimensionIDs(0) AS GUID
      LOCAL frameCount AS DWORD
      ' // Get the list of frame dimensions from the Image object.
      REDIM dimensionIDs(nCount - 1)
      hStatus = GdipImageGetFrameDimensionsList(pBitmap, dimensionIDs(0), nCount)
      ' // Get the number of frames in the first (and only) frame dimension.
      hStatus = GdipImageGetFrameCount(pBitmap, dimensionIDs(0), frameCount)
      IF frameCount = 0 THEN GOTO LExit
   END IF

   ' // Frame dimension page
   LOCAL pageGuid AS GUID
   pageGuid = $FrameDimensionPage

   ' // Print the bitmap
   LOCAL di AS DOCINFOW
   di.cbSize = SIZEOF(DOCINFOW)
   di.lpszDocName = VARPTR(wszFileName)
   hr = StartDocW(hdc, di)
   IF hr <= 0 THEN GOTO LExit
   LOCAL i, x AS LONG
   FOR i = 1 TO @pDevMode.dmCopies
      FOR x = 0 TO frameCount - 1
         IF StartPage(hdc) THEN
            ' // Select the frame
            hStatus = GdipImageSelectActiveFrame(pBitmap, pageGuid, x)
            ' // Draw the image
            IF bStretch THEN
               hStatus = GdipDrawImageRect(pGraphics, pBitmap, 0, 0, cx, cy)
            ELSE
               hStatus = GdipDrawImage(pGraphics, pBitmap, 0, 0)
            END IF
            EndPage(hdc)
         END IF
      NEXT
   NEXT
   EndDoc(hdc)

LExit:

   ' // Finished with the printer
   IF hPrinter THEN ClosePrinter(hPrinter)
   ' // Cleanup
   IF hdc THEN DeleteDC(hdc)
   IF pBitmap THEN GdipDisposeImage(pBitmap)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)
   ' // Shutdown GDI+
   IF token THEN GdiplusShutdown token

END FUNCTION
' ========================================================================================


[José Roca]

File: GdipUtils.inc

Code Select Expand


' ========================================================================================
' Displays the printer dialog and prints the specified resource image.
' Parameters:
' - hInstance = The instance handle.
' - wszImageName = The name of the image to print.
' - bStretch = %TRUE or %FALSE. Stretch the image to paper size.
' - nStretchMode = Stretching mode. Default value = %InterpolationModeHighQualityBicubic.
'   %InterpolationModeLowQuality = 1
'   %InterpolationModeHighQuality = 2
'   %InterpolationModeBilinear = 3
'   %InterpolationModeBicubic = 4
'   %InterpolationModeNearestNeighbor = 5
'   %InterpolationModeHighQualityBilinear = 6
'   %InterpolationModeHighQualityBicubic = 7
' Return Value: Returns %TRUE if the bitmap has been printed successfully, or %FALSE otherwise.
' ========================================================================================
FUNCTION GdiPlusPrintResourceImageDlg(BYVAL hInstance AS DWORD, BYREF wszImageName AS WSTRINGZ, OPTIONAL BYVAL bStretch AS LONG, BYVAL nStretchMode AS LONG) AS LONG

   IF hInstance = 0 THEN EXIT FUNCTION

   ' // Display te print dialog
   LOCAL hr AS LONG
   LOCAL ppd AS PRINTDLGAPIW
   ppd.lStructSize = SIZEOF(PRINTDLGAPIW)
   ppd.flags = %PD_RETURNDC OR %PD_ALLPAGES OR %PD_NOPAGENUMS OR %PD_NOSELECTION OR %PD_DISABLEPRINTTOFILE
   hr = PrintDlgW(ppd)
   IF hr <> %PD_RESULT_PRINT THEN EXIT FUNCTION

   ' // Initialize GDI+
   LOCAL token AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN GOTO LExit

   ' // Create a graphics object from the printer DC
   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   hStatus = GdipCreateFromHDC(ppd.hDc, pGraphics)
   IF hStatus <> %S_OK OR pGraphics = 0 THEN GOTO LExit

   ' // Create a bitmap from the resource image
   LOCAL hResource     AS DWORD                 ' // Resource handle
   LOCAL pResourceData AS DWORD                 ' // Pointer to the resoruce data
   LOCAL hGlobal       AS DWORD                 ' // Global memory handle
   LOCAL pGlobalBuffer AS DWORD                 ' // Pointer to global memory buffer
   LOCAL pImageStream  AS IStream               ' // IStream interface pointer
   LOCAL pBitmap       AS DWORD                 ' // Bitmap object
   LOCAL imageSize     AS DWORD                 ' // Image size
   LOCAL wID           AS WORD
   LOCAL dwID          AS DWORD
   ' // Find the resource and lock it
   IF LEFT$(wszImageName, 1) = "#" THEN
      wID = VAL(MID$(wszImageName, 2))
      dwID = MAK(DWORD, wID, 0)
      hResource = FindResourceW(hInstance, BYVAL dwID, BYVAL %RT_RCDATA)
   ELSE
      hResource = FindResourceW(hInstance, wszImageName, BYVAL %RT_RCDATA)
   END IF
   IF hResource = %NULL THEN GOTO LExit
   imageSize = SizeofResource(hInstance, hResource)
   IF imageSize = 0 THEN GOTO LExit
   pResourceData = LockResource(LoadResource(hInstance, hResource))
   IF pResourceData = %NULL THEN GOTO LExit
   ' // Allocate memory to hold the image
   hGlobal = GlobalAlloc(%GMEM_MOVEABLE, imageSize)
   IF hGlobal THEN
      ' // Lock the memory
      pGlobalBuffer = GlobalLock(hGlobal)
      IF pGlobalBuffer THEN
         ' // Copy the image from the resource file to global memory
         CopyMemory pGlobalBuffer, pResourceData, imageSize
         ' // Create an stream in global memory
         IF CreateStreamOnHGlobal(hGlobal, %FALSE, pImageStream) = %S_OK THEN
            ' // Create a bitmap from the data contained in the stream
            hStatus = GdipCreateBitmapFromStream(pImageStream, pBitmap)
            pImageStream = NOTHING
         END IF
      END IF
   END IF
   IF pBitmap = 0 THEN GOTO LExit

   ' // Get the width and height of the bitmap
   LOCAL nWidth, nHeight AS DWORD
   GdipGetImageWidth(pBitmap, nWidth)
   GdipGetImageHeight(pBitmap, nHeight)

   ' // Stretching
   LOCAL cx, cy AS SINGLE
   IF bStretch THEN
      IF nStretchMode THEN
         ' // Set the interpolation mode
         IF nStretchMode = 0 THEN nStretchMode = %InterpolationModeHighQualityBicubic
         GdipSetInterpolationMode(pGraphics, nStretchMode)
      END IF
      ' // Get the DPIs of the printer
      LOCAL dpiX, dpiY AS SINGLE
      GdipGetDpiX(pGraphics, dpiX)
      GdipGetDpiY(pGraphics, dpiY)
      ' // Calculate the width and height according to the DPIs of the printer
      cx = GetDeviceCaps(ppd.hDc, %HORZRES) / (dpiX / 100)
      cy = GetDeviceCaps(ppd.hDc, %VERTRES) / (dpiY / 100)
   END IF

   ' // How many frame dimensions does the Image object have?
   LOCAL nCount AS LONG
   hStatus = GdipImageGetFrameDimensionsCount(pBitmap, nCount)
   IF nCount THEN
      DIM dimensionIDs(0) AS GUID
      LOCAL frameCount AS DWORD
      ' // Get the list of frame dimensions from the Image object.
      REDIM dimensionIDs(nCount - 1)
      hStatus = GdipImageGetFrameDimensionsList(pBitmap, dimensionIDs(0), nCount)
      ' // Get the number of frames in the first (and only) frame dimension.
      hStatus = GdipImageGetFrameCount(pBitmap, dimensionIDs(0), frameCount)
      IF frameCount = 0 THEN GOTO LExit
   END IF

   ' // Frame dimension page
   LOCAL pageGuid AS GUID
   pageGuid = $FrameDimensionPage

   ' // Print the bitmap
   LOCAL di AS DOCINFOW
   di.cbSize = SIZEOF(DOCINFOW)
   di.lpszDocName = VARPTR(wszImageName)
   hr = StartDocW(ppd.hDc, di)
   IF hr <= 0 THEN GOTO LExit
   LOCAL i, x AS LONG
   FOR i = 1 TO ppd.nCopies
      FOR x = 0 TO frameCount - 1
         IF StartPage(ppd.hDc) THEN
            ' // Select the frame
            hStatus = GdipImageSelectActiveFrame(pBitmap, pageGuid, x)
            ' // Draw the image
            IF bStretch THEN
               hStatus = GdipDrawImageRect(pGraphics, pBitmap, 0, 0, cx, cy)
            ELSE
               hStatus = GdipDrawImage(pGraphics, pBitmap, 0, 0)
            END IF
            EndPage(ppd.hDc)
         END IF
      NEXT
   NEXT
   EndDoc(ppd.hDc)

LExit:

   ' // Cleanup
   IF ppd.hDc THEN DeleteDC(ppd.hDc)
   IF pBitmap THEN GdipDisposeImage(pBitmap)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)
   ' // Unlock and free the global memory
   IF pGlobalBuffer THEN GlobalUnlock(pGlobalBuffer)
   IF hGlobal THEN GlobalFree(hGlobal)
   ' // Shutdown GDI+
   IF token THEN GdiplusShutdown token

END FUNCTION
' ========================================================================================


[José Roca]

File: GdipUtils.inc

Code Select Expand


' ========================================================================================
' Prints the specified resource image using the current default printer and printer settings.
' Parameters:
' - hInstance = The instance handle.
' - wszImageName = The name of the image to print.
' - bStretch = %TRUE or %FALSE. Stretch the image to paper size.
' - nStretchMode = Stretching mode. Default value = %InterpolationModeHighQualityBicubic.
'   %InterpolationModeLowQuality = 1
'   %InterpolationModeHighQuality = 2
'   %InterpolationModeBilinear = 3
'   %InterpolationModeBicubic = 4
'   %InterpolationModeNearestNeighbor = 5
'   %InterpolationModeHighQualityBilinear = 6
'   %InterpolationModeHighQualityBicubic = 7
' Return Value: Returns %TRUE if the bitmap has been printed successfully, or %FALSE otherwise.
' ========================================================================================
FUNCTION GdiPlusPrintResourceImage(BYVAL hInstance AS DWORD, BYREF wszImageName AS WSTRINGZ, OPTIONAL BYVAL bStretch AS LONG, BYVAL nStretchMode AS LONG) AS LONG

   ' // Get the name of the default printer
   LOCAL wszPrinterName AS WSTRINGZ * %MAX_PATH
   GetProfileStringW("WINDOWS", "DEVICE", "", wszPrinterName, SIZEOF(wszPrinterName))
   wszPrinterName = PARSE$(wszPrinterName, 1)
   IF wszPrinterName = "" THEN EXIT FUNCTION

   ' // Open the printer
   LOCAL hPrinter AS DWORD
   IF OpenPrinterW(wszPrinterName, hPrinter, BYVAL %NULL) = 0 THEN EXIT FUNCTION
   ' // Allocate a buffer of the correct size
   LOCAL dwNeeded AS DWORD
   LOCAL bufferDoc AS STRING
   dwNeeded = DocumentPropertiesW(%NULL, hPrinter, wszPrinterName, BYVAL %NULL, BYVAL %NULL, 0)
   bufferDoc = SPACE$(dwNeeded)
   ' // Retrieve the printer configuration data
   LOCAL nRet AS LONG
   nRet = DocumentPropertiesW(%NULL, hPrinter, wszPrinterName, BYVAL STRPTR(bufferDoc), BYVAL %NULL, %DM_OUT_BUFFER)
   IF nRet <> %IDOK THEN GOTO LExit
   ' // Cast it to a DEVMODEW structure
   LOCAL pDevMode AS DEVMODEW PTR
   pDevMode = STRPTR(bufferDoc)
   ' // Create a device context for the printer
   LOCAL hdc AS DWORD
   hdc = CreateDCW(wszPrinterName, wszPrinterName, BYVAL %NULL, BYVAL pDevMode)
   IF hdc = %NULL THEN GOTO LExit

   ' // Initialize GDI+
   LOCAL hr AS LONG
   LOCAL token AS DWORD
   LOCAL StartupInput AS GdiplusStartupInput
   StartupInput.GdiplusVersion = 1
   hr = GdiplusStartup(token, StartupInput, BYVAL %NULL)
   IF hr THEN GOTO LExit

   ' // Create a graphics object from the printer DC
   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   hStatus = GdipCreateFromHDC(hdc, pGraphics)
   IF hStatus <> %S_OK OR pGraphics = 0 THEN GOTO LExit

   ' // Create a bitmap from the resource image
   LOCAL hResource     AS DWORD                 ' // Resource handle
   LOCAL pResourceData AS DWORD                 ' // Pointer to the resoruce data
   LOCAL hGlobal       AS DWORD                 ' // Global memory handle
   LOCAL pGlobalBuffer AS DWORD                 ' // Pointer to global memory buffer
   LOCAL pImageStream  AS IStream               ' // IStream interface pointer
   LOCAL pBitmap       AS DWORD                 ' // Bitmap object
   LOCAL imageSize     AS DWORD                 ' // Image size
   LOCAL wID           AS WORD
   LOCAL dwID          AS DWORD
   ' // Find the resource and lock it
   IF LEFT$(wszImageName, 1) = "#" THEN
      wID = VAL(MID$(wszImageName, 2))
      dwID = MAK(DWORD, wID, 0)
      hResource = FindResourceW(hInstance, BYVAL dwID, BYVAL %RT_RCDATA)
   ELSE
      hResource = FindResourceW(hInstance, wszImageName, BYVAL %RT_RCDATA)
   END IF
   IF hResource = %NULL THEN GOTO LExit
   imageSize = SizeofResource(hInstance, hResource)
   IF imageSize = 0 THEN GOTO LExit
   pResourceData = LockResource(LoadResource(hInstance, hResource))
   IF pResourceData = %NULL THEN GOTO LExit
   ' // Allocate memory to hold the image
   hGlobal = GlobalAlloc(%GMEM_MOVEABLE, imageSize)
   IF hGlobal THEN
      ' // Lock the memory
      pGlobalBuffer = GlobalLock(hGlobal)
      IF pGlobalBuffer THEN
         ' // Copy the image from the resource file to global memory
         CopyMemory pGlobalBuffer, pResourceData, imageSize
         ' // Create an stream in global memory
         IF CreateStreamOnHGlobal(hGlobal, %FALSE, pImageStream) = %S_OK THEN
            ' // Create a bitmap from the data contained in the stream
            hStatus = GdipCreateBitmapFromStream(pImageStream, pBitmap)
            pImageStream = NOTHING
         END IF
      END IF
   END IF
   IF pBitmap = 0 THEN GOTO LExit

   ' // Get the width and height of the bitmap
   LOCAL nWidth, nHeight AS DWORD
   GdipGetImageWidth(pBitmap, nWidth)
   GdipGetImageHeight(pBitmap, nHeight)

   ' // Stretching
   LOCAL cx, cy AS SINGLE
   IF bStretch THEN
      IF nStretchMode THEN
         ' // Set the interpolation mode
         IF nStretchMode = 0 THEN nStretchMode = %InterpolationModeHighQualityBicubic
         GdipSetInterpolationMode(pGraphics, nStretchMode)
      END IF
      ' // Get the DPIs of the printer
      LOCAL dpiX, dpiY AS SINGLE
      GdipGetDpiX(pGraphics, dpiX)
      GdipGetDpiY(pGraphics, dpiY)
      ' // Calculate the width and height according to the DPIs of the printer
      cx = GetDeviceCaps(hdc, %HORZRES) / (dpiX / 100)
      cy = GetDeviceCaps(hdc, %VERTRES) / (dpiY / 100)
   END IF

   ' // How many frame dimensions does the Image object have?
   LOCAL nCount AS LONG
   hStatus = GdipImageGetFrameDimensionsCount(pBitmap, nCount)
   IF nCount THEN
      DIM dimensionIDs(0) AS GUID
      LOCAL frameCount AS DWORD
      ' // Get the list of frame dimensions from the Image object.
      REDIM dimensionIDs(nCount - 1)
      hStatus = GdipImageGetFrameDimensionsList(pBitmap, dimensionIDs(0), nCount)
      ' // Get the number of frames in the first (and only) frame dimension.
      hStatus = GdipImageGetFrameCount(pBitmap, dimensionIDs(0), frameCount)
      IF frameCount = 0 THEN GOTO LExit
   END IF

   ' // Frame dimension page
   LOCAL pageGuid AS GUID
   pageGuid = $FrameDimensionPage

   ' // Print the bitmap
   LOCAL di AS DOCINFOW
   di.cbSize = SIZEOF(DOCINFOW)
   di.lpszDocName = VARPTR(wszImageName)
   hr = StartDocW(hdc, di)
   IF hr <= 0 THEN GOTO LExit
   LOCAL i, x AS LONG
   FOR i = 1 TO @pDevMode.dmCopies
      FOR x = 0 TO frameCount - 1
         IF StartPage(hdc) THEN
            ' // Select the frame
            hStatus = GdipImageSelectActiveFrame(pBitmap, pageGuid, x)
            ' // Draw the image
            IF bStretch THEN
               hStatus = GdipDrawImageRect(pGraphics, pBitmap, 0, 0, cx, cy)
            ELSE
               hStatus = GdipDrawImage(pGraphics, pBitmap, 0, 0)
            END IF
            EndPage(hdc)
         END IF
      NEXT
   NEXT
   EndDoc(hdc)

LExit:

   ' // Finished with the printer
   IF hPrinter THEN ClosePrinter(hPrinter)
   ' // Cleanup
   IF hdc THEN DeleteDC(hdc)
   IF pBitmap THEN GdipDisposeImage(pBitmap)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)
   ' // Unlock and free the global memory
   IF pGlobalBuffer THEN GlobalUnlock(pGlobalBuffer)
   IF hGlobal THEN GlobalFree(hGlobal)
   ' // Shutdown GDI+
   IF token THEN GdiplusShutdown token

END FUNCTION
' ========================================================================================


[José Roca]

File: AfxWin.inc

Code Select Expand


' ========================================================================================
' Checks if the specified URL exists.
' Parameters:
' - bstrUrl = URL to check.
' - vTimeout = Optional. Number of seconds to wait. The default value is -1 (infinite).
' Return value: TRUE or FALSE
' To retrieve extended error information, call GetLastError. The error code is returned as
' an HRESULT code to allow the use of OBJRESULT$ to get a localized description of it.
' ========================================================================================
FUNCTION AfxUrlExists (BYVAL bstrUrl AS WSTRING, OPTIONAL BYVAL vTimeout AS VARIANT) AS LONG

   LOCAL pWHttp AS IWinHttpRequest
   LOCAL iSucceeded AS INTEGER

   ' // Creates an instance of the HTTP service
   pWHttp = NEWCOM "WinHttp.WinHttpRequest.5.1"
   IF ISNOTHING(pWHttp) THEN
      SetLastError %E_NOINTERFACE
      EXIT FUNCTION
   END IF

   TRY
      ' // Opens an HTTP connection to an HTTP resource
      pWHttp.Open "GET", bstrUrl
      ' // Sends an HTTP request to the HTTP server
      pWHttp.Send
      ' // Wait for response
      iSucceeded = pWHttp.WaitForResponse(vTimeout)
      IF iSucceeded THEN
         ' // If it exists, pWHttp.Status returns a value of 200 and pWHttp.StatusText a value of "OK"
         ' // If it does not exist, pWHttp.Status returns a value of 404 and pWHttp.StatusText a value of "Not Found"
         IF pWHttp.Status = 200 THEN FUNCTION = %TRUE
      ELSE
         SetLastError HRESULT_FROM_WIN32(%ERROR_TIMEOUT)
      END IF
   CATCH
      SetLastError OBJRESULT
   END TRY

END FUNCTION
' ========================================================================================


[José Roca]

File: AfxWin.inc

Code Select Expand


' ========================================================================================
' Retrieves the version of the specified system DLL.
' ========================================================================================
FUNCTION AfxGetDllVersion (BYVAL bstrDllName AS WSTRING) AS CURRENCYX

   LOCAL pvsffi AS VS_FIXEDFILEINFO PTR
   LOCAL pVerInfo AS DWORD
   LOCAL dwHandle AS DWORD
   LOCAL dwVersion AS DWORD
   LOCAL cbLen AS DWORD
   LOCAL wMajor AS WORD
   LOCAL wMinor AS WORD
   cbLen = GetFileVersionInfoSize(BYCOPY bstrDllName, dwHandle)
   IF cbLen THEN
      pVerInfo = HeapAlloc(GetProcessHeap, %HEAP_ZERO_MEMORY, cbLen)
      IF pVerInfo THEN
         IF GetFileVersionInfo(BYCOPY bstrDllName, dwHandle, cbLen, BYVAL pVerInfo) THEN
            IF VerQueryValue(BYVAL pVerInfo, "\", BYVAL VARPTR(pvsffi), cbLen) THEN
               wMajor = HI(WORD, @pvsffi.dwFileVersionMS)
               wMinor = LO(WORD, @pvsffi.dwFileVersionMS)
            END IF
         END IF
         HeapFree GetProcessHeap, 0, pVerInfo
      END IF
   END IF
   FUNCTION = wMajor + wMinor / 100

END FUNCTION
' ========================================================================================


[José Roca]

File: AfxWin.inc

Code Select Expand


' ========================================================================================
' Retrieves the path of the specified system DLL.
' ========================================================================================
FUNCTION AfxGetDllPath (BYVAL bstrDllName AS WSTRING) AS WSTRING
   LOCAL hLib AS DWORD
   LOCAL wszPath AS WSTRINGZ * %MAX_PATH
   hLib = LoadLibraryW(BYCOPY bstrDllName)
   IF hLib THEN
      GetModuleFileNameW(hLib, wszPath, SIZEOF(wszPath))
      FreeLibrary hLib
   END IF
   FUNCTION = wszPath
END FUNCTION
' ========================================================================================


[José Roca]

Code Select Expand


' =====================================================================================
' Unscales an horizontal coordinate according the DPI (dots per pixel) being used by the application.
' =====================================================================================
FUNCTION AfxUnScaleX (BYVAL cx AS SINGLE) AS SINGLE
   LOCAL hDC AS DWORD
   hDC = GetDC(%NULL)
   FUNCTION = cx / (GetDeviceCaps(hDC, %LOGPIXELSX) / 96)
   ReleaseDC %NULL, hDC
END FUNCTION
' =====================================================================================

' =====================================================================================
' Unscales a vertical coordinate according the DPI (dots per pixel) being used by the application.
' =====================================================================================
FUNCTION AfxUnScaleY (BYVAL cy AS SINGLE) AS SINGLE
   LOCAL hDC AS DWORD
   hDC = GetDC(%NULL)
   FUNCTION = cy / (GetDeviceCaps(hDC, %LOGPIXELSY) / 96)
   ReleaseDC %NULL, hDC
END FUNCTION
' =====================================================================================


[José Roca]

File: GdipUtils.inc.

Code Select Expand


' ========================================================================================
' Returns the version of GdiPlus.dll
' ========================================================================================
FUNCTION GdiPlusDllVersion () AS CURRENCYX

   LOCAL pvsffi AS VS_FIXEDFILEINFO PTR
   LOCAL pVerInfo AS DWORD
   LOCAL dwHandle AS DWORD
   LOCAL dwVersion AS DWORD
   LOCAL cbLen AS DWORD
   LOCAL wMajor AS WORD
   LOCAL wMinor AS WORD
   cbLen = GetFileVersionInfoSize("GDIPLUS.DLL", dwHandle)
   IF cbLen THEN
      pVerInfo = HeapAlloc(GetProcessHeap, %HEAP_ZERO_MEMORY, cbLen)
      IF pVerInfo THEN
         IF GetFileVersionInfo("GDIPLUS.DLL", dwHandle, cbLen, BYVAL pVerInfo) THEN
            IF VerQueryValue(BYVAL pVerInfo, "\", BYVAL VARPTR(pvsffi), cbLen) THEN
               wMajor = HI(WORD, @pvsffi.dwFileVersionMS)
               wMinor = LO(WORD, @pvsffi.dwFileVersionMS)
            END IF
         END IF
         HeapFree GetProcessHeap, 0, pVerInfo
      END IF
   END IF
   FUNCTION = wMajor + wMinor / 100

END FUNCTION
' ========================================================================================