 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
 Verfasst am: 25.10.2013, 13:31 Titel: Drucken mit API |
 |
|
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 |
|
 |
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 26.10.2013, 23:21 Titel: |
|
|
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 |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4711
Wohnort: ~/
|
| Verfasst am: 27.10.2013, 08:08 Titel: |
|
|
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 27.10.2013, 08:40 Titel: |
|
|
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 |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4711
Wohnort: ~/
|
| Verfasst am: 27.10.2013, 12:12 Titel: |
|
|
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 |
|
|
grindstone
Anmeldungsdatum: 03.10.2010
Beiträge: 1283
Wohnort: Ruhrpott
|
| Verfasst am: 27.10.2013, 13:07 Titel: |
|
|
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 27.10.2013, 16:36 Titel: |
|
|
| 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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 27.10.2013, 17:41 Titel: |
|
|
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 |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4711
Wohnort: ~/
|
| Verfasst am: 27.10.2013, 20:27 Titel: |
|
|
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 27.10.2013, 21:07 Titel: |
|
|
| 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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 01.03.2015, 14:57 Titel: |
|
|
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 02.03.2015, 08:56 Titel: |
|
|
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  .
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 |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 04.03.2015, 13:09 Titel: |
|
|
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 |
|
|
|
|
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.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
