Vertical = .F. HIDDEN _VCaptionPicture, _HCaption _VCaptionPicture = "" _HCaption = .NULL.b) Header Init method
PROCEDURE Init IF DODEFAULT() This.SetVertical(This.Vertical) ELSE RETURN .F. ENDIF ENDPROCc) Header Destroy method
PROCEDURE Destroy DODEFAULT() IF !EMPTY(This._VCaptionPicture) ERASE (This._VCaptionPicture) ENDIF ENDPROCd) 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 ENDDEFINEThe 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.
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 ENDFUNCwas replaced by
FUNCTION GetXfcSystemObject() LOCAL loObject, Factory m.Factory = CREATEOBJECT("SessionFactory") m.loObject = m.Factory.CreateObject("xfcSystem") m.Factory = .NULL. RETURN m.loObject ENDFUNC