Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Vertical text in grid headers
Message
From
22/09/2018 16:21:46
 
 
To
18/09/2018 11:51:50
General information
Forum:
Visual FoxPro
Category:
Forms & Form designer
Environment versions
Visual FoxPro:
VFP 9 SP2
Miscellaneous
Thread ID:
01662096
Message ID:
01662205
Views:
72
>Dear All
>
>I'm facing the need to build a grid with text vertically oriented. The grid is not predefined in the number of columns it will have to support, and horizontal scrolling is a requisite.
>
>Other than setting grid's HeaderHeight to some sensible value + create images with the text vertically oriented + setting each header's .Picture accordingly, is there any other solution to that problem that won't involve synchronized grids?
>
>I don't mind writing this from scratch, but if there is some source out there already developed (even partially) to which I could be pointed, I would appreciate.

Update on this question (and sorry for the long post).

I managed to make this as transparent as possible. The Header class incorporates a Vertical property, and a SetVertical() method. When set to true, a vertical caption is built on the fly, using GDI libraries, and used in place of the text caption (that is, in the Header, Picture and Vertical properties do not work together, which I seem acceptable, for now).

If anyone is willing to try, this is the general setup.

a) Header new properties
	Vertical = .F.
	HIDDEN _VCaptionPicture, _HCaption
	_VCaptionPicture = ""
	_HCaption = .NULL.
b) Header Init method
	PROCEDURE Init
		IF DODEFAULT()
			This.SetVertical(This.Vertical)
		ELSE
			RETURN .F.
		ENDIF
	ENDPROC
c) Header Destroy method
	PROCEDURE Destroy
		DODEFAULT()
		IF !EMPTY(This._VCaptionPicture)
			ERASE (This._VCaptionPicture)
		ENDIF
	ENDPROC
d) Header SetVertical method (based on this post by Cesar Chalom: http://weblogs.foxite.com/vfpimaging/2012/03/16/draw-rotated-strings-with-gdiplusx/)
	PROCEDURE SetVertical (VStatus AS Logical)

		IF !PEMSTATUS(_Screen, "System", 5) OR !PEMSTATUS(_Screen.system, "Drawing", 5)
			This.Vertical = .F.
			RETURN .F.
		ENDIF

		IF PCOUNT() = 0
			RETURN This.Vertical
		ENDIF

		IF !m.VStatus
			IF This.Vertical AND !ISNULL(This._HCaption)
				This.Caption = This._HCaption
				This._HCaption = .NULL.
				This.Picture = ""
				IF !EMPTY(This._VCaptionPicture)
					ERASE (This._VCaptionPicture)
				ENDIF
				This._VCaptionPicture = ""
			ENDIF
			This.Vertical = .F.
			RETURN
		ENDIF

		LOCAL grFont AS xfcFont
		LOCAL FontStyle AS Integer
		m.FontStyle = 0
		IF This.FontBold
			m.FontStyle = m.FontStyle + _Screen.System.Drawing.FontStyle.Bold
		ENDIF
		IF This.FontItalic
			m.FontStyle = m.FontStyle + _Screen.System.Drawing.FontStyle.Italic
		ENDIF
		IF This.FontUnderline
			m.FontStyle = m.FontStyle + _Screen.System.Drawing.FontStyle.Underline
		ENDIF
		IF This.FontStrikethru
			m.FontStyle = m.FontStyle + _Screen.System.Drawing.FontStyle.Strikeout
		ENDIF

		m.grFont = _Screen.System.Drawing.Font.New(This.FontName, This.FontSize, m.FontStyle, _Screen.System.Drawing.GraphicsUnit.Point)

		LOCAL grBMP AS xfcBitmap

		m.grBMP = _Screen.System.Drawing.Bitmap.New(1, 1)

		LOCAL grGraphics AS xfcGraphics

		m.grGraphics = _Screen.System.Drawing.Graphics.Fromimage(m.grBMP)

		LOCAL grSize AS xfcSize

		m.grSize = m.grGraphics.MeasureString(This.Caption, m.grFont)

		LOCAL grNewBMP AS xfcBitmap
		LOCAL grTargetBMP AS xfcBitmap
		LOCAL grNewGraphics AS xfcGraphics

		m.grTargetBMP = _Screen.System.Drawing.Bitmap.New(ROUND(m.grSize.Height + 0.5, 0), ROUND(m.grSize.Width + 0.5, 0))

		m.grNewBMP = _Screen.System.Drawing.Bitmap.New(ROUND(MAX(m.grSize.Height, m.grSize.Width) + 0.5, 0), ;
								ROUND(MAX(m.grSize.Height, m.grSize.Width) + 0.5, 0))
		m.grNewGraphics = _Screen.System.Drawing.Graphics.Fromimage(m.grNewBMP)

		m.grNewGraphics.Clear(_Screen.System.Drawing.Color.FromRGB(BITRSHIFT(BITAND(This.BackColor, 0x00FF0000), 16), ;
								BITRSHIFT(BITAND(This.BackColor, 0x0FF00), 8), BITAND(This.BackColor, 0x0FF)))

		LOCAL grBrush AS xfcSolidBrush

		m.grBrush = _Screen.System.Drawing.SolidBrush.New(_Screen.System.Drawing.Color.FromRGB(BITRSHIFT(BITAND(This.ForeColor, 0x00FF0000), 16), ;
								BITRSHIFT(BITAND(This.ForeColor, 0x0FF00), 8), BITAND(This.ForeColor, 0x0FF)))

		LOCAL grStringFmt AS xfcStringFormat

		m.grStringFmt = _Screen.System.Drawing.StringFormat.New()
		m.grStringFmt.Alignment = _Screen.System.Drawing.StringAlignment.Center

		LOCAL grRect AS xfcRectangleF

		m.grRect = m.grNewBMP.GetBounds()

		m.grNewGraphics.TranslateTransform(m.grNewBMP.Width / 2, m.grNewBMP.Height / 2)
		m.grNewGraphics.RotateTransform(-90)
		m.grNewGraphics.TranslateTransform(-m.grNewBMP.Height / 2, -m.grNewBMP.Width / 2)

		m.grNewGraphics.DrawString(This.Caption, m.grFont, m.grBrush, m.grRect, m.grStringFmt)

	 	m.grNewGraphics.ResetTransform()

	 	m.grRect = m.grTargetBMP.GetBounds()
	 	m.grTargetBMP = .NULL.
	 	m.grTargetBMP = m.grNewBMP.Clone(m.grRect)

		LOCAL ARRAY CheckFile(1)
		IF !EMPTY(This._VCaptionPicture)
			ERASE (This._VCaptionPicture)
		ENDIF
		This._VCaptionPicture = ""
		DO WHILE EMPTY(This._VCaptionPicture) OR ADIR(m.CheckFile, This._VCaptionPicture) = 1
			This._VCaptionPicture = SYS(2023) + "~VFP_vh" + SYS(2015) + ".png"
		ENDDO

		m.grTargetBMP.Save(This._VCaptionPicture, _Screen.System.Drawing.Imaging.ImageFormat.PNG)

		This.Vertical = .T.
		This._HCaption = This.Caption
		This.Caption = ""
		This.Picture = This._VCaptionPicture

		STORE .NULL. TO m.grBrush, m.grFont, m.grRect, m.grSize, m.grStringFmt
		STORE .NULL. TO m.grBMP, m.grNewBMP, m.grTargetBMP
		STORE .NULL. TO m.grGraphics, m.grNewGraphics
 
	ENDPROC

ENDDEFINE
The result can be seen in the screenshots. The first demonstrates how a vertical header appears on a grid, and the other two how the vertical headers handle column reordering, and horizontal scroll.

A final but important note. I had to change a small piece of code in GDIPlusX library for this to work. VFP kept crashing when the form data session was set to Private (which is the standard in my actual setup). In system.prg, I changed the instantiation of DefaultSession to Steven Black's SessionFactory (at https://gist.github.com/StevenBlack/0b5238e6362078a6b33a). I'm still evaluating the impact of this change, so any insight on this - and anything else - will be welcome (of course, any conclusions I'll get on this will be forwarded and shared with GDIPlusX managers).
FUNCTION GetXfcSystemObject()
	LOCAL loObject, loDefault

	IF SET("Datasession") <> 1
		m.loDefault = CREATEOBJECT("DefaultSession")
		m.loObject = loDefault.Eval('CREATEOBJECT("xfcSystem")')
		m.loDefault = NULL
	ELSE
		m.loObject = CREATEOBJECT("xfcSystem")
	ENDIF
	RETURN m.loObject
ENDFUNC
was replaced by
FUNCTION GetXfcSystemObject()
	LOCAL loObject, Factory

	m.Factory = CREATEOBJECT("SessionFactory")
	m.loObject = m.Factory.CreateObject("xfcSystem")
	m.Factory = .NULL.
	RETURN m.loObject
ENDFUNC
----------------------------------
António Tavares Lopes
Previous
Reply
Map
View

Click here to load this message in the networking platform