It is currently Tue Jan 26, 2021 10:09 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 2 posts ] 
Author Message
 Post subject: DragNDrop export/import filter creation
PostPosted: Sun Oct 04, 2009 11:33 am 
Offline
PureBasic Protozoa
PureBasic Protozoa
User avatar

Joined: Fri Apr 25, 2003 3:08 pm
Posts: 4598
Location: Not Sydney!!! (Bad water, no goats)
Been reworking some routines in my programs to prevent wrist pain from too much clicking and changed my Export/Import filter creator around a bit.

You can load a list of import labels into the left list (Such as the import format and order that your program might use).

You can add blank lines at the top, bottom, above and below the current cursor position.

The listIconGadget is editable thanks to srod's code.

You can save and load import filter files.

You can load CSV header files. Such as the headings exported by most databases when asked to.

You can drag and drop the labels from the right list into the left. Each successive drop will replace on int he same column. The "<Blank>" dragged will clear the item.

Code:
;==============================================================================================================
; Visual designer created constants
;==============================================================================================================

Enumeration 1
  #Window_filter
EndEnumeration

#WindowIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #Gadget_filter_Internal
  #Gadget_filter_External
  #Gadget_filter_finternal
  #Gadget_filter_openinternal
  #Gadget_filter_saveinternal
  #Gadget_filter_fexternal
  #Gadget_filter_openfilter
  #Gadget_filter_savefilter
  #Gadget_filter_fcsv
  #Gadget_filter_opencsv
EndEnumeration

#GadgetIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #Image_filter_openinternal
  #Image_filter_saveinternal
  #Image_filter_openfilter
  #Image_filter_savefilter
  #Image_filter_opencsv
EndEnumeration

#ImageIndex = #PB_Compiler_EnumerationValue

CatchImage(#Image_filter_openinternal,  ?_OPT_filter_openinternal)
CatchImage(#Image_filter_saveinternal,  ?_OPT_filter_saveinternal)
CatchImage(#Image_filter_openfilter,    ?_OPT_filter_openfilter)
CatchImage(#Image_filter_savefilter,    ?_OPT_filter_saveinternal)
CatchImage(#Image_filter_opencsv,       ?_OPT_filter_opencsv)

DataSection
  _OPT_filter_openinternal  : IncludeBinary "Images\folder cyan open 48x48.ico"
  _OPT_filter_saveinternal  : IncludeBinary "Images\save48x48.ico"
  _OPT_filter_openfilter    : IncludeBinary "Images\folder orange open 48x48.ico"
  _OPT_filter_opencsv       : IncludeBinary "Images\foldernew48x48.ico"
EndDataSection

;==============================================================================================================
; Visual designer created windows code
;==============================================================================================================

Procedure.l Window_filter()
  If OpenWindow(#Window_filter, 81, 67, 473, 626, "Drag and drop filter creation test", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
      ListIconGadget(#Gadget_filter_Internal, 0, 0, 310, 550, "Blank", 0, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
        AddGadgetColumn(#Gadget_filter_Internal, 1, "Internal fields", 144)
        AddGadgetColumn(#Gadget_filter_Internal, 2, "External fields", 144)
        AddGadgetColumn(#Gadget_filter_Internal, 3, "Linenumber", 0)
        SetGadgetFont(#Gadget_filter_Internal, LoadFont(#Gadget_filter_Internal, "Arial", 10, 0))
        PVGadgets_BubbleTip(#Window_filter, #Gadget_filter_Internal, "Use right click menu to insert a line above or below the current one or delete a line.", BubbleTipStyle)
      ListIconGadget(#Gadget_filter_External, 315, 0, 157, 550, "Available fields", 153, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
        AddGadgetColumn(#Gadget_filter_External, 1, "Linenumber", 0)
        SetGadgetFont(#Gadget_filter_External, LoadFont(#Gadget_filter_External, "Arial", 10, 0))
        PVGadgets_BubbleTip(#Window_filter, #Gadget_filter_External, "Drag available labels to the filter box on the left. Drag the '<Blank>' label over a field to delete it.", BubbleTipStyle)
      Frame3DGadget(#Gadget_filter_finternal, 0, 550, 150, 75, "")
      ButtonImageGadget(#Gadget_filter_openinternal, 10, 565, 50, 50, ImageID(#Image_filter_openinternal))
        PVGadgets_BubbleTip(#Window_filter, #Gadget_filter_openinternal, "Open a list of internal fields off disk. Can be a text file with one field per line.", BubbleTipStyle)
      ButtonImageGadget(#Gadget_filter_saveinternal, 60, 565, 50, 50, ImageID(#Image_filter_saveinternal))
        PVGadgets_BubbleTip(#Window_filter, #Gadget_filter_saveinternal, "Save the current list of fields to a file on disk. This is a standard text file.", BubbleTipStyle)
      Frame3DGadget(#Gadget_filter_fexternal, 155, 550, 155, 75, "")
      ButtonImageGadget(#Gadget_filter_openfilter, 165, 565, 50, 50, ImageID(#Image_filter_openfilter))
        PVGadgets_BubbleTip(#Window_filter, #Gadget_filter_openfilter, "Open a pre-defined filter file from disk.", BubbleTipStyle)
      ButtonImageGadget(#Gadget_filter_savefilter, 215, 565, 50, 50, ImageID(#Image_filter_savefilter))
        PVGadgets_BubbleTip(#Window_filter, #Gadget_filter_savefilter, "Save the current filter file to disk.", BubbleTipStyle)
      Frame3DGadget(#Gadget_filter_fcsv, 315, 550, 157, 75, "")
      ButtonImageGadget(#Gadget_filter_opencsv, 325, 565, 50, 50, ImageID(#Image_filter_opencsv))
        PVGadgets_BubbleTip(#Window_filter, #Gadget_filter_opencsv, "Open a CSV header file to use as a list of labels to choose from in the filter box.", BubbleTipStyle)
      HideWindow(#Window_filter, 0)
      ProcedureReturn WindowID(#Window_filter)
  EndIf
EndProcedure

;==============================================================================================================
; All my procedural declarations
;==============================================================================================================

Declare   CopyFilter()                                                    ; Start the drop operation of the label from the buffer onto the internal filter list
Declare   GetFilter()                                                     ; Copy a label from the heading list over to the import filter list
Declare   InsertLine(Position.s)                                          ; Add a new line at the top, bottom or above and below the cursor
Declare   DeleteLine()                                                    ; Delete a line at the current cursor position

Declare   OpenFields()                                                    ; Open a list of fields that you will use as the target
Declare   SaveFields()                                                    ; Save the list of import fields to a file on disk
Declare   OpenFilter()                                                    ; Open a predefined list of fields from disk
Declare   SaveFilter()                                                    ; Save the current filter file to disk
Declare   OpenCSVHeader()                                                 ; Open a CSV header file for a device

;==============================================================================================================
;
;==============================================================================================================

Structure ProgramData
  QuitValue.i
  CurrentLine.i
  CurrentDir.s
  Internal.s
  Analyse.s
  Filters.s
EndStructure

;==============================================================================================================
;
;==============================================================================================================

Global Program.ProgramData

;==============================================================================================================
;
;==============================================================================================================

Program\CurrentDir  = GetCurrentDirectory()

;==============================================================================================================
;
;==============================================================================================================

Program\Internal    = Program\CurrentDir + "Files\Internal\"
Program\Analyse     = Program\CurrentDir + "Files\Analyse\"
Program\Filters     = Program\CurrentDir + "Files\Filters\"

;==============================================================================================================
;
;==============================================================================================================

Enumeration #GadgetIndex
  #PopMenu_filter
  #PopMenu_filter_beginning
  #PopMenu_filter_end
  #PopMenu_filter_above
  #PopMenu_filter_below
  #PopMenu_filter_delete
EndEnumeration

;==============================================================================================================
; Start the drop operation of the label from the buffer onto the internal filter list
;==============================================================================================================

Procedure CopyFilter()
  FilterText.s = EventDropText()
  CurrentLine = GetGadgetState(#Gadget_filter_Internal)
  If CurrentLine <> -1
    CurFilter.s   = StringField(FilterText.s, 1, "~")
    FilterLine.s  = StringField(FilterText.s, 2, "~")
    If CurFilter.s <> "<Blank>"
      SetGadgetItemText(#Gadget_filter_Internal, CurrentLine, CurFilter.s,  2)
      SetGadgetItemText(#Gadget_filter_Internal, CurrentLine, FilterLine.s, 3)
    ElseIf CurFilter.s = "<Blank>"
      SetGadgetItemText(#Gadget_filter_Internal, CurrentLine, "", 2)
      SetGadgetItemText(#Gadget_filter_Internal, CurrentLine, "", 3)
    EndIf
  EndIf
EndProcedure

;==============================================================================================================
; Copy a label from the heading list over to the import filter list
;==============================================================================================================

Procedure GetFilter()
  CurrentLine = GetGadgetState(#Gadget_filter_External)
  If CurrentLine <> -1
    CurFilter.s =       GetGadgetItemText(#Gadget_filter_External, CurrentLine, 0)
    CurFilter.s + "~" + GetGadgetItemText(#Gadget_filter_External, CurrentLine, 1)
    DragText(CurFilter, #PB_Drag_Copy)
  EndIf
EndProcedure

;==============================================================================================================
; Add a new line at the top, bottom or above and below the cursor
;==============================================================================================================

Procedure InsertLine(Position.s)
  CurrentLine = GetGadgetState(#Gadget_filter_Internal)
  NumItems    = CountGadgetItems(#Gadget_filter_Internal) - 1
  Select Position.s
    Case "Begin"  : CurPosition = 0
    Case "End"    : CurPosition = -1
    Case "Above"
      If CurrentLine = 0
        CurPosition = 0
      Else
        CurPosition = CurrentLine
      EndIf
    Case "Below"
      If CurrentLine = NumItems
        CurPosition = -1
      Else
        CurPosition = CurrentLine + 1
      EndIf
  EndSelect
  AddGadgetItem(#Gadget_filter_Internal, CurPosition, "" + Chr(10) + "" + Chr(10) + "" + Chr(10) + "")
EndProcedure

;==============================================================================================================
; Delete a line at the current cursor position
;==============================================================================================================

Procedure DeleteLine()
  CurrentLine = GetGadgetState(#Gadget_filter_Internal)
  If CurrentLine <> -1
    RemoveGadgetItem(#Gadget_filter_Internal, CurrentLine)
  EndIf
EndProcedure

;==============================================================================================================
; Open a list of fields that you will use as the target
;==============================================================================================================

Procedure OpenFields()
  Fields.s = OpenFileRequester("Internal field list to load", Program\Internal, "Fields file (*.fields)|*.fields", 0)
  If Fields.s <> ""
    FileId = ReadFile(#PB_Any, Fields.s)
    If FileId <> 0
      ClearGadgetItems(#Gadget_filter_Internal)
      While Eof(FileId) = 0
        AddGadgetItem(#Gadget_filter_Internal, -1, "" + Chr(10) + ReadString(FileId) + Chr(10) + "" + Chr(10) + "")
      Wend
      CloseFile(FileId)
    Else
      ; Could not read the file for some reason
    EndIf
  Else
    ; User cancelled the load 
  EndIf
EndProcedure

;==============================================================================================================
; Save the list of import fields to a file on disk
;==============================================================================================================

Procedure SaveFields()
  NumLines = CountGadgetItems(#Gadget_filter_Internal)
  If NumLines <> 0
    Fields.s = SaveFileRequester("Internal fields to save", Program\Internal, "Fields file (*.fields)|*.fields", 0)
    If Fields.s <> ""
      FileId = CreateFile(#PB_Any, Fields.s + ".fields")
      If FileId
        For LineStart = 0 To NumLines -1
          WriteStringN(Fileid, GetGadgetItemText(#Gadget_filter_Internal, LineStart, 1))
        Next
        CloseFile(FileId)
      Else
        ; Could not create a file on disk
      EndIf
    Else
      ; User cancelled the save process
    EndIf
  Else
    ; No lines in the display to save
  EndIf
EndProcedure

;==============================================================================================================
; Open a predefined list of fields from disk
;==============================================================================================================

Procedure OpenFilter()
  Filter.s = OpenFileRequester("Filter to load", Program\Filters, "Filter (*.filter)|*.filter", 0)
  If Filter.s <> ""
    FileId = ReadFile(#PB_Any, Filter.s)
    If FileId <> 0
      ClearGadgetItems(#Gadget_filter_Internal)
      While Eof(FileId) = 0
        CurrentLine.s = ReplaceString(ReadString(FileId), "|", Chr(10))
        AddGadgetItem(#Gadget_filter_Internal, -1, "" + Chr(10) + CurrentLine.s)
      Wend
      CloseFile(FileId)
    Else
      ; Could not read the file for some reason
    EndIf
  Else
    ; User cancelled the filter file load 
  EndIf
EndProcedure

;==============================================================================================================
; Save the current filter file to disk
;==============================================================================================================

Procedure SaveFilter()
  NumLines = CountGadgetItems(#Gadget_filter_Internal)
  If NumLines <> 0
    Filter.s = SaveFileRequester("Filter to save", Program\Filters, "Filter (*.filter)|*.filter", 0)
    If Filter.s <> ""
      FileId = CreateFile(#PB_Any, Filter.s + ".fields")
      If FileId
        For LineStart = 0 To NumLines -1
          LineOut.s = GetGadgetItemText(#Gadget_filter_Internal, LineStart, 1) + "|"
          LineOut.s = GetGadgetItemText(#Gadget_filter_Internal, LineStart, 2) + "|"
          LineOut.s = GetGadgetItemText(#Gadget_filter_Internal, LineStart, 3)
          WriteStringN(Fileid, LineOut.s)
          LineOut.s = ""
        Next
        CloseFile(FileId)
      Else
        ; Could not create a file on disk
      EndIf
    Else
      ; User cancelled the save process
    EndIf
  Else
    ; No lines in the display to save
  EndIf
EndProcedure

;==============================================================================================================
; Open a CSV header file for a device
;==============================================================================================================

Procedure OpenCSVheader()
  CSVHeader.s = OpenFileRequester("Header to load", Program\Analyse, "CSV header file (*.csv)|*.csv", 0)
  If CSVHeader.s <> ""
    FileId.l = ReadFile(#PB_Any, CSVHeader.s)
    If FileId.l <> 0
      ClearGadgetItems(#Gadget_filter_External)
      HeaderLine.s = ReadString(FileId.l)
      DelimCounter = CountString(HeaderLine.s, ",")
      CloseFile(FileId.l)
      For HeaderLoop = 1 To DelimCounter
        CurrentField.s = RemoveString(StringField(HeaderLine, HeaderLoop, ","), Chr(34))
        AddGadgetItem(#Gadget_filter_External, -1, CurrentField.s + Chr(10) + Str(HeaderLoop))
      Next
      AddGadgetItem(#Gadget_filter_External, -1, "<Blank>" + Chr(10) + "")
    Else
      ; The file could not be opened from disk
    EndIf
  Else
    ; User cancelled the file load
  EndIf
EndProcedure

;==============================================================================================================
; Generic, re-useable procedures
;==============================================================================================================

XIncludeFile "Modules\Generic\_EditableListIconGadget.pbi"                            ; Mr S of Rod's Editable ListIcon code. Very smurfy

;==============================================================================================================
;
;==============================================================================================================

If Window_filter()

  ;----------------------------------------------------------------------------
  ; Create my main popup menu
  ;----------------------------------------------------------------------------

  If CreatePopupImageMenu(#PopMenu_filter, #PB_Menu_ModernLook)
    MenuItem(#PopMenu_filter_beginning, "Insert new line at beginning"        , 0)
    MenuItem(#PopMenu_filter_end,       "Insert new line at end"              , 0)
    MenuItem(#PopMenu_filter_above,     "Insert new line at above selection"  , 0)
    MenuItem(#PopMenu_filter_below,     "Insert new line at below selection"  , 0)
    MenuBar()
    MenuItem(#PopMenu_filter_delete,    "Delete current line"                 , 0)
  EndIf

  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------

  SetListIconEditable(#Gadget_filter_Internal)

  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------

  Program\QuitValue = 0

  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------

  EnableGadgetDrop(#Gadget_filter_Internal, #PB_Drop_Text, #PB_Drag_Copy)
 
  ;----------------------------------------------------------------------------
  ;
  ;----------------------------------------------------------------------------

  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Select  EventWindow()
          Case  #Window_filter                    : Program\QuitValue = 1
        EndSelect
        ;----------------------------------------------------------------------
        ;
        ;----------------------------------------------------------------------
      Case #PB_Event_GadgetDrop
        Select EventGadget()
          Case #Gadget_filter_Internal
            Select EventDropType()
              Case #PB_Drop_Text                  : CopyFilter()
            EndSelect
        EndSelect
        ;----------------------------------------------------------------------
        ;
        ;----------------------------------------------------------------------
      Case #PB_Event_Menu
        Select EventMenu()
          Case #PopMenu_filter_beginning          : InsertLine("Begin")
          Case #PopMenu_filter_end                : InsertLine("End")
          Case #PopMenu_filter_above              : InsertLine("Above")
          Case #PopMenu_filter_below              : InsertLine("Below")
          Case #PopMenu_filter_delete             : DeleteLine()
        EndSelect
        ;----------------------------------------------------------------------
        ;
        ;----------------------------------------------------------------------
      Case #PB_Event_Gadget
        Select EventGadget()
          ;--------------------------------------------------------------------
          ;
          ;--------------------------------------------------------------------
          Case #Gadget_filter_Internal
            Select EventType()
              Case #PB_EventType_RightClick       : DisplayPopupMenu(#PopMenu_filter, WindowID(#Window_filter))           
            EndSelect
            ;------------------------------------------------------------------
            ;
            ;------------------------------------------------------------------
          Case #Gadget_filter_External
            Select EventType()
              Case #PB_EventType_DragStart        : GetFilter()
            EndSelect
            ;------------------------------------------------------------------
            ;
            ;------------------------------------------------------------------
          Case #Gadget_filter_openinternal        : OpenFields()
          Case #Gadget_filter_saveinternal        : SaveFields()
          Case #Gadget_filter_openfilter          : OpenFilter()
          Case #Gadget_filter_savefilter          : SaveFilter()
          Case #Gadget_filter_opencsv             : OpenCSVHeader()
          ;--------------------------------------------------------------------
          ;
          ;--------------------------------------------------------------------
        EndSelect
    EndSelect
  Until Program\QuitValue
  CloseWindow(#Window_filter)
EndIf
End

_________________
Amateur Radio, D-STAR/VK3HAF


Top
 Profile  
Reply with quote  
 Post subject: Re: DragNDrop export/import filter creation
PostPosted: Sun Oct 04, 2009 11:36 am 
Offline
PureBasic Protozoa
PureBasic Protozoa
User avatar

Joined: Fri Apr 25, 2003 3:08 pm
Posts: 4598
Location: Not Sydney!!! (Bad water, no goats)
This is srod's editable listicongadget code. Save it as an xinxluded file called "XIncludeFile "_EditableListIconGadget.pbi" and thank him for it as I could never have figured it out myself.

Code:
;===========================================================================================================================
; 'Editable ListIcon'.
;===========================================================================================================================
;
; Stephen Rodriguez.
; Created with Purebasic 4.02 for Windows.
;
; Date:  May 2007.
;
; Platforms:  Windows.
;
; Licence: DAYLike
;   (Do As You Like with it! - No Warranties!)
;   A credit to myself, whilst nice, is not absolutely necessary.
;
;
; NOTES.
; ------
; 1)  Register a listicon gadget to have editable cells by using the command SetListIconEditable(listID).
;     You MUST set up such listicons to have a column zero of zero width.
; 2)  Cells are made editable by intercepting double-clicks, setting the #LVS_EDITLABELS style,
;     repositioning the edit control which Windows uses to edit the labels in column zero and copying
;     the resulting text to the listicon cell.
; 3)  Cells can also be edited by means of the command EditCell().
;

;===========================================================================================================================
;
;===========================================================================================================================

#LVM_SUBITEMHITTEST = #LVM_FIRST + 57
#LVM_GETSUBITEMRECT = #LVM_FIRST + 56
#LVM_GETHEADER      = #LVM_FIRST + 31
#EC_RIGHTMARGIN     = 2

;===========================================================================================================================
;
;===========================================================================================================================

EnableExplicit

;===========================================================================================================================
;
;===========================================================================================================================

DeclareDLL.l SetListIconEditable(listID)

Declare.l   _LIEwinProc(hWnd, uMsg, wParam, lParam)
Declare.l   _LIEListProc(hWnd, uMsg, wParam, lParam)
Declare.l   _LIEeditProc(hWnd, uMsg, wParam, lParam)

;===========================================================================================================================
;
;===========================================================================================================================

Structure _LIEdit
  listOldProc.l
  editHwnd.l
  item.l
  subitem.l
  x.l
  y.l
  cx.l
  cy.l
EndStructure

;Returns zero if an error.

;===========================================================================================================================
;
;===========================================================================================================================

ProcedureDLL.l SetListIconEditable(listID)
  Protected result, parenthWnd, *mem._LIEdit, hWnd
    If IsGadget(listID) And GadgetType(listID) = #PB_GadgetType_ListIcon                     ; Check that listID references a valid listicon.
      hWnd = GadgetID(listID)
      If GetProp_(hWnd, "_LIEdit") = 0                                                        ; No!;Is the listicon already registered?
          *mem = AllocateMemory(SizeOf(_LIEdit))                                              ; Allocate enough memory for a _LIEdit structure.
        If *mem
          SetWindowLong_(hWnd, #GWL_STYLE, GetWindowLong_(hWnd, #GWL_STYLE) &~ #LVS_EDITLABELS)
            *mem\listOldProc = SetWindowLong_(hWnd, #GWL_WNDPROC, @_LIEListProc())            ; Set the fields of the _LIEedit structure.
            SetProp_(hWnd, "_LIEdit", *mem)                                                   ; Store a pointer to this structure in a window property ofthe listicon.         
            parenthWnd = GetParent_(hWnd)                                                     ; Subclass the parent window if not already through another listicon.
            If GetProp_(parenthWnd, "_LIEditOldProc") = 0                                     ; No!
              SetProp_(parenthWnd, "_LIEditOldProc", SetWindowLong_(parenthWnd, #GWL_WNDPROC, @_LIEwinProc()))
            EndIf
          result = 1
        EndIf
      EndIf
    EndIf
  ProcedureReturn result
EndProcedure

;===========================================================================================================================
; Sets the specified cell to be edited.
;===========================================================================================================================

ProcedureDLL EditCell(listID, item, subitem)
  Protected hWnd, *liedit._LIEdit, numrows, numcols
    If IsGadget(listID) And GadgetType(listID) = #PB_GadgetType_ListIcon                        ; Check that listID references a valid listicon.
        hWnd = GadgetID(listID)                                                               ; Check that the listicon is registered as editable.
        *liedit = GetProp_(hWnd, "_LIEdit")
        If *liedit
            numrows = CountGadgetItems(listID)                                                ; Check parameters are in range.
            numcols = SendMessage_(SendMessage_(hWnd, #LVM_GETHEADER, 0, 0), #HDM_GETITEMCOUNT, 0, 0)
            If item > = 0 And item < numrows And subitem > 0 And subitem < numcols
              *liedit\item = item
              *liedit\subitem = subitem
              SetWindowLong_(hWnd, #GWL_STYLE, GetWindowLong_(hWnd, #GWL_STYLE) | #LVS_EDITLABELS)
              SetActiveGadget(listID)
              SendMessage_(hWnd, #LVM_EDITLABEL, item, 0)
            EndIf
        EndIf
    EndIf
EndProcedure

;===========================================================================================================================
; Window proc of the ListIcon parent window.
;===========================================================================================================================

Procedure.l _LIEwinProc(hWnd, uMsg, wParam, lParam)
  Protected result, oldwinproc, *nmh. NMHDR, listhWnd, edithWnd, *liedit._LIEdit, *lvd.LV_DISPINFO, rc.RECT
  Static celltext$
    oldwinproc = GetProp_(hWnd, "_LIEditOldProc")                                               ; Retrieve the address of the old proc.
  Select uMsg
    Case #WM_NOTIFY
      *nmh = lParam
      Select *nmh\code
        Case #LVN_BEGINLABELEDIT
          listhWnd = *nmh\hwndFrom
            *liedit = GetProp_(listhWnd, "_LIEdit")                                           ; Retrieve the address of the LIEdit structure.
            If *liedit                                                                        ; Good to go!
              *liedit\editHwnd = 0
                edithWnd = SendMessage_(listhWnd, #LVM_GETEDITCONTROL, 0, 0)                  ; Get the handle of the edit control used to edit the label.
                SetProp_(edithWnd, "_LIEditOldProc", SetWindowLong_(edithWnd, #GWL_WNDPROC, @_LIEeditProc()))               ;Subclass the edit control.
                celltext$ = GetGadgetItemText(*nmh\idFrom, *liedit\item, *liedit\subitem)       ; Set text.
                SendMessage_(edithWnd, #WM_SETTEXT, 0, celltext$)
                SetGadgetItemText(*nmh\idFrom, *liedit\item, "", *liedit\subitem)
                rc\top = *liedit\subitem                                                      ; Get bounding rectangle.
                rc\left = #LVIR_BOUNDS
                SendMessage_(listhWnd, #LVM_GETSUBITEMRECT, *liedit\item, rc)
                *liedit\x = rc\left
                *liedit\y = rc\top
                *liedit\cx = SendMessage_(listhWnd, #LVM_GETCOLUMNWIDTH, *liedit\subitem, 0)
                *liedit\cy = rc\bottom - rc\top
            EndIf
        Case #LVN_ENDLABELEDIT
          listhWnd = *nmh\hwndFrom
            *liedit = GetProp_(listhWnd, "_LIEdit")                                           ; Retrieve the address of the LIEdit structure.
            If *liedit                                                                        ; Good to go!
              *lvd = lParam
              If *lvd\item\pszText
                SetGadgetItemText(*nmh\idFrom, *liedit\item, PeekS(*lvd\item\pszText), *liedit\subitem)
              Else             
                SetGadgetItemText(*nmh\idFrom, *liedit\item, celltext$, *liedit\subitem)
              EndIf
              SetWindowLong_(listhWnd, #GWL_STYLE, GetWindowLong_(listhWnd, #GWL_STYLE) &~ #LVS_EDITLABELS)
            EndIf
        Default
          result=CallWindowProc_(oldwinproc, hWnd, uMsg, wParam, lParam)
      EndSelect
    Case #WM_NCDESTROY
      result = CallWindowProc_(oldwinproc, hWnd, uMsg, wParam, lParam)
      RemoveProp_(hWnd, "_LIEditOldProc")
    Default
      result = CallWindowProc_(oldwinproc, hWnd, uMsg, wParam, lParam)
  EndSelect
  ProcedureReturn result
EndProcedure

;===========================================================================================================================
; Window proc of the ListIcon.
;===========================================================================================================================

Procedure.l _LIEListProc(hWnd, uMsg, wParam, lParam)
  Protected result, *liedit._LIEdit, PInfo.LVHITTESTINFO, *nmHEADER.HD_NOTIFY, rc.RECT, clientrc.RECT
    *liedit = GetProp_(hWnd, "_LIEdit")                                                       ; Retrieve the address of the LIEdit structure.
  Select uMsg
    Case #WM_NOTIFY
      *nmHEADER = lParam
      Select *nmHEADER\hdr\code
        Case #HDN_BEGINTRACK, #HDN_BEGINTRACKW                                                ; Prevent column 0 from being resized.
          If *nmHEADER\iItem = 0
            result = 1
          EndIf
        Default
          result = CallWindowProc_(*liedit\listOldProc, hWnd, uMsg, wParam, lParam)
      EndSelect
    Case #WM_LBUTTONDBLCLK
        PInfo\pt\x = lParam & $ffff                                                           ; Identify the clicked item
        PInfo\pt\y = (lParam >> 16) & $ffff
        SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, PInfo)
      If PInfo\iItem <> -1                                                                    ; A valid cell was clicked.
        *liedit\item = PInfo\iItem
        *liedit\subitem = PInfo\iSubItem
        ; scroll the listicon if the clicked cell is not entirely visible
        ; *****IF YOU WISH TO RESTRICT WHICH CELLS CAN BE EDITED, THEN PERFORM THE NECESSARY CHECKS HERE
        ; *****ON THE VALUES OF *liedit\item and *liedit\subitem (WHICH INDICATE WHICH CELL IS ABOUT
        ; *****TO BE EDITED) AND RUN THE FOLLOWING 2 LINES FOR THOSE CELLS WHICH ARE TO BE EDITED.
               rc\top = *liedit\subitem
               rc\left = #LVIR_BOUNDS
               SendMessage_(hWnd, #LVM_GETSUBITEMRECT, *liedit\item, rc)
               GetClientRect_(hWnd, clientrc)
              If rc\left < 0 Or (rc\right - rc\left) > = clientrc\right
                   SendMessage_(hWnd, #LVM_SCROLL, rc\left, 0)
               Else
                  If rc\right > clientrc\right
                      SendMessage_(hWnd, #LVM_SCROLL,rc\right - clientrc\right, 0)
                  EndIf
               EndIf
        SetWindowLong_(hWnd, #GWL_STYLE, GetWindowLong_(hWnd, #GWL_STYLE) | #LVS_EDITLABELS)
        SendMessage_(hWnd, #LVM_EDITLABEL, PInfo\iItem, 0)
        ;*****************************************************************************************
      EndIf
    Case #WM_NCDESTROY
      result = CallWindowProc_(*liedit\listOldProc, hWnd, uMsg, wParam, lParam)
      RemoveProp_(hWnd, "_LIEdit")
      FreeMemory(*liedit)
    Default
      result=CallWindowProc_(*liedit\listOldProc, hWnd, uMsg, wParam, lParam)
  EndSelect
  ProcedureReturn result
EndProcedure

;===========================================================================================================================
; Window proc of the edit control.
;===========================================================================================================================

Procedure.l _LIEeditProc(hWnd, uMsg, wParam, lParam)
  Protected result, oldwinproc, *liedit._LIEdit, *wpos.WINDOWPOS
    oldwinproc = GetProp_(hWnd, "_LIEditOldProc")                                             ; Retrieve the address of the old proc.
    *liedit = GetProp_(GetParent_(hWnd), "_LIEdit")                                           ; Retrieve the address of the LIEdit structure.
  Select uMsg
    Case #WM_ERASEBKGND
      result = CallWindowProc_(oldwinproc, hWnd, uMsg, wParam, lParam)                          ; A hack in order to clear the default selection of characters.
      If *liedit\editHwnd = 0
        *liedit\editHwnd = hWnd
        SendMessage_(hWnd, #EM_SETMARGINS, #EC_LEFTMARGIN | #EC_RIGHTMARGIN, 4)                 ; Set margins.
        SendMessage_(hWnd, #EM_SETSEL, -1, 0)
      EndIf
    Case #WM_WINDOWPOSCHANGING
      *wpos = lParam
      *wpos\cx = *liedit\cx                                                                     ; Comment this line to get an edit control which grows with the text.
      *wpos\cy = *liedit\cy + 3
      *wpos\x  = *liedit\x
      *wpos\y  = *liedit\y - 2
      result = CallWindowProc_(oldwinproc, hWnd, uMsg, wParam, lParam)
    Case #WM_NCDESTROY
      result = CallWindowProc_(oldwinproc, hWnd, uMsg, wParam, lParam)
      RemoveProp_(hWnd, "_LIEditOldProc")
      InvalidateRect_(GetParent_(hWnd), 0, 0)
    Default
      result = CallWindowProc_(oldwinproc, hWnd, uMsg, wParam, lParam)
  EndSelect
  ProcedureReturn result
EndProcedure

;===========================================================================================================================
;
;===========================================================================================================================

DisableExplicit

_________________
Amateur Radio, D-STAR/VK3HAF


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 2 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 19 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye