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
Ringkasan AI: 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.
Kode Sumber
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
See an example:
http://www.vietson.com/download/Agent/MSAgent_hello.html
Komentar Asli (3)
Dipulihkan dari Wayback Machine