Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
| Uploader: |  Jojo |
| Datum/Zeit: | 14.08.2007 13:55:11 |
#define WIN_INCLUDEALL
#include once "windows.bi"
Declare Function PrintMyText() As BOOL
Declare Function GetPrinterDCFromUser() As PRINTDLG
Declare Function GetPrinterDC() As PRINTDLG
Screen 19
If PrintMyText() = FALSE Then
Print "Ausdrucken fehlgeschlagen."
Else
Print "Daten an Drucker geschickt."
End If
Sleep
End
'===========================================================================
Function PrintMyText() As BOOL
'===========================================================================
Dim Printer As PRINTDLG
Dim di As DOCINFO
Print "1 druecken fuer den Standarddrucker"
Print "2 druecken fuer einen anderen Drucker"
Print "3 zum Beenden druecken"
Dim sKey as string
Do
sKey = Inkey
Select case sKey
case "1"
Printer = GetPrinterDC()
Print "> Standarddrucker"
Exit Do
case "2"
Printer = GetPrinterDCFromUser()
Print "> Anderer Drucker"
Exit Do
case "3"
End
end select
Loop
With di
.cbSize = Len( DOCINFO )
.lpszDocName = Strptr("DokumentName")
End With
'Ausdrucken
If StartDoc( Printer.hDC , @di ) <= 0 Then Return FALSE
If StartPage( Printer.hDC ) <= 0 Then Return FALSE
Dim hLogo As HBITMAP
Dim logo As BITMAP
Dim hDC_Image As HDC
Dim hwnd As HWND
hLogo = LoadImage ( GetModuleHandle(NULL), "wand006.bmp" , IMAGE_BITMAP,0, 0,LR_DEFAULTCOLOR Or LR_LOADFROMFILE)
If hLogo=NULL Then
MessageBox(0,"Bild konnte nicht geladen werden" , "ERROR" , MB_ICONWARNING ): Return FALSE
End If
GetObject(hLogo, Len(BITMAP), @logo )
hDC_Image = CreateCompatibleDC( NULL )
SelectObject( hDC_Image , hLogo )
StretchBlt( Printer.hDC , 0 , 0 , 1024 , 1024 , hDC_Image , 0 , 0 , logo.bmWidth , logo.bmHeight , SRCCOPY )
SetTextColor(Printer.hDC , Rgb( 0 , 255 , 0 ))
TextOut( Printer.hDC , 1010 , 10 , "Hallo das ist ein Test" , Len( "Hallo das ist ein Test" ) )
SetTextColor(Printer.hDC , Rgb( 255 , 0 , 0 ))
TextOut( Printer.hDC , 1200 , 500 , "Hallo das ist ein Test" , Len( "Hallo das ist ein Test" ) )
Dim DrawToDC As HDC
Dim ps As PAINTSTRUCT
Dim Pinsel As HBRUSH
DrawToDC = CreateCompatibleDC( NULL )
DrawToDC = BeginPaint( NULL , @ps )
Pinsel = SelectObject( DrawToDC , CreateSolidBrush( Rgb( 255 , 0 , 0 )))
MoveToEx( DrawToDC , 0 , 2000, NULL)
LineTo( DrawToDC , 0 , 2000 )
EndPaint( NULL , @ps )
BitBlt( Printer.hDC , 0 , 0 , 2000 , 2000 , DrawToDC , 0 , 0 , SRCCOPY )
If EndPage( Printer.hDC ) <= 0 Then Return FALSE
If EndDoc( Printer.hDC ) <= 0 Then Return FALSE
'Aufräumen
DeleteDC(Printer.hDC)
Return TRUE
End Function
'===========================================================================
Function GetPrinterDCFromUser() As PRINTDLG
'===========================================================================
Dim pd As PRINTDLG
With pd
.lStructSize = Sizeof(PRINTDLG)
.hwndOwner = NULL'(hWnd)
.Flags = PD_ALLPAGES Or PD_COLLATE Or PD_RETURNDC Or PD_NOSELECTION
End With
PrintDlg(@pd)
Return pd
End Function
'===========================================================================
Function GetPrinterDC() As PRINTDLG
'===========================================================================
Dim pd As PRINTDLG
'Initialize the PRINTDLG structure.
With pd
.lStructSize = Len( PRINTDLG )
.hwndOwner = NULL'(hWnd)
.Flags = PD_RETURNDEFAULT Or PD_RETURNDC
End With
'Invoke the printer dialog box.
PrintDlg( @pd )
'hDC member of the PRINTDLG structure contains the printer DC.
Return pd
End Function