2021-04-25

Getting the correct Windows version - OS()

VFP9's OS() function can't return reliable information to help us to detect wether running WIN10.

Under Win10, the OS() returns to us "Windows 6.02", the same information for Windows 8.

A Simple workaround is to use the RtlGetVersion Api call to get the OSVERSIONINFO structure that brings us the relevant information.

Save the code below as GETWINVERSION.PRG, and call it the same way you call the OS() function.


Parameters

nValue

Specifies the item to return, according to the following table.

nValues

ValueDescription

     1     

Specifies that the name and version number of the operating system is returned.

     3     

Identifies the major version number of the operating system. For example, for Windows 2000, the major number is 5.
For Windows 10, the major number is 10.

     4     

Identifies the minor version number of the operating system. For example, for Windows 2000, the minor version number is 0.

     5     

Identifies the build number of the operating system.





FUNCTION GetWinVersion(tnType)
* Similar to VFP9 OS() function, returning the correct Win version for Windows 10

* OSVERSIONINFOA structure (winnt.h)
* https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-osversioninfoa
*!*	typedef struct _OSVERSIONINFOA {
*!*	  DWORD dwOSVersionInfoSize;
*!*	  DWORD dwMajorVersion;
*!*	  DWORD dwMinorVersion;
*!*	  DWORD dwBuildNumber;
*!*	  DWORD dwPlatformId;
*!*	  CHAR  szCSDVersion[128];
*!*	} OSVERSIONINFOA, *POSVERSIONINFOA, *LPOSVERSIONINFOA

*!*	The following table summarizes the values returned by supported versions of Windows. 
*!*	Use the information in the column labeled "Other" to distinguish between operating systems with identical version numbers.

*!*	Operating system	 Version dwMajorVersion	dwMinorVersion	Other
*!*	Windows 10	           10.0*		    10		0	
*!*	Windows Server 2016	   10.0*		    10		0	
*!*	Windows 8.1	            6.3*		     6		3	
*!*	Windows Server 2012 R2	6.3*		     6		3	
*!*	Windows 8	              6.2		       6		2	
*!*	Windows Server 2012	    6.2	    	   6		2	
*!*	Windows 7	              6.1	    	   6		1	
*!*	Windows Server 2008 R2	6.1	    	   6		1	
*!*	Windows Server 2008	    6.0	    	   6		0	
*!*	Windows Vista	          6.0	    	   6		0	
*!*	Windows Server 2003 R2	5.2	    	   5		2	
*!*	Windows Server 2003	    5.2	    	   5		2	
*!*	Windows XP	            5.1	    	   5		1	
*!*	Windows 2000	          5.0	    	   5		0	
*!*	* For applications that have been manifested for Windows 8.1 or Windows 10. Applications not manifested for Windows 8.1 or Windows 10 will return the Windows 8 OS version value (6.2). To manifest your applications for Windows 8.1 or Windows 10, refer to Targeting your application for Windows.

LOCAL lcOS, lcOsVersionInfo, lcReturn, lcVersion, lnBuild, lnMajor, lnMinor, lnPlatformId, lnRet, lnSize

* https://docs.microsoft.com/en-us/windows/win32/devnotes/rtlgetversion
DECLARE INTEGER RtlGetVersion IN NTDLL.DLL STRING @lcOsVersionInfo

m.lcOsVersionInfo = REPLICATE(CHR(0), 148) && Initialize osVersionInfo structure
m.lnRet = RtlGetVersion( @m.lcOsVersionInfo )

m.lnSize = CTOBIN(SUBSTR(m.lcOsVersionInfo, 1, 2), "2RS") && DWORD dwlcOsVersionInfoSize
m.lnMajor = CTOBIN(SUBSTR(m.lcOsVersionInfo, 5, 4), "4RS") && DWORD dwMajorVersion
m.lnMinor = CTOBIN(SUBSTR(m.lcOsVersionInfo, 9, 4), "4RS") && DWORD dwMinorVersion
m.lnBuild = CTOBIN(SUBSTR(m.lcOsVersionInfo, 13, 4), "4RS") && DWORD dwBuildNumber
m.lnPlatformId = CTOBIN(SUBSTR(m.lcOsVersionInfo, 17, 4), "4RS") && DWORD dwPlatformId
m.lcVersion = SUBSTR(m.lcOsVersionInfo, 21) && CHAR  szCSDVersion[128]

DO CASE

CASE EMPTY(m.tnType)
	DO CASE
	CASE m.lnMajor = 10 AND m.lnMinor = 0
		m.lcOS = "Windows 10"
	CASE m.lnMajor = 6 AND m.lnMinor = 3
		m.lcOS = "Windows 8.1 / Server 2012 R2"
	CASE m.lnMajor = 6 AND m.lnMinor = 2
		m.lcOS = "Windows 8 / Server 2012"
	CASE m.lnMajor = 6 AND m.lnMinor = 1
		m.lcOS = "Windows 7 / Server 2008 R2"
	CASE m.lnMajor = 6 AND m.lnMinor = 0
		m.lcOS = "Windows Vista / Server 2008"
	CASE m.lnMajor = 5 AND m.lnMinor = 2
		m.lcOS = "Windows Server 2003"
	CASE m.lnMajor = 5 AND m.lnMinor = 1
		m.lcOS = "Windows XP"
	CASE m.lnMajor = 5 AND m.lnMinor = 0
		m.lcOS = "Windows 2000"
	OTHERWISE
	ENDCASE
	m.lcReturn = m.lcOS + " " + TRANSFORM(m.lnMajor) + "." + TRANSFORM(m.lnMinor) + " build " + TRANSFORM(m.lnBuild)

CASE m.tnType = 1
	m.lcReturn = "Windows " + TRANSFORM(m.lnMajor) + "." + TRANSFORM(m.lnMinor)

CASE INLIST(m.tnType, 2, 6, 7, 8, 9, 10, 11)
	m.lcReturn = ""

CASE m.tnType = 3
	m.lcReturn = TRANSFORM(m.lnMajor)

CASE m.tnType = 4
	m.lcReturn = TRANSFORM(m.lnMinor)

CASE m.tnType = 5
	m.lcReturn = TRANSFORM(m.lnBuild)

OTHERWISE
	m.lcReturn = ""

ENDCASE
RETURN m.lcReturn


2021-04-08

Segoe MDL2 Assets Icons in VFP9 with Gdi+

As discussed before in this blog, VFP can't display natively any character having its CHR() higher than 0xFF (decimal 255). 

There are several very interesting fonts that bring very cool and up to date icons that we could use in our apps, such as the SEGOE MDL2 ASSETS, used by Windows 10 all over.

The Unicodes can be obtained directly by the CharMap.EXE or all over the web. Here's an excellent starting point: https://docs.microsoft.com/en-us/windows/uwp/design/style/segoe-ui-symbol-font


The samples below will use GDI+ to save any desired character as an image, allowing us to use those cool images in our apps. They use the _GDIPLUS.VCX FFC classes, but is really very easy to adapt to GdiPlusX as well, if needed.

Adapt it to your needs!

Basically a function that retrieves a single unicode character and saves it as an image file. 

Usage:
To get the "Print" icon: 


EXTRACT A SINGLE ICON


lcFile = "Print.bmp"
lcUnicode = "e749"
lcFont = "SEGOE MDL2 ASSETS"
lnSize = 32 && Pixels
lnForeColor = RGB(0, 0, 255) && Black
lnBackColor = RGB(255, 255, 255) && White
=MakeImageFromUnicode(m.lcFile, lcUnicode, lcFont, lnSize, lnForeColor, lnBackColor)


Save the code Below as "MakeImageFromUnicode.prg":


FUNCTION MakeImageFromUnicode(tcFileName, tcUnicode, tcFontName, tnImgSize, tnForeColor, tnBackColor)
*!* tcUnicode allows up to 2 characters, that will be drawn one over the other
*!* Par1: Main Unicode
*!* Par2: Socondary Unicode
*!* Par3: Mode, where 0=Center, 1=TopLeft, 2=TopRight, 3=BottLeft, 4=BottRight
*!* Par4: Size of the 2nd character

	LOCAL lnChars, lnFactor, lnFontHeight, lnFontSize, lnHeight, lnLines, lnNewFontSize, lnWidth
	LOCAL lqUnicode
	LOCAL lcUnicode1, lcUnicode2, lnMode, lnSize2
	IF EMPTY(m.tcFileName) OR EMPTY(m.tcUnicode) OR EMPTY(m.tcFontName) OR EMPTY(m.tnImgSize)
		RETURN
	ENDIF

	m.lnFontSize = 48
	m.lnWidth	 = m.tnImgSize
	m.lnHeight	 = m.tnImgSize

	* Create a font object using the text object's settings.
	LOCAL loFont0 AS GpFont OF HOME() + "FFC/_GdiPlus.vcx"
	m.loFont0 = NEWOBJECT('gpFont', HOME() + 'FFC/_GdiPlus.vcx')
	m.loFont0.Create(m.tcFontName, m.lnFontSize, 0, 3) && 0 = Font Style

	LOCAL loGfx0 AS GpGraphics OF HOME() + "FFC/_GdiPlus.vcx"
	m.loGfx0 = NEWOBJECT('gpGraphics', home() + 'FFC\_GdiPlus.vcx')
	m.loGfx0.CreateFromHWnd(_screen.HWnd)
	m.lnChars = 0
	m.lnLines = 0

	LOCAL loSize AS gpSize OF HOME() + "FFC/_GdiPlus.vcx"
	m.loSize  = m.loGfx0.MeasureStringA("A", m.loFont0, , , @m.lnChars, @m.lnLines)
	* lnFontWidth = loSize.W
	m.lnFontHeight	= m.loSize.H
	m.lnFactor		= m.lnFontHeight / m.tnImgSize
	m.lnNewFontSize	= INT(m.lnFontSize / m.lnFactor)

	* Create a font object using the text object's settings.
	LOCAL loFont AS GpFont OF HOME() + "FFC/_GdiPlus.vcx"
	m.loFont = NEWOBJECT('gpFont', HOME() + 'FFC/_GdiPlus.vcx')
	m.loFont.Create(m.tcFontName, m.lnNewFontSize, 0, 3) && 0 = Font Style

	LOCAL loBMP AS GpBitmap OF HOME() + "FFC/_GdiPlus.vcx"
	m.loBMP = NEWOBJECT("gpBitmap", HOME() + "FFC/_GdiPlus.vcx")
	#DEFINE GdiPlus_PixelFormat_32BPPARGB        0x0026200a
	m.loBMP.Create(m.lnHeight, m.lnHeight, GdiPlus_PixelFormat_32BPPARGB)

	LOCAL loGfx AS GpGraphics OF HOME() + "FFC/_GdiPlus.vcx"
	m.loGfx = NEWOBJECT('gpGraphics', HOME() + 'FFC/_GdiPlus.vcx')
	m.loGfx.CreateFromImage(m.loBMP)

	* Setting the Backcolor
	LOCAL loBackColor AS GpColor OF HOME() + "FFC/_GdiPlus.vcx"
	IF EMPTY(m.tnBackColor)
		m.loBackColor = 0xFFFFFFFF && White background
	ELSE
		m.loBackColor		 = NEWOBJECT("gpColor", HOME() + 'FFC/_GdiPlus.vcx')
		m.loBackColor.FoxRGB = m.tnBackColor
	ENDIF
	m.loGfx.CLEAR(m.loBackColor) && Background

	* Create a rectangle
	LOCAL loRect AS GpRectangle OF HOME() + "FFC/_GdiPlus.vcx"
	m.loRect = NEWOBJECT("GPRectangle", HOME() + 'FFC/_GdiPlus.vcx', "", 0, 0, m.lnWidth, m.lnHeight)
	m.loRect.y = m.loRect.y + 1

	* Setting the Forecolor
	LOCAL loColor AS GpColor OF HOME() + "FFC/_GdiPlus.vcx"
	IF EMPTY(m.tnForeColor)
		m.tnForeColor = 0 && Black
	ENDIF
	m.loColor		 = NEWOBJECT("gpColor", HOME() + 'FFC/_GdiPlus.vcx')
	m.loColor.FoxRGB = m.tnForeColor

	LOCAL loBrush AS GpSolidBrush OF HOME() + "FFC/_GdiPlus.vcx"
	m.loBrush = NEWOBJECT("gpSolidBrush", HOME() + 'FFC/_GdiPlus.vcx', "", m.loColor)

	* The character need to be drawn at the center of the image object
	* Get a basic string format object
	* StringAlignment enumeration
	* Applies to GpStringFormat::Alignment, GpStringFormat::LineAlignment
	#DEFINE GDIPLUS_STRINGALIGNMENT_Near	0	&& in Left-To-Right locale, this is Left
	#DEFINE GDIPLUS_STRINGALIGNMENT_Center	1
	#DEFINE GDIPLUS_STRINGALIGNMENT_Far		2	&& in Left-To-Right locale, this is Right
	LOCAL loStringFormat AS gpStringFormat OF HOME() + "FFC/_GdiPlus.vcx"
	m.loStringFormat = NEWOBJECT("GpStringFormat", HOME() + "FFC/_GdiPlus.vcx")
	m.loStringFormat.Create()
	m.loStringFormat.Alignment	   = GDIPLUS_STRINGALIGNMENT_Center
	m.loStringFormat.LineAlignment = GDIPLUS_STRINGALIGNMENT_Center

	* Prepare the Unicode
	m.lcUnicode1 = GETWORDNUM(m.tcUnicode, 1, ",")
	m.lqUnicode	 = LEFT(BINTOC(EVALUATE("0x" + m.lcUnicode1), "4RS"), 2)

	* Draw the string
	m.loGfx.DrawStringW(m.lqUnicode, m.loFont, m.loRect, m.loStringFormat, m.loBrush)
	m.lcUnicode2	= GETWORDNUM(m.tcUnicode, 2, ",")

	IF NOT EMPTY(m.lcUnicode2)
		m.lqUnicode	= LEFT(BINTOC(EVALUATE("0x" + m.lcUnicode2), "4RS"), 2)
		m.lnMode	= VAL(GETWORDNUM(m.tcUnicode, 3, ","))
		m.lnSize2	= VAL(GETWORDNUM(m.tcUnicode, 4, ","))
		m.lnSize2	= EVL(m.lnSize2, 100)

		lnNewFontSize = CEILING(m.lnNewFontSize * (lnSize2/100))
		m.loFont.Create(m.tcFontName, m.lnNewFontSize, 0, 3) && 0 = Font Style
		m.loStringFormat.Alignment	   = GDIPLUS_STRINGALIGNMENT_Center
		m.loStringFormat.LineAlignment = GDIPLUS_STRINGALIGNMENT_Center

		m.loRect.w = INT(m.lnWidth  * (m.lnSize2 / 100))
		m.loRect.H = INT(m.lnHeight * (m.lnSize2 / 100))

		DO CASE
			CASE m.lnMode = 0 && No transformation, the 2nd image will be drawn over the original
				m.loRect.x = INT((m.lnWidth  - m.loRect.w) / 2)
				m.loRect.Y = INT((m.lnHeight - m.loRect.H) / 2)

			CASE m.lnMode = 1 && Top-Left
				m.loRect.x = 0
				m.loRect.Y = 0

			CASE m.lnMode = 2 && Top-Right
				m.loRect.x = m.lnWidth - m.loRect.w
				m.loRect.Y = 0

			CASE m.lnMode = 3 && Bottom-Left
				m.loRect.x = 0
				m.loRect.Y = m.lnHeight - m.loRect.H

			CASE m.lnMode = 4 && Bottom-Right
				m.loRect.x = m.lnWidth - m.loRect.w
				m.loRect.Y = m.lnHeight - m.loRect.H

			OTHERWISE
		ENDCASE
		m.loRect.y = m.loRect.y + 1
		m.loGfx.DrawStringW(m.lqUnicode, m.loFont, m.loRect, m.loStringFormat, m.loBrush)
	ENDIF

	* Save as image
	m.loBMP.SaveToFile(m.tcFileName, "image/bmp")

	RETURN
ENDFUNC 


The function also allows you to create new icons by merging two, in this case, the Printer and the Settings icon at the bottom right:

CUSTOMIZE YOUR ICONS


lcFile = "Print.bmp"
lcUnicode = "e749,e713,4,25"
lcFont = "SEGOE MDL2 ASSETS"
lnSize = 32 && Pixels
lnForeColor = RGB(0, 0, 128) && Dark Blue
lnBackColor = RGB(255, 255, 128) && Yellow
=MakeImageFromUnicode(m.lcFile, lcUnicode, lcFont, lnSize, lnForeColor, lnBackColor)


EXTRACTING ALL ICONS FROM A FONT

The above function can be adapted in order to extract all characters of a given font, using a loop.
Fonts usually have some codes that are not being used, so in the code below I used a simple trick to detect the empty font dimensions, and every time the same conditions are met in the loop, the unicode will be discarded.
Just run the code below to extract all icons from any given font, at the desired image size and colors. Adjust the initial variables to fit your needs!

* Setup the initial 5 variables
LOCAL lcFontName, lnImgSize, lnForeColor, lnBackColor, lcImageType
m.lcFontName  = "SEGOE MDL2 ASSETS"
m.lnImgSize	  = 64  && The desired bmp size in pixels
m.lnForeColor = RGB(0, 0, 0) && the ForeColor
m.lnBackColor = RGB(255, 255, 255) && the BackColor
m.lcImageType = "bmp" && available: bmp, jpg, gif, tif, png



* Let's start
LOCAL lcEmptyUnicode, lcFileName, lcHex, lcUnicode, lnChars, lnEmptyH, lnEmptyW, lnFactor
LOCAL lnFontHeight, lnFontSize, lnFontWidth, lnHeight, lnLines, lnNewFontSize, lnWidth, loSizeReal, n

m.lnFontSize  = 48
m.lnWidth	  = m.lnImgSize
m.lnHeight	  = m.lnImgSize
m.lcImageType = LOWER(EVL(m.lcImageType, "bmp"))

* Create a rectangle
LOCAL loRect AS GpRectangle OF HOME() + "FFC/_GdiPlus.vcx"
m.loRect   = NEWOBJECT("GPRectangle", HOME() + 'FFC/_GdiPlus.vcx', "", 0, 0, m.lnWidth, m.lnHeight)
m.loRect.y = m.loRect.y + 1

* The character need to be drawn at the center of the image object
* Get a basic string format object
* StringAlignment enumeration
* Applies to GpStringFormat::Alignment, GpStringFormat::LineAlignment
#DEFINE GDIPLUS_STRINGALIGNMENT_Near	0	&& in Left-To-Right locale, this is Left
#DEFINE GDIPLUS_STRINGALIGNMENT_Center	1
#DEFINE GDIPLUS_STRINGALIGNMENT_Far		2	&& in Left-To-Right locale, this is Right
LOCAL loStringFormat AS gpStringFormat OF HOME() + "FFC/_GdiPlus.vcx"
m.loStringFormat = NEWOBJECT("GpStringFormat", HOME() + "FFC/_GdiPlus.vcx")
m.loStringFormat.Create()
m.loStringFormat.Alignment	   = GDIPLUS_STRINGALIGNMENT_Center
m.loStringFormat.LineAlignment = GDIPLUS_STRINGALIGNMENT_Center



* Create a font object using the text object's settings.
LOCAL loFont0 AS GpFont OF HOME() + "FFC/_GdiPlus.vcx"
m.loFont0 = NEWOBJECT('gpFont', HOME() + 'FFC/_GdiPlus.vcx')
m.loFont0.Create(m.lcFontName, m.lnFontSize, 0, 3) && 0 = Font Style

LOCAL loGfx0 AS GpGraphics OF HOME() + "FFC/_GdiPlus.vcx"
m.loGfx0 = NEWOBJECT('gpGraphics', home() + 'FFC\_GdiPlus.vcx')
m.loGfx0.CreateFromHWnd(_screen.HWnd)

LOCAL loSize AS gpSize OF HOME() + "FFC/_GdiPlus.vcx"
m.lnChars	   = 0
m.lnLines	   = 0
m.loSize	   = m.loGfx0.MeasureStringA("A", m.loFont0, , , @m.lnChars, @m.lnLines)
m.lnFontWidth  = m.loSize.W
m.lnFontHeight = m.loSize.H

m.lnFactor		= m.lnFontHeight / m.lnImgSize
m.lnNewFontSize	= INT(m.lnFontSize / m.lnFactor)

* Create a font object using the text object's settings.
LOCAL loFont AS GpFont OF HOME() + "FFC/_GdiPlus.vcx"
m.loFont = NEWOBJECT('gpFont', HOME() + 'FFC/_GdiPlus.vcx')
m.loFont.Create(m.lcFontName, m.lnNewFontSize, 0, 3) && 0 = Font Style

* Get the measure of the empty character, that will be used to avoid saving it several times
m.lcEmptyUnicode = CHR(0) + CHR(0)
LOCAL loSizeEmpty AS gpSize OF HOME() + "FFC/_GdiPlus.vcx"
m.loSizeEmpty = m.loGfx0.MeasureStringW(m.lcEmptyUnicode, m.loFont, m.loRect, m.loStringFormat, @m.lnChars, @m.lnLines)
m.lnEmptyW	  = m.loSizeEmpty.W
m.lnEmptyH	  = m.loSizeEmpty.H

LOCAL loBMP AS GpBitmap OF HOME() + "FFC/_GdiPlus.vcx"
m.loBMP = NEWOBJECT("gpBitmap", HOME() + "FFC/_GdiPlus.vcx")
#DEFINE GdiPlus_PixelFormat_32BPPARGB        0x0026200a
m.loBMP.Create(m.lnHeight, m.lnHeight, GdiPlus_PixelFormat_32BPPARGB)

LOCAL loGfx AS GpGraphics OF HOME() + "FFC/_GdiPlus.vcx"
m.loGfx = NEWOBJECT('gpGraphics', HOME() + 'FFC/_GdiPlus.vcx')
m.loGfx.CreateFromImage(m.loBMP)

* Setting the Backcolor
LOCAL loBackColor AS GpColor OF HOME() + "FFC/_GdiPlus.vcx"
IF EMPTY(m.lnBackColor)
   m.loBackColor = 0xFFFFFFFF && White background
ELSE
   m.loBackColor		 = NEWOBJECT("gpColor", HOME() + 'FFC/_GdiPlus.vcx')
   m.loBackColor.FoxRGB = m.lnBackColor
ENDIF

* Setting the Forecolor
LOCAL loColor AS GpColor OF HOME() + "FFC/_GdiPlus.vcx"
IF EMPTY(m.lnForeColor)
   m.lnForeColor = 0 && Black
ENDIF
m.loColor		 = NEWOBJECT("gpColor", HOME() + 'FFC/_GdiPlus.vcx')
m.loColor.FoxRGB = m.lnForeColor

LOCAL loBrush AS GpSolidBrush OF HOME() + "FFC/_GdiPlus.vcx"
m.loBrush = NEWOBJECT("gpSolidBrush", HOME() + 'FFC/_GdiPlus.vcx', "", m.loColor)


FOR m.n = 0xe001 TO 0xf8b3 && the last available found in charmap
   m.lcHex		 = TRANSFORM(m.n, "@0")
   m.lcHex		 = STRTRAN(m.lcHex, "0x0000", "")
   m.lcFileName = FORCEEXT(m.lcHex, m.lcImageType)

   * Prepare the Unicode
   m.lcUnicode	 = LEFT(BINTOC(EVALUATE("0x" + m.lcHex), "4RS"), 2)

   m.loSizeReal = m.loGfx0.MeasureStringW(m.lcUnicode, m.loFont, m.loRect, m.loStringFormat, @m.lnChars, @m.lnLines)

   m.loGfx.CLEAR(m.loBackColor) && Background

   * Draw the string
   m.loGfx.DrawStringW(m.lcUnicode, m.loFont, m.loRect, m.loStringFormat, m.loBrush)

   * Save as image
   m.loBMP.SaveToFile(m.lcFileName, "image/" + m.lcImageType)
ENDFOR

* Clear GDI+ objects
m.loRect         = NULL
m.loStringFormat = NULL
m.loColor        = NULL
m.loBackColor    = NULL
m.loBrush        = NULL
m.loSize         = NULL
m.loSizeEmpty    = NULL
m.loGfx0         = NULL
m.loGfx          = NULL
m.loBMP          = NULL
m.loFont0        = NULL
m.loFont         = NULL

RETURN

 

IMPORTANT

Don't forget that all fonts have a license. That means that you need to check first if you are allowed to distribute the images generated. Make sure to read the EULA, and see what you can or cannot do with them, ok?


SEE ALSO

Unicode button icons in Visual FoxPro
Unicode Controls in Visual FoxPro - A new faster and efficient aproach
Unicode Button Icons in Visual FoxPro

2021-03-23

Saving a VFP Report at a higher resolution with FoxyPreviewer

VFP9 brought the possibility to save our reports as images, using the ReportListener class, and the OutputPage method:

loListener.OutputPage(lnPage, "\MyReportImage.PNG", 104) && PNG file type


This brings us some useful, but lousy images regarding quality. For instance, the Sample "COLORS.FRX" brings me a 816 x 1056 pixels image - a really poor quality image, if we are thinking of printing or manipulating it further.


But the "OutputPage" method also allows us to draw the report page at any desired image size, by passing a GDI+ Graphics handle instead of the file name widely used.

Here is the working sample - notice that the report engine works only with 96 DPI, so to have better quality, you need to save in bigger dimensions.

Use the function GETREPORTPAGEEX to get your higher resolution reports, here is the parameter list

  • tcFile - The destination image file name
  • toListener - The ReportListener associated with the current report
  • tnPage - The report page number
  • tnEncoder - 100=EMF, 101=TIFF, 102=JPEG, 103=GIF, 104=PNG, 105=BMP
  • tnScale - the scale factor to be applied to the image. 1=Default (low quality), 10=Super high quality
  • tnWidth - The output image width (optional, if using the "tnScale")
  • tnHeight - The output image height (optional, if using "tnScale")


DO FoxyPreviewer.App

LOCAL loListener AS REPORTLISTENER
LOCAL lcFile, lnPage, lnFileType
m.loListener			  = CREATEOBJECT("FoxyListener")
m.loListener.LISTENERTYPE = 3

REPORT FORM (ADDBS(_Samples) + "Solution\Reports\Colors.FRX") OBJECT m.loListener

m.lnFileType = 104 && PNG
	&& 100 - EMF
	&& 101 - TIFF
	&& 102 - JPEG
	&& 103 - GIF
	&& 104 - PNG
	&& 105 - BMP

FOR m.lnPage = 1 TO m.loListener.PAGETOTAL
	m.lcFile = "c:\temp\Test__" + SYS(2015) + "__" + ALLTRIM(STR(m.lnPage)) + ".png"
	GetReportPageEx(m.lcFile, m.loListener, m.lnPage, m.lnFileType, 5) && 5 times bigger image than default
	* For the default lower quality image, use:
	*   loListener.OutputPage(lnPage, "c:\Test" + ALLTRIM(STR(lnPage)) + ".png", lnFileType)
ENDFOR
m.loListener = NULL
RETURN



PROCEDURE GetReportPageEx(tcFile, toListener AS REPORTLISTENER, tnPage, tnEncoder, tnScale, tnWidth, tnHeight)
	LOCAL lhGfx
	*!*	100 - image type EMF
	*!*	101 - image type TIFF
	*!*	102 - image type JPEG
	*!*	103 - image type GIF
	*!*	104 - image type PNG
	*!*	105 - image type BMP
	m.tnEncoder	= EVL(m.tnEncoder, 104) && Default = 104-PNG
	m.tnScale	= EVL(m.tnScale, 1)
	IF EMPTY(m.tnWidth)
		m.tnWidth  = m.toListener.GETPAGEWIDTH()  / 10 * m.tnScale
		m.tnHeight = m.toListener.GETPAGEHEIGHT() / 10 * m.tnScale
	ENDIF

	#DEFINE Gdiplus_PixelFormat_32BppArgb		0x0026200a
	#DEFINE OUTPUTDEVICETYPE_GDIPLUS 			1

	LOCAL loBMP AS GpBitmap OF ADDBS(HOME()) + "/FFC/_GDIPLUS.VCX"
	m.loBMP = NEWOBJECT("GpBitmap", ADDBS(HOME()) + "/FFC/_GDIPLUS.VCX")
	m.loBMP.CREATE(m.tnWidth, m.tnHeight, Gdiplus_PixelFormat_32BppArgb)

	LOCAL loGfx AS GpGraphics OF ADDBS(HOME()) + "/FFC/_GDIPLUS.VCX"
	m.loGfx = NEWOBJECT('GpGraphics', ADDBS(HOME()) + "/FFC/_GDIPLUS.VCX")
	m.loGfx.CreateFromImage(m.loBMP)
	m.lhGfx = m.loGfx.GetHandle()

	m.toListener.OUTPUTPAGE(m.tnPage, m.lhGfx, OUTPUTDEVICETYPE_GDIPLUS, 0, 0, m.tnWidth, m.tnHeight, 0, 0, m.tnWidth, m.tnHeight)
	m.loBMP.SaveToFile(m.tcFile, "image/png")
ENDPROC

2021-01-31

IMAP Configuration issues - "Sent items" not saving in Outlook and WLM - Windows Live Mail

I've just passed through a weird issue, when after reconfiguring Outlook Mail, the "Sent items" folder was not showing the sent e-mails. Of course, I made sure to tick the checkbox that tells to store the sent items.

After a long search, I found the most ridiculous solution from "Hawk", at:

https://answers.microsoft.com/en-us/windowslive/forum/livemail-files/windows-live-mail-my-sent-items-are-no-longer/b9d6f6eb-0072-4d5f-875c-55ce01d81e87

This problem is very easy to fix if this is an IMAP mail folder.


You may notice that your drafts aren't saving either, in fact nothing is going into the folders from your computer when you produce a mail. You may find that mail produced from other devices appears, but not the mail from your windows 7 computer. You may also notice that your folders, Drafts, Junk E-mail, etc are not positioned at the left hand side of the list, but are in fact tabbed across a bit, right of the inbox. Is this so?


The Solution is simple:


1) Right Click on the account and open Properties

2) Go to the IMAP tab.

3) Enter "Inbox" into the Root folder path *AND HERE's THE TRICK: IT MUST BE "Inbox", not "inbox" the entry is case sensitive.

4) Press apply and let the folders reorganise themselves. They should now reload and all be on the left hand side.


Done. New sent items, drafts etc will now move to the correct folders.

2021-01-23

PUTFILE function as originally typed (not in uppercase)

As already discussed in Fox.Wikis - "VFP has always been a bit funny about filename cases. More specifically, how it works with filename case is not documented. It will translate filenames to lower case in some cases, and to upper in others, and leave it alone in yet others." PUTFILE is in that list of strange functions, always returning UPPERCASE file names. So here's a short function that I've been using that returns the chosen filename the way the user typed.

The parameters and usage is exactly the same as the VFP original PUTFILE function:

FUNCTION XPUTFILE(tcCustomText, tcFileName, tcFileExt)

	* Usage:
	* ? PUTFILE("Save file as...", "MyFile.PDF", "PDF;TXT;*")

	#DEFINE COMMDLOG_DEFAULT_FLAG 	0x00080000
	#DEFINE COMMDLOG_RO 			4
	#DEFINE COMMDLOG_MULTFILES 		512

	LOCAL lcSetDefa
	m.lcSetDefa = SET("Default") + CURDIR()

	LOCAL loDlgForm AS "Form"
	m.loDlgForm = CREATEOBJECT("Form")
	m.loDlgForm.ADDOBJECT("oleObject1", "oleComDialObject")

	LOCAL loDlg
	m.loDlg = m.loDlgForm.OleObject1

	LOCAL lcFilter, lcFileExt, lnExtCount, n
	IF NOT EMPTY(tcFileExt)
		lnExtCount = GETWORDCOUNT(m.tcFileExt, ";")
		lcFilter = ""
		FOR n = 1 TO lnExtCount
			lcFileExt = GETWORDNUM(m.tcFileExt, n, ";")
			IF lcFileExt = "*"
				lcFilter = lcFilter + "All files|*.*"
			ELSE 
				lcFilter = lcFilter + lcFileExt + " files|*." + lcFileExt && EVL(tcFileExt, "All files|*.*")
			ENDIF			
			IF n < lnExtCount
				lcFilter = lcFilter + "|"
			ENDIF 
		ENDFOR
	ELSE
		lcFilter = "*.*|*.*" && EVL(tcFileExt, "All files|*.*")
	ENDIF 

	m.loDlg.FILTER		= lcFilter
	m.loDlg.FileName	= EVL(m.tcFileName, "")
	m.loDlg.DialogTitle	= EVL(m.tcCustomText, "Save file as...")
	m.loDlg.FLAGS		= COMMDLOG_RO + COMMDLOG_DEFAULT_FLAG
	m.loDlg.MaxFileSize	= 256

	LOCAL lnResult AS INTEGER, lcFileName
	* lnResult = loDlg.ShowOpen()
	m.lnResult = m.loDlg.ShowSave()

	* Restore the original directory
	SET DEFAULT TO (m.lcSetDefa)

	IF EMPTY(m.loDlg.FileTitle) && Clicked 'Cancel'
		m.lcFileName = ""
	ELSE
		m.lcFileName = m.loDlg.FileName
	ENDIF
	m.loDlgForm = NULL
	RETURN m.lcFileName


DEFINE CLASS oleComDialObject AS OLECONTROL
	OLECLASS ="MSComDlg.CommonDialog.1"
ENDDEFINE