VFP has a _moverlists class included in its distribution which is based on two listboxes.
An alternative SuperMover class, a basic example of which follows, is based on two grids which in turn offers developers far more scope than is available in the _moverlists class.
FI, you can add checkboxes to the grids for further subselection, images to visually identify file types, comboboxes, multiple record selection, and so on.
The simple undocumented example selects fields from a table for inclusion in a search but the class lends itself to other forms of data selection.
As there is a limit of 254 fields in a VFP table, filters are applied to the two cursors required and it's unlikely there would be any serious performance implications using filters under these conditions.
If you were to deploy the class with serious numbers of records, then a SELECT-SQL statement to populate the cursors would be more appropriate.
What is not included for simplicity is a vertically aligned four command button set which is placed to the right of the second grid.
The button functions are:-
Move selected record top in second grid
Move selected record up in second grid
Move selected record down in second grid
Move selected record bottom in second grid
Other than that the class emulates most of the behaviour of the _moverlists class including double clicking and/or drag and drop to transfer from one grid to the other.
The selected records are identified as[color blue] SELECTEDLIST.selected = .T.[/color]
You need to replace the hard coded table reference in the init() event of the form either by passing a table name as a parameter to the form or by substituting your own tablename for the one supplied.
You also need to add the following form properties and values ensuring the path\filenames are correct
candropicon = "dragmove.cur"
nodropicon = "nodrop01.cur"
[color green]
**************************************************
*-- Form: supermover (d:\supermover\supermover.scx)
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 02/09/05 04:38:06 PM
*[/color][color blue]
DEFINE CLASS supermover AS form
Height = 171
Width = 415
ShowWindow = 0
DoCreate = .T.
ShowTips = .T.
AutoCenter = .T.
BorderStyle = 1
Caption = "Field selector"
MaxButton = .F.
MinButton = .F.
WindowType = 1
candropicon = "dragmove.cur"
nodropicon = "nodrop01.cur"
nsourceno = 0
nselectedno = 0
nseconds = 0
Name = "SUPERMOVER"
ADD OBJECT grdsourcelist AS grid WITH ;
ColumnCount = 1, ;
AllowHeaderSizing = .F., ;
AllowRowSizing = .F., ;
HeaderHeight = 0, ;
Height = 132, ;
Left = 12, ;
ReadOnly = .T., ;
Top = 24, ;
Width = 169, ;
HighlightBackColor = RGB(10,36,106), ;
HighlightStyle = 2, ;
Name = "grdSOURCELIST", ;
Column1.FontName = "MS Sans Serif", ;
Column1.ControlSource = "", ;
Column1.Width = 149, ;
Column1.ReadOnly = .T., ;
Column1.ToolTipText = "Double click to move or left mouse to drag and drop", ;
Column1.Name = "Column1"
ADD OBJECT supermover.grdsourcelist.column1.header1 AS header WITH ;
Caption = "Header1", ;
Name = "Header1"
ADD OBJECT supermover.grdsourcelist.column1.text1 AS textbox WITH ;
FontName = "MS Sans Serif", ;
BorderStyle = 0, ;
Margin = 0, ;
MousePointer = 1, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
ADD OBJECT cmdadd AS commandbutton WITH ;
Top = 24, ;
Left = 195, ;
Height = 25, ;
Width = 25, ;
FontName = "Courier New", ;
FontSize = 10, ;
Caption = ">", ;
ToolTipText = "Add this field", ;
Name = "cmdAdd"
ADD OBJECT cmdaddall AS commandbutton WITH ;
Top = 50, ;
Left = 195, ;
Height = 25, ;
Width = 25, ;
FontName = "Courier New", ;
FontSize = 10, ;
Caption = ">>", ;
ToolTipText = "Add all fields", ;
Name = "cmdAddAll"
ADD OBJECT cmdremove AS commandbutton WITH ;
Top = 76, ;
Left = 195, ;
Height = 25, ;
Width = 25, ;
FontName = "Courier New", ;
FontSize = 10, ;
Caption = "<", ;
Enabled = .F., ;
ToolTipText = "Remove this field", ;
Name = "cmdRemove"
ADD OBJECT cmdremoveall AS commandbutton WITH ;
Top = 102, ;
Left = 195, ;
Height = 25, ;
Width = 25, ;
FontName = "Courier New", ;
FontSize = 10, ;
Caption = "<<", ;
Enabled = .F., ;
ToolTipText = "Remove all fields", ;
Name = "cmdRemoveAll"
ADD OBJECT lblinstructions AS label WITH ;
Caption = "Please select the fields you wish to add to the search and click on suitable button", ;
Left = 13, ;
Top = 5, ;
Name = "lblInstructions"
ADD OBJECT grdselectedlist AS grid WITH ;
ColumnCount = 1, ;
AllowHeaderSizing = .F., ;
AllowRowSizing = .F., ;
HeaderHeight = 0, ;
Height = 132, ;
Left = 234, ;
ReadOnly = .T., ;
Top = 24, ;
Width = 169, ;
HighlightBackColor = RGB(10,36,106), ;
HighlightStyle = 2, ;
Name = "grdSELECTEDLIST", ;
Column1.FontName = "MS Sans Serif", ;
Column1.ControlSource = "", ;
Column1.Width = 149, ;
Column1.ReadOnly = .T., ;
Column1.ToolTipText = "Double click to move or left mouse to drag and drop", ;
Column1.Name = "Column1"
ADD OBJECT supermover.grdselectedlist.column1.header1 AS header WITH ;
Caption = "Header1", ;
Name = "Header1"
ADD OBJECT supermover.grdselectedlist.column1.text1 AS textbox WITH ;
FontName = "MS Sans Serif", ;
BorderStyle = 0, ;
Margin = 0, ;
MousePointer = 1, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"
PROCEDURE Destroy
USE IN SOURCELIST
USE IN SELECTEDLIST
ENDPROC
PROCEDURE Init
WITH THISFORM
.LockScreen = .T.
SET DELETED ON
CREATE CURSOR sourcelist ;
(fieldname C(50) ,;
selected L)
CREATE CURSOR selectedlist ;
(fieldname C(50) ,;
selected L)
IF !USED([PATIENTS])
USE patients IN 0
ENDIF
lnFields = AFIELDS(laTemp,[PATIENTS])
FOR i = 1 TO lnFields
DO CASE
CASE laTemp[i,2] = [L]
* Exclude from list, logical field
OTHE
INSERT INTO SOURCELIST ( ;
fieldname ,;
selected) ;
VALUES ;
(PROPER(LOWER(laTemp[i,1])) ,;
.T.)
INSERT INTO SELECTEDLIST ( ;
fieldname ,;
selected) ;
VALUES ;
(PROPER(LOWER(laTemp[i,1])),;
.F.)
ENDC
ENDF
WITH .grdSOURCELIST
SET FILTER TO SOURCELIST.selected IN SOURCELIST
.RecordSource = [SOURCELIST]
.Column1.ControlSource = [SOURCELIST.fieldname]
GO TOP IN SOURCELIST
.Refresh()
ENDWITH
WITH .grdSELECTEDLIST
SET FILTER TO SELECTEDLIST.selected IN SELECTEDLIST
.RecordSource = [SELECTEDLIST]
.Column1.ControlSource = [SELECTEDLIST.fieldname]
ENDWITH
.LockScreen = .F.
ENDW
ENDPROC
PROCEDURE grdsourcelist.DragDrop
LPARAMETERS oSource, nXCoord, nYCoord
IF !EMPTY(oSource.Value)
THISFORM.cmdRemove.Click()
ENDI
ENDPROC
PROCEDURE grdsourcelist.DragOver
LPARAMETERS oSource, nXCoord, nYCoord, nState
DO CASE
CASE nState = 0
oSource.DragIcon = THISFORM.CanDropIcon
CASE nState = 1
oSource.DragIcon = THISFORM.NoDropIcon
ENDCASE
ENDPROC
PROCEDURE text1.DblClick
THISFORM.cmdAdd.Click()
ENDPROC
PROCEDURE text1.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
DO CASE
CASE nButton = 1
IF (SECONDS() - THISFORM.nSeconds ) > _DBLCLICK
THISFORM.nSeconds = SECONDS()
THIS.Drag(1)
ELSE
THIS.DblClick()
ENDI
ENDC
ENDPROC
PROCEDURE text1.DragOver
LPARAMETERS oSource, nXCoord, nYCoord, nState
DO CASE
CASE nState = 0
oSource.DragIcon = THISFORM.CanDropIcon
CASE nState = 1
oSource.DragIcon = THISFORM.NoDropIcon
ENDCASE
ENDPROC
PROCEDURE cmdadd.Click
WITH THISFORM
.LockScreen = .T.
REPLACE SOURCELIST.selected WITH .F. IN SOURCELIST
SELECT SELECTEDLIST
SET FILTER TO IN SELECTEDLIST
LOCATE FOR UPPER(ALLTRIM(SOURCELIST.fieldname)) ;
= UPPER(ALLTRIM(SELECTEDLIST.fieldname))
REPLACE SELECTEDLIST.selected WITH .T. IN SELECTEDLIST
SET FILTER TO SELECTEDLIST.selected IN SELECTEDLIST
.cmdRemove.Enabled = .T.
.cmdRemoveAll.Enabled = .T.
SELECT SOURCELIST
LOCATE FOR SOURCELIST.selected
IF !FOUND()
.cmdAdd.Enabled = .F.
.cmdAddAll.Enabled = .F.
ELSE
.cmdAdd.Enabled = .T.
.cmdAddAll.Enabled = .T.
ENDIF
.cmdFind.Enabled = .T.
GO TOP IN SOURCELIST
GO TOP IN SELECTEDLIST
.grdSOURCELIST.Refresh()
.grdSELECTEDLIST.Refresh()
.LockScreen = .F.
ENDW
ENDPROC
PROCEDURE cmdaddall.Click
WITH THISFORM
.LockScreen = .T.
SET FILTER TO IN SOURCELIST
REPLACE SOURCELIST.selected WITH .F. ALL IN SOURCELIST
SET FILTER TO IN SELECTEDLIST
REPLACE SELECTEDLIST.selected WITH .T. ALL IN SELECTEDLIST
SET FILTER TO SOURCELIST.selected IN SOURCELIST
SET FILTER TO SELECTEDLIST.selected IN SELECTEDLIST
GO TOP IN SOURCELIST
GO TOP IN SELECTEDLIST
.cmdAdd.Enabled = .F.
.cmdAddAll.Enabled = .F.
.cmdRemove.Enabled = .T.
.cmdRemoveAll.Enabled = .T.
.cmdFind.Enabled = .T.
.grdSOURCELIST.Refresh()
.grdSELECTEDLIST.Refresh()
.LockScreen = .F.
ENDW
ENDPROC
PROCEDURE cmdremove.Click
WITH THISFORM
.LockScreen = .T.
REPLACE SELECTEDLIST.selected WITH .F. IN SELECTEDLIST
SELECT SOURCELIST
SET FILTER TO IN SOURCELIST
LOCATE FOR UPPER(ALLTRIM(SELECTEDLIST.fieldname)) ;
= UPPER(ALLTRIM(SOURCELIST.fieldname))
REPLACE SOURCELIST.selected WITH .T. IN SOURCELIST
SET FILTER TO SOURCELIST.selected IN SOURCELIST
.cmdAdd.Enabled = .T.
.cmdAddAll.Enabled = .T.
SELECT SELECTEDLIST
LOCATE FOR SELECTEDLIST.selected
IF !FOUND()
.cmdRemove.Enabled = .F.
.cmdRemoveAll.Enabled = .F.
.cmdFind.Enabled = .F.
ELSE
.cmdRemove.Enabled = .T.
.cmdRemoveAll.Enabled = .T.
.cmdFind.Enabled = .T.
ENDIF
GO TOP IN SOURCELIST
GO TOP IN SELECTEDLIST
.grdSOURCELIST.Refresh()
.grdSELECTEDLIST.Refresh()
.LockScreen = .F.
ENDW
ENDPROC
PROCEDURE cmdremoveall.Click
WITH THISFORM
.LockScreen = .T.
SET FILTER TO IN SELECTEDLIST
REPLACE SELECTEDLIST.selected WITH .F. ALL IN SELECTEDLIST
SET FILTER TO IN SOURCELIST
REPLACE SOURCELIST.selected WITH .T. ALL IN SOURCELIST
SET FILTER TO SOURCELIST.selected IN SOURCELIST
SET FILTER TO SELECTEDLIST.selected IN SELECTEDLIST
GO TOP IN SOURCELIST
GO TOP IN SELECTEDLIST
.cmdAdd.Enabled = .T.
.cmdAddAll.Enabled = .T.
.cmdRemove.Enabled = .F.
.cmdRemoveAll.Enabled = .F.
.cmdFind.Enabled = .F.
.grdSOURCELIST.Refresh()
.grdSELECTEDLIST.Refresh()
.LockScreen = .F.
ENDW
ENDPROC
PROCEDURE grdselectedlist.DragDrop
LPARAMETERS oSource, nXCoord, nYCoord
IF !EMPTY(oSource.Value)
THISFORM.cmdAdd.Click()
ENDI
ENDPROC
PROCEDURE grdselectedlist.DragOver
LPARAMETERS oSource, nXCoord, nYCoord, nState
DO CASE
CASE nState = 0
oSource.DragIcon = THISFORM.CanDropIcon
CASE nState = 1
oSource.DragIcon = THISFORM.NoDropIcon
ENDCASE
ENDPROC
PROCEDURE text1.MouseDown
LPARAMETERS nButton, nShift, nXCoord, nYCoord
DO CASE
CASE nButton = 1
IF (SECONDS() - THISFORM.nSeconds) > _DBLCLICK
THISFORM.nSeconds = SECONDS()
THIS.Drag(1)
ELSE
THIS.DblClick()
ENDI
ENDC
ENDPROC
PROCEDURE text1.DblClick
THISFORM.cmdRemove.Click()
ENDPROC
ENDDEFINE[/color][color green]
*
*-- EndDefine: supermover
**************************************************[/color]