Braking in ListIconGadget

Charing6195 · Post by **Charing6195** » Thu Jul 29, 2021 4:35 pm

All I welcome.
The tabular editor supporting any number of simultaneously open tables was required to write. Approximately so:

Code: Select all

Structure Cell
  CellContent$
  ColorCellBack.l
  ColorCellFront.l
EndStructure

Structure Column
  Array Row.Cell(0)
  Map MapCellSelect$()                                      ; Card of the chosen cells in a column (a key = № a number)
  ColumnName.s                                              ; The heading text
EndStructure

Structure PARAM Extends LVHITTESTINFO
  Array Column.Column(0)
  ColumnCount.l
  ContainerID.l
  CurrentGadgetID.l
  TableID.l
  SeparationID.l
  ScrollPos.l
  RowCount.l
  RowHeight.l
  WindowID.l
EndStructure

Global WidthScroll=GetSystemMetrics_(#SM_CXVSCROLL)
Global ColorCellFrontSelect=GetSysColor_(#COLOR_WINDOW)     ; White colour of the text of the chosen cell
Global ColorCellBackSelect=GetSysColor_(#COLOR_HIGHLIGHT)   ; Dark blue colour of a background of the chosen cell
Global ColorCellBackDefault=-1
Global ColorCellFrontDefault=RGB(1,1,1)
Global ColorBackSeparationDefault=RGB(225,235,242)
Global ColorBackSeparationSelect=RGB(175,175,175)
Global NewMap MapGadgets.PARAM()
Global AmountWindow                                         ; Number of open windows

Procedure IsMouseOver(hWnd)
  GetWindowRect_(hWnd,r.RECT)
  GetCursorPos_(p.POINT)
  Result = PtInRect_(r,p\y << 32 + p\x)
  ProcedureReturn Result
EndProcedure
Procedure SelectRow(Row,FlagRowSelect)                      ; Procedure of a choice/dump of a number
  Table=MapGadgets()\TableID
  Separation=MapGadgets()\SeparationID
  Static OldRow
  
  If OldRow<>Row
    If FlagRowSelect                                          ; To allocate a number
      SetGadgetItemColor(Separation,Row-1,#PB_Gadget_BackColor,ColorBackSeparationSelect,1)
      SetGadgetItemColor(Separation,Row-1,#PB_Gadget_FrontColor,ColorCellFrontSelect,1)
      
      PushMapPosition(MapGadgets())
      SetGadgetItemColor(Table,Row-1,#PB_Gadget_BackColor,ColorCellBackSelect,#PB_All)
      SetGadgetItemColor(Table,Row-1,#PB_Gadget_FrontColor,ColorCellFrontSelect,#PB_All)
      For j=1 To ArraySize(MapGadgets(Str(Table))\Column())
        AddMapElement(MapGadgets()\Column(j)\MapCellSelect$(),Str(Row))
      Next
      PopMapPosition(MapGadgets())
      AddMapElement(MapGadgets(Str(Separation))\Column(1)\MapCellSelect$(),Str(Row))
      
    Else                                                      ; To dump a number
      
      SetGadgetItemColor(Separation,Row-1,#PB_Gadget_BackColor,ColorBackSeparationDefault,1)
      SetGadgetItemColor(Separation,Row-1,#PB_Gadget_FrontColor,ColorCellFrontDefault,1)
      
      PushMapPosition(MapGadgets())
      For j=1 To ArraySize(MapGadgets(Str(Table))\Column())
        SetGadgetItemColor(Table,Row-1,#PB_Gadget_BackColor,MapGadgets()\Column(j)\Row(Row)\ColorCellBack,j)
        SetGadgetItemColor(Table,Row-1,#PB_Gadget_FrontColor,MapGadgets()\Column(j)\Row(Row)\ColorCellFront,j)
        DeleteMapElement(MapGadgets()\Column(j)\MapCellSelect$(),Str(Row))
      Next
      PopMapPosition(MapGadgets())
      DeleteMapElement(MapGadgets(Str(Separation))\Column(1)\MapCellSelect$(),Str(Row))
      
    EndIf
    OldRow=Row
    ProcedureReturn Row
  EndIf
EndProcedure
Procedure OpenTable(Array TableArray.Cell(2),X, Y, WidthWindow, HeightWindow, NameTable$)
  Window=OpenWindow(#PB_Any, X, Y, WidthWindow, HeightWindow, NameTable$, #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)
  Table=ListIconGadget(#PB_Any,  40,  0, WindowWidth(Window)-40, WindowHeight(Window), "Column 0", 120,#PB_ListIcon_GridLines|#PB_ListIcon_HeaderDragDrop)
  Container=ContainerGadget(#PB_Any, 0, GadgetY(Table), GadgetX(Table), GadgetHeight(Table))
  Separation=ListIconGadget(#PB_Any, 0,0,GadgetX(Table)+WidthScroll+FrameWindow+1,GadgetHeight(Container),"", GadgetWidth(Container),#PB_ListIcon_GridLines)
  
  MapGadgets(Str(Window))\TableID=Table
  MapGadgets()\SeparationID=Separation
  MapGadgets()\WindowID=Window
  MapGadgets(Str(Separation))\TableID=Table
  MapGadgets()\SeparationID=Separation
  MapGadgets()\WindowID=Window
  MapGadgets()\RowHeight = SendMessage_(GadgetID(Separation), #LVM_GETITEMSPACING, 1, 0) >> 16; Height of a line Separation
  MapGadgets(Str(Table))\TableID=Table
  MapGadgets()\SeparationID=Separation
  MapGadgets()\WindowID=Window
  MapGadgets()\RowHeight = SendMessage_(GadgetID(Table), #LVM_GETITEMSPACING, 1, 0) >> 16; Height of a line Table
  
  CloseGadgetList()
  AddGadgetColumn(Separation,1,"",GetGadgetItemAttribute(Separation,0,#PB_ListIcon_ColumnWidth)); To add the first column to Separation in the width as zero
  
  SetGadgetItemAttribute(Table,0,#PB_ListIcon_ColumnWidth,0,0); To hide zero column Table
  SetGadgetItemAttribute(Separation,0,#PB_ListIcon_ColumnWidth,0,0)
  
  ReDim MapGadgets(Str(Table))\Column(ArraySize(TableArray(),1))
  
  For j = 0 To ArraySize(TableArray(),1)
    For i = 0 To ArraySize(TableArray(),2)
      With MapGadgets()\Column(j)
        If i=0                                              ; Heading filling
          If j
            \ColumnName=TableArray(j,i)\CellContent$
            
            ReDim MapGadgets()\Column(j)\Row(ArraySize(TableArray(),2))
            
            AddGadgetColumn(Table, j, Str(j), 60)
            
            SetGadgetItemText(Table,i-1,TableArray(j,i)\CellContent$,j)
          EndIf
          
        Else                                                ; Filling of other cells
          
          If j=0
            AddGadgetItem(Table, -1,TableArray(j,i)\CellContent$)
          Else
            If i<=ArraySize(MapGadgets()\Column(j)\Row())
              MapGadgets()\Column(j)\Row(i)\CellContent$=TableArray(j,i)\CellContent$
              MapGadgets()\Column(j)\Row(i)\ColorCellBack=TableArray(j,i)\ColorCellBack
              MapGadgets()\Column(j)\Row(i)\ColorCellFront=TableArray(j,i)\ColorCellFront
              
              SetGadgetItemColor(Table,i-1,#PB_Gadget_BackColor,MapGadgets()\Column(j)\Row(i)\ColorCellBack,j)
              SetGadgetItemColor(Table,i-1,#PB_Gadget_FrontColor,MapGadgets()\Column(j)\Row(i)\ColorCellFront,j)
            EndIf
            SetGadgetItemText(Table,i-1,TableArray(j,i)\CellContent$,j)
          EndIf
        EndIf
        
        If j=ArraySize(TableArray(),1)
          AddGadgetItem(Separation, -1,Str(i+1))
          SetGadgetItemText(Separation,i,GetGadgetItemText(Separation,i,0),1); To copy contents of 0th column in 1 for Separation
          SetGadgetItemColor(MapGadgets()\SeparationID,i-1,#PB_Gadget_BackColor,ColorBackSeparationDefault,1)
          SetGadgetItemColor(MapGadgets()\SeparationID,i-1,#PB_Gadget_FrontColor,ColorCellFrontDefault,1)
          PushMapPosition(MapGadgets())
          ReDim MapGadgets(Str(Separation))\Column(1):ReDim MapGadgets()\Column(1)\Row(i)
          PopMapPosition(MapGadgets())
        EndIf
      EndWith
    Next
  Next
  
  ResizeGadget(Table,#PB_Ignore,#PB_Ignore,#PB_Ignore,ArraySize(TableArray(),2)*MapGadgets(Str(Table))\RowHeight-50)
  ResizeWindow(Window,#PB_Ignore,#PB_Ignore,#PB_Ignore,GadgetHeight(Table))
  ResizeGadget(Container,#PB_Ignore,#PB_Ignore,#PB_Ignore,GadgetHeight(Table))
  ResizeGadget(Separation,#PB_Ignore,#PB_Ignore,#PB_Ignore,GadgetHeight(Table)+WidthScroll)
  ProcedureReturn Window
EndProcedure

Dim TableArray.Cell(10,40)                                  ; Table contents (10 columns, 40 lines)

For j=0 To ArraySize(TableArray(),1)
  For i=0 To ArraySize(TableArray(),2)
    If i=0
      TableArray(j,i)\CellContent$=Trim("Column "+Str(j))
    Else
      TableArray(j,i)\CellContent$=Str(j)+Str(i)
      If i>10
        TableArray(j,i)\ColorCellBack=#Cyan
        TableArray(j,i)\ColorCellFront=#Blue
      Else
        TableArray(j,i)\ColorCellBack=-1
        TableArray(j,i)\ColorCellFront=#Black
      EndIf
    EndIf
  Next
Next
AmountWindow+1
Window=OpenTable(TableArray(),0, 0, 640, 10, "Table "+Str(AmountWindow))

Dim TableArray.Cell(10,80)

For j=0 To ArraySize(TableArray(),1)
 For i=0 To ArraySize(TableArray(),2)
   If i=0
     TableArray(j,i)\CellContent$=Trim("Column "+Str(j))
   Else
     TableArray(j,i)\CellContent$=Str(j)+Str(i)
     If i>15
       TableArray(j,i)\ColorCellBack=#Green
       TableArray(j,i)\ColorCellFront=#Yellow
     Else
       TableArray(j,i)\ColorCellBack=-1
       TableArray(j,i)\ColorCellFront=#Black
     EndIf
   EndIf
 Next
Next
AmountWindow+1
Window=OpenTable(TableArray.Cell(),100, 30, 800, 400, "Table "+Str(AmountWindow))

;Dim TableArray.Cell(10,80)
;For j=0 To ArraySize(TableArray(),1)
 ;For i=0 To ArraySize(TableArray(),2)
   ;If i=0
     ;TableArray(j,i)\CellContent$=Trim("Column "+Str(j))
   ;Else
     ;TableArray(j,i)\CellContent$=Str(j)+Str(i)
   ;EndIf
 ;Next
;Next
;AmountWindow+1
;Window=OpenTable(TableArray(),1500, 30, 800, 400, "Table "+Str(AmountWindow))
If SetCursorPos_(WindowX(Window)+50,WindowY(Window)+10)     ; All windows are pasted to the cursor for convenience of positioning
  mouse_event_(#MOUSEEVENTF_LEFTDOWN, WindowX(Window),WindowY(Window),0,0)
EndIf

Repeat
  Event=WaitWindowEvent()
  
  If Event
    Window=EventWindow()
    
    If FindMapElement(MapGadgets(),Str(Window))
      Select #True
        Case IsMouseOver(GadgetID(MapGadgets()\SeparationID))
          Separation=MapGadgets()\SeparationID
          Table=MapGadgets()\TableID
          MapGadgets()\CurrentGadgetID=Separation
          
        Case IsMouseOver(GadgetID(MapGadgets()\TableID))
          Separation=MapGadgets()\SeparationID
          Table=MapGadgets()\TableID
          MapGadgets()\CurrentGadgetID=Table
      EndSelect
      
      Select Event
        Case #PB_Event_CloseWindow
          If AmountWindow>1                                 ; Number of open windows
            DeleteMapElement(MapGadgets(),Str(Window))
            CloseWindow(Window)
            AmountWindow-1
          Else                                              ; Last window is closed after a cycle
            Break
          EndIf
          
        Case #WM_VSCROLL,#WM_MOUSEWHEEL                     ; Event of vertical scrolling
          Select MapGadgets()\CurrentGadgetID
            Case Separation
              SelItem = GetScrollPos_(GadgetID(Separation),#SB_VERT) - GetScrollPos_(GadgetID(Table),#SB_VERT)
              SendMessage_(GadgetID(Table), #LVM_SCROLL, 0, SelItem * MapGadgets(Str(Table))\RowHeight)              
              
            Case Table
              SelItem = GetScrollPos_(GadgetID(Table),#SB_VERT) - GetScrollPos_(GadgetID(Separation),#SB_VERT)
              SendMessage_(GadgetID(Separation), #LVM_SCROLL, 0, SelItem * MapGadgets(Str(Table))\RowHeight)
          EndSelect
          
        Case #WM_MOUSEMOVE
          If MapGadgets()\CurrentGadgetID
            GetCursorPos_(p.POINT)
            ScreenToClient_ (GadgetID(MapGadgets()\CurrentGadgetID), @p)           
            MapGadgets()\pt\x = p\x : MapGadgets()\pt\y = p\y
            SendMessage_(GadgetID(MapGadgets()\CurrentGadgetID),#LVM_SUBITEMHITTEST ,0,@MapGadgets())
            r.RECT
            r\top = MapGadgets()\iSubItem
            r\left = #LVIR_BOUNDS
            SendMessage_(GadgetID(MapGadgets()\CurrentGadgetID), #LVM_GETSUBITEMRECT, MapGadgets()\iItem, r)
            If MapGadgets()\iSubItem = 0
              r\right = SendMessage_(GadgetID(MapGadgets()\CurrentGadgetID), #LVM_GETCOLUMNWIDTH, 0, 0)
            EndIf
            If p\y < 20                                       ; Correction № a number
              MapGadgets()\iItem=-1
            Else
              MapGadgets()\iItem+1
            EndIf
            
            If MapGadgets()\CurrentGadgetID=Separation
              If GetAsyncKeyState_(#VK_LBUTTON)=32768         ; The left Button of the Mouse is long pressed
                SelectRow(MapGadgets()\iItem,1)
              EndIf
            EndIf
          EndIf
      EndSelect
    EndIf
  EndIf
ForEver

CloseWindow(EventWindow())
ClearMap(MapGadgets())

At the left the separated strip (too ListIconGadget) in which numbers of lines are written is inserted. For convenience descriptors of windows and гаджетов are stored in map MapGadgets (), whence it is easy to receive all parametres for a concrete window.
If to spend on a strip the cursor at the pressed Left button of the Mouse, a cell in the Table and in the Strip are highlighted (a number) is allocated.
All works, but is not clear:
1) Why in the Strip with the big delay? The sensation such, that all is put in a stack and then through fair time is taken. And after all the same function SetGadgetItemColor () is used for colouring, and identifiers гаджетов to it are taken instantly from MapGadgets (). There Should be all without conflicts, quickly! The Table, but not the Strip also can be late!
The effect is more appreciable, if it is a lot of lines!
2) Why event #WM_VSCROLL does not come? Because of it scrolling of lines is carried out by a mouse wheel, but not a ruler.
PureBasic v.5.31. I apologise for the English. In advance thanks.

Charing6195 · Post by **Charing6195** » Thu Jul 29, 2021 5:06 pm

I tried to divide actions in time, using a stream:

Code: Select all

Procedure MyThread(Row)
  If MapGadgets()\SeparationID
    If FlagRowSelect                                        ; Выделить ряд
      SetGadgetItemColor(MapGadgets()\SeparationID,Row-1,#PB_Gadget_BackColor,ColorBackSeparationSelect,1)
      SetGadgetItemColor(MapGadgets()\SeparationID,Row-1,#PB_Gadget_FrontColor,ColorCellFrontSelect,1)
    Else                                                    ; Сбросить ряд
      SetGadgetItemColor(MapGadgets()\SeparationID,Row-1,#PB_Gadget_BackColor,ColorBackSeparationDefault,1)
      SetGadgetItemColor(MapGadgets()\SeparationID,Row-1,#PB_Gadget_FrontColor,ColorCellFrontDefault,1)
    EndIf
  EndIf
EndProcedure

...

        Case #WM_MOUSEMOVE

            ...
            
            If MapGadgets()\CurrentGadgetID=Separation
              If GetAsyncKeyState_(#VK_LBUTTON)=32768
                Row=SelectRow(Row)  
                If Row
                  If Thread=CreateThread(@MyThread(), Row)
                    WaitThread(Thread)
                  EndIf
                EndIf
              EndIf
            EndIf
          EndIf

No, has not helped...

Also has found out one more not clear effect. Add these lines in my first example and uncomments them:

Code: Select all

          If FindMapElement(MapGadgets(),Str(GadgetID))
            GetCursorPos_(p.POINT)
            ScreenToClient_ (GadgetID(Table), @p)           
            MapGadgets()\pt\x = p\x : MapGadgets()\pt\y = p\y
            SendMessage_(GadgetID(Table),#LVM_SUBITEMHITTEST ,0,@MapGadgets())
            r.RECT
            r\top = MapGadgets()\iSubItem
            r\left = #LVIR_BOUNDS
            SendMessage_(GadgetID(Table), #LVM_GETSUBITEMRECT, MapGadgets()\iItem, r)
            If MapGadgets()\iSubItem = 0
              r\right = SendMessage_(GadgetID(Table), #LVM_GETCOLUMNWIDTH, 0, 0)
            EndIf
            If p\y < 20
              MapGadgets()\iItem=-1
            Else
              MapGadgets()\iItem+1
            EndIf
            
            If GadgetID=Separation
              If GetAsyncKeyState_(#VK_LBUTTON)=32768
                ;keybd_event_(#VK_CONTROL,1,0,0)               ; Emulation of pressing of key Ctrl
                ;keybd_event_(#VK_CONTROL,1,#KEYEVENTF_KEYUP,0)
                ; CAUTIOUSLY!!! Without it can chop off the keyboard!
                SelectRow(MapGadgets()\iItem,1)
              EndIf
            EndIf
          EndIf

The truth works differently? And at what here key Ctrl?

netmaestro · Post by **netmaestro** » Thu Jul 29, 2021 5:52 pm

WM_VSCROLL won't show up in a PB event loop. To use it, subclass the parent of the scrollbar and convert the message to a custom event which you can then handle within your event loop. Small example:

Code: Select all

#MSG_VSCROLL = #PB_Event_FirstCustomValue

Procedure ScrollAreaProc(hWnd, Msg, wParam, lParam)
  oldproc = GetProp_(hWnd, "oldproc")
  
  Select msg
    Case #WM_NCDESTROY
      RemoveProp_(hWnd, "oldproc")
      
    Case #WM_VSCROLL
      PostEvent(#MSG_VSCROLL,0,0,0,wParam)
  EndSelect
  ProcedureReturn CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
EndProcedure

Procedure ScrollEventProc()
  positiondata.l = EventData() ; Contains wParam value 
  If positiondata & $FFFF = #SB_THUMBTRACK Or positiondata & $FFFF = #SB_THUMBPOSITION
    newposition = positiondata >> 16 & $FFFF
    Debug newposition
  EndIf
EndProcedure

OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)

ScrollAreaGadget(0,0,0,320,240,320,1024)
SetProp_(GadgetID(0), "oldproc", SetWindowLongPtr_(GadgetID(0), #GWL_WNDPROC, @ScrollAreaProc()))
BindEvent(#MSG_VSCROLL, @ScrollEventProc())

Repeat
  EventID = WaitWindowEvent()
  
Until EventID=#PB_Event_CloseWindow

Note the use of BindEvent() here. If you handle the message in your event loop, all you will get is the scroll position after the mouse button is released. BindEvent() provides the updated scroll position in real time as it moves. (If you're interested in that)

Charing6195 · Post by **Charing6195** » Thu Jul 29, 2021 7:30 pm

Thanks, netmaestro!
Means, it is necessary to do something like it:

Code: Select all

Procedure OpenTable(Array TableArray.Cell(2),X, Y, WidthWindow, HeightWindow, NameTable$)
  
  ...
  
  MapGadgets(Str(Window))\TableID=Table
  MapGadgets()\SeparationID=Separation
  MapGadgets()\WindowID=Window
  MapGadgets(Str(Separation))\TableID=Table
  MapGadgets()\SeparationID=Separation
  MapGadgets()\WindowID=Window
  MapGadgets()\RowHeight = SendMessage_(GadgetID(Separation), #LVM_GETITEMSPACING, 1, 0) >> 16
  MapGadgets(Str(Table))\TableID=Table
  MapGadgets()\SeparationID=Separation
  MapGadgets()\WindowID=Window
  MapGadgets()\RowHeight = SendMessage_(GadgetID(Table), #LVM_GETITEMSPACING, 1, 0) >> 16
  
  SetProp_(GadgetID(Table),"PB_WindowID",Window)
  SetProp_(GadgetID(Table),"PB_ContainerID",Container)
  SetProp_(GadgetID(Table),"PB_GadgetID",Table)
  SetProp_(GadgetID(Separation),"PB_GadgetID",Separation)
  SetProp_(GadgetID(Separation),"PB_ContainerID",Container)
  SetProp_(GadgetID(Separation),"PB_WindowID",Window)
  SetProp_(WindowID(Window),"PB_SeparationID",Separation)
  SetProp_(WindowID(Window),"PB_ContainerID",Container)
  SetProp_(WindowID(Window),"PB_TableID",Table)
  
  ...
  
  EndProcedure

And I wished to manage only MapGadgets ().
Well, let will be. I, unfortunately, understand classes of windows worse, than it would be desirable...

Charing6195 · Post by **Charing6195** » Thu Jul 29, 2021 9:16 pm

No, it it was not required. Has made as has told netmaestro and has a little corrected a code for reliability.
Scrolling works

Code: Select all

Structure Cell
  CellContent$
  ColorCellBack.l
  ColorCellFront.l
EndStructure

Structure Column
  Array Row.Cell(0)
  Map MapCellSelect$()                                      ; Card of the chosen cells in a column (a key = № a number)
  ColumnName.s                                              ; The heading text
EndStructure

Structure PARAM Extends LVHITTESTINFO
  Array Column.Column(0)
  ColumnCount.l
  ContainerID.l
  CurrentGadgetID.l
  TableID.l
  SeparationID.l
  ScrollPos.l
  RowCount.l
  RowHeight.l
  WindowID.l
EndStructure

Global WidthScroll=GetSystemMetrics_(#SM_CXVSCROLL)
Global ColorCellFrontSelect=GetSysColor_(#COLOR_WINDOW)     ; White colour of the text of the chosen cell
Global ColorCellBackSelect=GetSysColor_(#COLOR_HIGHLIGHT)   ; Dark blue colour of a background of the chosen cell
Global ColorCellBackDefault=-1
Global ColorCellFrontDefault=RGB(1,1,1)
Global ColorBackSeparationDefault=RGB(225,235,242)
Global ColorBackSeparationSelect=RGB(175,175,175)
Global NewMap MapGadgets.PARAM()
Global AmountWindow                                         ; Number of open windows

Procedure IsMouseOver(hWnd)
  GetWindowRect_(hWnd,r.RECT)
  GetCursorPos_(p.POINT)
  Result = PtInRect_(r,p\y << 32 + p\x)
  ProcedureReturn Result
EndProcedure
Procedure SelectRow(Row,FlagRowSelect)                      ; Procedure of a choice/dump of a number
  Table=MapGadgets()\TableID
  Separation=MapGadgets()\SeparationID
  Static OldRow
  
  If OldRow<>Row
    If FlagRowSelect                                          ; To allocate a number
      SetGadgetItemColor(Separation,Row-1,#PB_Gadget_BackColor,ColorBackSeparationSelect,1)
      SetGadgetItemColor(Separation,Row-1,#PB_Gadget_FrontColor,ColorCellFrontSelect,1)
      
      PushMapPosition(MapGadgets())
      SetGadgetItemColor(Table,Row-1,#PB_Gadget_BackColor,ColorCellBackSelect,#PB_All)
      SetGadgetItemColor(Table,Row-1,#PB_Gadget_FrontColor,ColorCellFrontSelect,#PB_All)
      For j=1 To ArraySize(MapGadgets(Str(Table))\Column())
        AddMapElement(MapGadgets()\Column(j)\MapCellSelect$(),Str(Row))
      Next
      PopMapPosition(MapGadgets())
      AddMapElement(MapGadgets(Str(Separation))\Column(1)\MapCellSelect$(),Str(Row))
      
    Else                                                      ; To dump a number
      
      SetGadgetItemColor(Separation,Row-1,#PB_Gadget_BackColor,ColorBackSeparationDefault,1)
      SetGadgetItemColor(Separation,Row-1,#PB_Gadget_FrontColor,ColorCellFrontDefault,1)
      
      PushMapPosition(MapGadgets())
      For j=1 To ArraySize(MapGadgets(Str(Table))\Column())
        SetGadgetItemColor(Table,Row-1,#PB_Gadget_BackColor,MapGadgets()\Column(j)\Row(Row)\ColorCellBack,j)
        SetGadgetItemColor(Table,Row-1,#PB_Gadget_FrontColor,MapGadgets()\Column(j)\Row(Row)\ColorCellFront,j)
        DeleteMapElement(MapGadgets()\Column(j)\MapCellSelect$(),Str(Row))
      Next
      PopMapPosition(MapGadgets())
      DeleteMapElement(MapGadgets(Str(Separation))\Column(1)\MapCellSelect$(),Str(Row))
      
    EndIf
    OldRow=Row
    ProcedureReturn Row
  EndIf
EndProcedure

#MSG_VSCROLL = #PB_Event_FirstCustomValue
Procedure ScrollAreaProc(hWnd, Msg, wParam, lParam)
  oldproc = GetProp_(hWnd, "oldproc")
  
  Select msg
    Case #WM_NCDESTROY
      RemoveProp_(hWnd, "oldproc")
      
    Case #WM_VSCROLL,#WM_MOUSEWHEEL
      
      Debug "#WM_MOUSEWHEEL"
      
      
      PostEvent(#MSG_VSCROLL,0,0,0,wParam)
  EndSelect
  ProcedureReturn CallWindowProc_(oldproc, hWnd, Msg, wParam, lParam)
EndProcedure

Procedure ScrollEventProc()
  positiondata.l = EventData()                                ; Contains wParam value 
  If positiondata & $FFFF = #SB_THUMBTRACK Or positiondata & $FFFF = #SB_THUMBPOSITION
    Separation=MapGadgets()\SeparationID
    Table=MapGadgets()\TableID
    SelItem = GetScrollPos_(GadgetID(Table),#SB_VERT) - GetScrollPos_(GadgetID(Separation),#SB_VERT)
    PushMapPosition(MapGadgets())
    SendMessage_(GadgetID(Separation), #LVM_SCROLL, 0, SelItem * SendMessage_(GadgetID(Separation), #LVM_GETITEMSPACING, 1, 0) >> 16)
    PopMapPosition(MapGadgets())
  EndIf
EndProcedure

Procedure OpenTable(Array TableArray.Cell(2),X, Y, WidthWindow, HeightWindow, NameTable$)
  Window=OpenWindow(#PB_Any, X, Y, WidthWindow, HeightWindow, NameTable$, #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)
  Table=ListIconGadget(#PB_Any,  40,  0, WindowWidth(Window)-40, WindowHeight(Window), "Column 0", 120,#PB_ListIcon_GridLines|#PB_ListIcon_HeaderDragDrop)
  Container=ContainerGadget(#PB_Any, 0, GadgetY(Table), GadgetX(Table), GadgetHeight(Table))
  Separation=ListIconGadget(#PB_Any, 0,0,GadgetX(Table)+WidthScroll+FrameWindow+1,GadgetHeight(Container),"", GadgetWidth(Container),#PB_ListIcon_GridLines)
  
  MapGadgets(Str(Window))\TableID=Table
  MapGadgets()\ContainerID=Container
  MapGadgets()\SeparationID=Separation
  MapGadgets()\WindowID=Window
  MapGadgets(Str(Separation))\TableID=Table
  MapGadgets()\SeparationID=Separation
  MapGadgets()\WindowID=Window
  MapGadgets()\RowHeight = SendMessage_(GadgetID(Separation), #LVM_GETITEMSPACING, 1, 0) >> 16; Height of a line Separation
  MapGadgets(Str(Table))\TableID=Table
  MapGadgets()\SeparationID=Separation
  MapGadgets()\WindowID=Window
  MapGadgets()\RowHeight = SendMessage_(GadgetID(Table), #LVM_GETITEMSPACING, 1, 0) >> 16; Height of a line Table

  SetProp_(GadgetID(Separation), "oldproc", SetWindowLongPtr_(GadgetID(Separation), #GWL_WNDPROC, @ScrollAreaProc()))
  SetProp_(GadgetID(Table), "oldproc", SetWindowLongPtr_(GadgetID(Table), #GWL_WNDPROC, @ScrollAreaProc()))
  BindEvent(#MSG_VSCROLL, @ScrollEventProc())

  CloseGadgetList()
  AddGadgetColumn(Separation,1,"",GetGadgetItemAttribute(Separation,0,#PB_ListIcon_ColumnWidth)); To add the first column to Separation in the width as zero
  
  SetGadgetItemAttribute(Table,0,#PB_ListIcon_ColumnWidth,0,0); To hide zero column Table
  SetGadgetItemAttribute(Separation,0,#PB_ListIcon_ColumnWidth,0,0)
  
  ReDim MapGadgets(Str(Table))\Column(ArraySize(TableArray(),1))
  
  For j = 0 To ArraySize(TableArray(),1)
    For i = 0 To ArraySize(TableArray(),2)
      With MapGadgets()\Column(j)
        If i=0                                              ; Heading filling
          If j
            \ColumnName=TableArray(j,i)\CellContent$
            
            ReDim MapGadgets()\Column(j)\Row(ArraySize(TableArray(),2))
            
            AddGadgetColumn(Table, j, Str(j), 60)
            
            SetGadgetItemText(Table,i-1,TableArray(j,i)\CellContent$,j)
          EndIf
          
        Else                                                ; Filling of other cells
          
          If j=0
            AddGadgetItem(Table, -1,TableArray(j,i)\CellContent$)
          Else
            If i<=ArraySize(MapGadgets()\Column(j)\Row())
              MapGadgets()\Column(j)\Row(i)\CellContent$=TableArray(j,i)\CellContent$
              MapGadgets()\Column(j)\Row(i)\ColorCellBack=TableArray(j,i)\ColorCellBack
              MapGadgets()\Column(j)\Row(i)\ColorCellFront=TableArray(j,i)\ColorCellFront
              
              SetGadgetItemColor(Table,i-1,#PB_Gadget_BackColor,MapGadgets()\Column(j)\Row(i)\ColorCellBack,j)
              SetGadgetItemColor(Table,i-1,#PB_Gadget_FrontColor,MapGadgets()\Column(j)\Row(i)\ColorCellFront,j)
            EndIf
            SetGadgetItemText(Table,i-1,TableArray(j,i)\CellContent$,j)
          EndIf
        EndIf
        
        If j=ArraySize(TableArray(),1)
          AddGadgetItem(Separation, -1,Str(i+1))
          SetGadgetItemText(Separation,i,GetGadgetItemText(Separation,i,0),1); To copy contents of 0th column in 1 for Separation
          SetGadgetItemColor(MapGadgets()\SeparationID,i-1,#PB_Gadget_BackColor,ColorBackSeparationDefault,1)
          SetGadgetItemColor(MapGadgets()\SeparationID,i-1,#PB_Gadget_FrontColor,ColorCellFrontDefault,1)
          PushMapPosition(MapGadgets())
          ReDim MapGadgets(Str(Separation))\Column(1):ReDim MapGadgets()\Column(1)\Row(i)
          PopMapPosition(MapGadgets())
        EndIf
      EndWith
    Next
  Next
  
  ResizeGadget(Table,#PB_Ignore,#PB_Ignore,#PB_Ignore,ArraySize(TableArray(),2)*MapGadgets(Str(Table))\RowHeight-50)
  ResizeWindow(Window,#PB_Ignore,#PB_Ignore,#PB_Ignore,GadgetHeight(Table))
  ResizeGadget(Container,#PB_Ignore,#PB_Ignore,#PB_Ignore,GadgetHeight(Table))
  ResizeGadget(Separation,#PB_Ignore,#PB_Ignore,#PB_Ignore,GadgetHeight(Table)+WidthScroll)
  ProcedureReturn Window
EndProcedure

Dim TableArray.Cell(10,80)

For j=0 To ArraySize(TableArray(),1)
 For i=0 To ArraySize(TableArray(),2)
   If i=0
     TableArray(j,i)\CellContent$=Trim("Column "+Str(j))
   Else
     TableArray(j,i)\CellContent$=Str(j)+Str(i)
     If i>15
       TableArray(j,i)\ColorCellBack=#Green
       TableArray(j,i)\ColorCellFront=#Yellow
     Else
       TableArray(j,i)\ColorCellBack=-1
       TableArray(j,i)\ColorCellFront=#Black
     EndIf
   EndIf
 Next
Next
AmountWindow+1
Window=OpenTable(TableArray.Cell(),100, 30, 800, 400, "Table "+Str(AmountWindow))

If SetCursorPos_(WindowX(Window)+50,WindowY(Window)+10)     ; All windows are pasted to the cursor for convenience of positioning
  mouse_event_(#MOUSEEVENTF_LEFTDOWN, WindowX(Window),WindowY(Window),0,0)
EndIf

Repeat
  If GetCursorPos_(cursor.POINT)
    GadgetID=0:Event=WaitWindowEvent()
    
    hndl=WindowFromPoint_(PeekQ(@cursor))
    If hndl
      hndl=GetDlgCtrlID_(hndl)
      If FindMapElement(MapGadgets(),Str(hndl))
        Window=MapGadgets()\WindowID                        ; Window under the cursor
      EndIf
    EndIf
    
    If AmountWindow=1                                       ; If it is necessary - to be switched last window to it (the cursor can be out of it)
      ForEach MapGadgets()
        If IsWindow(MapGadgets()\WindowID)
          Window=MapGadgets()\WindowID
          Break
        EndIf
      Next
    EndIf
    
    If IsWindow(Window)

      Container=MapGadgets(Str(Window))\ContainerID
      Separation=MapGadgets()\SeparationID
      Table=MapGadgets()\TableID
      
      Select #True                                        ; GadgetID - Flowing гаджет under the cursor
        Case IsMouseOver(GadgetID(Container))
          GadgetID=Separation
          text$ = " Separation"+#CRLF$
          
        Case IsMouseOver(GadgetID(Table))
          GadgetID=Table
          text$ = " Table"+#CRLF$
      EndSelect
      
      Select Event                                        ; On event #PB_Event_CloseWindow it is possible to close a window, only if it not unique (requirement WaitWindowEvent ())
        Case #PB_Event_CloseWindow
          If AmountWindow>1                               ; Quantity of available windows
            CloseWindow(EventWindow())
            AmountWindow-1
          Else                                            ; If the window the only thing, is closed after an exit from a cycle
            Break
          EndIf
          
        ;Case #WM_MOUSEWHEEL                               ; Event of vertical scrolling
          ;Select MapGadgets()\CurrentGadgetID
            ;Case Separation
              ;SelItem = GetScrollPos_(GadgetID(Separation),#SB_VERT) - GetScrollPos_(GadgetID(Table),#SB_VERT)
              ;SendMessage_(GadgetID(Table), #LVM_SCROLL, 0, SelItem * MapGadgets(Str(Table))\RowHeight)              
              
            ;Case Table
              ;SelItem = GetScrollPos_(GadgetID(Table),#SB_VERT) - GetScrollPos_(GadgetID(Separation),#SB_VERT)
              ;SendMessage_(GadgetID(Separation), #LVM_SCROLL, 0, SelItem * MapGadgets(Str(Table))\RowHeight)
          ;EndSelect
          
        Case #WM_MOUSEMOVE
          If MapGadgets()\CurrentGadgetID
            GetCursorPos_(p.POINT)
            ScreenToClient_ (GadgetID(MapGadgets()\CurrentGadgetID), @p)           
            MapGadgets()\pt\x = p\x : MapGadgets()\pt\y = p\y
            SendMessage_(GadgetID(MapGadgets()\CurrentGadgetID),#LVM_SUBITEMHITTEST ,0,@MapGadgets())
            r.RECT
            r\top = MapGadgets()\iSubItem
            r\left = #LVIR_BOUNDS
            SendMessage_(GadgetID(MapGadgets()\CurrentGadgetID), #LVM_GETSUBITEMRECT, MapGadgets()\iItem, r)
            If MapGadgets()\iSubItem = 0
              r\right = SendMessage_(GadgetID(MapGadgets()\CurrentGadgetID), #LVM_GETCOLUMNWIDTH, 0, 0)
            EndIf
            If p\y < 20                                       ; Correction № a number
              MapGadgets()\iItem=-1
            Else
              MapGadgets()\iItem+1
            EndIf
            
            If MapGadgets()\CurrentGadgetID=Separation
              If GetAsyncKeyState_(#VK_LBUTTON)=32768         ; The left Button of the Mouse is long pressed
                SelectRow(MapGadgets()\iItem,1)
              EndIf
            EndIf
          EndIf
      EndSelect
    EndIf
  EndIf
ForEver

CloseWindow(EventWindow())
ClearMap(MapGadgets())

But now scrolling from a wheel, on the contrary, does not work. Though event #WM_MOUSEWHEEL comes. How it to explain?

Charing6195 · Post by **Charing6195** » Fri Jul 30, 2021 2:17 pm

Well. Has made so:

Code: Select all

...
Global GetScroll
Procedure Scroll(hWnd, Msg, wParam, lParam)
  GadgetID=GetProp_(hWnd,"PB_GadgetID")
  result = CallWindowProc_(GetScroll, hWnd, Msg, wParam, lParam)
  
  If FindMapElement(MapGadgets(),Str(GadgetID))
    Table=MapGadgets()\TableID
    Separation=MapGadgets()\SeparationID
    
    Select Msg
      Case #WM_VSCROLL,#WM_MOUSEWHEEL
        
        SelItem = GetScrollPos_(GadgetID(Table),#SB_VERT) - GetScrollPos_(GadgetID(Separation),#SB_VERT)
        SendMessage_(GadgetID(Separation), #LVM_SCROLL, 0, SelItem * MapGadgets()\RowHeight)
        
        PushMapPosition(MapGadgets())
        SelItem = GetScrollPos_(GadgetID(Separation),#SB_VERT) - GetScrollPos_(GadgetID(Table),#SB_VERT)
        SendMessage_(GadgetID(Table), #LVM_SCROLL, 0, SelItem * MapGadgets(Str(Table))\RowHeight)
        PopMapPosition(MapGadgets())
    EndSelect
    ProcedureReturn result
  EndIf
EndProcedure

Procedure OpenTable(Array TableArray.Cell(2),X, Y, WidthWindow, HeightWindow, NameTable$)
...
MapGadgets(Str(Window))\TableID=Table
...
  SetProp_(GadgetID(Table),"PB_GadgetID",Table)
  SetProp_(GadgetID(Separation),"PB_GadgetID",Separation)
  ...
  GetScroll = SetWindowLongPtr_(GadgetID(Table), #GWL_WNDPROC, @Scroll())
  GetScroll = SetWindowLongPtr_(GadgetID(Separation), #GWL_WNDPROC, @Scroll())
  ProcedureReturn Window
EndProcedure
...
 Case #WM_MOUSEMOVE
    If GadgetID=Separation And FindMapElement(MapGadgets(),Str(GadgetID))
       GetCursorPos_(p.POINT)
       ScreenToClient_ (GadgetID(Separation), @p)           
       MapGadgets()\pt\x = p\x : MapGadgets()\pt\y = p\y
        SendMessage_(GadgetID(Separation),#LVM_SUBITEMHITTEST ,0,@MapGadgets())
        r.RECT
        r\top = MapGadgets()\iSubItem
        r\left = #LVIR_BOUNDS
        SendMessage_(GadgetID(Separation), #LVM_GETSUBITEMRECT, MapGadgets()\iItem, r)
        If MapGadgets()\iSubItem = 0
          r\right = SendMessage_(GadgetID(Separation), #LVM_GETCOLUMNWIDTH, 0, 0)
        EndIf
        If p\y < 20                                       ; Correction № a number
          MapGadgets()\iItem=-1
        Else
          MapGadgets()\iItem+1
        EndIf
            
        If GetAsyncKeyState_(#VK_LBUTTON)=32768         ; The left Button of the Mouse is long pressed
          SelectRow(MapGadgets()\iItem,1)
        EndIf
      EndIf
          ...

Now works as it is necessary.
Also there was a main question of a subject: function SetGadgetItemColor () itself solves how to use turn of events or something in this sort at switching with gadget on gadget, or I with delay define GadgetID? It seems to me, that the first variant, and emulation Ctrl is any by-effect influencing turn.
I unique who has met this riddle (owing to simultaneously several windows with LictIcon), or at someone was similar? Respond, I will be glad

PureBasic Forums - English

Braking in ListIconGadget

Braking in ListIconGadget

Re: Braking in ListIconGadget

Re: Braking in ListIconGadget

Re: Braking in ListIconGadget

Re: Braking in ListIconGadget

Re: Braking in ListIconGadget