Print all ListIconGadget entries

[Hroudtwolf]

Code updated for 5.20+

This function prints all entries of a ListIconGadget.

Code: Select all

; Print ListIconGadget
; 2006 Hroudtwolf
; PureBasic-Lounge.de
; PB 4.00 Release

Procedure PrintListIconGadget (GadgetID)
  Protected CountOfItems,result,hDC,RelXY
  Protected ImageW,ImageH,ii.IMAGEINFO,hImage,x,rc.point
  CountOfItems=CountGadgetItems(GadgetID)-1
  If CountOfItems<1
     ProcedureReturn #False
  EndIf
  result=SendMessage_ (GadgetID (GadgetID),#LVM_CREATEDRAGIMAGE,1,rc)   
  ImageList_GetImageInfo_(result,0,@ii)
  ImageW=ii\rcImage\right
  ImageH=ii\rcImage\bottom
  ImageList_Destroy_(result)
  hImage=CreateImage (#PB_Any,ImageW,ImageH*(CountOfItems+1))
  hDC=StartDrawing (ImageOutput (hImage))
    Box (0,0,ImageW,ImageH*(CountOfItems+1),$FFFFFF)
    For x=0 To CountOfItems     
      result=SendMessage_ (GadgetID (GadgetID),#LVM_CREATEDRAGIMAGE,x,rc)       
      ImageList_Draw_(result,0,hDC,0,x*ImageH,#ILD_NORMAL   )
      ImageList_Destroy_(result)
      Line (0,(x*ImageH)+ImageH,ImageW,0,$000000)
      SendMessage_(GadgetID(GadgetID),#LVM_ENSUREVISIBLE,x,#True)
    Next x
  StopDrawing ()
  If PrintRequester()   
    StartPrinting("ListIcon")
    RelSize.f=PrinterPageWidth()/ImageWidth(hImage)
    If StartDrawing (PrinterOutput ())
       DrawImage (ImageID(hImage),0,0,ImageWidth(hImage)*RelSize.f,ImageHeight(hImage)*RelSize.f)
       StopDrawing ()
    EndIf     
    StopPrinting()
  EndIf
  FreeImage (hImage)
EndProcedure

[fsw]

Your code doesn't work.

1.) 2x GadgetID (0) needs to be changed to the real ID (variable).
2.) PrinterPageWidth() gives a pretty big number: 2147348480
3.) Only the visible items are printed

Regarding point 2:
even if this number (2147348480) is divided by the real page width (8.5") the number is still way to high.
Don't know if the problem is associated with the setting (network printer) but don't think so.
Maybe a bug in PrinterPageWidth()?

[Hroudtwolf]

Thank you, fsw.
I fixed the Bugs. See in the o-post.

[ebs]

I know this is a very old post, but this is exactly what I need to do.
To test it, I created a ListIcon with 12 columns 100 pixels wide, filled it with data and tried to print it.

My problem is that it works differently on different versions of Windows. In all cases, the image created is 1200 pixels wide as expected.
On Windows XP, the text in all 12 columns is printed correctly.
However, on Windows 10, only the text in the first column is printed; all the other columns are blank, even though the image being printed is 1200 pixels wide.

Just to be sure that the problem wasn't related to my particular printer or driver, I saved the print image to a file.
The image file showed the same results as the printed page: all columns printed on Windows XP, but only the first column on Windows 10.

Does anyone know if the LVM_CREATEDRAGIMAGE message works differently on Windows 10 vs XP? Any and all suggestions are welcome!

Thanks,
Eric

[doctorized]

On Windows XP, the text in all 12 columns is printed correctly.
However, on Windows 10, only the text in the first column is printed; all the other columns are blank, even though the image being printed is 1200 pixels wide.

I have the same problem with windows 7 ultimate x64. Only the first column and the first letter of the column is missing. My test:

Code: Select all

; Print ListIconGadget
; 2006 Hroudtwolf
; PureBasic-Lounge.de
; PB 4.00 Release

Procedure PrintListIconGadget (GadgetID)
  Protected CountOfItems,result,hDC,RelXY
  Protected ImageW,ImageH,ii.IMAGEINFO,hImage,x,rc.point
  CountOfItems=CountGadgetItems(GadgetID)-1
  If CountOfItems<1
     ProcedureReturn #False
  EndIf
  result=SendMessage_ (GadgetID (GadgetID),#LVM_CREATEDRAGIMAGE,1,rc)   
  ImageList_GetImageInfo_(result,0,@ii)
  ImageW=ii\rcImage\right
  ImageH=ii\rcImage\bottom
  ImageList_Destroy_(result)
  hImage=CreateImage (#PB_Any,ImageW,ImageH*(CountOfItems+1))
  hDC=StartDrawing (ImageOutput (hImage))
    Box (0,0,ImageW,ImageH*(CountOfItems+1),$FFFFFF)
    For x=0 To CountOfItems     
      result=SendMessage_ (GadgetID (GadgetID),#LVM_CREATEDRAGIMAGE,x,rc)       
      ImageList_Draw_(result,0,hDC,0,x*ImageH,#ILD_NORMAL   )
      ImageList_Destroy_(result)
      Line (0,(x*ImageH)+ImageH,ImageW,0,$000000)
      SendMessage_(GadgetID(GadgetID),#LVM_ENSUREVISIBLE,x,#True)
    Next x
  StopDrawing ()
  If PrintRequester()   
    StartPrinting("ListIcon")
    RelSize.f=PrinterPageWidth()/ImageWidth(hImage)
    If StartDrawing (PrinterOutput ())
       DrawImage (ImageID(hImage),0,0,ImageWidth(hImage)*RelSize.f,ImageHeight(hImage)*RelSize.f)
       StopDrawing ()
    EndIf     
    StopPrinting()
  EndIf
  FreeImage (hImage)
EndProcedure

If OpenWindow(0, 0, 0, 700, 300, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    ; left column
    TextGadget    (6,  10,  10, 330, 20, "ListIcon Standard", #PB_Text_Center)
    ListIconGadget(0,  10,  25, 330, 170, "Column 1", 100)
    AddGadgetColumn(0,1,"Col 2",60)
    AddGadgetColumn(0,2,"Col 3",60)
    AddGadgetColumn(0,3,"Col 4",60)
    ButtonGadget(1,100,220,60,20,"print")
      For i = 0 To 10          ; add 4 items to each line of the listicons
        AddGadgetItem(0, i, "Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4")
      Next

    ; Here we change the ListIcon display to large icons and show an image
   
      Repeat
     Event = WaitWindowEvent()
     
     Select Event
     
       Case #PB_Event_Gadget
         Select EventGadget()
         	Case 1
         		PrintListIconGadget(0)
         EndSelect
     
     EndSelect
   Until Event = #PB_Event_CloseWindow

  EndIf

And I get 11 rows writing just "tem 1". Did you find out the solution?

[VB6_to_PBx]

On Windows XP, the text in all 12 columns is printed correctly.
However, on Windows 10, only the text in the first column is printed; all the other columns are blank, even though the image being printed is 1200 pixels wide.

I have the same problem with windows 7 ultimate x64. Only the first column and the first letter of the column is missing. My test:

Code: Select all

; Print ListIconGadget
; 2006 Hroudtwolf
; PureBasic-Lounge.de
; PB 4.00 Release

Procedure PrintListIconGadget (GadgetID)
  Protected CountOfItems,result,hDC,RelXY
  Protected ImageW,ImageH,ii.IMAGEINFO,hImage,x,rc.point
  CountOfItems=CountGadgetItems(GadgetID)-1
  If CountOfItems<1
     ProcedureReturn #False
  EndIf
  result=SendMessage_ (GadgetID (GadgetID),#LVM_CREATEDRAGIMAGE,1,rc)   
  ImageList_GetImageInfo_(result,0,@ii)
  ImageW=ii\rcImage\right
  ImageH=ii\rcImage\bottom
  ImageList_Destroy_(result)
  hImage=CreateImage (#PB_Any,ImageW,ImageH*(CountOfItems+1))
  hDC=StartDrawing (ImageOutput (hImage))
    Box (0,0,ImageW,ImageH*(CountOfItems+1),$FFFFFF)
    For x=0 To CountOfItems     
      result=SendMessage_ (GadgetID (GadgetID),#LVM_CREATEDRAGIMAGE,x,rc)       
      ImageList_Draw_(result,0,hDC,0,x*ImageH,#ILD_NORMAL   )
      ImageList_Destroy_(result)
      Line (0,(x*ImageH)+ImageH,ImageW,0,$000000)
      SendMessage_(GadgetID(GadgetID),#LVM_ENSUREVISIBLE,x,#True)
    Next x
  StopDrawing ()
  If PrintRequester()   
    StartPrinting("ListIcon")
    RelSize.f=PrinterPageWidth()/ImageWidth(hImage)
    If StartDrawing (PrinterOutput ())
       DrawImage (ImageID(hImage),0,0,ImageWidth(hImage)*RelSize.f,ImageHeight(hImage)*RelSize.f)
       StopDrawing ()
    EndIf     
    StopPrinting()
  EndIf
  FreeImage (hImage)
EndProcedure

If OpenWindow(0, 0, 0, 700, 300, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    ; left column
    TextGadget    (6,  10,  10, 330, 20, "ListIcon Standard", #PB_Text_Center)
    ListIconGadget(0,  10,  25, 330, 170, "Column 1", 100)
    AddGadgetColumn(0,1,"Col 2",60)
    AddGadgetColumn(0,2,"Col 3",60)
    AddGadgetColumn(0,3,"Col 4",60)
    ButtonGadget(1,100,220,60,20,"print")
      For i = 0 To 10          ; add 4 items to each line of the listicons
        AddGadgetItem(0, i, "Item 1"+Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4")
      Next

    ; Here we change the ListIcon display to large icons and show an image
   
      Repeat
     Event = WaitWindowEvent()
     
     Select Event
     
       Case #PB_Event_Gadget
         Select EventGadget()
         	Case 1
         		PrintListIconGadget(0)
         EndSelect
     
     EndSelect
   Until Event = #PB_Event_CloseWindow

  EndIf

And I get 11 rows writing just "tem 1". Did you find out the solution?

on Windows 8.0 i got a black rectangle at the top then all the 1st column text

then in compiler options unchecked enable modern theme support XP ... then i got just a total blank page

[doctorized]

So, the code is not working properly. Any suggestions?

[RASHAD]

Quick hack for A4 paper size
Consider it as start
Not suitable for Dot Matrix printers

Code: Select all

Prototype.i p_PrintWindow(hWnd, hdc, flags)
OpenLibrary(1, "User32.dll")
Global PrintWindow.p_PrintWindow = GetFunction(1, "PrintWindow")

Procedure PrintListIconGadget (Gadget)
  Header = SendMessage_(GadgetID(gadget),#LVM_GETHEADER,0,0)
  RowCount = SendMessage_(GadgetID(Gadget),#LVM_GETITEMCOUNT, 0, 0)
  ColumnCount = SendMessage_(Header, #HDM_GETITEMCOUNT, 0, 0)
  SendMessage_(GadgetID(gadget), #LVM_ENSUREVISIBLE, 0, #True)
  x = GadgetX(gadget)
  y = GadgetY(gadget)
  w = GadgetWidth(gadget)
  h = GadgetHeight(gadget)  
  For col = 0 To ColumnCount
    SendMessage_(GadgetID(gadget), #LVM_SETCOLUMNWIDTH,col,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)
  Next
  SendMessage_(GadgetID(gadget), #LVM_GETITEMRECT, RowCount - 1,r.RECT)
  NoPages = r\bottom / 1030
  SetGadgetState(gadget,-1)
  PrintRequester()
  If StartPrinting("ListIcon")
    ResizeGadget(gadget,x,y,r\right+50,1025)         
    For sc = 0 To NoPages
      ShowScrollBar_(GadgetID(gadget),#SB_BOTH,0)
      If CreateImage(1,r\right+50,1025, 24)
        hdc = StartDrawing(ImageOutput(1))
        If hdc
          PrintWindow(GadgetID(gadget), hdc, 0)
          StopDrawing()
        EndIf
      EndIf             
      If StartDrawing(PrinterOutput())
        DrawImage(ImageID(1), 200, 200 ,ImageWidth(1)*6,ImageHeight(1)*6)
        If sc < NoPages 
          NewPrinterPage()
        EndIf     
       StopDrawing()
      EndIf     
      FreeImage(1)
      InvalidateRect_(GadgetID(gadget),0,#True)
      SendMessage_(GadgetID(gadget), #LVM_SCROLL, 0,1000)
    Next
    StopPrinting()
    EndIf
    ResizeGadget(gadget,x,y,w,h)
    SendMessage_(GadgetID(gadget), #LVM_ENSUREVISIBLE, 0, #True) 
EndProcedure

LoadFont(0,"Tahoma",16)

If OpenWindow(0, 0, 0, 700, 300, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    TextGadget    (6,  10,  10, 330, 20, "ListIcon Standard", #PB_Text_Center)
    ListIconGadget(0,  10,  25, 330, 170, "Column 1", 100)
    SetGadgetFont(0,FontID(0))
    SetGadgetColor(0,#PB_Gadget_BackColor,$D2FEFC)
    SetGadgetColor(0,#PB_Gadget_FrontColor,$FE3714)
    AddGadgetColumn(0,1,"Col 2",60)
    AddGadgetColumn(0,2,"Col 3",60)
    AddGadgetColumn(0,3,"Col 4",60)
    ButtonGadget(1,100,220,60,20,"print")
      For i = 0 To 235          ; add 4 items to each line of the listicons
        AddGadgetItem(0, i, "Item : "+Str(i) +Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4")
      Next
Repeat
  Event = WaitWindowEvent()
     
    Select Event
     
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 1
            PrintListIconGadget(0)
         EndSelect
     
     EndSelect
Until Event = #PB_Event_CloseWindow

EndIf

Edit : Better appearance

[doctorized]

Quick hack for A4 paper size
Consider it as start
Not suitable for Dot Matrix printers

Code: Select all

...

Tested with Windows 7 Ultimate x64, PB 5,71 beta 2 and the only thing I get is 7 pages with a black box. Saved it as pdf and xps, see them here: http://users.sch.gr/arahiotis/other/listicon.zip Only SmartBoard Notebook managed to show the first 8 and a half rows of every page and then just black (screenshot included).

[blueb]

Tested with Windows 7 Ultimate x64, PB 5,71 beta 2 and the only thing I get is 7 pages with a black box. ...

I had no trouble printing on Win 10 Pro 64 and PB 5.71 beta 2 (x86).
Printed all 7 pages with no problem (text on a grey background)

[RASHAD]

This tech. is good for ListIcon() having Icons ,Images & checkboxes

Hi blueb
Yes I start to like Windows 10 very much

@doctorized
Try the next it gives better results with Windows 7 x64
In case you have trouble please post your configurations
- Give scale your attention

Code: Select all

; Prototype.i p_PrintWindow(hWnd, hdc, flags)
; OpenLibrary(1, "User32.dll")
; Global PrintWindow.p_PrintWindow = GetFunction(1, "PrintWindow")
Global start,finish

Procedure PrintListIconGadget (Gadget)
  Header = SendMessage_(GadgetID(gadget),#LVM_GETHEADER,0,0)
  RowCount = SendMessage_(GadgetID(Gadget),#LVM_GETITEMCOUNT, 0, 0)
  ColumnCount = SendMessage_(Header, #HDM_GETITEMCOUNT, 0, 0)
  SendMessage_(GadgetID(gadget), #LVM_ENSUREVISIBLE, 0, #True)
  x = GadgetX(gadget)
  y = GadgetY(gadget)
  w = GadgetWidth(gadget)
  h = GadgetHeight(gadget)  
  SendMessage_(GadgetID(gadget), #LVM_GETITEMRECT, RowCount - 1,r.RECT)
  NoPages = r\bottom / 1030
  NoPages = 15
  start = 0
  finish = 2
  SetGadgetState(gadget,-1)
  PrintRequester()
  If StartPrinting("ListIcon")
    ResizeGadget(gadget,x,y,r\right+50,1025)         
    For sc = 0 To finish
      For col = 0 To ColumnCount
        SendMessage_(GadgetID(gadget), #LVM_SETCOLUMNWIDTH,col,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)
      Next
      SendMessage_(GadgetID(gadget), #LVM_GETITEMRECT, RowCount - 1,r.RECT)  
      ResizeGadget(gadget,x,y,r\right+50,1025)      
      ShowScrollBar_(GadgetID(gadget),#SB_BOTH,0)
      If CreateImage(1,r\right+50,1025, 24)
        hdc = StartDrawing(ImageOutput(1))
        If hdc
          If sc >= start And sc <= finish
            SendMessage_(GadgetID(gadget),#WM_PRINT,hDC, #PRF_CHILDREN|#PRF_CLIENT|#PRF_NONCLIENT| #PRF_ERASEBKGND)
          EndIf
          StopDrawing()
        EndIf
      EndIf             
      If StartDrawing(PrinterOutput())
        If sc >= start And sc <= finish
          scale = 6
          DrawImage(ImageID(1), 200, 200 ,ImageWidth(1)*scale,ImageHeight(1)*scale)
          If sc < finish
            NewPrinterPage()
          EndIf
        EndIf     
       StopDrawing()
      EndIf     
      FreeImage(1)
      InvalidateRect_(GadgetID(gadget),0,#True)
      SendMessage_(GadgetID(gadget), #LVM_SCROLL, 0,1000)
    Next
    StopPrinting()
    EndIf
    ResizeGadget(gadget,x,y,w,h)
    SendMessage_(GadgetID(gadget), #LVM_ENSUREVISIBLE, 0, #True) 
EndProcedure

LoadFont(0,"Tahoma",16)

If OpenWindow(0, 0, 0, 700, 300, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    TextGadget    (6,  10,  10, 330, 20, "ListIcon Standard", #PB_Text_Center)
    ListIconGadget(0,  10,  25, 330, 170, "Column 1", 100)
    SetGadgetFont(0,FontID(0))
    SetGadgetColor(0,#PB_Gadget_BackColor,$D2FEFC)
    SetGadgetColor(0,#PB_Gadget_FrontColor,$FE3714)
    AddGadgetColumn(0,1,"Col 2",60)
    AddGadgetColumn(0,2,"Col 3",60)
    AddGadgetColumn(0,3,"Col 4",60)
    ButtonGadget(1,100,220,60,20,"print")
      For i = 0 To 235          ; add 4 items to each line of the listicons
        AddGadgetItem(0, i, "Item : "+Str(i) +Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4")
      Next
Repeat
  Event = WaitWindowEvent()
     
    Select Event
     
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 1
            PrintListIconGadget(0)
         EndSelect
     
     EndSelect
Until Event = #PB_Event_CloseWindow

EndIf

[doctorized]

The last code prints the first 102 lines from the ListIcon (Item : 0 to Item : 101) in 3 pages. What configuration do you need?

[RASHAD]

So it works OK
You can now print the pages you like
There is start & finish (0 to 2) 3 Pages which you got

[doctorized]

So it works OK
You can now print the pages you like
There is start & finish (0 to 2) 3 Pages which you got

Also, the printed quality is like low jpeg quality. Is there a way to increase it?

[RASHAD]

You can create image 4 times or more in size then after capture the page image resize it back to the normal size before printing