Seite 1 von 1

PrintFont

Verfasst: 13.10.2009 17:35
von Neuland
Hallo
Hatte immer Probleme Textzeilen bzw. Text mit PureBasic auf meine Drucker auszugeben.
Entweder war der Text zu groß oder zu klein...
Hier meine Lösung:

Code: Alles auswählen

;Hilfsunterprogramm:
;Druckeransteuerung  PrintFont  V.0.4
;Druckt immer nur eine Zeile Text unter der anderen,
;unabhängig vom Textstiel, deren Größe und der
;eingestellten Auflösung des Druckers!
;Aufruf:
;PrintText("Schriftart",Schriftgroesse,"Text")
;Beispiel:
;PrintText("Arial", 12, "Testtext")
;Unterprogrammaufruf nach: StartPrinting()
;und vor StopPrinting()
;Die Variable endy uebergibt den Startwert der ersten
;vertikalen Textausgabe auf den Drucker in Pixel.
;
Procedure PrintText(font.s,fontgr.w,text.s)
 Shared endy
 ypos = PrinterPageWidth()
 xpos = PrinterPageHeight()
 lRand = 100
  LoadFont(10, font, (xpos / 1024) * fontgr)
  If StartDrawing(PrinterOutput())
    DrawingFont(FontID(10))
    DrawText(lRand, endy, text)
    StopDrawing()
  EndIf
  endy = endy + (ypos / 460) * fontgr
EndProcedure

endy = 100


; START DEMO ######################################
If OpenWindow(0, 0, 0, 300, 200, "PureBasic Window Druckertest", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
endy = 100
TextGadget(0, 10, 20, 140, 38, "Druckeransteuerung...", #PB_Text_Center) 
demotex.s = "Hallo Welt!"

 If PrintRequester()
   If StartPrinting("PureBasic-PrintText")

    PrintText("Courier", 12,"<< Demoseite  PrintText  Version 0.4 >>")
    PrintText("Tahoma", 40, "Test Tahoma")
    PrintText("Arial", 40, "Test Arial")
    PrintText("Times New Roman", 16, demotex)

    PrintText("Courier", 24, ">>>>>>>>>><<<<<<<<<<")
    PrintText("Courier", 24, "TEST TEST  TEST TEST")
    PrintText("Courier", 24, ">>>>>>>>>><<<<<<<<<<")

    For z = 0 To 20 Step 2
      PrintText("Arial", 6 + z, demotex + " Schriftgröße: " + Str(6+z))
    Next z

    StopPrinting()
   EndIf

 EndIf

  SetGadgetText(0, "Druckauftrag beendet!")

  Repeat
    EventID = WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow
      Quit = 1
    EndIf
  Until Quit = 1
EndIf

End
; ENDE DEMO ######################################
EDIT:
Diese Programmversion funktioniert nur bis PB 4.20, danach wird die Schrift invertiert ausgedruckt (Bug?!?).

Neuer Code muss so aussehen:

Code: Alles auswählen

;Hilfsunterprogramm:
;Druckeransteuerung  PrintFont  V.0.5
;Druckt immer nur eine Zeile Text unter der anderen,
;unabhängig vom Textstiel, deren Größe und der
;eingestellten Auflösung des Druckers!
;Aufruf:
;PrintText("Schriftart",Schriftgroesse,"Text")
;Beispiel:
;PrintText("Arial", 12, "Testtext")
;Unterprogrammaufruf nach: StartPrinting()
;und vor StopPrinting()
;Die Variable endy uebergibt den Startwert der ersten
;vertikalen Textausgabe auf den Drucker in Pixel.
;
Procedure PrintText(font.s,fontgr.w,text.s)
Shared endy
ypos = PrinterPageWidth()
xpos = PrinterPageHeight()
lRand = 100
  LoadFont(10, font, (xpos / 1024) * fontgr)
  If StartDrawing(PrinterOutput())
    DrawingFont(FontID(10))
    DrawText(lRand, endy, text, RGB(0,0,0), RGB(255,255,255))
    StopDrawing()
  EndIf
  endy = endy + (ypos / 460) * fontgr
EndProcedure

endy = 100


; START DEMO ######################################
If OpenWindow(0, 0, 0, 300, 200, "PureBasic Window Druckertest", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
endy = 100
TextGadget(0, 10, 20, 140, 38, "Druckeransteuerung...", #PB_Text_Center) 
demotex.s = "Hallo Welt!"

If PrintRequester()
   If StartPrinting("PureBasic-PrintText")

    PrintText("Courier", 12,"<< Demoseite  PrintText  Version 0.5 >>")
    PrintText("Tahoma", 40, "Test Tahoma")
    PrintText("Arial", 40, "Test Arial")
    PrintText("Times New Roman", 16, demotex)

    PrintText("Courier", 24, ">>>>>>>>>><<<<<<<<<<")
    PrintText("Courier", 24, "TEST TEST  TEST TEST")
    PrintText("Courier", 24, ">>>>>>>>>><<<<<<<<<<")

    For z = 0 To 20 Step 2
      PrintText("Arial", 6 + z, demotex + " Schriftgröße: " + Str(6+z))
    Next z

    StopPrinting()
   EndIf

EndIf

  SetGadgetText(0, "Druckauftrag beendet!")

  Repeat
    EventID = WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow
      Quit = 1
    EndIf
  Until Quit = 1
EndIf

End
; ENDE DEMO ######################################
Im "PDF Handbuch 4.41" und in der Hilfe sollten die optionalen Punkte [, VordergrundFarbe [, HintergrundFarbe]] auf Pfichtfeldern geändert werden.

...
DrawText()

Syntax

Ergebnis = DrawText(x, y, Text$ , VordergrundFarbe , HintergrundFarbe)
Beschreibung
...