|
|
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StrokePath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function FillPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function StrokeAndFillPath Lib "gdi32" (ByVal hdc As Long) As Long
Private Sub Form_Paint()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim hBrush As Long, oldBrush As Long
Const sText = "Hello"
'set the form's font to 'Times New Roman, size 48'
Me.FontName = "Times New Roman"
Me.FontSize = 48
'make sure Me.TextHeight returns a value in Pixels
Me.ScaleMode = vbPixels
'create a new, white brush
hBrush = CreateSolidBrush(vbWhite)
'replace the current brush with the new white brush
oldBrush = SelectObject(Me.hdc, hBrush)
'set the fore color to black
Me.ForeColor = vbBlack
'open a path bracket
BeginPath Me.hdc
'draw the text
TextOut Me.hdc, 0, 0, sText, Len(sText)
'close the path bracket
EndPath Me.hdc
'render the specified path by using the current pen
StrokePath Me.hdc
'begin a new path
BeginPath Me.hdc
TextOut Me.hdc, 0, Me.TextHeight(sText), sText, Len(sText)
EndPath Me.hdc
'fill the path’s interior by using the current brush and polygon-filling mode
FillPath Me.hdc
'begin a new path
BeginPath Me.hdc
TextOut Me.hdc, 0, Me.TextHeight(sText) * 2, sText, Len(sText)
EndPath Me.hdc
'stroke the outline of the path by using the current pen and fill its interior by using the current brush
StrokeAndFillPath Me.hdc
'replace this form's brush with the original one
SelectObject Me.hdc, oldBrush
'delete our white brush
DeleteObject hBrush
End Sub
|
|
