Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Drucken mit API

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Windows-spezifische Fragen
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 25.10.2013, 13:31    Titel: Drucken mit API Antworten mit Zitat

Also Text und Linien mit LineTo funktioniert schon mal.
Nun würd ich gern auch den zu druckenden Text formatiern (bei Seitenrand neue Zeile) oder vllt sogar eine ganze Grafik drucken.
Doch leider komme ich nicht ganz nach bei den befehlen dazu.

also um den Text zu trennen hab ich folgendes gefunden: GetTextExtentExPoint()
leider reicht mein vergammeltes Englisch nicht aus um die Funktionsweise zu erschließen... deshalb hab ich nach beispielen gesucht.
Hab auch was gefunden (Ich glaub in VB), komm trotzdem noch nicht mit klar.
Also zu druckenden Text übergeben, die länge des Strings, blatt-breite, und nun?
werden die zeilen in einem array gespeichert?

hier ein Auszug aus dem bspCode (TEXT ist in dem Fall das zu druckende)
Code:
sa := Explode(#13#10, TEXT);
    for Paragraphs := 0 to length(sa) - 1 do
    begin
      s := sa[Paragraphs];
      if s = '' then
        Continue;
      repeat
        // Seitenkopf
        MoveToEx(dc, BORDERLEFT * 10, -BORDERTOP * 10, nil);
        LineTo(dc, PageW * 10 - BORDERRIGHT * 10, -BORDERTOP * 10);
        rect.Left := BORDERLEFT * 10;
        rect.Top := -BORDERTOP * 10 + tm.tmHeight;
        rect.Right := PageW * 10 - BORDERRIGHT * 10;
        rect.Bottom := rect.Top - tm.tmHeight;
        DrawText(dc, PChar(APPNAME), length(APPNAME), rect, DT_CENTER);
        // Text in Zeílen umbrechen
        GetTextExtentExPoint(dc, PChar(s), length(s), (PageW * 10) - (BORDERLEFT * 10) - (BORDERRIGHT * 10), @cntChars,
          nil, size);
        while (s[cntChars] <> ' ') do
          Dec(cntChars);
        // Text ausgeben
        // Achtung: Angaben in 1/10 mm
        TextOut(dc, BORDERLEFT * 10, -(BORDERTOP * 10) + -i * (Size.cy + 8), PChar(s), cntChars);
        Delete(s, 1, cntChars);
        Inc(i);
        // wenn Höhe aller Zeilen größer der Seitenhöhe, neu Seite anfangen
        TextHeight := i * (tm.tmHeight div 10) + BORDERTOP + BORDERBOTTOM;
        if TextHeight >= PageH - BORDERTOP - BORDERBOTTOM then
        begin
          // Seitenfuß
          MoveToEx(dc, BORDERLEFT * 10, -(PageH - BORDERTOP) * 10, nil);
          LineTo(dc, PageW * 10 - BORDERRIGHT * 10, -(PageH - BORDERTOP) * 10);
          rect.Left := BORDERLEFT * 10;
          rect.Top := -(PageH - BORDERTOP) * 10 - 10;
          rect.Right := PageW * 10 - BORDERRIGHT * 10;
          rect.Bottom := rect.Top - tm.tmHeight;
          DrawText(dc, PChar(IntToStr(cntPage)), length(IntToStr(cntPage)), rect, DT_RIGHT);
          // neue Seite
          EndPage(dc);
          Inc(cntPage);
          // Zeilenzähler zurücksetzen
          i := 1;
        end;
      until CntChars < 1;
    end;
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 26.10.2013, 23:21    Titel: Antworten mit Zitat

also erstmal der Code ist wohl nicht VB sondern Delphi

eine lösung hab ich leider auch noch nicht. eins meiner größten probleme ist der letzte Parameter in
Code:
GetTextExtentExPoint(dc, PChar(s), length(s), (PageW * 10) - (BORDERLEFT * 10) - (BORDERRIGHT * 10), @cntChars,
          nil, size);

Der verfasser hat size mit TSize deklariert - aber ich finde nirgends eine referenz für TSize. Ich glaube das es ein Type ist da TextOut() Size.cy aufruft. Leider kann ich nichts weiter im gesamten Quelltext finden.

Also so siehts es bis jetzt erstmal aus
Code:
     Dim As Integer cntChars, Size
     GetTextExtentExPoint(Printer.hDC, StrPtr(s), Len(s), 500, @cntChars, Null, size)

Vllt. kann hierzu jemand was sagen, ob ich auf dem richtigen weg bin. Zumindest bekomme ich kein Error ausser zu Size. Prog läuft zwar trotzdem nur das Ergebnis ist nicht zufriedenstellend.

Den hauptquelltext für die FB Variante hab ich glaub ich aus dem FB-Portal.
Code:
 #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
 
 Dim Shared As String s
 s = TEXT

 If PrintMyText(strptr(Text),len(Text),gross) = FALSE Then
     ? "Ausdrucken fehlgeschlagen."
 Else
     ? "Daten an Drucker geschickt."
 End If
 
 Sleep
 
 
 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 * 4, 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
 
     SetMapMode(Printer.hDC, MM_LOMETRIC)
     SetBkMode(Printer.hDC, TRANSPARENT)
     SelectObject(Printer.hDC, hfMyFont)
     SetTextColor(Printer.hDC, Rgb(0, 0, 0))
     
     Dim As Integer cntChars, Size
     GetTextExtentExPoint(Printer.hDC, StrPtr(s), Len(s), 500, @cntChars, Null, size)
     
     
     TextOut(Printer.hDC, 1, -1, text, lang)
     MoveToEx(Printer.hdc, 1050, -80, Null)
        LineTo(Printer.hdc, 210 * 10, -80)
        LineTo(Printer.hdc, 30 + (LeN(text) * gross), -120)
     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
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4594
Wohnort: ~/

BeitragVerfasst am: 27.10.2013, 08:08    Titel: Antworten mit Zitat

Mit Delphi bin ich nie in Berührung gekommen (wenn man vom Schmalspur-Pascal in meiner Schulzeit absieht). Zu TSize habe ich mal folgendes gefunden, aber ob es dasselbe ist, das bei dir verwendet wird?
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Types.TSize
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 27.10.2013, 08:40    Titel: Antworten mit Zitat

ja super danke ich hab auch gerade was dazu gefunden im delphi treff.
Zitat:
TextExtent: TextHeight und TextWidth in einem. Aus dem String-Parameter wird die Höhe und Breite bei den aktuellen Font-Einstellungen ermittelt und in einem Typ TSize (Mit den Integerwerten cx und cy) zurückgegeben.


die Frage ist nun wie kann ich ein solchen Type in FB nachstellen.

Probiert hab ich folgendes
Code:
 Type Tsize
   As Integer cx
   As Integer cy
 End Type

...

Dim Size As Tsize
GetTextExtentExPoint(,,,,,size.cy)

Problem ist das das Prog zwar startet gibt aber error: Passing scalar as pointer, at parameter 7 of GETTEXTEXTENTEXPOINT() zurück.
So wie ich das verstanden hab gibt GetTextE... x und y zurück. trag ich aber nur size ein geht gar nix.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4594
Wohnort: ~/

BeitragVerfasst am: 27.10.2013, 12:12    Titel: Antworten mit Zitat

size.cy ist bei dir der sechste Parameter. Wenn du einen falschen Parametertyp für Parameter 7 übergibst liegt das wohl nicht an size.cy; die Fehlermeldung wundert mich allerdings doch etwas.

Zitat:
trag ich aber nur size ein geht gar nix.

Wie auch? Die Fehlermeldung besagt doch, dass er einen Pointer haben will.
Am besten mal in die betreffende Header-Datei reinschauen, was da genau gefragt ist.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
grindstone



Anmeldungsdatum: 03.10.2010
Beiträge: 1208
Wohnort: Ruhrpott

BeitragVerfasst am: 27.10.2013, 13:07    Titel: Antworten mit Zitat

Ohne dein Programm jetzt genauer analysiert zu haben: Die API "GetTextExtentExPoint(" erwartet als 7. Parameter den Pointer auf eine Struktur vom Typ "SIZE". Dieser Typ ist in der "windows.bi" bereits vordefiniert und hat die Integer-Variablen "cx" und "cy".
Also
Code:
...

Dim Shared As SIZE tsize

...

GetTextExtentExPoint(Printer.hDC, StrPtr(s), Len(s), 500, @cntChars, Null, @tsize)

...
Die Werte kannst du dann mit
Code:
Print tsize.cx
Print tsize.cy
ausdrucken oder anderweitig weiterverarbeiten.

Gruß
grindstone
_________________
For ein halbes Jahr wuste ich nich mahl wie man Proggramira schreibt. Jetzt bin ich einen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 27.10.2013, 16:36    Titel: Antworten mit Zitat

Zitat:
size.cy ist bei dir der sechste Parameter

Sorry, hab ein Komma vergessen.

Zitat:
vom Typ "SIZE". Dieser Typ ist in der "windows.bi" bereits vordefiniert

gut zu wissen. hatte es auch mit @ versucht, trotzdem kam der Fehler. Aber so geht es jetzt. Kann jetzt also "formatierten" Text drucken und Rahmen ziehen. Im folgendem Bsp-code werden auch Leerzeichen beachtet.

Kann mir vllt. jemand sagen wie man die Farbe der Linien ändern kann und Grafiken (zb. BMPs) zu Papier(oder PDF C.) bringt. Ich bin mir sicher das beides geht doch leider noch nichts gefunden. Ich find die MS-online-Referenz ziehmlich unübersichtlich.

Seitenumbruch ist allerdings noch nicht beachtet.
Code:
 #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
 Declare Function DeleteText(text AS String, anzahl As Integer) As String
 Declare Function FindNextSpaceL(text As String, start As Integer) As Integer
 
 
 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
 Dim Shared As SIZE tsize
 
 'Hier bitte Programmieren ;-)   
 input "zu druckender Text: ", Text
 If Text = "" Then Text = "Hallo liebe Leute. Wie ihr seht geht es mal und mal nicht. Was sollen wir tun?"
 input "Schriftgroesse z.B. 14: ", gross
 
 Dim Shared As String s
 s = TEXT

 If PrintMyText(strptr(Text),len(Text),gross) = FALSE Then
     ? "Ausdrucken fehlgeschlagen."
 Else
     ? "Daten an Drucker geschickt."
 End If
 
 Sleep
 
 
 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 * 4, 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
 
     SetMapMode(Printer.hDC, MM_LOMETRIC)
     SetBkMode(Printer.hDC, TRANSPARENT)
     SelectObject(Printer.hDC, hfMyFont)
     SetTextColor(Printer.hDC, Rgb(0, 0, 0))
     
     'mm x 10
     Dim As Integer cntChars, BorderU = 100, BorderL = 800, BorderR = 800, BorderD = 100
     Dim As Integer Zeile = 0, PageW = GetDeviceCaps(Printer.hDC, HORZSIZE) * 10
     Dim As Integer Zeilenabstand = 8
     
     Do
       s = LTrim(s)
       If Len(s) < 1 Then Exit Do
       
       GetTextExtentExPoint(Printer.hDC, StrPtr(s), Len(s), _
          PageW - BorderL - BorderR, @cntChars, Null, @Tsize)
       
       'Zeile an Leerzeichen trennen
       If Chr(s[CntChars]) <> " " And TSize.cx > PageW - BorderL - BorderR Then
         Dim AS Integer NewCnt = FindNextSpaceL(s, CntChars)
         If NewCnt > 0 Then CntChars = NewCnt
       End If
       
       'Zeile ausgeben
       TextOut(Printer.hDC, BorderL, -BorderU + -Zeile * (TSize.cy + Zeilenabstand), strptr(s), cntchars)
       s = DeleteText(s, CntChars) 'gedruckten bereich aus String löschen
       Zeile += 1
     Loop
     
     MoveToEx(Printer.hdc, BorderL, -BorderU, Null)
        LineTo(Printer.hdc, PageW - BorderR, -BorderU)
        LineTo(Printer.hdc, PageW - BorderR, -BorderU + -Zeile * (TSize.cy + Zeilenabstand))
        LineTo(Printer.hdc, BorderL, -BorderU + -Zeile * (TSize.cy + Zeilenabstand))
        LineTo(Printer.hdc, BorderL, -BorderU)
     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
 
 Function DeleteText(text AS String, anzahl As Integer) As String
   Return Mid(text, anzahl + 1, Len(text) - anzahl)
 End Function
 
 Function FindNextSpaceL(text As String, start As Integer) As Integer
   If start < 2 Then Return 0
   
   For i AS Integer = Start To 1 Step -1
     If Chr(text[i]) = " " Then Return i
   Next
   
   Return 0
 End Function
 
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 27.10.2013, 17:41    Titel: Antworten mit Zitat

Zwecks BMP dachte ich, ich hätte da was gefunden bekomme aber runtime error 12 Segmentierungsverletzung

DrawState

Code:
...
        LineTo(Printer.hdc, BorderL, -BorderU)
     
     Dim As Any Ptr bild = Imagecreate(616, 413)
     BLoad "KGA.bmp", bild

     DrawState(Printer.hDC, bild, 0, 0, 0, BorderL, -BorderU + -Zeile * (TSize.cy + Zeilenabstand) + 100, 616, 413, DSS_NORMAL)
     Imagedestroy(bild)
     
     If EndPage(Printer.hDC) <= 0 Then Return FALSE
...
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4594
Wohnort: ~/

BeitragVerfasst am: 27.10.2013, 20:27    Titel: Antworten mit Zitat

Da wäre es jetzt interessant, ob -exx etwas genaueres liefert. Ansonsten mal rantasten, in welcher Zeile genau die Schutzverletzung auftritt.

Ist der Bildpuffer für das geladene Bild groß genug?
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 27.10.2013, 21:07    Titel: Antworten mit Zitat

Zitat:
Da wäre es jetzt interessant, ob -exx etwas genaueres liefert.

nein leider nicht CMD spuckt nur "runtime error 12 (Segmentation violation) in c:\...." aus. Ohne "at line".

rangetastet hab ich mich: Bload hat noch funktioniert. Also muss das übel bei DrawState sein. Die Frage ist nur wo? Ich bin mir ja nicht so sicher mit den ganzen Parametern und ob die Funktion überhaupt dafür gedacht ist. Aber die beschreibung hab ich so verstanden. Hm.

Ich denke doch das der 2. ein Pointer auf das Img sein soll. allerdings 3-5 hab ich keine Ahnung.

Die Grafik lässt sich auch auf den Screen zeichnen, nur um noch mal sicher zu gehen.

Übrigens ist mir noch aufgefallen das Umlaute selbst nach 'CharToOEM Text, Text' nicht richtig dargestellt werden. Dafür muss bei CreateFont der 9. Parameter in OEM_Charset geändert werden.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 01.03.2015, 14:57    Titel: Antworten mit Zitat

Hallo leute, ich hatte das drucken für eine Weile auf Eis gelegt und würde da jetzt gern wieder anknüpfen.

Problem: Programm soll festlegen ob mein Ausdruck im Querformat/Landscape sein soll.

Ich hab mir dazu schon einiges angeschaut aber ich bekomme es leider nicht so recht eingebunden. Ich habe schon heraus gefunden das es sich um Devmode handelt und in FB gibt es dafür wingdi.bi .
Auf dieser Seite gibt es ein Bsp. wie Devmode benutzt wird bzw werden könnte.

In folgenden Code habe ich diese beiden Zeilen eingefügt:
Dim devmode As DEVMODEA
dm->dmOrientation=DMORIENT_LANDSCAPE (und auch probiert: devmode->dmOrientation=DMORIENT_LANDSCAPE)

Code:

 #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
 Declare Function DeleteText(text AS String, anzahl As Integer) As String
 Declare Function FindNextSpaceL(text As String, start As Integer) As Integer
 
 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
 Dim Shared As SIZE tsize
 
 Screenres 666, 444, 32
 'Hier bitte Programmieren ;-)   
 input "zu druckender Text: ", Text

 CharToOEM Text, Text

 input "Schriftgroesse z.B. 14: ", gross
 
 Dim Shared As String s
 s = TEXT

 If PrintMyText(strptr(Text),len(Text),gross) = FALSE Then
     ? "Ausdrucken fehlgeschlagen."
 Else
     ? "Daten an Drucker geschickt."
 End If
 
 Sleep
 
 
 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 devmode As DEVMODEA
     Dim hfMyFont As HFONT = CreateFont(gross * 4, 0, 0, 0, 0, 0, 0, 0,_
        OEM_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
     dm->dmOrientation=DMORIENT_LANDSCAPE
     'Ausdrucken
     If StartDoc(Printer.hDC, @di) <= 0 Then Return FALSE
     If StartPage(Printer.hDC) <= 0 Then Return FALSE
 
     SetMapMode(Printer.hDC, MM_LOMETRIC)
     SetBkMode(Printer.hDC, TRANSPARENT)
     SelectObject(Printer.hDC, hfMyFont)
     SetTextColor(Printer.hDC, Rgb(0, 0, 0))
     
     'mm x 10
     Dim As Integer cntChars, BorderU = 100, BorderL = 800, BorderR = 800, BorderD = 100
     Dim As Integer Zeile = 0, PageW = GetDeviceCaps(Printer.hDC, HORZSIZE) * 10
     Dim As Integer Zeilenabstand = 8
     
     'TEXT DRUCKEN
     Do
       s = LTrim(s)
       If Len(s) < 1 Then Exit Do
       
       GetTextExtentExPoint(Printer.hDC, StrPtr(s), Len(s), _
          PageW - BorderL - BorderR, @cntChars, Null, @Tsize)
       
       'Zeile an Leerzeichen trennen
       If Chr(s[CntChars]) <> " " And TSize.cx > PageW - BorderL - BorderR Then
         Dim AS Integer NewCnt = FindNextSpaceL(s, CntChars)
         If NewCnt > 0 Then CntChars = NewCnt
       End If
       
       'Zeile ausgeben
       TextOut(Printer.hDC, BorderL, -BorderU + -Zeile * (TSize.cy + Zeilenabstand), strptr(s), cntchars)
       s = DeleteText(s, CntChars) 'gedruckten bereich aus String löschen
       Zeile += 1
     Loop
     
     'LINIEN DRUCKEN
     MoveToEx(Printer.hdc, BorderL, -BorderU, Null)
        LineTo(Printer.hdc, PageW - BorderR, -BorderU)
        LineTo(Printer.hdc, PageW - BorderR, -BorderU + -Zeile * (TSize.cy + Zeilenabstand))
        LineTo(Printer.hdc, BorderL, -BorderU + -Zeile * (TSize.cy + Zeilenabstand))
        LineTo(Printer.hdc, BorderL, -BorderU)
     
     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
 
 Function DeleteText(text AS String, anzahl As Integer) As String
   Return Mid(text, anzahl + 1, Len(text) - anzahl)
 End Function
 
 Function FindNextSpaceL(text As String, start As Integer) As Integer
   If start < 2 Then Return 0
   
   For i AS Integer = Start To 1 Step -1
     If Chr(text[i]) = " " Then Return i
   Next
   
   Return 0
 End Function
 
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 02.03.2015, 08:56    Titel: Antworten mit Zitat

Also jetzt geht es erst einmal. Habe erfolgreich ein paar Probedrucke auf meinem Lexmark X6650 und in ein PDF Creator im Querformat gemacht.

Bin mir nur nicht so ganz sicher ob es so richtig ist mit den Definitionen und der Reihenfolge. Gestern hatte ich plötzlich das Problem das auf dem Desktop die Hälfte meiner Programm und Datei Icons(dll, bas, txt, exe und einige Verknüpfungen) als unbekannte Datei angezeigt wurden. Weder Neustart noch löschen der C:\user\name\appdata\local\iconcache.db nur Sys.widerh. funktionierte.
Ob das nun von meinen Versuchen stammt kann ich nicht sagen. Kann auch gut sein das es an meinem System liegt durchgeknallt .

Ich hab die besagten 2 Zeilen aus meinem gestrigen beitrag verschoben und ergänzt. Kann mir jemand sagen ob das nun so richtig ist. Also die Zeilen nach PrintDlg(@pd) .

Code:
Function GetPrinterFromUser(hWnd As HWND) As PRINTDLG
    Dim pd As PRINTDLG
    Dim devmode As DEVMODEA
   
    With pd
        .lStructSize    = SizeOf(PRINTDLG)
        .hwndOwner      = hWnd
        .Flags          = PD_ALLPAGES Or PD_COLLATE Or PD_RETURNDC Or PD_NOSELECTION
    End With
   
    PrintDlg(@pd)
     
    Dim As devmode Ptr dm = GlobalLock( pd.hDevmode )
    dm->dmOrientation=DMORIENT_LANDSCAPE
    ResetDC(pd.hDC,dm)
    GlobalUnlock( dm )
   
    Return pd
End Function


der Fehler mit meinen Icons trat übrigens auf, da fehlte noch die ResetDC Zeile
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
braesident



Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin

BeitragVerfasst am: 04.03.2015, 13:09    Titel: Antworten mit Zitat

Sorry wegen meines mehrfach Posts. Ich habe ein neues Problem. Diesmal mit den Farben von Text und Linien.

Nachdem ich nun erfolglos 3 Tage versuche die Farbe für die Linien zu ändern habe ich festgestellt das SetTextColor(Printer.hDc,RGB(255,0,0)) auf TextOut(...) (wie im obigen Code) auch keine Auswirkung hat. Laut MS soll die Funktion aber für TextOut sein. Die Rückgabe von SetTextColor ist auch nicht CLR_INVALID und die Druckereigenschaften sind nicht Schwarz. Denn eine BMP die ich anschließend der LineTo's mit drucke ist auch in Farbe.

Ich konnte leider nicht ein mal heraus finden wie die Linien bei LineTo gezeichnet werden!? mit dem DC_Pen?

folgendes habe ich in Bezug auf Linien ausprobiert
Code:
     Dim As HPen myPen = CreatePen( PS_SOLID , 1 , RGB(255,0,0))
     SelectObject(Printer.hDC, myPen)
     MoveToEx(Printer.hdc, BorderL, -BorderU, Null)
     LineTo(Printer.hdc, PageW - BorderR, -BorderU)

und
Code:
     SelectObject(Printer.hDC, GetStockObject(DC_PEN))
     SetDCPenColor(Printer.hdc, RGB(255,000,000))
     MoveToEx(Printer.hdc, BorderL, -BorderU, Null)
     LineTo(Printer.hdc, PageW - BorderR, -BorderU)

leider alles ohne erfolg. Kann mir da bitte bitte jemand helfen.

PS. die Sache mit dem Querformat hat die letzten gefühlten 1000 versuche problemlos funktioniert.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden MSN Messenger
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Windows-spezifische Fragen Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz