kleine Listen(Gadgets) drucken, für den Hausgebrauch

Windowsspezifisches Forum , API ,..
Beiträge, die plattformübergreifend sind, gehören ins 'Allgemein'-Forum.
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

kleine Listen(Gadgets) drucken, für den Hausgebrauch

Beitrag von hjbremer »

ich wollte mehrere Listen mit wenigen Items auf ein Blatt ausdrucken
Mit dem Canvasgadget wollte ich nicht / kann ich nicht.

im Forum fand ich CaptureGadget und hier eine Demo damit, das allermeiste vom Code ist für diese Demo
sollte auch mit 5.70 und x64 laufen, aber nicht getestet.

Code: Alles auswählen

;kleine Listen(Gadgets) drucken, ganz einfach für den Hausgebrauch
; 
;HJBremer und PB 5.41 LTS x86 Windows 10 - 10.02.2019
;  für alle die das kleine DemoProgramm oder Teile davon gebrauchen können !

;Quellen
;https://www.purebasic.fr/english/viewtopic.php?f=5&t=70746
;https://docs.microsoft.com/de-de/windows/desktop/gdi/wm-print
;https://docs.microsoft.com/en-us/windows/desktop/api/wingdi/nf-wingdi-bitblt
;https://docs.microsoft.com/de-de/windows/desktop/api/winuser/nf-winuser-getwindowdc 

EnableExplicit

Enumeration
   #window
   #list1
   #list2
   #list3
   #list4
   #combo
   #spin
   #text
   #img1 : #img2 : #img3: #imgtext
   #image
   #imagegadget
   #checkboxP1
   #checkboxB1
   #printrand
   #buttonPrn1 : #buttonPrn2
   #optionframe0 : #optionframe1 : #optionframe2
   #optiongadget1 : #optiongadget2 : #optiongadget3 : #optiongadget4 : #optiongadget5
   #textdummy
   #buttonEnde   
EndEnumeration

CompilerIf Defined(Top, #PB_Constant) = 0    ;für SetXY + Write
   ;eigene Konstanten in PB einbinden siehe
   ; https://www.purebasic.fr/english/viewtopic.php?f=12&t=18820&start=15
   Enumeration
      #Top : #TopLeft : #TopRight : #TopCenter
      #Left
      #Right
      #Bottom : #BottomLeft : #BottomRight
   EndEnumeration
CompilerEndIf

Procedure.i SetXY(gadgetnr, parent, flag, abstand=10)
   ;SetXY Mini nur für einige Gadgets + Windows
   
   Protected p.rect, x, y
   
   If IsGadget(parent)      
      p\top = GadgetY(parent)
      p\left = GadgetX(parent)
      p\right = GadgetX(parent) + GadgetWidth(parent)
      p\bottom = GadgetY(parent) + GadgetHeight(parent)
      
      Select flag
         Case #Top: x = p\left : y = p\top - abstand - GadgetHeight(gadgetnr)             
         Case #Left: x = p\left - abstand - GadgetWidth(gadgetnr) : y = p\top              
         Case #Right: x = p\right + abstand : y = p\top            
         Case #Bottom : x = p\left : y = p\bottom + abstand            
         Case #BottomRight : x = p\right - GadgetWidth(gadgetnr) : y = p\bottom + abstand             
         Default: Debug "unbekanntes Flag für ParentGadget - Gadgetnr." + gadgetnr   
      EndSelect
      
   ElseIf IsWindow(parent)      
      p\top = 0
      p\left = 0
      p\right = WindowWidth(parent)
      p\bottom = WindowHeight(parent)
      
      Select flag
         Case #TopLeft : x = p\left + abstand : y = p\top + abstand            
         Case #TopRight : x = p\right - abstand - GadgetWidth(gadgetnr) : y = p\top + abstand            
         Case #TopCenter : x = (p\right / 2) - (GadgetWidth(gadgetnr) / 2) : y = p\top + abstand            
         Case #BottomLeft : x = p\left + abstand : y = p\bottom - abstand - GadgetHeight(gadgetnr)            
         Case #BottomRight : x = p\right - abstand - GadgetWidth(gadgetnr) : y = p\bottom - abstand - GadgetHeight(gadgetnr)
         Default: Debug "unbekanntes Flag für ParentWindow etc - Gadgetnr." + gadgetnr 
      EndSelect
   Else 
      Debug "Parent Gadget/Window existiert nicht. Nr." + parent
      ProcedureReturn
   EndIf
   
   ResizeGadget(gadgetnr, x, y, #PB_Ignore, #PB_Ignore)
   
EndProcedure

Procedure.i Write(text$, parent, flag, abstand=8)
   
   Protected s.Size   
   Protected dc = GetWindowDC_(0)   
   SelectObject_(dc, GetGadgetFont(#PB_Default))
   GetTextExtentPoint32_(dc, @text$, Len(text$), s)
   ReleaseDC_(0, dc)
   
   Protected nr = TextGadget(#PB_Any, 0, 0, s\cx + 2, s\cy + 0, text$) ;, #PB_Text_Border)
   SetXY(nr, parent, flag, abstand)
   
   ProcedureReturn nr
EndProcedure

Procedure.i GetPrintDotmm(prndc, mm = 0, flag = 0)
   ;Quelle: https://docs.microsoft.com/de-de/windows/desktop/api/wingdi/nf-wingdi-getdevicecaps
   
   Protected pysLeft  = GetDeviceCaps_(prndc, #PHYSICALOFFSETX)   ;nicht druckbarer Bereich Links   
   Protected pysTop   = GetDeviceCaps_(prndc, #PHYSICALOFFSETY)   ;nicht druckbarer Bereich Oben  
   Protected horRes   = GetDeviceCaps_(prndc, #HORZRES)           ;Breite des druckbaren Bereichs der Seite in dots 
   Protected verRes   = GetDeviceCaps_(prndc, #VERTRES)           ;Höhe des druckbaren Bereichs der Seite 
   Protected width    = GetDeviceCaps_(prndc, #HORZSIZE)          ;Breite des druckbaren Bereichs der Seite in mm 
   Protected height   = GetDeviceCaps_(prndc, #VERTSIZE)          ;Höhe des druckbaren Bereichs der Seite in mm
   
   Protected horDotmm.f = horRes / width     ;dots pro mm Horizontal
   Protected verdotmm.f = verRes / height    ;dots pro mm Vertikal - meistens gleich Horizontal
   
   Select flag
      Case 0: ProcedureReturn horDotmm
      Case 1: ProcedureReturn (horDotmm * mm) - pysLeft ; linker Rand 
      Case 2: ProcedureReturn (verDotmm * mm) - pysTop  ; oberer Rand        
   EndSelect
   
EndProcedure

Procedure.f GetPrintScale(prndc)
   
   Protected windc, size, res 
   Protected wrs.f, prs.f, scale.f
   
   windc = GetDC_(0)
   size  = GetDeviceCaps_(windc, #HORZSIZE)
   res   = GetDeviceCaps_(windc, #HORZRES)
   wrs   = res / size
   ReleaseDC_(0, windc)
   
   size  = GetDeviceCaps_(prndc, #HORZSIZE)
   res   = GetDeviceCaps_(prndc, #HORZRES)
   prs   = res / size   
   scale = prs / wrs    ;: Debug scale
   
   ProcedureReturn scale   
EndProcedure

Procedure.i GetCaptureImage(image, pbnr, frame=1)
   ;macht ein Bild von einem Gadget
   ;wenn image = pb_any dann muß aufrufende Proc das Image löschen 
   
   ; der Teil mit WM_Print ist nur da um mit BitBlt zu vergleichen
   ; der Teil mit den Frames ist nur für WM_Print sinnvoll, ausser man will einen anderen Rahmen 
   
   If IsGadget(pbnr) = 0 : ProcedureReturn -1: EndIf
   
   Protected dcsource, brush, r.Rect
   Protected hwnd = GadgetID(pbnr)      
   Protected width = GadgetWidth(pbnr) 
   Protected height = GadgetHeight(pbnr)      
   Protected imagenr = CreateImage(image, width, height) : If image = #PB_Any : image = imagenr : EndIf   
   
   Protected dc = StartDrawing(ImageOutput(image)) 
   
   If GetGadgetState(#checkboxB1) = #PB_Checkbox_Unchecked
      ;WM_Print kopiert ein Gadget anscheinend wie es erstellt wurde, 
      ;dies ist aber nicht unbedingt das was man sieht, darum den Rahmen ev. nachmalen
      SendMessage_(hwnd, #WM_PRINT, dc, #PRF_CHILDREN|#PRF_CLIENT|#PRF_NONCLIENT|#PRF_ERASEBKGND)
   Else
      ;dcsource = GetDC_(GadgetID(pbnr))       ;GetDC_() verursacht Versatz
      dcsource = GetWindowDC_(GadgetID(pbnr))  ;es muß GetWindowDC_ sein !! dann besser als WM_Print
      BitBlt_(dc, 0, 0, width, height, dcsource, 0, 0, #SRCCOPY)
      ReleaseDC_(GadgetID(pbnr), dcsource)     
   EndIf
     
   Select frame
      Case 0
      Case 1
         SetRect_(r, 0, 0, width, height)   
         DrawEdge_(dc, r, #EDGE_ETCHED, #BF_RECT)         
      Case 2
         SetRect_(r, 0, 0, width, height)   
         SelectObject_(dc, GetStockObject_(#NULL_BRUSH)) 
         SelectObject_(dc, GetStockObject_(#BLACK_PEN))   
         Rectangle_(dc, 0, 0, width, height)         
   EndSelect
   
   StopDrawing()
   
   ProcedureReturn image
   
EndProcedure

Procedure.i PrintGadgetImage(faktor.f = 1)
   ;Demo um die Images zu drucken
   
   Protected pr, rx, ry, x, y, dc, scale.f, text$
   
   ;da man StartDrawing() nicht verschachteln kann müssen die Images vorher erstellt werden.
   GetCaptureImage(#img1, #list1)
   GetCaptureImage(#img2, #list2)
   GetCaptureImage(#img3, #list3)
   GetCaptureImage(#imgtext, #text)
   
   DefaultPrinter() 
   dc = StartDrawing(PrinterOutput())
   If faktor = 0  ;mit faktor kann man den Ausdruck größer/kleiner machen
      scale = 1   ; scale = 1 bedeutet Ausdruck im Original ohne Skalierung
   Else
      ;scale ist der Wert um Größe vom Ausdruck gleich Bildschirm zu machen
      scale = GetPrintScale(dc) * faktor
   EndIf   
   StopDrawing()
   
   ResizeImage(#img1, ImageWidth(#img1) * scale , ImageHeight(#img1) * scale)
   ResizeImage(#img2, ImageWidth(#img2) * scale , ImageHeight(#img2) * scale, #PB_Image_Raw)
   ResizeImage(#img3, ImageWidth(#img3) * scale , ImageHeight(#img3) * scale, #PB_Image_Raw)
   ResizeImage(#imgtext, ImageWidth(#imgtext) * scale , ImageHeight(#imgtext) * scale, #PB_Image_Raw)
   
   ;da Loadfont() nicht innerhalb von StartDrawing() aufgerufen werden kann
   ;muß wegen scale und dem dc dies einmal vorher geschehen, wo ist eigentlich egal.
   ;Funktioniert gut solange man nur den Default-Drucker benutzt, will man einen anderen  
   ;Drucker mit dem PrintRequester auswählen, muß man den Font mit der Windows-Api laden.
   
   LoadFont(1, "Arial", 10 * scale) 
   
   DefaultPrinter()   
   StartPrinting("ImgCopy")
   dc = StartDrawing(PrinterOutput())  ;dieses dc von StartDrawing hat nun einen anderen Wert
   
   ;hier ist der Rand in mm und die Abstände der Gadgets zueinander für x + y in Pixel !!!
   pr = GetGadgetState(#printrand)  ;Rand
   rx = GetPrintDotmm(dc, pr, 1)    ;die 1 steht für linker Rand, 2 oberer Rand
   ry = GetPrintDotmm(dc, pr, 2)     
   
   DrawingFont(FontID(1))
   DrawText(rx, ry, "Listen Demodruck", #Black, #White)
   
   ry = GetPrintDotmm(dc, pr + 6, 2)  ;Rand oben größer
   
   x = rx : y = ry    
   DrawImage(ImageID(#img1), x, y) ;Listen werden mit einem Rand von rx + ry gedruckt
   
   If GetGadgetState(#checkboxP1) = #PB_Checkbox_Unchecked
      
      y = GadgetHeight(#list1) + 10             
      DrawImage(ImageID(#img2), rx, ry + (y * scale)) ;kommt unter #img1
      
      x = (GadgetWidth(#list1) + 10)     
      DrawImage(ImageID(#img3), rx + (x * scale), ry) ;kommt neben #img1
      
      x = GetPrintDotmm(dc, 130, 1)    ;die 1 steht für linker Rand, 2 oberer Rand
      y = GetPrintDotmm(dc, 100, 2)  
      DrawImage(ImageID(#imgtext), x, y) ;130 mm von links + 100 mm von oben
      
      ;Info
      x = rx: y = ry + ((20 + GadgetHeight(#list3)) * scale)      
      text$ = "Liste 1: Resize = Standard / Liste 2 + 3: Resize = Raw / man sieht einen Unterschied"            
      DrawText(x, y, text$, #Black, #White)
      
   EndIf
   
   StopDrawing()         
   StopPrinting()
   
EndProcedure

Define j, colbr = 99

OpenWindow(#window, 0, 0, 1300, 610, "ListIconGadget", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)

ListIconGadget(#list1, 0, 0, 400, 240, "Liste 1", colbr, #PB_ListIcon_GridLines)
ListIconGadget(#list2, 0, 0, 400, 240, "Liste 2", colbr, #PB_ListIcon_FullRowSelect)
ListIconGadget(#list3, 0, 0, 400, 490, "Liste 3", colbr, #PB_ListIcon_GridLines)
ListViewGadget(#list4, 0, 0, 150, 222)
ImageGadget(#imagegadget, 0, 0, 0, 0, 0)

ComboBoxGadget(#combo, 0, 0, 222, 24, #PB_ComboBox_Editable)
AddGadgetItem(#combo, -1, "ComboBox editable...")
AddGadgetItem(#combo, -1, "keine Ahnung")

SpinGadget(#spin, 0, 0, 222, 24, 0, 100, #PB_Spin_Numeric)
TextGadget(#text, 0, 0, 222, 24, "HJ Bremer", #PB_Text_Center|#PB_Text_Border)

For j = #list1 To #list3          
   AddGadgetColumn(j, 1, "Col 1", colbr)
   AddGadgetColumn(j, 2, "Col 2", colbr)
   AddGadgetColumn(j, 3, "Col 3", colbr)       
Next

For j = 1 To 8        
   AddGadgetItem(#list1, j, "Bananen" + #LF$ + Str(j) +" kg" + #LF$ + "a 1,20" + #LF$ + StrF(j * 1.20,2))
   AddGadgetItem(#list2, j, "Äpfel" + #LF$ + Str(j) +" kg" + #LF$ + "a 1,50" + #LF$ + StrF(j * 1.50,2))
   AddGadgetItem(#list3, j, "Reis" + #LF$ + Str(j) +" kg" + #LF$ + "a 2,50" + #LF$ + StrF(j * 2.50,2))
   AddGadgetItem(#list4, -1, "Item " + Str(j) + " of the Listview")
Next

SetGadgetItemColor(#list1, -1, #PB_Gadget_FrontColor, #Blue, 1)

SetXY(#list1, #window, #TopLeft)
SetXY(#list2, #list1, #Bottom)
SetXY(#list3, #list1, #Right)
SetXY(#list4, #list3, #Right)
SetXY(#combo, #list4, #Right)
SetXY(#spin,  #combo, #Bottom)
SetXY(#text,  #spin,  #Bottom)

SetXY(#imagegadget, #list4, #Bottom)

CheckBoxGadget(#checkboxP1, 0, 0, 120, 25, " nur Liste 1 drucken")
CheckBoxGadget(#checkboxB1, 0, 0, 120, 25, " BitBlt benutzen")

SpinGadget(#printrand, 0, 0, 120, 22, 5, 100, #PB_Spin_Numeric)
SetGadgetState (#printrand, 10)

ButtonGadget(#buttonPrn1, 0, 0, 120, 25, "Drucken ori")
ButtonGadget(#buttonPrn2, 0, 0, 120, 25, "Drucken resize")

OptionGadget(#optionframe0, 0, 0, 120, 20, "Image Frame ori")
OptionGadget(#optionframe1, 0, 0, 120, 20, "Image Frame 1")
OptionGadget(#optionframe2, 0, 0, 120, 20, "Image Frame 2")
TextGadget(#textdummy, 0, 0, 0, 0, "")
OptionGadget(#optiongadget1, 0, 0, 120, 20, "ListIconGadget")
OptionGadget(#optiongadget2, 0, 0, 120, 20, "ListViewGadget")
OptionGadget(#optiongadget3, 0, 0, 120, 20, "ComboboxGadget") 
OptionGadget(#optiongadget4, 0, 0, 120, 20, "SpinGadget") 
OptionGadget(#optiongadget5, 0, 0, 120, 20, "TextGadget") 

ButtonGadget(#buttonEnde, 0, 0, 120, 25, "Ende")

SetXY(#buttonEnde, #window, #BottomRight)
SetXY(#buttonPrn1, #window, #BottomLeft)
SetXY(#buttonPrn2, #buttonPrn1, #Right)
SetXY(#checkboxP1, #buttonPrn2, #Top, 12)
SetXY(#printrand,  #buttonPrn1, #Top, 12)

SetXY(#optionframe0, #checkboxP1, #Right, 40)
SetXY(#optionframe1, #optionframe0, #Bottom, 1)
SetXY(#optionframe2, #optionframe1, #Bottom, 1)

SetXY(#optiongadget1, #optionframe0, #Right, 40)
SetXY(#optiongadget2, #optiongadget1, #Bottom, 1)
SetXY(#optiongadget3, #optiongadget2, #Bottom, 1)
SetXY(#optiongadget4, #optiongadget1, #Right, 20)
SetXY(#optiongadget5, #optiongadget4, #Bottom, 1)
SetXY(#checkboxB1,    #optiongadget1, #Top, 1)

Write("Drucken Rand in mm", #printrand, #Top,2)
Write("für Demo drücken", #optionframe0, #Top)

Define event, gadget, frame = 0, typ = #list1
Define add, wert

Repeat
   event = WaitWindowEvent()
   gadget = EventGadget()
   
   Select event         
      Case #PB_Event_Gadget         
         Select gadget
            Case #printrand: SetActiveGadget(#buttonPrn1)
            Case #buttonPrn1: PrintGadgetImage(0)   ;Größe nicht ändern               
            Case #buttonPrn2: PrintGadgetImage(1)   ;1 = Screen = Ausdruck; 0.9 kleiner, 1.1 größer              
               
            Case #optionframe0: PostEvent(#PB_Event_Gadget, EventWindow(), #textdummy, typ, 0)               
            Case #optionframe1: PostEvent(#PB_Event_Gadget, EventWindow(), #textdummy, typ, 1)
            Case #optionframe2: PostEvent(#PB_Event_Gadget, EventWindow(), #textdummy, typ, 2)
               
            Case #optiongadget1: PostEvent(#PB_Event_Gadget, EventWindow(), #textdummy, #list1, frame)
            Case #optiongadget2: PostEvent(#PB_Event_Gadget, EventWindow(), #textdummy, #list4, frame)
            Case #optiongadget3: PostEvent(#PB_Event_Gadget, EventWindow(), #textdummy, #combo, frame)
            Case #optiongadget4: PostEvent(#PB_Event_Gadget, EventWindow(), #textdummy, #spin,  frame)
            Case #optiongadget5: PostEvent(#PB_Event_Gadget, EventWindow(), #textdummy, #text,  frame)
               
            Case #checkboxB1: PostEvent(#PB_Event_Gadget, EventWindow(), #textdummy, typ,  frame)
               
            Case #textdummy
               typ = EventType()
               frame = EventData() 
               GetCaptureImage(#image, typ, frame)               
               SetGadgetState(#imagegadget, ImageID(#image))
               
            Case #buttonende: event = #PB_Event_CloseWindow
         EndSelect
         
   EndSelect
Until event = #PB_Event_CloseWindow

Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Benutzeravatar
Argax
Beiträge: 6
Registriert: 28.09.2018 14:03

Re: kleine Listen(Gadgets) drucken, für den Hausgebrauch

Beitrag von Argax »

Und hat das geklappt?

VG,
Argax
This signature is under construction
Antworten