Advertisement
1_2002 Custom Controls/ Forms/ Menus #104733

Display vertical Text in a MSFlexGrid

With this code you are able to display vertical Text in a Flexgrid. This is very helpfull, when you need to display a column which only has a YES/NO Value and would waste to much horizontal Column Space to display the Column Header

AI

AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Source Code
original-source
Private Sub Form_Load()
'---------------------------------------------------------------------------
---------------
' Name  : Form_Load
' Purpose  : Event when Form is being loaded
' Parameters :
' Date  : Sonntag 22 August 1999 17:36
' Revised  :
'---------------------------------------------------------------------------
---------------
 'Draw the Text
 DrawText
End Sub
Private Sub DrawText()
'---------------------------------------------------------------------------
---------------
' Name  : DrawText
' Purpose  : This Function Draws the Text vertical
' Parameters :
' Date  : Sonntag 22 August 1999 17:36
' Revised  :
'---------------------------------------------------------------------------
---------------
 'Declaration
 Dim stText1 As String
 Dim stText2 As String
 Dim imaxWidth As Integer
 Dim picTmp As PictureBox
 'Define the Text, add some extra spaces before and after the Text
 stText1 = " This is my vertical Text "
 stText2 = " This is shorter "
 'Get the max Width of the Text which will be displayed
 If TextWidth(stText1) > imaxWidth Then imaxWidth = TextWidth(stText1)
 If TextWidth(stText2) > imaxWidth Then imaxWidth = TextWidth(stText2)
 'Start with
 With MSFlexGrid1
 'Set the Width of the Col's so that the Text will be
 'Displayed ok
 .ColWidth(0) = TextHeight("W") * 2
 .ColWidth(1) = TextHeight("W") * 2
 'Set Hight of the First Row, thats where we are going to display
 'the vertical Text
 .RowHeight(0) = imaxWidth
 'Set Row for the First Time
 .Row = 0
 'Save Rotated Text
 Set picTmp = GetRotatetText(stText1)
 'Set Col
 .Col = 0
 'Set Picture
 Set .CellPicture = picTmp.Image
 'Save Rotated Text
 Set picTmp = GetRotatetText(stText2)
 'Set Col
 .Col = 1
 'Set Picture
 Set .CellPicture = picTmp.Image
 'End with
 End With
End Sub
Public Function GetRotatetText(stText As String) As PictureBox
'---------------------------------------------------------------------------
---------------
' Name  : GetRotatetText
' Purpose  : This Function Returns the Picture, which contains the
verical drawed Text
' Parameters : stText Contains the Text which has to be draw
' Date  : Sonntag 22 August 1999 17:37
' Revised  :
'---------------------------------------------------------------------------
---------------
 'Declaration
 Dim iIndex As Integer
 'Check if the first Picture has been used allready
 If Picture1(0).Tag <> "" Then
 Load Picture1(Picture1.Count)
 Else
 Picture1(0).Tag = "used"
 End If
 'Save Index
 iIndex = Picture1.Count - 1
 'Start with
 With Picture1(iIndex)
 'Set the Heigth
 .Height = MSFlexGrid1.RowHeight(0)
 'Draws the Text on the PictureBox
 DrawRotatedText Picture1(iIndex), 0, .Height, 90, stText
 'Set Return
 Set GetRotatetText = Picture1(iIndex)
 'End with
 End With
End Function
Public Function DrawRotatedText(ByVal pTarget As Object, _
        ByVal X As Single, ByVal Y As Single, _
        ByVal dAngle As Double, _
        ByVal stText As String) As Boolean
'---------------------------------------------------------------------------
---------------
' Name  : DrawRotatedText
' Purpose  : This Function Draws the Text an the PictureBox which is
defined in the
'    parameters
' Parameters : pTarget An Object, in this case the PictureBox
'    X  The X Coordinate
'    Y  The Y Coordinate
'    dAngle The Angle which should be used to draw, any anlge is
possible
'    stText The Text which should be drawn on the PictureBox
' Date  : Sonntag 22 August 1999 17:38
' Revised  :
'---------------------------------------------------------------------------
---------------
 'Declaration
 Dim RotFont As LOGFONT, OldFont As Long, hFont As Long
 Dim OldX As Single, OldY As Single
 'Set Error Handling
 On Error GoTo ErrorRotatedText
 'Define the LogFont Type
 With RotFont
 .lfEscapement = CLng(dAngle * 10)
 .lfFaceName = pTarget.FontName
 .lfHeight = pTarget.FontSize * -20 / Screen.TwipsPerPixelY
 .lfWeight = IIf(pTarget.FontBold, FW_BOLD, FW_NORMAL)
 If pTarget.FontStrikethru Then .lfStrikeOut = 1
 If pTarget.FontUnderline Then .lfUnderline = 1
 If pTarget.FontItalic Then .lfItalic = 1
 .lfOutPrecision = OUT_TT_PRECIS
 .lfQuality = ANTIALIASED_QUALITY
 .lfCharSet = DEFAULT_CHARSET
 .lfPitchAndFamily = VARIABLE_PITCH
 End With
 'Generate and Asign the Font-Object
 hFont = CreateFontIndirect(RotFont)
 OldFont = SelectObject(pTarget.hDC, hFont)
 'Save the Coordinatees
 OldX = pTarget.CurrentX
 OldY = pTarget.CurrentY
 'Set the desired Coordinates
 pTarget.CurrentX = X
 pTarget.CurrentY = Y
 'Print the Text
 pTarget.Print stText
 'Set the Coordinates back
 pTarget.CurrentX = OldX
 pTarget.CurrentY = OldY
 'Set original Font back and destroy the Generated Font
 SelectObject pTarget.hDC, OldFont
 DeleteObject hFont
 'Set Return
 DrawRotatedText = True
ExitRotatedText:
 Exit Function
ErrorRotatedText:
 Resume ExitRotatedText
End Function
Original Comments (3)
Recovered from Wayback Machine