|
Option Explicit
Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" ( _
ByVal H As Long, ByVal W As Long, ByVal E As Long, _
ByVal O As Long, ByVal W As Long, ByVal I As Long, _
ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long
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
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _
ByVal crColor As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Dim Fnt_hDC As Long
Dim Fnt_Add As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc _
As Long, ByVal nIndex As Long) As Long
Public Declare Function MulDiv Lib "kernel32" (ByVal nNumber _
As Long, ByVal nNumerator As Long, ByVal nDenominator _
As Long) As Long
Public Const LOGPIXELSY = 90
Sub Text_Make(Groesse As Integer, Grad As Long, Stil_Italic _
As Long, Stil_Bold As Boolean, Stil_Underline As Long, _
Font_Name As String, Farbe As Long, Ziel_hDC As Long)
If Fnt_hDC > 0 Then Text_Delete
If Stil_Bold = False Then
Fnt_hDC = CreateFont(Groesse, 0, Grad * 10, 0, 400, _
Stil_Italic, Stil_Underline, 0, 1, 4, &H10, 2, 4, _
Font_Name)
Else
Fnt_hDC = CreateFont(Groesse, 0, Grad * 10, 0, 700, _
Stil_Italic, Stil_Underline, 0, 1, 4, &H10, 2, 4, _
Font_Name)
End If
Text_Select Ziel_hDC
SetTextColor Ziel_hDC, Farbe
End Sub
Sub Text_Select(Ziel As Long)
Fnt_Add = SelectObject(Ziel, Fnt_hDC)
End Sub
Sub Text_Delete()
DeleteDC Fnt_hDC
Fnt_hDC = 0
End Sub
Sub Text_Print(X As Long, Y As Long, sText As String, Ziel As Long)
TextOut Ziel, X + 4, Y + 4, sText, Len(sText)
Text_Delete
End Sub
|
|