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