| CreateFontIndirect, DeleteObject, CreateDC, DeleteDC, TextOut, EndDoc, EndPage |
| |
| |
| Private Const LF_FACESIZE = 32 | |
| Private Type LOGFONT | |
| lfHeight As Long | |
| lfWidth As Long | |
| lfEscapement As Long | |
| lfOrientation As Long | |
| lfWeight As Long | |
| lfItalic As Byte | |
| lfUnderline As Byte | |
| lfStrikeOut As Byte | |
| lfCharSet As Byte | |
| lfOutPrecision As Byte | |
| lfClipPrecision As Byte | |
| lfQuality As Byte | |
| lfPitchAndFamily As Byte | |
| lfFaceName As String * LF_FACESIZE | |
| End Type | |
| |
| Private Type DOCINFO | |
| cbSize As Long | |
| lpszDocName As String | |
| lpszOutput As String | |
| lpszDatatype As String | |
| fwType As Long | |
| End Type | |
| |
| Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long |
| Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long |
| Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long |
| Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, _ |
| ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long |
| Private Declare Function DeleteDC 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 'Or Boolean. |
| Private Declare Function StartDoc Lib "gdi32" Alias "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long |
| Private Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) As Long |
| Private Declare Function StartPage Lib "gdi32" (ByVal hdc As Long) As Long |
| Private Declare Function EndPage Lib "gdi32" (ByVal hdc As Long) As Long |
| |
| Const DESIREDFONTSIZE = 12 | Could use variable, TextBox etc. |
| |
| Private Sub cmd1_Click() | Combine API Calls with the Printer object. |
| Dim OutString As String, lf As LOGFONT, result As Long, hOldfont As Long |
| Dim hPrintDc As Long, hFont As Long, i%, max% | |
| max = 3600 | |
| |
| Printer.Print "" | |
| Printer.Print Tab(12); "Printer Object" | |
| hPrintDc = Printer.hdc | |
| OutString = Text1.Text | Der zu rotierende String. |
| |
| For i = 0 To max | Max muß vierstellig sein. |
| lf.lfEscapement = i | 1800 druckt auf dem Kopf. |
| lf.lfHeight = (DESIREDFONTSIZE * -20) / Printer.TwipsPerPixelY |
| hFont = CreateFontIndirect(lf) | |
| hOldfont = SelectObject(hPrintDc, hFont) | |
| result = TextOut(hPrintDc, 1400, 1500, OutString, _ | Ausgabekoordinaten. |
| Len(OutString)) | |
| result = SelectObject(hPrintDc, hOldfont) | |
| result = DeleteObject(hFont) | |
| i = i + 200 | |
| Next i | |
| |
| Printer.Print Tab(12); "Zeile 2 wird nach der For-Schleife gedruckt." |
| Printer.EndDoc | |
| End Sub | |
| |
| Private Sub cmd2_Click() | Print using API calls only. |
| Dim OutString As String | String to be rotated. |
| Dim lf As LOGFONT | Structure for setting up rotated font. |
| Dim temp As String | Temp string var. |
| Dim result As Long | Return value for calling API functions. |
| Dim hOldfont As Long | Hold old font information. |
| Dim hPrintDc As Long | Handle to printer dc. |
| Dim hFont As Long | Handle to new Font |
| Dim di As DOCINFO | Structure for Print Document info. |
| |
| OutString = "Hello World" | Set string to be rotated. |
| |
| Set rotation in tenths of a degree. 1800 = 180 degrees. |
| lf.lfEscapement = 1000 | 1800 druckt also auf dem Kopf. |
| lf.lfHeight = (DESIREDFONTSIZE * -20) / Printer.TwipsPerPixelY |
| hFont = CreateFontIndirect(lf) | Create the rotated font. |
| di.cbSize = 20 | Size of DOCINFO structure. |
| di.lpszDocName = "My Document" | Set name of print job (Optional). |
| |
| hPrintDc = CreateDC(Printer.DriverName, _ | Create a printer device context. |
| Printer.DeviceName, 0, 0) | |
| result = StartDoc(hPrintDc, di) | Start a new print document. |
| result = StartPage(hPrintDc) | Start a new page. |
| |
| hOldfont = SelectObject(hPrintDc, hFont) | Select our rotated font structure and save previous font info. |
| result = TextOut(hPrintDc, 1000, 1000, OutString, _ | Send rotated text to printer, starting at location 1000, 1000. |
| Len(OutString)) | |
| result = SelectObject(hPrintDc, hOldfont) | Reset font back to original, non-rotated. |
| result = TextOut(hPrintDc, 1000, 1000, OutString, _ | Send non-rotated text to printer at same page location. |
| Len(OutString)) | |
| result = EndPage(hPrintDc) | End the page. |
| result = EndDoc(hPrintDc) | End the print job. |
| result = DeleteDC(hPrintDc) | Delete the printer device context. |
| result = DeleteObject(hFont) | Delete the font object. |
| End Sub | |
| |
zurück