New Update v2.0 :ListIcon MultiLines edit and more(Windows)

Windows specific forum
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Re: ListIcon MultiLines edit and more(Windows)

Post by srod »

Aye, this will be great when ready. 8)
I may look like a mule, but I'm not a complete ass.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: ListIcon MultiLines edit and more(Windows)

Post by RASHAD »

@Demivec Hi
I could not recreate the case
Which column no. you are talking about?

I am using XP 32 SP2 and PB 4.41

Keep going
Egypt my love
User avatar
Demivec
Addict
Addict
Posts: 4270
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: ListIcon MultiLines edit and more(Windows)

Post by Demivec »

RASHAD wrote:I could not recreate the case
Which column no. you are talking about?

I am using XP 32 SP2 and PB 4.41
It is present in the odd numbered cells (line #'s 0, 2, 4) of odd numbered columns that are resized. It happens when the column is sized skinny enough to cause text wrap, the multiple lines (not the first) in the cell overwrite what is present on those lines and never redraw on their own even when resized larger. When other redraw events are handled, such as scrolling or editing of those cells, their contents are properly refreshed, just not as a result of resizing.

To demonstrate, I have resized two columns smaller, then larger (but smaller than original size). Here's a portion of the screen shot:
Image

It does this with either PB 4.41 or 4.50b3 .
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: ListIcon MultiLines edit and more(Windows)

Post by RASHAD »

@Demivec Hi
Thank you mate for your reply
Can you include your report with your suggestions about add or remove any other facility
So if I can do it will be an add on to the utility
That will be nice


Have a good day mate
Egypt my love
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: ListIcon MultiLines edit and more(Windows)

Post by RASHAD »

@Demivec
Please Check
Egypt my love
User avatar
Demivec
Addict
Addict
Posts: 4270
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: ListIcon MultiLines edit and more(Windows)

Post by Demivec »

@RASHAD: The problem still occurs under the same conditions. However, there is an improvement. After the problem occurs (which then shows overwritten text in some cells) any scrolling causes all cells to be redrawn correctly.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: ListIcon MultiLines edit and more(Windows)

Post by RASHAD »

@Demivec
New Update
Just I added
SendMessage_(GadgetID(1), #LVM_SCROLL, 0, 0)
after #HDN_ITEMCHANGING To simulate that the Val. ScrollBar had been moved

Sorry because that problem does not exist here with me

Check please
Egypt my love
User avatar
Demivec
Addict
Addict
Posts: 4270
Joined: Mon Jul 25, 2005 3:51 pm
Location: Utah, USA

Re: ListIcon MultiLines edit and more(Windows)

Post by Demivec »

@RASHAD: I see no discernible difference from the previous changes.

I know it is difficult to make changes where you can not see the cause or the effect. If I get some time I will look more closely at your code to see if something stands out. :wink:
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: Update v1.01:ListIcon MultiLines edit and more(Windows)

Post by RASHAD »

It was a very very bad surprise for me
I lost my balance and concentration for while
But it does not matter anymore I am back on track
More to come soon

Have fun
Egypt my love
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re:New Update v2.0:ListIcon MultiLines edit and more(Windows

Post by RASHAD »

;Speed optimized
;Bugs fixed (It is not my concern,the new ideas is)
;Added a new feature 2 actions related to each Item and can be more or less
;You can run the process while the prog still on
;Almost any process Excel sheet,Word doc,PowerPoint Slideshow,Show image,Listen to music,Run script....etc no limit
;250 icons are ready let us say 200 that means at least 100 more adds on to the prog so probably I will be on this thread
;for the next 20 years
;Click left mouse on icon to run (next will be the right click to edit the script)
;You need Girl2.bmp and music file to demonstrate (See Control())
;Limitations: The multilines do not show(but it is there) on XP (I am looking for workaround)

;To do :
;Save the content to mdb and read from mdb DataBase
;And more and more ........

;Have fun

Code: Select all


Structure new_mm 
Text.s 
EndStructure

Global brush_1,brush_1_2,brush_4,brush_4_2,brush_8_9,XP_BR_1,XP_BR_4
Global Column_0_W,WinX,WinY,XX,YY,StdColor,AltColor,ColColor,ColColor_2,Item_Sp,Nolines,LineLimit,Sortflag,Editflag,HCFlag,Vis_Flag
Global OldCallback,OldEditProc,hEdit,rct.RECT,r.RECT,rc.RECT,CellSelectOn,CurItem,CurSubItem,CurSelItem,CurSelSubItem
Global rfont,hfont,hfonth,rfonth,RFontS,HFontS,STCbcolor,STCfcolor,Oddbrush,Evenbrush,index,Coln,LI_size
Global header_h ,row_h,imageList,DefaultF,SpecialF,Coln
Global SFColor, SBColor,DFColor,DBColor 
Global Dim AlignColumn(0),Dim MaskedColumn(0),Dim FixedColumn(0),Dim Act.s(0,0),Dim menu.new_mm(7)

#CDDS_ITEMPREPAINT = #CDDS_ITEM|#CDDS_PREPAINT 
#CDDS_SUBITEMPREPAINT = #CDDS_SUBITEM|#CDDS_ITEMPREPAINT

  index = 1  
  WinX = 1024
  WinY = 768
  LI_size = 1000
  Column_0_W = 210                                                                      ;Default Column Width  
  StdColor = $E6FFFF                                                                    ;Default Row Color
  AltColor = $BAEEE8                                                                    ;Alternate Row Color
  Oddbrush=CreateSolidBrush_($00FFFF)                                                   ;Odd Header Style Back Color
  Evenbrush=CreateSolidBrush_($00FFFF)                                                  ;Even Header Style Back Color                                                                   
  HFontS=32                                                                             ;New Header Font Size
  hfontn$ = "Tahoma"
  RFontS=10                                                                              ;New Item Font Size
  rfontn$ = "Microsoft Sans Serif"
  Nolines =4                                                                            ;No. of lines per Row
  LineLimit = 50                                                                        ;Max No. of characters per line                                                                            
  Sortflag =1                                                                           ;Sorting Flag (1 = Sort , 0 = No Sort)   
  ;coln = 0

DefaultF = LoadFont(2,"Microsoft Sans Serif",RFontS)

Prototype.i SetTheme(Gadget.i, String_1.p-unicode,String_2.p-unicode)

Declare MediaWindow()
Declare WndProc(hwnd, uMsg, wParam, lParam)
Declare LIcallback(hwnd, msg, wparam, lparam)

Procedure Control(Row,Col)
   Chr$ = GetGadgetItemText(1,Row,Col)
   If Chr$ = Chr(173)
      MediaWindow()
   ElseIf Chr$ = Chr(175)
      RunProgram("c:\windows\media\flourish.mid")
   ;ElseIf Chr$ = Chr(143)
      ;ApplicationWin()
   EndIf
EndProcedure


Procedure MediaWindow()
          LoadImage(0, "girl2.bmp")  
          medw = OpenWindow(1,0,0,250,350,"",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
          EnableMenuItem_(GetSystemMenu_(medw, 0), #SC_CLOSE,#MF_GRAYED)
          StickyWindow(1,1)
          ImageGadget(0,0,0,250,350, ImageID(0))
          DisableGadget(0,1)
          
          ButtonGadget(100,10,320,100,25,"BACK")
  
Repeat
SetActiveWindow(1)

  Select WaitWindowEvent()

    Case #PB_Event_Gadget
     
        Select EventGadget()
        
          Case 100
            EventID = #PB_Event_CloseWindow  
          
          Case 101

          
          Case 102
             
          
          Case 103

          
          Case 104

          
          Case 105
        
        EndSelect    
     
   EndSelect

Until EventID = #PB_Event_CloseWindow

    CloseWindow(1)

EndProcedure


Procedure EndEdit() 
    If hEdit
      SetGadgetItemText(1, CurItem, GetGadgetText(2)+Chr(10), CurSubItem)
      If CurSubItem = 1
      SetGadgetItemText(4, CurItem, GetGadgetText(2)+Chr(10), 1)
      EndIf 
      FreeGadget(2) 
      hEdit = 0 
    EndIf  
EndProcedure

Procedure EditFocus(hwnd, *rc.RECT)
    hDC = GetDC_(hwnd) 
    OldPen = SelectObject_(hDC, CreatePen_(#PS_INSIDEFRAME,1,$0000FF)) 
    OldBrush = SelectObject_(hDC, GetStockObject_(#NULL_BRUSH)) 
    Rectangle_(hDC, *rc\left, *rc\top, *rc\right, *rc\bottom) 
    SelectObject_(hDC, OldBrush) 
    SelectObject_(hDC, OldPen) 
    ReleaseDC_(hwnd, hDC) 
EndProcedure

;Return for new line
;Esc or 'LeftClick on any other field' to end edit
Procedure EditProc(hwnd, uMsg, wParam, lParam)
   
   Select uMsg
   
    Case #WM_KEYDOWN ,#WM_MENUSELECT                                   
         RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE)  
  
    Case #WM_CHAR
      If wParam = #VK_RETURN
         Select hwnd
            Case GadgetID(2)
              If SendMessage_(hwnd,#EM_GETLINECOUNT,0,0) = Nolines
                 EndEdit()
                 ProcedureReturn 0
              EndIf            
         EndSelect
      ElseIf SendMessage_(hwnd,#EM_LINELENGTH,-1,0) = LineLimit
         ProcedureReturn 0
      EndIf
      
      If wParam = #VK_ESCAPE
            EndEdit()
            ProcedureReturn 0
      EndIf

   EndSelect   

    ProcedureReturn CallWindowProc_(OldEditProc, hwnd, uMsg, wParam, lParam)
EndProcedure


Procedure LIcallback(hwnd, msg, wparam, lparam)
If IsGadget(4)
   ShowScrollBar_(GadgetID(4),#SB_BOTH,0)
EndIf
  result = CallWindowProc_(oldCallback, hwnd, msg, wparam, lparam)
  
  Select msg
  
    Case #WM_NOTIFY
      SetActiveGadget(1)
      If HCFlag = 1
      *NMHDR.NMHDR = lparam
        If *NMHDR\code = #NM_CUSTOMDRAW
        *pnmcd.NMCUSTOMDRAW = lparam
            Select *pnmcd\dwDrawStage
              Case #CDDS_PREPAINT
                result = #CDRF_NOTIFYITEMDRAW
              Case #CDDS_ITEMPREPAINT
                text$=GetGadgetItemText(GetDlgCtrlID_(hWnd),-1,*pnmcd\dwItemSpec)
                If *pnmcd\dwItemSpec&1
                  SetTextColor_(*pnmcd\hdc,$4C9C53)
                Else
                  SetTextColor_(*pnmcd\hdc,$16B8CF)
                EndIf
                result = #CDRF_NEWFONT
            EndSelect
        EndIf
      EndIf
      

    Case #WM_RBUTTONDOWN
          If GetDlgCtrlID_(hWnd) = 1
                DisplayPopupMenu(1, WindowID(0))
          EndIf
           
  
    Case #WM_LBUTTONDBLCLK
          If Editflag <> 0 And GetDlgCtrlID_(hWnd) <> 4
           If hwnd<>hEdit 
            EndEdit() 
            pInfo.LVHITTESTINFO 
            pInfo\pt\x = lParam & $FFFF 
            pInfo\pt\y = lParam >> 16 & $FFFF 
            SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, pInfo) 
            rc.RECT 
            rc\top = pInfo\iSubItem 
            rc\left = #LVIR_BOUNDS 
            SendMessage_(hwnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc) 
            If hEdit=0
              UseGadgetList(hwnd) 
              CurItem = pInfo\iItem
              CurSubItem = pInfo\iSubItem              
              If MaskedColumn(CurSubItem) = 0 And GetDlgCtrlID_(hWnd) <> 4
                Text$ = GetGadgetItemText(1, CurItem, CurSubItem)
                hEdit = StringGadget(2, rc\left, rc\top, rc\right-rc\left, rc\bottom-rc\top, Text$,#ES_MULTILINE|#PB_String_BorderLess) 
                SendMessage_(hEdit, #WM_SETFONT, DefaultF, 1)
                RedrawWindow_(GadgetID(1),0,0,#RDW_INVALIDATE|#RDW_UPDATENOW) 
                OldEditProc = SetWindowLongPtr_(hEdit, #GWL_WNDPROC, @EditProc()) 
                SetFocus_(hEdit)
              EndIf 
            EndIf 
           Else 
            result = CallWindowProc_(oldCallback, hwnd, uMsg, wParam, lParam)
           EndIf
          EndIf
     
    Case #WM_LBUTTONDOWN
       If GetDlgCtrlID_(hWnd) <> 4           ;
            EndEdit()                      
            pInfo.LVHITTESTINFO 
            pInfo\pt\x = lParam & $FFFF
            pInfo\pt\y = lParam >> 16 & $FFFF 
            SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, pInfo) 
            rc.RECT 
            rc\top = pInfo\iSubItem 
            rc\left = #LVIR_BOUNDS
            SendMessage_(hwnd, #LVM_GETSUBITEMRECT, pInfo\iItem, rc)
            If CellSelectOn
              InvalidateRect_(hwnd, rct, 1) 
            EndIf 
            CellSelectOn = 1 
            CurSelItem = pInfo\iItem 
            CurSelSubItem = pInfo\iSubItem
         If CurSelSubItem <> 8 And CurSelSubItem <> 9
          If hwnd<>hEdit And GetActiveGadget() = 1 
            If Editflag <> 0 Or GetDlgCtrlID_(hWnd) <> 4
              EditFocus(hwnd, rc)
              SetFocus_(hEdit)
            Else
              CellSelectOn = 0
              InvalidateRect_(hwnd, rct, 1)                          
            EndIf
            CopyMemory(rc, rct, SizeOf(RECT))
          Else     
            SetFocus_(hEdit)               
            result = CallWindowProc_(oldCallback, hwnd, uMsg, wParam, lParam)
          EndIf
         Else
            Control(CurSelItem,CurSelSubItem)
         EndIf 
      EndIf 
            
       
    Case #WM_CTLCOLOREDIT 
          If GetFocus_()=lParam 
            SetBkMode_(wParam, #TRANSPARENT)
            SetTextColor_(wParam, $0000FF) 
            result = CreateSolidBrush_($FFFFFF) 
          Else 
            result = CallWindowProc_(oldCallback, hwnd, uMsg, wParam, lParam)
          EndIf
       
    Case #WM_VSCROLL,#WM_MOUSEWHEEL 
          Item_Sp = SendMessage_(GadgetID(1), #LVM_GETITEMSPACING, #True, 0) >> 16 
          SelItem = GetScrollPos_(GadgetID(1),#SB_VERT) - GetScrollPos_(GadgetID(4),#SB_VERT)
          SendMessage_(GadgetID(4), #LVM_SCROLL, 0, SelItem * Item_Sp)
          UpdateWindow_(GadgetID(4))
          rc.RECT 
          TopVisibleItem = SendMessage_(hwnd, #LVM_GETTOPINDEX, 0, 0) 
          If CellSelectOn 
            rc\top = CurSelSubItem
            rc\left = #LVIR_BOUNDS
            SendMessage_(hwnd, #LVM_GETSUBITEMRECT, CurSelItem, rc) 
            rct\top = rc\top 
            rct\bottom = rc\bottom
            If TopVisibleItem <= CurSelItem And hEdit = 0
              EditFocus(hwnd, rct) 
            EndIf 
          EndIf 
          If hEdit 
            If TopVisibleItem<=CurItem 
              ResizeGadget(2,#PB_Ignore, rc\top,#PB_Ignore,#PB_Ignore) 
              HideGadget(2, 0) 
              RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
            Else 
              HideGadget(2, 1) 
            EndIf 
            SetFocus_(hEdit)             
          EndIf    
;        
    Case #WM_HSCROLL
          rc.RECT 
          TopVisibleItem = SendMessage_(hwnd, #LVM_GETTOPINDEX, 0, 0) 
          If CellSelectOn 
            rc\top = CurSelSubItem 
            rc\left = #LVIR_BOUNDS
            SendMessage_(hwnd, #LVM_GETSUBITEMRECT, CurSelItem, rc) 
            rct\left = rc\left 
            rct\right = rc\right 
            If TopVisibleItem<=CurSelItem  And hEdit = 0
              EditFocus(hwnd, rct) 
            EndIf 
          EndIf 
          If hEdit 
            If TopVisibleItem <= CurSelItem
              ResizeGadget(2, rc\left,#PB_Ignore,#PB_Ignore,#PB_Ignore) 
              HideGadget(2, 0) 
              RedrawWindow_(hEdit, 0, 0, #RDW_INTERNALPAINT|#RDW_ERASE|#RDW_INVALIDATE) 
            Else 
              HideGadget(2, 1) 
            EndIf 
            SetFocus_(hEdit) 
          EndIf
          
     Case #WM_KEYDOWN ,#WM_MENUSELECT
          If  IsGadget(2) = 0
              SetFocus_(GadgetID(1))             
          EndIf
          If wParam=#VK_NEXT                       
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_PAGEDOWN,0)
          ElseIf wParam=#VK_PRIOR
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_PAGEUP,0)
          ElseIf wParam=#VK_UP
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_LINEUP,0)
          ElseIf wParam=#VK_DOWN
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_LINEDOWN,0)
          ElseIf wParam=#VK_HOME
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_TOP,0)
          ElseIf wParam=#VK_END
            SendMessage_(GadgetID(1),#WM_VSCROLL,#SB_BOTTOM,0)
          ElseIf wParam=#VK_LEFT
            SendMessage_(GadgetID(1),#WM_HSCROLL,#SB_LINELEFT,0)
          ElseIf wParam=#VK_RIGHT
            SendMessage_(GadgetID(1),#WM_HSCROLL,#SB_LINERIGHT,0)
          EndIf
  
   EndSelect
  ProcedureReturn result
EndProcedure

Procedure RAddColumn(LiID.i,Title$,Colw.i,Align.i,Editmask.i,Fixedmask.i)
    Coln = Coln + 1
    ReDim AlignColumn.i(Coln)
    ReDim MaskedColumn.i(Coln)
    ReDim FixedColumn.i(Coln)     
    AddGadgetColumn(LiID,Coln,Title$,Colw)
    liColumn.LV_COLUMN
    liColumn\mask = #LVCF_FMT
    Select align
        Case 0: liColumn\fmt = #LVCFMT_LEFT
        Case 1: liColumn\fmt = #LVCFMT_CENTER
        Case 2: liColumn\fmt = #LVCFMT_RIGHT
    EndSelect
    SendMessage_(GadgetID(LiID), #LVM_SETCOLUMN,coln, liColumn)
    AlignColumn(Coln) = Align.i
    MaskedColumn(Coln) = Editmask.i
    FixedColumn(Coln) = Fixedmask.i
EndProcedure


Procedure RAdd_0_Column(STCbcolor.l,STCfcolor.l,Align.l,Editmask.l,Fixedmask.l)    
    SendMessage_(WindowID(0),#LVM_GETITEMRECT,0,r.Rect)
    OpenWindow(2,r\left+10 ,r\top+10,Column_0_W,r\bottom-78,"",#WS_POPUP,WindowID(0))
    ListIconGadget(4,0,0,Column_0_W-2,r\bottom-80,"Column 1",0)
    SendMessage_(GadgetID(4),#LVM_SETEXTENDEDLISTVIEWSTYLE,#LVS_EX_GRIDLINES,#LVS_EX_GRIDLINES)
    AddGadgetColumn(4,1,"Column 1",Column_0_W)
    oldCallback = SetWindowLongPtr_(GadgetID(4), #GWL_WNDPROC, @LIcallback())
    liColumn.LV_COLUMN
    liColumn\mask = #LVCF_FMT
    Select align
        Case 0: liColumn\fmt = #LVCFMT_LEFT
        Case 1: liColumn\fmt = #LVCFMT_CENTER
        Case 2: liColumn\fmt = #LVCFMT_RIGHT
    EndSelect
    SendMessage_(GadgetID(4), #LVM_SETCOLUMN,0,liColumn)
    AlignColumn(0) = Align
    MaskedColumn(0) = Editmask
    FixedColumn(0) = Fixedmask
    SetGadgetColor(4,#PB_Gadget_BackColor,STCbcolor)
    SetGadgetColor(4,#PB_Gadget_FrontColor,STCfcolor)
    SendMessage_(GadgetID(4), #LVM_SETIMAGELIST, #LVSIL_SMALL, imageList)
EndProcedure


Procedure HR_F_St_Sz( hfontn$,hh.i,hfflag.i)      
      hfonth = hh
      rfonth = rh
      If hfonth <> 0      
        Header_1 = SendMessage_(GadgetID(1), #LVM_GETHEADER, 0, 0)
        Header_4 = SendMessage_(GadgetID(4), #LVM_GETHEADER, 0, 0)
        SetWindowTheme_(Header_1, @null.w, @null.w)
        SetWindowTheme_(Header_4, @null.w, @null.w) 
        hfont = LoadFont(1, hfontn$, hfonth,hfflag)
        SendMessage_(Header_1, #WM_SETFONT, hfont, 1)
        SendMessage_(Header_4, #WM_SETFONT, hfont, 1)
          If OpenLibrary(0, "UxTheme.dll")
              swt.SetTheme = GetFunction(0, "SetWindowTheme")
              swt(Header_1,"", "HEADER")
              swt(Header_4,"", "HEADER")
          EndIf
       Else      
        SetWindowLongPtr_(GadgetID(1), #GWL_STYLE, GetWindowLongPtr_(GadgetID(1), #GWL_STYLE)|#LVS_NOCOLUMNHEADER)
        SetWindowLongPtr_(GadgetID(4), #GWL_STYLE, GetWindowLongPtr_(GadgetID(4), #GWL_STYLE)|#LVS_NOCOLUMNHEADER)        
      EndIf   
EndProcedure


Procedure WndProc(hwnd, uMsg, wParam, lParam)
      If GetActiveGadget() = 4
        SetActiveGadget(1)
      EndIf
         WinX = WindowWidth(0)
         WinY = WindowHeight(0)
         GetWindowRect_(WindowID(0), wr.RECT)
      If IsGadget(1)
         GetWindowRect_(GadgetID(1), gr.RECT)
      EndIf
      XX = gr\left - wr\left - 2
      YY = gr\top - wr\top - 2
      result = #PB_ProcessPureBasicEvents 

Select uMsg
   
   Case #WM_NOTIFY
      *NMHDR.NMHDR = lParam
      ; Fixed Column Width
       If *NMHDR\hWndFrom = GetWindow_(GadgetID(1),#GW_CHILD) And *NMHDR\code = #HDN_BEGINTRACK
          *phdn.NMHEADER = lParam
             Li_c0 = SendMessage_(GadgetID(1), #LVM_GETCOLUMNWIDTH, 1,0)                       
              If *phdn\Iitem = 0 Or FixedColumn(*phdn\Iitem) = 1 Or Li_c0 > WinX - 40
                  ProcedureReturn 1
              Else
                  Column_0_W = SendMessage_(GadgetID(1),#LVM_GETCOLUMNWIDTH,1,0) + 2          
              EndIf
       EndIf
       If IsGadget(4) And *NMHDR\hWndFrom = GetWindow_(GadgetID(4),#GW_CHILD) And *NMHDR\code = #HDN_BEGINTRACK
          *phdn.NMHEADER = lParam                  
              If *phdn\Iitem = 0
                    ProcedureReturn 1              
              EndIf   
       EndIf       
   
       
    Select *NMHDR\code 
      Case #NM_CUSTOMDRAW 
        *LVCDHeader.NMLVCUSTOMDRAW = lParam
          Select *LVCDHeader\nmcd\dwDrawStage    ;               
            Case #CDDS_PREPAINT
               result = #CDRF_NOTIFYITEMDRAW 
            Case #CDDS_ITEMPREPAINT
               result = #CDRF_NOTIFYSUBITEMDRAW            
            Case #CDDS_SUBITEMPREPAINT 
                Row = *LVCDHeader\nmcd\dwItemSpec 
                Col = *LVCDHeader\iSubItem
                 If OSVersion() < #PB_OS_Windows_Vista
                    subItemRect1.RECT\left = #LVIR_BOUNDS
                    subItemRect1.RECT\top  = *LVCDHeader\iSubItem
                    subItemRect4.RECT\left  = #LVIR_BOUNDS
                    subItemRect4.RECT\top   = *LVCDHeader\iSubItem
                    SendMessage_(GadgetID(1), #LVM_GETSUBITEMRECT, Row, @subItemRect1)
                    subItemText1$ = GetGadgetItemText(1, Row, Col)
                    If IsWindowVisible_(WindowID(2)) And Col = 1                    
                        SendMessage_(GadgetID(4), #LVM_GETSUBITEMRECT, Row, @subItemRect4)
                        subItemText4$ = GetGadgetItemText(1, Row, 1)
                        subItemText1$ = ""
                    EndIf
                    If Row&1=1                      
                      If GetDlgItem_(hwnd,wParam) = GadgetID(1)
                         FillRect_(*LVCDHeader\nmcd\hdc, subItemRect1,XP_BR_1)
                      ElseIf GetDlgItem_(hwnd,wParam) = GadgetID(4)
                         FillRect_(*LVCDHeader\nmcd\hdc, subItemRect4,XP_BR_4)                         
                      EndIf
                    EndIf
                    If Col = 8 Or Col = 9
                       FillRect_(*LVCDHeader\nmcd\hdc, subItemRect1,brush_8_9)
                       SelectObject_(*LVCDHeader\nmcd\hdc,SpecialF)
                    Else
                       SelectObject_(*LVCDHeader\nmcd\hdc,DefaultF)
                    EndIf
                    If Right(GetGadgetItemText(1,Row,Col), 1)=Chr(10)
                        SetTextColor_(*LVCDHeader\nmcd\hdc , $0000FF)
                    Else
                        SetTextColor_(*LVCDHeader\nmcd\hdc , $000000)
                    EndIf
                    subItemRect1\left + 4
                    subItemRect1\top + 4  
                    subItemRect1\right - 4
                    subItemRect1\bottom - 4
                    subItemRect4\left + 4
                    subItemRect4\top + 4  
                    subItemRect4\right - 4
                    subItemRect4\bottom - 4                                      
                    DrawText_(*LVCDHeader\nmcd\hdc, subItemText1$, Len(subItemText1$), subItemRect1,AlignColumn(Col)|#DT_END_ELLIPSIS | #DT_WORDBREAK)                          
                    DrawText_(*LVCDHeader\nmcd\hdc, subItemText4$, Len(subItemText4$), subItemRect4,AlignColumn(Col)|#DT_END_ELLIPSIS | #DT_WORDBREAK)                  
                    result = #CDRF_SKIPDEFAULT
                 Else                   
                    If GetDlgItem_(hwnd,wParam) = GadgetID(1) And (Col = 8 Or Col = 9)
                      SelectObject_(*LVCDHeader\nmcd\hDC,SpecialF) 
                    Else
                      SelectObject_(*LVCDHeader\nmcd\hDC,DefaultF) 
                    EndIf 
                    ; Odd Row Color
                    If Row&1=1
                     If  GetDlgItem_(hwnd,wParam) = GadgetID(1)
                             *LVCDHeader\clrTextBk = ColColor
                      ElseIf GetDlgItem_(hwnd,wParam) = GadgetID(4)
                             *LVCDHeader\clrTextBk = ColColor_2
                     EndIf
                    EndIf
                     If Col = 8 Or Col = 9
                        *LVCDHeader\clrTextBk = $CBFFFF  
                     EndIf

                    If  Right(GetGadgetItemText(1,Row,Col), 1)=Chr(10)
                        *LVCDHeader\clrText = $0000FF
                    Else
                        *LVCDHeader\clrText = $000000
                    EndIf
                    result = #CDRF_NEWFONT
                 EndIf
          EndSelect
    EndSelect
    
    
      *nmHEADER.HD_NOTIFY = lParam
      Gadget_ID = *nmHEADER\hdr\hwndFrom  
      Select *nmHEADER\hdr\code 
        Case #HDN_ITEMCHANGING,#HDN_ITEMCHANGED
            Column_0_W = GetGadgetItemAttribute(1,0,#PB_ListIcon_ColumnWidth,1) + 2
            SendMessage_(GadgetID(1),#LVM_GETITEMRECT,0,r.Rect)                                                                                    
            If (r\right - r\left + 42) > WinX
               MoveWindow_(WindowID(2),WindowX(0)+XX ,WindowY(0)+YY,Column_0_W+2,WinY-76,1)
            Else
               MoveWindow_(WindowID(2),WindowX(0)+XX ,WindowY(0)+YY,Column_0_W+2,WinY-56,1) 
            EndIf
            If CellSelectOn = 1
                FreeGadget(2) 
                hEdit = 0 
                InvalidateRect_(GadgetID(1),0,1)
                CellSelectOn = 0
            EndIf          
            
           
;        Case #HDN_ENDTRACK
;              InvalidateRect_(GadgetID(1),0,1)
;              InvalidateRect_(GadgetID(4),0,1)
             
                
       Case #HDN_DIVIDERDBLCLICK
            *phdn.NMHEADER = lParam
            If *phdn\iItem = 1
                SendMessage_(GadgetID(1), #LVM_SETCOLUMNWIDTH, 1,#LVSCW_AUTOSIZE)
            EndIf            
 
 EndSelect
 
  
;       Case #WM_GETMINMAXINFO                                       ;Min resizing for windows        
;             *pMinMax.MINMAXINFO = lParam
;             If Column_0_W+60 > 580
;                 *pMinMax\ptMinTrackSize\x=Column_0_W+60
;             Else
;                 *pMinMax\ptMinTrackSize\x=580
;             EndIf
;                 *pMinMax\ptMinTrackSize\y=350

 
      Case #WM_MEASUREITEM 
            hdc = GetDC_(wnd) 
            *nmm.MEASUREITEMSTRUCT = lParam 
            *lnew_mm.new_mm = *nmm\itemData
            GetTextExtentPoint32_(hdc,*lnew_mm\Text,Len(*lnew_mm\Text),@size.SIZE); 
            *nmm\itemWidth = size\cx 
            *nmm\itemHeight = size\cy
            ReleaseDC_(wnd,hdc)
          
      Case #WM_DRAWITEM 
            *nmd.DRAWITEMSTRUCT = lParam 
            *llnew_mm.new_mm = *nmd\itemData 
            If *nmd\itemState & #ODS_SELECTED 
                SetTextColor_(*nmd\hDC,SFColor) 
                SetBkColor_(*nmd\hDC,SBColor) 
                ntx = *nmd\rcItem\left 
                nty = *nmd\rcItem\top 
                ExtTextOut_(*nmd\hDC,ntx,nty,#ETO_OPAQUE,*nmd\rcItem,*llnew_mm\Text,Len(*llnew_mm\Text),0)
            Else
                SetTextColor_(*nmd\hDC,DFColor) 
                SetBkColor_(*nmd\hDC,DBColor)  
                ntx = *nmd\rcItem\left
                nty = *nmd\rcItem\top 
                ExtTextOut_(*nmd\hDC,ntx,nty,#ETO_OPAQUE,*nmd\rcItem,*llnew_mm\Text,Len(*llnew_mm\Text),0)
            EndIf
          
      Case #WM_ENTERSIZEMOVE
            If IsWindowVisible_(WindowID(2))
              HideWindow(2,1)
              Vis_Flag = 1
            EndIf
              HideGadget(5,1)          
              HideGadget(6,1)
              HideGadget(8,1)
              HideGadget(9,1)   
      
      Case #WM_EXITSIZEMOVE
            If Vis_Flag = 1
              HideWindow(2,0)
              Vis_Flag = 0
            EndIf
              HideGadget(5,0)
              HideGadget(6,0)       
              HideGadget(8,0)
              HideGadget(9,0)
      
      
      Case #WM_SIZE,#WM_MOVE,#WM_PAINT
            MoveWindow_(GadgetID(1),10,10,WinX-20,WinY-60,1)
            MoveWindow_(GadgetID(4),2,2,Column_0_W,WinY-60,1)
            SendMessage_(GadgetID(4), #LVM_SETCOLUMNWIDTH, 1,Column_0_W+4)
            MoveWindow_(GadgetID(5),10,WinY-35,100,25,1)
            MoveWindow_(GadgetID(6),120,WinY-35,100,25,1)
            MoveWindow_(GadgetID(8),340,WinY-35,100,25,1)
            MoveWindow_(GadgetID(9),450,WinY-35,100,25,1)
   EndSelect   
  ProcedureReturn result 
EndProcedure

   
If OSVersion() < #PB_OS_Windows_XP
    MessageRequester("Error","For XP and Newer Versions Only",#MB_ICONWARNING)
    End
EndIf

brush_1 = CreateSolidBrush_($E6FFFF)
brush_1_2 = CreateSolidBrush_($BAEEE8)

brush_4 = CreateSolidBrush_($E6FEE1)
brush_4_2 = CreateSolidBrush_($B9FCAB)

brush_8_9 = CreateSolidBrush_($CBFFFF)

XP_BR_1 = brush_1
XP_BR_4 = brush_4

OpenWindow(0,0,0,WinX,WinY,"RASHAD ListView Pro",#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered)
ListIconGadget(1,10,10,WinX-20,WinY-60,"Column 0",0)
SendMessage_(GadgetID(1),#LVM_SETEXTENDEDLISTVIEWSTYLE,#LVS_EX_GRIDLINES,#LVS_EX_GRIDLINES)

;Row Height
StartDrawing(WindowOutput(0))
DrawingFont(FontID(2))      
Height = TextHeight("W")
StopDrawing()

row_h = Nolines* Height
If OSVersion() < #PB_OS_Windows_Vista
  row_h = row_h + 8
EndIf

SpecialF = LoadFont(3,"Webdings",row_h/2)

imageList = ImageList_Create_(1,row_h,#ILC_MASK | #ILC_COLOR32, 0, 0)                           ; Row height
SendMessage_(GadgetID(1), #LVM_SETIMAGELIST, #LVSIL_SMALL, imageList)

HideGadget(1,1)
SetGadgetColor(1,#PB_Gadget_BackColor,StdColor)

ButtonGadget(5,10,WinY - 35,100,25,"Fr/Unfreeze C0" ,#PB_Button_Toggle)
ButtonGadget(6,120,WinY - 35,100,25,"En/Disable Edit" ,#PB_Button_Toggle)
ButtonGadget(8,340,WinY - 35,100,25,"Header Style" ,#PB_Button_Toggle)
ButtonGadget(9,450,WinY - 35,100,25,"Rows Color" ,#PB_Button_Toggle)

;RAddColumn(ListIconID, Title$, Column_Width, Column_Alignment(0=Left 1=Center 2=Right), Column_Edit_Mask(1=Masked 0=Non Masked), Column_Width_Fixed(1=Masked 0=Non Masked)
;RAdd_0_Column(Column_0 Backcolor,Column_0 Frontcolor,Align.l,Editmask.l,Fixedmask.l)
;Align.l : 0 = Left aligned 1 = Center aligned 2 = Right aligned
;Editmask.l : 1 = noedit / 0 = editable
;Fixedmask.l : 1 = Fixed width / 0 = Resizeable
;********************************************
RAddColumn(1,"Column 1",Column_0_W-4,0,0,0)                       ;Note 1: The last 3 parameter must be the same as RAdd_0_Column
;********************************************
RAddColumn(1,"Column 2",200,1,0,1)
RAddColumn(1,"Column 3",200,0,0,0)
RAddColumn(1,"Column 4",200,0,1,1)
RAddColumn(1,"Column 5",200,0,0,0)
RAddColumn(1,"Column 6",200,2,1,0)
RAddColumn(1,"Column 7",200,1,0,1)
RAddColumn(1,"1",row_h,1,0,1)
RAddColumn(1,"2",row_h,1,0,1)

;To edit Column 0 : 1- Make Editmask = 1 ,2- Unfreeze Col_0 ,3- Edit the subitems ,4- Freeze it again
STCbcolor = $E6FEE1
STCfcolor = $000000
;*****************************************
RAdd_0_Column(STCbcolor,STCfcolor,0,0,0)                          ;Note 1:The last 3 parameter must be the same as RAddColumn 1
;*****************************************

;Remember to add the data of column 0 of Gadget(1) to column 0 of Gadget(4)
For i=0 To LI_size
  ;First
  AddGadgetItem(1, -1,""+Chr(10)+ "Line "+Str(i)+" column number zero"+Chr(10)+"Line "+Str(i)+" col 1"+Chr(10)+"Line "+Str(i)+" col 2"+Chr(10)+"Line "+Str(i)+" col 3"+Chr(10)+"Line "+Str(i)+" col 4"+Chr(10)+"Line "+Str(i)+" col 5"+Chr(10)+"Line "+Str(i)+" col 6"+Chr(10)+""+Chr(10)+"")
  ;Second
  AddGadgetItem(4, -1,""+Chr(10)+ "Line "+Str(i)+" column number zero")
Next

SetGadgetItemText(1,1, Chr(173) ,8)
SetGadgetItemText(1,2, Chr(175) ,8)
SetGadgetItemText(1,2, Chr(184) ,9)
SetGadgetItemText(1,5, Chr(143) ,9)
SetGadgetItemText(1,7, Chr(34) ,8)

;RHR_F_St_St(Header_Font_name ,Header_Font_Height ,Header_Font_Style ,Row_Font_name ,Row_Font_Height ,Row_Font_Style)
;Header_Font_Height : HFontS = 0 No Header
;Header_Font_Style / Row_Font_Style : Bold = 256 ,Default = 0 ,Heigh Quality = 16 ,Italic = 512 ,StrikeOut = 8 ,Underline = 4

HR_F_St_Sz("Tahoma",HFontS,16)

HideGadget(1,0)


hPMenu = CreatePopupMenu(1)
  MenuItem(1, "")
  MenuItem(2, "")
  MenuItem(3, "")
 MenuBar()
OpenSubMenu("")
  MenuItem(4, "")
  MenuItem(5, "")
CloseSubMenu()
 MenuBar()
  MenuItem( 6, "")

menu(1)\Text = " Cut"
menu(2)\Text = " Copy"
menu(3)\Text = " Paste"
menu(4)\Text = " AUTOSIZE"
menu(5)\Text = " AUTOSIZE_USEHEADER"
menu(6)\Text = " Quit"

menu(7)\Text = " Options"   ;SubMenu


ModifyMenu_(hPMenu,1,#MF_BYCOMMAND|#MF_OWNERDRAW,1,menu(1)) 
ModifyMenu_(hPMenu,2,#MF_BYCOMMAND|#MF_OWNERDRAW,2,menu(2)) 
ModifyMenu_(hPMenu,3,#MF_BYCOMMAND|#MF_OWNERDRAW,3,menu(3))
;SubMenu By Position
ModifyMenu_(hPMenu,4,#MF_BYPOSITION|#MF_OWNERDRAW,0,menu(7))
          
ModifyMenu_(hPMenu,4,#MF_BYCOMMAND|#MF_OWNERDRAW,4,menu(4))
ModifyMenu_(hPMenu,5,#MF_BYCOMMAND|#MF_OWNERDRAW,5,menu(5)) 
ModifyMenu_(hPMenu,6,#MF_BYCOMMAND|#MF_OWNERDRAW,6,menu(6))
    
    DFColor = $000000
    DBColor = $E6FEE1
    SFColor = $E6FEE1
    SBColor = $000000

oldCallback = SetWindowLongPtr_(GadgetID(1), #GWL_WNDPROC, @LIcallback())

SetWindowCallback(@WndProc())

ColColor = StdColor
ColColor_2 = $E6FEE1
HideWindow(2,1)
SetActiveGadget(1)


Repeat 
  
  Event = WaitWindowEvent()

Select Event

  Case #PB_Event_Gadget
    
     Select EventGadget()         

      Case 5
            If GetGadgetState(5) = 1            
            HideWindow(2,0)            
            Else            
            HideWindow(2,1)           
            EndIf
      
      Case 6
            Editflag = Editflag!1
            For i = 0 To LI_size
            SetGadgetItemText(4,i,GetGadgetItemText(1,i,0),0)
            Next
      
      
      Case 8
            HCFlag = HCFlag!1
            InvalidateRect_(WindowID(0),0,#True)
        
      Case 9
          If GetGadgetState(9) = 1
            ColColor = AltColor
            ColColor_2 = $B9FCAB
            XP_BR_1 = brush_1_2
            XP_BR_4 = brush_4_2 
          Else
            ColColor = StdColor
            ColColor_2 = $E6FEE1
            XP_BR_1 = brush_1
            XP_BR_4 = brush_4
          EndIf
            InvalidateRect_(GadgetID(1),0,1) 
            InvalidateRect_(GadgetID(4),0,1)

    EndSelect 
         
      Case #PB_Event_Menu
      
        Select EventMenu() 
          
          Case 1
                SetClipboardText(GetGadgetItemText(1,CurSelItem ,CurSelSubItem))
                SetGadgetItemText(1,CurSelItem,"" ,CurSelSubItem)
                If CurSelSubItem = 1
                    SetGadgetItemText(4,CurSelItem,"" ,CurSelSubItem)
                EndIf 
          
          Case 2
                ClearClipboard()
                SetClipboardText(GetGadgetItemText(1,CurSelItem ,CurSelSubItem))

          Case 3              
                SetGadgetItemText(1,CurSelItem,GetClipboardText(),CurSelSubItem)
                If CurSelSubItem = 1
                    SetGadgetItemText(4,CurSelItem,GetClipboardText(),CurSelSubItem)
                EndIf 

          Case 4
                For i=1 To coln-2
                    SendMessage_(GadgetID(1), #LVM_SETCOLUMNWIDTH, i,#LVSCW_AUTOSIZE)
                Next

          Case 5
                For i=1 To coln-2
                    SendMessage_(GadgetID(1), #LVM_SETCOLUMNWIDTH, i,#LVSCW_AUTOSIZE_USEHEADER & #LVSCW_AUTOSIZE)
                    Length1=SendMessage_(GadgetID(1), #LVM_GETCOLUMNWIDTH, i, 0)
                    StartDrawing(WindowOutput(0))
                    DrawingFont(hfont)
                    Length2 = TextWidth(GetGadgetItemText(1,-1,i))+2*hfonth
                    StopDrawing()
                    If Length2 > Length1
                      SendMessage_(GadgetID(1), #LVM_SETCOLUMNWIDTH, i,Length2)
                    EndIf
                Next

        EndSelect
EndSelect 

Until event = #PB_Event_CloseWindow

Edit : Bug fixed
Last edited by RASHAD on Sun May 09, 2010 4:01 pm, edited 1 time in total.
Egypt my love
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: New Update v2.0 :ListIcon MultiLines edit and more(Windo

Post by RASHAD »

Updated the previous post

1- Modified the code for best performance
2- XP support back to normal
3- Added Popup Menu support
click left mouse button to select cell
click right mouse button for PopUp Menu


Have fun
Egypt my love
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4954
Joined: Sun Apr 12, 2009 6:27 am

Re: New Update v2.0 :ListIcon MultiLines edit and more(Windo

Post by RASHAD »

Updated
1- Ascii / unicode support
2- Enhaneced features
3- More slick mouse / keyboard movements

Case #HDN_ENDTRACK are remarked
remove ; in case any troubles with XP (with PB 4.41 everything is OK)
Egypt my love
liam
User
User
Posts: 38
Joined: Tue Jul 03, 2007 3:48 am
Location: Philippines

Re: New Update v2.0 :ListIcon MultiLines edit and more(Windo

Post by liam »

cool gadget!
thanks rashad
PureBasic 4.51(x86) on WinXP SP3
Post Reply