FreeBasic: Drucken

1. Dürfte -lang deprecated brauchen
	zum Inhaltsverzeichnis
 'Dieses Beispielprogramm soll die Verwendung des Print-Dialogs zeigen und
 'ein Beispiel für das Schreiben in einen Drucker-DC sein.
 'Der Autor, Dominik Schäffner, übernimmt keine Haftung für irgendwelche
 'Schäden, die durch den Gebrauch des Programmes entstanden sind.
 'Dieses Beispielprogramm darf ohne jegliche Einschränkungen
 'meinerseits frei verwendet werden.
 
 'Modifikation durch Michael Frey 16.06.2006
 '(Entfernung der Fenster)
 '(PrintMyText)
 
 DefInt A-Z
 Option Explicit
 Option Private
 
 #define WIN_INCLUDEALL
 #include once "windows.bi"
 
 Declare Function GetPrinterFromUser(hWnd As HWND) As PRINTDLG
 Declare Function PrintMyText(text AS zstring ptr, lang as uinteger,gross as uinteger) As BOOL
 
 Dim PrintStatus As String
 Dim Shared hWnd As HWND
 Dim ps As PAINTSTRUCT
 Dim hDC As HDC
 Dim text as string
 dim gross as uinteger   
 
 'Hier bitte Programmieren ;-)   
 input Text$
 input gross
 
 If PrintMyText(strptr(Text$),len(Text$),gross) = FALSE Then
     ? "Ausdrucken fehlgeschlagen."
 Else
     ? "Daten an Drucker geschickt."
 End If
 
 
 
 Function GetPrinterFromUser(hWnd As HWND) As PRINTDLG
     Dim pd As PRINTDLG
    
     With pd
         .lStructSize    = SizeOf(PRINTDLG)
         .hwndOwner      = hWnd
         .Flags          = PD_ALLPAGES Or PD_COLLATE Or PD_RETURNDC Or PD_NOSELECTION
     End With
    
     PrintDlg(@pd)
    
     Return pd
 End Function
 
 Function PrintMyText(text AS zstring ptr, lang as uinteger,gross as uinteger) As BOOL
     Dim Printer As PRINTDLG
     Dim di As DOCINFO
     Dim hfMyFont As HFONT = CreateFont(gross, 0, 0, 0, 0, 0, 0, 0,_
        DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY,_
        DEFAULT_PITCH, "Times New Roman")
   
     'Printer-Dialog anzeigen
     Printer = GetPrinterFromUser(hWnd)
   
     With di
         .cbSize         = SizeOf(DOCINFO)
         .lpszDocName    = StrPtr("DruckerTest")
     End With
   
     'Ausdrucken
     If StartDoc(Printer.hDC, @di) <= 0 Then Return FALSE
     If StartPage(Printer.hDC) <= 0 Then Return FALSE
 
     SetBkMode(Printer.hDC, TRANSPARENT)
     SelectObject(Printer.hDC, hfMyFont)
     SetTextColor(Printer.hDC, Rgb(0, 0, 0))
     TextOut(Printer.hDC, 30, 40, text, lang)
     If EndPage(Printer.hDC) <= 0 Then Return FALSE
     If EndDoc(Printer.hDC) <= 0 Then Return FALSE
    
     'Aufräumen
     DeleteDC(Printer.hDC)
     DeleteObject(hfMyFont)
    
     Return TRUE
 End Function
Dieser Quellcode wurde von MichaelFrey am 16.06.2006 mit der Freebasic Version 0.16 Beta getestet.
Lizenz: Public Domain, siehe auch [1]
	zum Inhaltsverzeichnis