Seite 1 von 1

ListIconGadget drucken mit Hilfe eines Image

Verfasst: 16.03.2009 22:56
von hjbremer
Irgendwann kam mal die Frage - wie drucke ich ein ListIconGadget aus - und irgendwer meinte erst auf ein Image ausgeben und dann dieses drucken. Vielmehr kam dann aber auch nicht.

Bisher habe ich den Inhalt eines LV als primitive Liste gedruckt und das reichte mir, aber ich dachte mir nun, auf ein Image ausgeben und dann drucken, das hört sich simpel an. Aber wie immer steckt der Teufel im Detail. Billys Win-Api läßt grüßen.

Hier das Ergebnis als Include-Datei.

Code: Alles auswählen

Declare lvPrint1Start(lvnr,ignr,flag=0)
Declare lvPrint2Leer(*lvp)
Declare lvPrint3Fuellen(*lvp,von=-1,bis=-1)
Declare lvPrint4Print(*lvp,x,y,fbr.f,fhh.f)

;lvPrint.pbi
;ListIconGadget ausdrucken by HJBremer März 2009
;PB 4.x Windows XP

Structure lvprint
  dc.i            
  ignr.i          ;Imagegadget für Anzeige / Vorschau
  lvnr.i
  lvid.i
  font.i

  hdid.i
  cols.i
  
  hd.rect
  lv.rect
  lvbr.i
  lvhh.i
  hdhh.i
  
  itemhh.i
  itembr.w[0]      ;hiermit wird in itemxx gespeichert/gelesen
  itemxx.s{200}    ;Platz für 100 Spalten, bei Bedarf vergrößern
  itemtext$
  itempage.i
  itemcount.i
  
  imagenr.i
  oldpen.i
  oldbrush.i
  pen1.i
  brush1.i
  hdcolor.i
  lvcolor.i
  
  nextitem.i
EndStructure

Procedure lvPrint1Start(lvnr,ignr,flag=0)

Protected *lvp.lvprint = AllocateMemory(SizeOf(lvprint))
Protected j

With *lvp
  \ignr = ignr
  \lvnr = lvnr
  \lvid = GadgetID(\lvnr) 
  \font = GetGadgetFont(\lvnr)

  \hdid = SendMessage_(\lvid,#LVM_GETHEADER,0,0)
  \cols = SendMessage_(\hdid,#HDM_GETITEMCOUNT,0,0)  
  \itempage = SendMessage_(\lvid,#LVM_GETCOUNTPERPAGE,0,0)
  \itemcount = SendMessage_(\lvid,#LVM_GETITEMCOUNT,0,0)
  
  ;Höhe einer LVZeile
   If \itemcount        
      \lv\top = 0: \lv\left = #LVIR_LABEL 
      SendMessage_(\lvid, #LVM_GETSUBITEMRECT, 0, \lv.rect)
      \itemhh = \lv\bottom - \lv\top
   EndIf  
   
   ;wenn horizontale Scrollbar 
   If GetWindowLong_(\lvid,#GWL_STYLE) & #WS_HSCROLL 
    \itempage + 1  ;funktioniert so sicher, bis Fontsize 14
   EndIf           ;darüber ist Schrift für Header sowieso zu groß

  ;LVbreite incl. unsichtbare Cols mit letzter Col des Headers ermitteln
  SendMessage_(\hdid, #HDM_GETITEMRECT , \cols-1, \hd.rect)
  \lvbr = \hd\right 
  
  ;Headerhöhe
  \hdhh = \hd\bottom 
  
  ;LV Höhe incl. Header
  GetWindowRect_(\lvid, \lv.rect)
  OffsetRect_(\lv.rect, - \lv\left, - \lv\top)
  \lvhh = \lv\bottom
  
  ;Breite der einzelnen Spalten durch Abfrage des Headers
  For j = 0 To \cols - 1
    SendMessage_(\hdid, #HDM_GETITEMRECT ,j,\hd.rect) 
    \itembr[j] = \hd\right - \hd\left
  Next
  
  ;\pen1 = CreatePen_(#PS_SOLID,0,#Red)   
  ;\brush1 = CreateSolidBrush_($FEFEFE)

  \pen1 = GetStockObject_(#BLACK_PEN)
  \brush1 = GetStockObject_(#WHITE_BRUSH)
  \hdcolor = #Black
  \lvcolor = #Black
  
  If flag
     \itempage = flag
     \lvhh = 1 + \hdhh + (\itemhh * \itempage)
  EndIf

EndWith
ProcedureReturn *lvp
EndProcedure

Procedure lvPrint2Leer(*lvp.lvprint)

If Not *lvp: ProcedureReturn 0: EndIf

Protected j,k

With *lvp
  If IsImage(\imagenr): FreeImage(\imagenr): EndIf
  \imagenr = CreateImage(-1, \lvbr, \lvhh)
  
  \dc = StartDrawing(ImageOutput(\imagenr)) 
  
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawingFont(\font)
      FrontColor(\hdcolor)
      
      ;wichtig für DrawText_() 
       SetTextAlign_(\dc,#TA_TOP)
       
      ;Gesamtrahmen mit pen und brush malen
       \oldPen = SelectObject_(\dc, \pen1) 
       \oldBrush = SelectObject_(\dc, \brush1)
       Rectangle_(\dc, 0, 0, \lvbr, \lvhh)

      ;Header malen
       For j = 0 To \cols - 1
           SendMessage_(\hdid, #HDM_GETITEMRECT, j, \hd.rect) 
           If j = \cols - 1
             DrawEdge_(\dc,\hd,#BDR_RAISEDOUTER,#BF_BOTTOM|#BF_MONO)
           Else
             DrawEdge_(\dc,\hd,#BDR_RAISEDOUTER,#BF_BOTTOMRIGHT|#BF_MONO)
           EndIf
           \itemtext$ = GetGadgetItemText(\lvnr, -1, j)
           ;Text positionieren und malen
           If j = 0
             \hd\right - 6: OffsetRect_(\hd,5,2)
           Else
             \hd\right - 5: OffsetRect_(\hd,4,2)
           EndIf
           DrawText_(\dc,\itemtext$,-1,\hd,#DT_END_ELLIPSIS)
       Next       
       
       ;leeres Lv malen 
       SetRect_(\lv,0,0,0,\hdhh)
       For j = 0 To \itempage - 1
         SetRect_(\lv,0,\lv\bottom,0,\lv\bottom + \itemhh)
         For k = 0 To \cols - 1
           \lv\left = \lv\right
           \lv\right + \itembr[k] 
           If k = \cols - 1
             DrawEdge_(\dc,\lv,#BDR_RAISEDOUTER,#BF_BOTTOM)
           Else
             DrawEdge_(\dc,\lv,#BDR_RAISEDOUTER,#BF_BOTTOMRIGHT)
           EndIf
         Next
       Next
       
       SelectObject_(\dc,\oldBrush) 
       SelectObject_(\dc,\oldPen) 
       DeleteObject_(\brush1) 
       DeleteObject_(\pen1)
  
  StopDrawing()
  
  If IsGadget(\ignr)
     SetGadgetState(\ignr,ImageID(\imagenr))
  EndIf

EndWith
ProcedureReturn *lvp\imagenr
EndProcedure

Procedure lvPrint3Fuellen(*lvp.lvprint,von=-1,bis=-1)

If Not *lvp: ProcedureReturn 0: EndIf

Protected j,k,add

With *lvp
  
  If von < 0: von = 0: EndIf
  If von > \itemcount: von = \itemcount - \itempage: EndIf
  If bis = -1: bis = \itemcount: EndIf
  If bis > \itemcount: bis = \itemcount: EndIf
  If bis - von >= \itempage: bis = von + \itempage - 1: EndIf
  
  \dc = StartDrawing(ImageOutput(\imagenr)) 
  
      DrawingMode(#PB_2DDrawing_Transparent)
      DrawingFont(\font)
      FrontColor(\lvcolor)
      
      ;wichtig für DrawText_() 
       SetTextAlign_(\dc,#TA_TOP)

       SetRect_(\lv,0,0,0,\hdhh)
       For j = von To bis
         SetRect_(\lv,0,\lv\bottom,0,\lv\bottom + \itemhh)
         For k = 0 To \cols - 1
           \lv\left = \lv\right
           \lv\right + \itembr[k] 
            ;Textitem malen
            \itemtext$ = GetGadgetItemText(\lvnr,j,k) 
            add = 3: If k = 0: add = 4: EndIf
            OffsetRect_(\lv,add,0): \lv\right - add
            DrawText_(\dc,\itemtext$,-1,\lv,#DT_END_ELLIPSIS)          
            OffsetRect_(\lv,-add,0): \lv\right + add
         Next
       Next
  
  StopDrawing()
  
  If IsGadget(\ignr)
     SetGadgetState(\ignr,ImageID(\imagenr))
  EndIf
  
  \nextitem = j
  
EndWith
ProcedureReturn j
EndProcedure

Procedure lvPrint4Print(*lvp.lvprint,x,y,fbr.f,fhh.f)

If Not *lvp: ProcedureReturn 0: EndIf

Protected hdc,hres,vres,neuimgbr,neuimghh

With *lvp

  StartPrinting("Test")
      
      hdc = StartDrawing(PrinterOutput()) 
    
      HRes = GetDeviceCaps_(hDC,#HORZRES)   ;:DebugL( hres )
      VRes = GetDeviceCaps_(hDC,#VERTRES)   ;:DebugL( vres)
      
      neuimgbr = \lvbr*fbr
      
      If neuimgbr > hres - x
         neuimgbr = hres - x
         fhh = (neuimgbr / \lvbr)
      EndIf   
      
      neuimghh = \lvhh*fhh
      
      If neuimghh > vres - y
         neuimghh = vres - y
         fbr = neuimghh / \lvhh
         neuimgbr = \lvbr*fbr
      EndIf   

      ;ResizeImage(\imagenr,neuimgbr,neuimghh)
      DrawImage(ImageID(\imagenr),x,y,neuimgbr,neuimghh)
        
      StopDrawing() 
   
  StopPrinting()
 
EndWith
EndProcedure 

1.Demo - EinzelAusdruck

Code: Alles auswählen


Procedure.s Zufallsdaten()

Dim x$(4)
Restore Daten

For k = 0 To 4: Read.s x$(k): Next
text$ + x$(Random(4)) + #LF$

For k = 0 To 4: Read.s x$(k): Next
text$ + x$(Random(4)) + #LF$

For k = 0 To 4: Read.s x$(k): Next
text$ + x$(Random(4)) 

For k = 0 To 4: Read.s x$(k): Next
text$ + x$(Random(4)) 

ProcedureReturn text$
EndProcedure

;=Demo================================================================

fontidArial = FontID(LoadFont(#PB_Any,"Arial",10))
fontidTimes = FontID(LoadFont(#PB_Any,"Times",11))
fontidCourier = FontID(LoadFont(#PB_Any,"Courier New",10))

whh = 500
OpenWindow(0, 9, 99, 950, whh, "") 
;CreateGadgetList(WindowID(0)) 

lvnr = ListIconGadget(-1, 10,10,400,350,"Lfdnr",50,#PB_ListIcon_GridLines)
       SetGadgetFont(lvnr,fontidArial)       
       AddGadgetColumn(lvnr, 1, "Sp 1 01234567890123456789", 140)
       AddGadgetColumn(lvnr, 2, "Sp 2", 140)
       AddGadgetColumn(lvnr, 3, "Sp 3", 130)
       For j = 0 To 100
        text$ = Zufallsdaten()
        AddGadgetItem(lvnr, -1, Str(j)+#LF$+text$)
       Next
       
ignr = ImageGadget(-1,450,10,0,0,0)

  sp = 15
  ze = 380
b1nr = ButtonGadget(-1,sp +   0,ze,88,22,"Image")
b2nr = ButtonGadget(-1,sp + 100,ze,88,22,"<")
b3nr = ButtonGadget(-1,sp + 200,ze,88,22,">")
b4nr = ButtonGadget(-1,sp + 300,ze,88,22,"Print")
t1nr =   TextGadget(-1,sp + 300,ze+25,65,20, "Size *",#PB_Text_Right|512) 
s1nr = StringGadget(-1,sp + 370,ze+25,18,20, "3",#PB_String_Numeric) 

HideGadget(b2nr,1): HideGadget(b3nr,1): HideGadget(b4nr,1)
HideGadget(t1nr,1): HideGadget(s1nr,1)

Repeat 
event = WaitWindowEvent() 
  Select event
      Case #PB_Event_Gadget 
           Select EventGadget() 
              Case b1nr
                HideGadget(b2nr,0): HideGadget(b3nr,0): HideGadget(b4nr,0)
                HideGadget(t1nr,0): HideGadget(s1nr,0)
                If *p.lvprint: FreeMemory(*p): EndIf 
                proseite = 22  ;wenn null wird Anzahl des LV genommen
                *p.lvprint = lvPrint1Start(lvnr,ignr,proseite)
                lvPrint2Leer(*p)
                lvPrint3Fuellen(*p)
                proseite = *p\itempage

              Case b2nr  ;zurück
                lvPrint2Leer(*p)
                lvPrint3Fuellen(*p,*p\nextitem - (2 * proseite))

              Case b3nr  ;weiter
                lvPrint2Leer(*p)
                lvPrint3Fuellen(*p,*p\nextitem)

              Case b4nr
                size = Val(GetGadgetText(s1nr))
                If PrintRequester() ;oder DefaultPrinter()
                   lvPrint4Print(*p,10,10,size,size)
                EndIf   
                
           EndSelect   
  EndSelect
Until event = #PB_Event_CloseWindow 

End

DataSection
Daten:
Data.s "12345 ", "35793 ", "48265 ", "72561 ", "55127 "
Data.s "Wieda", "Bremen", "Kuhdorf", "Neustadt", "Bonn"
Data.s "Otto ", "Mike ", "Hans-Jürgen ", "Ulrike ", "Familie "
Data.s "Meier", "Bremer", "Müller", "Holzfäller", "Rappel"
EndDataSection           

2. Demo - Komplett Ausdruck der Liste

Code: Alles auswählen

XIncludeFile "\Bremer\PureBasic430_Pbi\lvPrint.pbi"

Procedure.s Zufallsdaten()

Dim x$(4)
Restore Daten

For k = 0 To 4: Read.s x$(k): Next
text$ + x$(Random(4)) + #LF$

For k = 0 To 4: Read.s x$(k): Next
text$ + x$(Random(4)) + #LF$

For k = 0 To 4: Read.s x$(k): Next
text$ + x$(Random(4)) 

For k = 0 To 4: Read.s x$(k): Next
text$ + x$(Random(4)) 

ProcedureReturn text$
EndProcedure

;=Demo================================================================

fontidArial = FontID(LoadFont(#PB_Any,"Arial",10))
fontidTimes = FontID(LoadFont(#PB_Any,"Times",11))
fontidCourier = FontID(LoadFont(#PB_Any,"Courier New",10))

whh = 500
OpenWindow(0, 9, 99, 950, whh, "") 
;CreateGadgetList(WindowID(0)) 

lvnr = ListIconGadget(-1, 10,10,400,350,"Sp 0 xxxxxxxxxx",50,#PB_ListIcon_GridLines)
       SetGadgetFont(lvnr,fontidArial)       
       AddGadgetColumn(lvnr, 1, "Sp 1 01234567890123456789", 140)
       AddGadgetColumn(lvnr, 2, "Sp 2", 140)
       AddGadgetColumn(lvnr, 3, "Sp 3", 130)
       For j = 0 To 48
        text$ = Zufallsdaten()
        AddGadgetItem(lvnr, -1, Str(j)+#LF$+text$)
       Next
       
ignr = ImageGadget(-1,450,10,0,0,0)

  sp = 15
  ze = 380
b1nr = ButtonGadget(-1,sp +   0,ze,88,22,"Image")
b2nr = ButtonGadget(-1,sp + 100,ze,88,22,"<")
b3nr = ButtonGadget(-1,sp + 200,ze,88,22,">")
b4nr = ButtonGadget(-1,sp + 300,ze,88,22,"Print")
t1nr =   TextGadget(-1,sp + 300,ze+25,65,20, "Size *",#PB_Text_Right|512) 
t2nr =   TextGadget(-1,sp + 300,ze+50,65,20, "pro Seite",#PB_Text_Right|512) 
s1nr = StringGadget(-1,sp + 370,ze+25,18,20, "3",#PB_String_Numeric) 
s2nr = StringGadget(-1,sp + 370,ze+50,18,20, "25",#PB_String_Numeric) 

HideGadget(b2nr,1): HideGadget(b3nr,1): HideGadget(b4nr,1)
HideGadget(t1nr,1): HideGadget(t2nr,1): HideGadget(s1nr,1): HideGadget(s2nr,1)

Repeat 
event = WaitWindowEvent() 
  Select event
      Case #PB_Event_Gadget 
           Select EventGadget() 
              Case b1nr
                HideGadget(b2nr,0): HideGadget(b3nr,0): HideGadget(b4nr,0)
                HideGadget(t1nr,0): HideGadget(t2nr,0): HideGadget(s1nr,0): HideGadget(s2nr,0)
                If *p.lvprint: FreeMemory(*p): EndIf 
                proseite = Val(GetGadgetText(s2nr))
                *p.lvprint = lvPrint1Start(lvnr,ignr,proseite)
                lvPrint2Leer(*p)
                lvPrint3Fuellen(*p)
                proseite = *p\itempage

              Case b2nr  ;zurück
                lvPrint2Leer(*p)
                lvPrint3Fuellen(*p,*p\nextitem - (2 * proseite))

              Case b3nr  ;weiter
                lvPrint2Leer(*p)
                lvPrint3Fuellen(*p,*p\nextitem)

              Case b4nr
                size = Val(GetGadgetText(s1nr))
                seiten = *p\itemcount / *p\itempage
                If *p\itemcount % *p\itempage
                   seiten + 1
                EndIf 
                If PrintRequester() ;oder DefaultPrinter()     
                    abitem = 0
                    For j = 1 To seiten
                      lvPrint2Leer(*p)
                      abitem = lvPrint3Fuellen(*p,abitem)
                      lvPrint4Print(*p,10,10,size,size)
                    Next
                EndIf
                
           EndSelect   
  EndSelect
Until event = #PB_Event_CloseWindow 

End

DataSection
Daten:
Data.s "12345 ", "35793 ", "48265 ", "72561 ", "55127 "
Data.s "Wieda", "Bremen", "Kuhdorf", "Neustadt", "Bonn"
Data.s "Otto ", "Mike ", "Hans-Jürgen ", "Ulrike ", "Familie "
Data.s "Meier", "Bremer", "Müller", "Holzfäller", "Rappel"
EndDataSection                      
PS:
die Angabe für proseite in der Eventschleife kann auch null sein, es wird dann die Anzahl Zeilen vom ListIconGadget genommen.
Je nach Druckerauflösung ist der Wert für Size anders. Ich habe nur dafür gesorgt, das die Breite angepasst wird.
Wird die Liste zu stark vergrößert, wird der Ausdruck etwas pixelig wegen dem Resize des Image. Aber in der Regel ist die Qualität noch ausreichend, finde ich.
Wer Farbe will, kann mit den Werten für Pen,Brush und Color spielen.

und ansonsten kann jeder tun hiermit was er will

Verfasst: 16.03.2009 23:10
von ts-soft
:allright: sehr nützlich

Ist wirklich sehr pixelig, muß auf mind. 8x vergößern, aber da kann ich
bestimmt noch was in den Druckereinstellungen manipulieren.

Verfasst: 17.03.2009 01:14
von hjbremer
wegen dem pixelig, man kann auch Resize nehmen, habe ich im Code auskommentiert und bei DrawImage die Größenangaben dann entfernen. Bei mir mit meinem alten Canon Drucker hatte Resize allerdings keinen besonderen Effekt. Das kann bei höher auflösenden Druckern aber anders aussehen.

Aber wem das nicht reicht der muß/kann die Procedure Fuellen als Muster nehmen und daraus eine Druckroutine machen, welche die verschiedenen Auflösungen berücksichtigt. GetDeviceCaps_ läßt grüßen.

Verfasst: 17.03.2009 01:21
von ts-soft
:allright:
Sieht schon viel besser aus :D

Verfasst: 17.03.2009 17:29
von Andesdaf
ist wirklich sehr nützlich :allright: