Code: Select all
Procedure ThemesEnabled()
dll.DLLVERSIONINFO
dll\cbsize=SizeOf(dll)
lib=OpenLibrary(#PB_Any,"comctl32.dll")
If lib
CallFunction(lib,"DllGetVersion",@dll)
DLLVersion = dll\dwMajorVersion
CloseLibrary(lib)
EndIf
If DLLVersion = 6
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
If ThemesEnabled() = 0
MessageRequester("Error","Please Enable Modern them first",#MB_OK|#MB_ICONERROR)
End
EndIf
#ItemCount = 350000
#LVSICF_NOINVALIDATEALL = 1
#LVSICF_NOSCROLL = 2
#LVN_ODCACHEHINT = #LVN_FIRST - 13
#HDF_IMAGE = $800
#HDI_IMAGE = $20
Prototype.i p_PrintWindow(hWnd, hdc, flags)
OpenLibrary(1, "User32.dll")
Global PrintWindow.p_PrintWindow = GetFunction(1, "PrintWindow")
Global start,finish,selno
Structure Licon Align 4 ;#PB_Structure_AlignC
index.i
imgID.i
item1.s
item2.f
item3.s
EndStructure
Global NewList myItems.licon() ,NewList state() ,Dim ssort(5,1)
Global sort ,ii.lv_item,oldproc,header, header_h,row,col,rowed,coled ,editflag ,out ,imgH , ttext$
Global cont1,start,finish
sort = 1
ssort(1,0) = OffsetOf(Licon\index)
ssort(1,1) = TypeOf(Licon\index)
ssort(3,0) = OffsetOf(Licon\item1)
ssort(3,1) = TypeOf(Licon\item1)
ssort(4,0) = OffsetOf(Licon\item2)
ssort(4,1) = TypeOf(Licon\item2)
ssort(5,0) = OffsetOf(Licon\item3)
ssort(5,1) = TypeOf(Licon\item3)
ii\mask = #LVIF_IMAGE
Procedure setItemImg(Row,Col,Img)
ii\iItem = Row
ii\iSubItem = Col
ii\iImage = Img
SendMessage_(GadgetID(0), #LVM_SETITEM, 0, @ii)
EndProcedure
Procedure SetHeaderImage(Gadget, Column, TextAlign, Arrow)
Columntxt.s = GetGadgetItemText(Gadget,-1,Column)
Hdr.HDITEM\mask = #HDI_BITMAP | #HDI_FORMAT | #HDI_TEXT
Hdr\fmt = #HDF_BITMAP | TextAlign | #HDF_STRING | Arrow
Hdr\hbm = 0
Hdr\pszText = @Columntxt
Hdr\cchTextMax = #MAX_PATH
SendMessage_(Header, #HDM_SETITEM, Column, @Hdr)
EndProcedure
Procedure PrintListIconGadget (Gadget)
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 = RowCount/30
SetGadgetState(gadget,-1)
PrintRequester()
If StartPrinting("ListIcon")
SendMessage_(GadgetID(gadget), #LVM_SCROLL, 0,start*1000)
ResizeGadget(gadget,x,y,r\right+50,1025)
CreateImage(1,r\right+50,1025, 24)
For sc = start To finish
For col = 0 To ColumnCount
SendMessage_(GadgetID(gadget), #LVM_SETCOLUMNWIDTH,col,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)
Next
ShowScrollBar_(GadgetID(gadget),#SB_BOTH,0)
hdc = StartDrawing(ImageOutput(1))
If hdc
If sc >= start And sc <= finish
PrintWindow(GadgetID(gadget), hdc, 0)
EndIf
StopDrawing()
EndIf
If StartDrawing(PrinterOutput())
DrawImage(ImageID(1), 400, 400 ,ImageWidth(1)*6,ImageHeight(1)*6)
If sc < finish
NewPrinterPage()
EndIf
StopDrawing()
EndIf
InvalidateRect_(GadgetID(gadget),0,#True)
SendMessage_(GadgetID(gadget), #LVM_SCROLL, 0,1000)
Next
StopPrinting()
EndIf
If IsImage(1)
FreeImage(1)
EndIf
ResizeGadget(gadget,x,y,w,h)
SendMessage_(GadgetID(gadget), #LVM_ENSUREVISIBLE, 0, #True)
EndProcedure
Procedure Hheight(hWnd, uMsg, wParam, lParam)
result = CallWindowProc_(oldproc, hWnd, uMsg, wParam, lParam)
Select uMsg
Case #HDM_LAYOUT
*hdlayout.HD_LAYOUT = lParam
If *hdlayout\prc <> 0
*rect.RECT = *hdlayout\prc
*rect\top = header_h
EndIf
If *hdlayout\pwpos <> 0
*windowpos.WINDOWPOS = *hdlayout\pwpos
*windowpos\cy = header_h
EndIf
EndSelect
ProcedureReturn result
EndProcedure
Procedure winCB(hWnd, uMsg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_NOTIFY
*pnmh.NMHEADER = lParam
If *pnmh\hdr\hwndFrom = header
If *pnmh\iItem = 0
ProcedureReturn 1
EndIf
EndIf
Select *pnmh\hdr\code
Case #HDN_ITEMCHANGED
If editflag = 1
r.RECT\top = coled
r.RECT\left = #LVIR_BOUNDS
SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT, rowed, r)
If coled = 0
r\left+trimx + 2
r\right = r\left + SendMessage_(GadgetID(0),#LVM_GETCOLUMNWIDTH,0,0)
EndIf
MoveWindow_(GadgetID(100),r\left,r\top,r\right-r\left,r\bottom-r\top,1)
SetFocus_(GadgetID(100))
EndIf
Case #HDN_DIVIDERDBLCLICK
ResizeGadget(100,-out,0,0,0)
editflag = 0
Case #LVN_ODCACHEHINT
result = 0
Case #LVN_ODFINDITEM
result = -1
Case #LVN_GETDISPINFO ;
*pnmlvdi.NMLVDISPINFO = lParam
row = *pnmlvdi\item\iItem
If SelectElement(myItems(), row) <> 0
If *pnmlvdi\item\mask & #LVIF_IMAGE And *pnmlvdi\item\iSubItem = 1
If SelectElement(state(), PeekI(@myItems()\index)) <> 0
*pnmlvdi\item\iImage = state()
EndIf
EndIf
If *pnmlvdi\item\mask & #LVIF_IMAGE And *pnmlvdi\item\iSubItem = 2
*pnmlvdi\item\mask & #LVIF_IMAGE|#LVIF_STATE|#LVIF_TEXT
*pnmlvdi\item\iImage = PeekI(@myItems()\imgID)
EndIf
If *pnmlvdi\item\mask & #LVIF_TEXT
Select *pnmlvdi\item\iSubItem
Case 1
PokeS(*pnmlvdi\item\pszText ,Str(PeekI(@myItems()\index)))
Case 3
PokeS(*pnmlvdi\item\pszText , PeekS(@myItems()\item1),-1, #PB_Unicode)
Case 4
PokeS(*pnmlvdi\item\pszText ,StrF(PeekF(@myItems()\item2)))
Case 5
PokeS(*pnmlvdi\item\pszText , PeekS(@myItems()\item3),-1, #PB_Unicode)
EndSelect
EndIf
EndIf
Case #LVN_BEGINSCROLL
editflag = 0
If IsWindowVisible_(GadgetID(100))
ShowWindow_(GadgetID(100),#SW_HIDE)
UpdateWindow_(GadgetID(100))
EndIf
Case #LVN_COLUMNCLICK ;Click Header item
HitInfo.LVHITTESTINFO
SendMessage_(GadgetID(0), #LVM_HITTEST, 0, @HitInfo)
*nmlv.NM_LISTVIEW = lParam
col = *nmlv\iSubItem
If IsWindowVisible_(GadgetID(100))
ShowWindow_(GadgetID(100),#SW_HIDE )
RedrawWindow_(GadgetID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW | #RDW_ERASE)
;UpdateWindow_(GadgetID(100))
EndIf
If col <> 2
SortStructuredList(myItems(),sort, ssort(col,0), ssort(col,1))
RedrawWindow_(GadgetID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW | #RDW_ERASE)
sort ! 1
For index = 1 To 5
SetHeaderImage(0, index, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, 0)
Next
If sort = 0
SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTUP)
Else
SetHeaderImage(0, col, #LVCFMT_LEFT|#LVCFMT_BITMAP_ON_RIGHT, #HDF_SORTDOWN)
EndIf
EndIf
Case #NM_DBLCLK ;LV Cell Double Click
HitInfo.LVHITTESTINFO
Hitinfo\pt\x = WindowMouseX(0)
HitInfo\pt\y = WindowMouseY(0) - GadgetY(0)
SendMessage_(GadgetID(0), #LVM_SUBITEMHITTEST, 0, @HitInfo)
rowed = hitinfo\iItem
coled = hitinfo\iSubItem
r.RECT\top = coled
r.RECT\left = #LVIR_BOUNDS
SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT, rowed, r)
If coled > 2
ShowWindow_(GadgetID(100),#SW_SHOW)
MoveWindow_(GadgetID(100),r\left,r\top,r\right-r\left,r\bottom-r\top,1)
SetGadgetText(100,GetGadgetItemText(0,rowed,coled))
SetFocus_(GadgetID(100))
editflag = 1
Else
If IsWindowVisible_(GadgetID(100))
ShowWindow_(GadgetID(100),#SW_HIDE )
UpdateWindow_(GadgetID(100))
EndIf
EndIf
Case #NM_CLICK ;LV Row Click
HitInfo.LVHITTESTINFO; = lParam
Hitinfo\pt\x = WindowMouseX(0)
HitInfo\pt\y = WindowMouseY(0) - GadgetY(0)
SendMessage_(GadgetID(0), #LVM_SUBITEMHITTEST, 0, @HitInfo)
row = hitinfo\iItem
col = hitinfo\iSubItem
If IsWindowVisible_(GadgetID(100))
ShowWindow_(GadgetID(100),#SW_HIDE )
UpdateWindow_(GadgetID(100))
EndIf
If SelectElement(myItems(), row)
SelectElement(state(), row)
st = state()
If selno =10000000
selno = 0
EndIf
If col = 1
If st = 35
state() = 36
selno + 1
ElseIf st = 36
state() = 35
selno - 1
EndIf
Else
state() = st
EndIf
SendMessage_(GadgetID(0), #LVM_REDRAWITEMS ,row,row)
Else
SetGadgetState(0,-1)
MessageRequester("Info","The checked row is empty",#MB_OK)
EndIf
EndSelect
Case #WM_SIZE
If IsWindowVisible_(GadgetID(100))
ShowWindow_(GadgetID(100),#SW_HIDE )
UpdateWindow_(GadgetID(100))
EndIf
MoveWindow_(GadgetID(0),10,10,WindowWidth(0)-20,WindowHeight(0)-20,1)
Case #WM_EXITSIZEMOVE
If IsWindowVisible_(GadgetID(cont1))
ResizeGadget(cont1,WindowWidth(0)/2-100,WindowHeight(0)/2-50,200,110)
EndIf
EndSelect
ProcedureReturn result
EndProcedure
LoadFont(0,"Tahoma",12)
LoadFont(1,"consolas",16,#PB_Font_Bold )
;
If OpenWindow(0, 0, 0, 700, 410, "Virtual ListIconGadget", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
If CreatePopupImageMenu(0, #PB_Menu_ModernLook)
MenuItem(1, "Add before")
MenuItem(2, "Get Full Text")
MenuItem(3, "Delete")
MenuItem(4, "Save")
MenuItem(5, "Print")
MenuItem(6, "Quit")
EndIf
SetWindowCallback(@winCB())
ListIconGadget(0,10,10,680,390,"Index",0,#LVS_OWNERDATA| #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect |#PB_ListIcon_MultiSelect| #PB_ListIcon_CheckBoxes)
GetClientRect_(GadgetID(0), @lr.RECT)
SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
SetGadgetFont(0,FontID(0))
SetGadgetColor(0,#PB_Gadget_BackColor,$DEFEFE)
AddGadgetColumn(0,1,"Index",100)
AddGadgetColumn(0,2,"Image",80)
AddGadgetColumn(0,3,"TEST2",150)
AddGadgetColumn(0,4,"TEST3",150)
AddGadgetColumn(0,5,"TEST4",150)
li = ImageList_Create_(32,32,#ILC_COLOR32| #ILC_MASK, 0, #ItemCount)
file$ = "Shell32.dll"
;num_icons = ExtractIconEx_(file$, -1, #Null, #Null, #Null)
Dim sicon(35)
;Dim licon(35)
For icon = 0 To 35
ExtractIconEx_(file$, icon, 0, sicon(), 35)
ImageList_AddIcon_(li,sicon(icon))
Next
FreeArray(sicon())
stateli = SendMessage_(GadgetID(0),#LVM_GETIMAGELIST,#LVSIL_STATE,0)
CreateImage(0,32,32,32,#PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(0))
ImageList_Draw_(stateli,0,hdc,6,10,#ILD_NORMAL)
StopDrawing()
CreateImage(1,32,32,32,#PB_Image_Transparent)
hdc = StartDrawing(ImageOutput(1))
ImageList_Draw_(stateli,1,hdc,6,10,#ILD_NORMAL)
StopDrawing()
ImageList_Add_(li,ImageID(0),0)
ImageList_Add_(li,ImageID(1),0)
FreeImage(0)
FreeImage(1)
SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, li)
header_h = 35
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
SendMessage_(header,#HDM_SETBITMAPMARGIN,-2,0)
SendMessage_(header,#WM_SETFONT,FontID(0),0)
oldproc = SetWindowLongPtr_(Header, #GWL_WNDPROC, @Hheight())
SendMessage_(GadgetID(0), #LVM_SETITEMCOUNT, #ItemCount, #LVSICF_NOINVALIDATEALL| #LVSICF_NOSCROLL)
For i = 0 To #ItemCount - 50
AddElement(state())
state() = 35
AddElement(myItems())
myItems()\index = i
myItems()\imgID = i
myItems()\item1 = "PureBasic " + Str(i)
myItems()\item2 = Random(#ItemCount)/14
myItems()\item3 = "TEST3 " + Str(i)
Next
StringGadget(100,0,0,0,0,"")
SetGadgetFont(100,FontID(1))
SetParent_(GadgetID(100),GadgetID(0))
cont1 = ContainerGadget(#PB_Any,WindowWidth(0)/2-100,WindowHeight(0)/2-50,200,110,#PB_Container_Flat)
SetGadgetColor(cont1,#PB_Gadget_BackColor,$DEFEFE)
tx1 = TextGadget(#PB_Any,10,10,100,24,"From page :")
SetGadgetColor(tx1,#PB_Gadget_BackColor,$DEFEFE)
fromp = SpinGadget(#PB_Any,110,10,80,24,0,1000,#PB_Spin_Numeric)
SetGadgetState(fromp,0)
tx2 = TextGadget(#PB_Any,10,40,100,24,"To page :")
SetGadgetColor(tx2,#PB_Gadget_BackColor,$DEFEFE)
top = SpinGadget(#PB_Any,110,40,80,24,1,1000,#PB_Spin_Numeric)
SetGadgetState(top,0)
okb = ButtonGadget(#PB_Any,10,75,60,24,"Print")
cancelb = ButtonGadget(#PB_Any,130,75,60,24,"Cancel")
CloseGadgetList()
HideGadget(cont1,1)
AddKeyboardShortcut(0,#PB_Shortcut_Return,10)
AddKeyboardShortcut(0,#PB_Shortcut_Escape,20)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_A,30)
out = GetSystemMetrics_(#SM_CXSCREEN)
hi.LVHITTESTINFO
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
If IsLibrary(1)
CloseLibrary(1)
EndIf
Quit = 1
Case #WM_RBUTTONDOWN
HitInfo.LVHITTESTINFO; = lParam
Hitinfo\pt\x = WindowMouseX(0)
HitInfo\pt\y = WindowMouseY(0) - GadgetY(0)
SendMessage_(GadgetID(0), #LVM_SUBITEMHITTEST, 0, @HitInfo)
row = hitinfo\iItem
If SelectElement(myItems(), row)
SetGadgetState(0,row)
DisplayPopupMenu(0, WindowID(0))
Else
SetGadgetState(0,-1)
MessageRequester("Info","The checked row is empty",#MB_OK)
EndIf
Case #PB_Event_Menu
Select EventMenu()
Case 1 ;Add
SelectElement(myItems(), row)
InsertElement(state())
state() = 35
InsertElement(myItems())
myItems()\imgID = 0
myItems()\index = ListSize(myItems())
myItems()\item1 = "PureBasic " + Str(myItems())
myItems()\item2 = Random(#ItemCount)/14
myItems()\item3 = "TEST3 " + Str(myItems())
ResetList(myItems())
i = 0
While NextElement(myItems())
myItems()\index = i
i+1
Wend
RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
Case 2 ;Get full text
;Fullitem(0,10 , 2)
;Debug imgH
;Debug ttext$
Case 3 ;Delete
SelectElement(myItems(),row)
SelectElement(state(), row)
DeleteElement(myItems())
DeleteElement(state())
ResetList(myItems())
i = 0
While NextElement(myItems())
myItems()\index = i
i+1
Wend
RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
Case 4 ;Save
OpenFile(0,GetTemporaryDirectory()+"test.txt")
ResetList(myItems())
While NextElement(myItems())
WriteString(0,Str(myItems()\index)+";"+Str(myItems()\imgID)+";"+myItems()\item1+";"+StrF(myItems()\item2)+";"+myItems()\item3+#CRLF$)
Wend
CloseFile(0)
Case 5 ;Print
DisableGadget(0,1)
HideGadget(cont1,0)
ResizeGadget(cont1,WindowWidth(0)/2-100,WindowHeight(0)/2-50,200,110)
Case 6 ;Quit
If IsLibrary(1)
CloseLibrary(1)
EndIf
End
Case 7
Case 10 ;Return to accept
If GetActiveGadget() = 100
SelectElement(myItems(), rowed)
edit$ = GetGadgetText(100)
Select coled
Case 1
myItems()\index = ValD(edit$)
Case 3
myItems()\item1 = edit$
Case 4
myItems()\item2 = ValF(edit$)
Case 5
myItems()\item3 = edit$
EndSelect
RedrawWindow_(WindowID(0),#Null,#Null,#RDW_INVALIDATE|#RDW_UPDATENOW| #RDW_ERASE)
If IsWindowVisible_(GadgetID(100))
ShowWindow_(GadgetID(100),#SW_HIDE )
UpdateWindow_(GadgetID(100))
EndIf
SetGadgetText(100,"")
editflag = 0
EndIf
Case 20 ;Esc to dismiss
If GetActiveGadget() = 100
If IsWindowVisible_(GadgetID(100))
ShowWindow_(GadgetID(100),#SW_HIDE )
UpdateWindow_(GadgetID(100))
EndIf
SetGadgetText(100,"")
editflag = 0
EndIf
Case 30 ;Select all
HitInfo.LVHITTESTINFO
SendMessage_(GadgetID(0), #LVM_HITTEST, 0, @HitInfo)
SetGadgetItemState(0, HitInfo\iItem, #PB_ListIcon_Checked|#PB_ListIcon_Selected)
selno =10000000
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case fromp ;From Page
start = GetGadgetState(fromp)
Case top ;To Page
finish = GetGadgetState(top)
Case okb ;Print
HideGadget(cont1,1)
DisableGadget(0,0)
PrintListIconGadget(0)
Case cancelb ;Cancel printing
HideGadget(cont1,1)
DisableGadget(0,0)
EndSelect
EndSelect
Until Quit = 1
If IsLibrary(1)
CloseLibrary(1)
EndIf
EndIf