- Can include CheckBoxes & Icons using Fullitem(gadget,row) to get it's handel and draw it
Code: Select all
Global start,finish ,Header ,RowCount ,ColumnCount , startitem , lastitem ,itemperpage , pagestyle ,pagewidth , pageheight
Global Dim colw(10)
startitem = 20
lastitem = 100
itemperpage = 34
pagestyle = 1 ; 0 = Portrait - 1 = Landscape
pagewidth = 715 ; A4 page width
pageheight = 935 ; A4 page height
If pagestyle = 1
itemperpage = 25
Swap pagewidth,pageheight
EndIf
If startitem >= lastitem
MessageRequester("Error","Last item < start item",#MB_OK | #MB_ICONERROR )
End
EndIf
Procedure.s Fullitem(gadget,row)
Header = SendMessage_(GadgetID(gadget), #LVM_GETHEADER, 0, 0)
nSubitems = SendMessage_(Header, #HDM_GETITEMCOUNT, 0, 0) - 1
item.LVITEM
item\Mask = #LVIF_TEXT | #LVIF_IMAGE
item\iItem = row
item\iSubItem = 0
SendMessage_(GadgetID(gadget), #LVM_GETITEM, 0, @item)
imglH = SendMessage_(GadgetID(gadget), #LVM_GETIMAGELIST, #LVSIL_SMALL, 0)
imgH = ImageList_GetIcon_(imglH, item\iImage, #ILD_TRANSPARENT)
item\cchTextMax = #MAX_PATH
text$ = Space(#MAX_PATH)
item\pszText = @Text$
For isub = 0 To nSubitems
item\iSubItem = isub
SendMessage_(GadgetID(gadget), #LVM_GETITEM, 0, @item)
ttext$ = ttext$ + Text$ + Chr(10)
Next
;ProcedureReturn ttext$
EndProcedure
Procedure BlankPage(gadget)
For col = 0 To ColumnCount - 1
SendMessage_(GadgetID(gadget), #LVM_SETCOLUMNWIDTH,col,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)
Next
Info.LVHITTESTINFO
r.RECT\top = 1
r.RECT\left = #LVIR_BOUNDS
SendMessage_(GadgetID(gadget), #LVM_GETSUBITEMRECT, 0, r)
colw = r\right - SendMessage_(GadgetID(gadget), #LVM_GETCOLUMNWIDTH,0,0)
SendMessage_(GadgetID(gadget), #LVM_SETCOLUMNWIDTH,0,colw+20)
colw(0) = colw+20
For col = 1 To ColumnCount - 1
w = SendMessage_(GadgetID(gadget), #LVM_GETCOLUMNWIDTH,col,0)
SendMessage_(GadgetID(gadget), #LVM_SETCOLUMNWIDTH,col,w+20)
colw(col) = colw(col-1)+w+20
Next
CreateImage(0,pagewidth,pageheight,24,$DFFEFE)
hdc = StartDrawing(ImageOutput(0))
Box(20,20,pagewidth-40,30,$E1E1E2)
DrawingMode(#PB_2DDrawing_Outlined )
Box(20,20,pagewidth-40,pageheight-20,0)
For y = 50 To (pageheight-25) Step 25
Line(21,y,673,1,$EEEEEF)
Next
For x = 0 To ColumnCount - 1
Line(colw(x),21,1,pageheight-37,$EEEEEF)
Next
SetBkMode_(hdc,#TRANSPARENT)
text$ = GetGadgetItemText(gadget,-1,0)
TextOut_(hdc, 25 ,28, @text$,Len(text$))
For h = 1 To ColumnCount - 1
text$ = GetGadgetItemText(gadget,-1,h)
TextOut_(hdc,colw(h-1)+25,28, @text$,Len(text$))
Next
StopDrawing()
EndProcedure
Procedure PopulatePage(gadget ,start, finish)
x = 25 : y = 54
CreateImage(1,pagewidth,pageheight,24,$DFFEFE)
hdc = StartDrawing(ImageOutput(1))
DrawImage(ImageID(0),0,0)
SetBkMode_(hdc,#TRANSPARENT)
For row = start To finish
text$ = GetGadgetItemText(gadget,row,0)
TextOut_(hdc, 25, y, @text$,Len(text$))
For col = 1 To ColumnCount - 1
text$ = GetGadgetItemText(gadget,0,col)
TextOut_(hdc, colw(col-1)+4,y, @text$,Len(text$))
Next
y + 25
Next
StopDrawing()
EndProcedure
Procedure PrintListIconGadget(Gadget)
PrintRequester()
If StartPrinting("ListIcon")
If StartVectorDrawing(PrinterVectorOutput(#PB_Unit_Millimeter))
For start = startitem To lastitem
finish = start + itemperpage
If finish > lastitem
finish = lastitem
EndIf
PopulatePage(gadget ,start, finish)
MovePathCursor(10, 10)
pw = 195 : ph = 182*1.41
If pagestyle = 1
Swap pw,ph
EndIf
DrawVectorImage(ImageID(1),255,pw,ph)
If finish < lastitem
NewPrinterPage()
start = finish
Else
Break
EndIf
Next
StopVectorDrawing()
EndIf
FreeImage(1)
StopPrinting()
NewPrinterPage()
EndIf
EndProcedure
LoadFont(0,"Tahoma",16)
If OpenWindow(0, 0, 0, 600, 400, "ListIconGadgets", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ListIconGadget(0, 10, 10, 580, 350, "Column 1", 100)
SetGadgetFont(0,FontID(0))
SetGadgetColor(0,#PB_Gadget_BackColor,$D2FEFC)
SetGadgetColor(0,#PB_Gadget_FrontColor,$FE3714)
AddGadgetColumn(0,1,"Col 2",100)
AddGadgetColumn(0,2,"Col 3",120)
AddGadgetColumn(0,3,"Col 4",150)
ButtonGadget(1,10,370,60,20,"print")
For i = 0 To 250
AddGadgetItem(0, i, "Item : "+Str(i) +Chr(10)+"Item 2"+Chr(10)+"Item 3"+Chr(10)+"Item 4")
Next
Header = SendMessage_(GadgetID(0),#LVM_GETHEADER,0,0)
RowCount = SendMessage_(GadgetID(0),#LVM_GETITEMCOUNT, 0, 0)
ColumnCount = SendMessage_(Header, #HDM_GETITEMCOUNT, 0, 0)
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 1
BlankPage(0)
PrintListIconGadget(0)
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
EndIf
Edit 2 : Now you can print at Landscape page style