Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Passing supermover to report
Message
 
 
To
21/05/2001 12:11:20
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
00509448
Message ID:
00509557
Views:
16
>Here is a mover form I use. It moves records from one buffered table to another.
>
>
>**************************************************
>*-- Form:         frmmover (c:\grams\source\mover.scx)
>*-- ParentClass:  form
>*-- BaseClass:    form
>*-- Time Stamp:   02/25/01 01:51:09 PM
>*
>DEFINE CLASS frmmover AS form
>
>
>	Height = 234
>	Width = 505
>	Desktop = .T.
>	ShowWindow = 1
>	DoCreate = .T.
>	BufferMode = 2
>	AutoCenter = .T.
>	BorderStyle = 3
>	Caption = "Select"
>	ControlBox = .F.
>	Closable = .F.
>	Icon = "handshak.ico"
>	WindowType = 1
>	AlwaysOnTop = .T.
>	fromtable = ""
>	totable = ""
>	Name = "frmMover"
>	changes = .F.
>	columnfield = .F.
>	parentkeyvalue = .F.
>	parentforeignkey = .F.
>	joinkey = .F.
>
>
>	ADD OBJECT lstfrom AS listbox WITH ;
>		FontName = "MS Sans Serif", ;
>		ColumnCount = 2, ;
>		ColumnWidths = "232,0", ;
>		Height = 170, ;
>		Left = 6, ;
>		MultiSelect = .T., ;
>		Top = 25, ;
>		Width = 232, ;
>		IntegralHeight = .T., ;
>		Name = "lstFrom"
>
>
>	ADD OBJECT lstto AS listbox WITH ;
>		FontName = "MS Sans Serif", ;
>		ColumnCount = 2, ;
>		ColumnWidths = "232,0", ;
>		Height = 170, ;
>		Left = 268, ;
>		MultiSelect = .T., ;
>		Top = 25, ;
>		Width = 232, ;
>		IntegralHeight = .T., ;
>		Name = "lstTo"
>
>
>	ADD OBJECT lblfrom AS label WITH ;
>		AutoSize = .T., ;
>		FontName = "MS Sans Serif", ;
>		Caption = "Available", ;
>		Height = 15, ;
>		Left = 9, ;
>		Top = 6, ;
>		Width = 45, ;
>		Name = "lblFrom"
>
>
>	ADD OBJECT lblto AS label WITH ;
>		AutoSize = .T., ;
>		FontName = "MS Sans Serif", ;
>		Caption = "Selected", ;
>		Height = 15, ;
>		Left = 271, ;
>		Top = 6, ;
>		Width = 44, ;
>		Name = "lblTo"
>
>
>	ADD OBJECT cmdok AS commandbutton WITH ;
>		Top = 201, ;
>		Left = 361, ;
>		Height = 27, ;
>		Width = 68, ;
>		FontName = "MS Sans Serif", ;
>		Caption = "\< OK", ;
>		Default = .T., ;
>		Name = "cmdOK"
>
>
>	ADD OBJECT cmdcancel AS commandbutton WITH ;
>		Top = 201, ;
>		Left = 433, ;
>		Height = 27, ;
>		Width = 68, ;
>		FontName = "MS Sans Serif", ;
>		Cancel = .T., ;
>		Caption = "\< Cancel", ;
>		Name = "cmdCancel"
>
>
>	ADD OBJECT cmdadd AS commandbutton WITH ;
>		Top = 27, ;
>		Left = 242, ;
>		Height = 24, ;
>		Width = 24, ;
>		FontName = "MS Sans Serif", ;
>		Picture = "add.bmp", ;
>		Caption = "", ;
>		Name = "cmdAdd"
>
>
>	ADD OBJECT cmdaddall AS commandbutton WITH ;
>		Top = 54, ;
>		Left = 242, ;
>		Height = 24, ;
>		Width = 24, ;
>		FontName = "MS Sans Serif", ;
>		Picture = "addall.bmp", ;
>		Caption = "", ;
>		Name = "cmdAddAll"
>
>
>	ADD OBJECT cmdremove AS commandbutton WITH ;
>		Top = 82, ;
>		Left = 242, ;
>		Height = 24, ;
>		Width = 24, ;
>		FontName = "MS Sans Serif", ;
>		Picture = "remove.bmp", ;
>		Caption = "", ;
>		Name = "cmdRemove"
>
>
>	ADD OBJECT cmdremoveall AS commandbutton WITH ;
>		Top = 110, ;
>		Left = 242, ;
>		Height = 24, ;
>		Width = 24, ;
>		FontName = "MS Sans Serif", ;
>		Picture = "remall.bmp", ;
>		Caption = "", ;
>		Name = "cmdRemoveAll"
>
>
>	PROCEDURE Init
>		LPARAMETERS cCaption,cFromTableField,cToTable,cParentKeyValue,cParentForeignKey,cJoinKey
>		This.FromTable=JUSTSTEM(cFromTableField)
>		This.ColumnField=JUSTEXT(cFromTableField)
>		This.Caption=cCaption
>		This.ToTable=cToTable
>		This.ParentKeyValue=cParentKeyValue
>		This.ParentForeignKey=cParentForeignKey
>		This.JoinKey=cJoinKey
>		cField=This.ColumnField
>		cFromTable=This.FromTable
>		SELECT (cFromTable)
>		nIndex=1
>		SCAN
>			This.lstFrom.AddItem(&cField.,nIndex,1)
>			This.lstFrom.List(nIndex,2)=&cFromTable..pk
>			nIndex=nIndex+1
>		ENDSCAN
>		SELECT (cToTable)
>		nIndex=1
>		SCAN
>			This.lstTo.AddItem(&cField.,nIndex,1)
>			This.lstTo.List(nIndex,2)=&cJoinKey
>			nIndex=nIndex+1
>		ENDSCAN
>		ThisForm.Refresh()
>	ENDPROC
>

Seems like it was parsed incorrectly, so I put a blank space in commandbuttons captions. I'll look into it. We have mover class in our classlibrary, I believe, it looks similar. I just saw word "super" and thought, it's something interesting... :)
>	PROCEDURE Unload
>		lChanges=ThisForm.Changes
>		RETURN (lChanges)
>	ENDPROC
>
>
>	PROCEDURE cmdok.Click
>		cToTable=ThisForm.ToTable
>		cColumnField=ThisForm.ColumnField
>		cFromTable=ThisForm.FromTable
>		cParentKeyValue=ThisForm.ParentKeyValue
>		cParentForeignKey=ThisForm.ParentForeignKey
>		cJoinKey=ThisForm.JoinKey
>		SELECT (cToTable)
>		FOR i = 1 TO ThisForm.lstTo.ListCount
>			cJoinKeyValue=ALLT(ThisForm.lstTo.List(i,2))
>			LOCA FOR &cParentForeignKey = cParentKeyValue AND &cJoinKey = cJoinKeyValue
>			IF !FOUND()
>				INSERT INTO (cToTable) (pk,&cParentForeignKey.,&cJoinKey.) VALUES ;
>				                       (SYS(2015),cParentKeyValue,cJoinKeyValue)
>			ENDIF
>		ENDFOR
>		SELECT (cToTable)
>		SCAN
>			lFound=.F.
>			FOR i = 1 TO ThisForm.lstTo.ListCount
>				IF ALLT(ThisForm.lstTo.List(i,2)) = ALLT(&cJoinKey.)
>					lFound=.T.
>				ENDIF
>			ENDFOR
>			IF !lFound
>				DELETE
>			ENDIF
>		ENDSCAN
>		=TABLEUPDATE(2,.T.,cToTable)
>		ThisForm.Changes=.T.
>		ThisForm.Release()
>	ENDPROC
>
>
>	PROCEDURE cmdcancel.Click
>		ThisForm.Changes=.F.
>		ThisForm.Release()
>	ENDPROC
>
>
>	PROCEDURE cmdadd.Click
>		FOR i = 1 TO ThisForm.lstFrom.ListCount
>			IF ThisForm.lstFrom.Selected(i)
>				ThisForm.lstTo.AddItem(ThisForm.lstFrom.List(i))
>				ThisForm.lstTo.List(ThisForm.lstTo.ListCount,2)=;
>					ThisForm.lstFrom.List(i,2)
>			ENDIF
>		ENDFOR
>		FOR i = ThisForm.lstFrom.ListCount TO 1 STEP -1
>			IF ThisForm.lstFrom.Selected(i)
>				ThisForm.lstFrom.RemoveItem(i)
>			ENDIF
>		ENDFOR
>		ThisForm.Refresh()
>	ENDPROC
>
>
>	PROCEDURE cmdadd.Refresh
>		IF ThisForm.lstFrom.ListCount=0
>			This.Enabled=.F.
>		ELSE
>			This.Enabled=.T.
>		ENDIF
>	ENDPROC
>
>
>	PROCEDURE cmdaddall.Click
>		FOR i = 1 TO ThisForm.lstFrom.ListCount
>			ThisForm.lstTo.AddItem(ThisForm.lstFrom.List(i))
>			ThisForm.lstTo.List(ThisForm.lstTo.ListCount,2)=;
>				ThisForm.lstFrom.List(i,2)
>		ENDFOR
>		FOR i = ThisForm.lstFrom.ListCount TO 1 STEP -1
>			ThisForm.lstFrom.RemoveItem(i)
>		ENDFOR
>		ThisForm.Refresh()
>	ENDPROC
>
>
>	PROCEDURE cmdaddall.Refresh
>		IF ThisForm.lstFrom.ListCount=0
>			This.Enabled=.F.
>		ELSE
>			This.Enabled=.T.
>		ENDIF
>	ENDPROC
>
>
>	PROCEDURE cmdremove.Refresh
>		IF ThisForm.lstTo.ListCount=0
>			This.Enabled=.F.
>		ELSE
>			This.Enabled=.T.
>		ENDIF
>	ENDPROC
>
>
>	PROCEDURE cmdremove.Click
>		FOR i = 1 TO ThisForm.lstTo.ListCount
>			IF ThisForm.lstTo.Selected(i)
>				ThisForm.lstFrom.AddItem(ThisForm.lstTo.List(i))
>				ThisForm.lstFrom.List(ThisForm.lstTo.ListCount,2)=;
>					ThisForm.lstTo.List(i,2)
>			ENDIF
>		ENDFOR
>		FOR i = ThisForm.lstTo.ListCount TO 1 STEP -1
>			IF ThisForm.lstTo.Selected(i)
>				ThisForm.lstTo.RemoveItem(i)
>			ENDIF
>		ENDFOR
>		ThisForm.Refresh()
>	ENDPROC
>
>
>	PROCEDURE cmdremoveall.Refresh
>		IF ThisForm.lstTo.ListCount=0
>			This.Enabled=.F.
>		ELSE
>			This.Enabled=.T.
>		ENDIF
>	ENDPROC
>
>
>	PROCEDURE cmdremoveall.Click
>		FOR i = 1 TO ThisForm.lstTo.ListCount
>			ThisForm.lstFrom.AddItem(ThisForm.lstTo.List(i))
>			ThisForm.lstFrom.List(ThisForm.lstFrom.ListCount,2)=;
>				ThisForm.lstTo.List(i,2)
>		ENDFOR
>		FOR i = ThisForm.lstTo.ListCount TO 1 STEP -1
>			ThisForm.lstTo.RemoveItem(i)
>		ENDFOR
>		ThisForm.Refresh()
>	ENDPROC
>
>
>ENDDEFINE
>*
>*-- EndDefine: frmmover
>**************************************************
>
Seems like it was truncated by HTML, so I insert a blank space. Thanks, John. I believe, we have the similar class in our classlib, but the word "super" caught my attention, so I thought, it's something more interesting... :)

Thanks again. I haven't decided yet, what kind of interface I'm going to use in my future application, I still haven't time to concentrate on it, because I'm doing lots of small stuff and changes in my existing...

Once I get closer to this point, I'll start a new thread for ideas...
If it's not broken, fix it until it is.


My Blog
Previous
Reply
Map
View

Click here to load this message in the networking platform