************************************************** *-- Class: icgcommontext (c:\development\test\test.vcx) *-- ParentClass: textbox *-- BaseClass: textbox *-- Time Stamp: 06/15/06 11:23:02 AM * DEFINE CLASS icgcommontext AS textbox Anchor = 768 Height = 23 Width = 100 builderx = "c:\development\builders\libs\icgbuilders, icgtxtbuilder" Name = "icgcommontext" autocr = .F. *-- logical for setting to all caps upcase = .F. PROCEDURE setexprops * shell method for setting properties with an expression on init. If (This.UpCase) && will set to upper case input If (This.MaxLength > 0) This.Format = Replicate("!",This.MaxLength) Endif Endif ENDPROC PROCEDURE onchange *** shell method to fire when control value changes ENDPROC PROCEDURE Init this.SetExProps() && set expression-based properties DODEFAULT() ENDPROC PROCEDURE GotFocus DoDefault() If (This.autocr) Set Confirm Off Else Set Confirm On Endif ENDPROC PROCEDURE value_assign LPARAMETERS vNewVal *To do: Modify this routine for the Assign method THIS.VALUE = m.vNewVal ENDPROC *-- documentation PROCEDURE zreadme ENDPROC ENDDEFINE * *-- EndDefine: icgcommontext **************************************************The normal searchable textbox -
************************************************** *-- Class: icgcommonsrchfield (c:\development\test\test.vcx) *-- ParentClass: icgcommontext (c:\development\icgcommon\libs\icgcommon.vcx) *-- BaseClass: textbox *-- Time Stamp: 06/15/06 02:59:08 PM *-- searchable field * DEFINE CLASS icgcommonsrchfield AS icgcommontext FontSize = 9 Anchor = 768 Height = 23 StatusBarText = "F5 - BEG F6 - END F7 - PREV F8 - NEXT F9 - FIND F11 - SAVE" Width = 100 *-- Boolean to tell whether a field is searchable or not searchable = .T. icsrchalias = "" icsrchtag = "" builderx = "c:\development\builders\libs\icgbuilders, srchtxtbuilder" upcase = .T. Name = "icgcommonsrchfield" ltracknavigation = .F. *-- does a search of the current field if there is a key for it. PROCEDURE search *** Search Method gcseekval = This.Value If Type("gcseekval") = 'C' gcseekval = Alltrim(gcseekval) Endif =Tablerevert(.T.) Thisform.Revert Set Near On If !Empty(This.icsrchalias) If !Empty(This.icsrchtag) =Seek(gcseekval, This.icsrchalias, This.icsrchtag) Set Order To Tag ( This.icsrchtag ) Endif Endif If Eof() Go Bottom Endif If (This.ltracknavigation) This.UpdateOnNav() Endif Thisform.Refresh() ENDPROC *-- Go to Last Record in current order PROCEDURE goend *** GoEnd =tablerevert(.T.) Thisform.Revert GO BOTTOM If (This.ltracknavigation) This.UpdateOnNav() Endif THISFORM.Refresh() ENDPROC *-- Go to Top Record in current order PROCEDURE gotop *** GoTop =tablerevert(.T.) Thisform.Revert GO top If (This.ltracknavigation) This.UpdateOnNav() Endif THISFORM.Refresh() ENDPROC *-- Go to next record in current order PROCEDURE gonext *** GoNext =tablerevert(.T.) Thisform.Revert IF !EOF() SKIP 1 ENDIF IF EOF() GO BOTTOM ENDIF If (This.ltracknavigation) This.UpdateOnNav() Endif THISFORM.Refresh() ENDPROC *-- Go To Prev record in current order. PROCEDURE goprev *** GoPrev =Tablerevert(.T.) Thisform.Revert If !Bof() Skip -1 Endif If Bof() Go Top Endif If (This.ltracknavigation) This.UpdateOnNav() Endif Thisform.Refresh() ENDPROC PROCEDURE embeddedsearch *** Embedded Search Method gcseekval = This.Value If Type("gcseekval") = 'C' gcseekval = Alltrim(gcseekval) Endif cCtrl = This.ControlSource =Tablerevert(.T.) Browse For (gcseekval $ &cCtrl) If (This.ltracknavigation) This.UpdateOnNav() Endif Thisform.Refresh() ENDPROC PROCEDURE setexprops DODEFAULT() this.icsrchalias = ALLTRIM(this.icsrchalias) this.icsrchtag = ALLTRIM(this.icsrchtag) ENDPROC PROCEDURE When This.ForeColor = Rgb(0,0,255) && Blue ENDPROC PROCEDURE RightClick this.browse thisform.Refresh() ENDPROC PROCEDURE KeyPress Lparameters nKeyCode, nShiftAltCtrl Local lnSellngth If This.searchable Do Case Case nKeyCode = -8 && F9 - SRCH This.Search Nodefault Case nKeyCode = -7 && F8 - NEXT This.GoNext Nodefault Case nKeyCode = -6 && F7 - PREV This.GoPrev Nodefault Case nKeyCode = -5 && F6 - END This.GoEnd Nodefault Case nKeyCode = -4 && F5 - TOP This.GoTop Nodefault Case nKeyCode = -2 && F3 - Embedded srch This.EmbeddedSearch Nodefault Endcase Endif ENDPROC PROCEDURE GotFocus DoDefault() If !Empty(This.icsrchalias) Select ( This.icsrchalias ) If !Empty(This.icsrchtag) * Set Order To Tag ( This.icsrchtag ) Endif Endif ENDPROC PROCEDURE LostFocus DoDefault() This.ForeColor = Rgb(0,0,0) && ENDPROC *-- browse this field PROCEDURE browse ENDPROC ENDDEFINE * *-- EndDefine: icgcommonsrchfield **************************************************And the new subclass of that, using underlying FK's
************************************************** *-- Class: icgcommonsrchfk (c:\development\test\test.vcx) *-- ParentClass: icgcommonsrchfield (c:\development\test\test.vcx) *-- BaseClass: textbox *-- Time Stamp: 06/19/06 02:59:02 PM * DEFINE CLASS icgcommonsrchfk AS icgcommonsrchfield *-- underlying FK field to be updated icunderlyingfk = "" *-- table to perform lookups in iclookuptable = "" *-- index tag in lookup table to search iclookuptag = "" *-- temp alias for the lookup table opened again in a separate work area to keep from messing up relations iclookupalias = "" *-- underlying table containing the FK to be updated icunderlyingalias = "" *-- field from the lookup table to update the FK with icupdatesource = "" lfound = .F. *-- validation msg cvalidmsg = "" Name = "icgcommonsrchfk" PROCEDURE dolookup && lookup Lparameters vSeekVal, llExact Local cLookupAlias, cUpdateAlias, cUpdateField, cUpdateFrom If Empty(This.iclookupalias) This.opentemp() Endif cLookupAlias = This.iclookupalias cUpdateAlias = This.icunderlyingalias cUpdateField = This.icunderlyingfk cUpdateFrom = Alltrim(cLookupAlias)+[.]+Alltrim(This.icupdatesource) *SELECT ( cLookupAlias ) If !llExact Set Near On ENDIF this.lfound = .F. If Seek(vSeekVal,cLookupAlias,This.iclookuptag) this.lfound = .T. * Select ( cUpdateAlias ) Return &cUpdateFrom Endif ENDPROC PROCEDURE opentemp && Local cFileName1 If !Empty(This.iclookuptable) cFileName1 = Substr(Sys(2015), 3, 10) && create temp file This.iclookupalias = cFileName1 Use ( This.iclookuptable ) In 0 Again Alias &cFileName1 Endif ENDPROC PROCEDURE doupdate && update the fk here Lparameters vUpDateVal Local cUpdateAlias, cUpdateField cUpdateAlias = This.icunderlyingalias cUpdateField = This.icunderlyingfk Select ( cUpdateAlias ) Replace &cUpdateField With vUpDateVal ENDPROC PROCEDURE search *** Search Method && to-do: *!* 1. Fix seekval to be the underlying FK not the controlsourced value *!* 1. perform lookup and substitute that. *!* 2. revert the lookup table (controlsource alias) *!* 3. do seek, and set index Local cLookupAlias gcseekval = This.dolookup(This.Value, .F.) If Type("gcseekval") = 'C' gcseekval = Alltrim(gcseekval) Endif cLookupAlias = This.iclookuptable =Tablerevert(.F.,cLookupAlias) Thisform.Revert Set Near On If !Empty(This.icsrchalias) If !Empty(This.icsrchtag) =Seek(gcseekval, This.icsrchalias, This.icsrchtag) Set Order To Tag ( This.icsrchtag ) Endif Endif If Eof() Go Bottom Endif If (This.ltracknavigation) This.UpdateOnNav() Endif Thisform.Refresh() ENDPROC PROCEDURE Valid && Local lgUpdateval lgUpdateval = This.dolookup(This.Value,.T.) If !(This.lfound) WAIT WINDOW this.cvalidmsg NOWAIT Return 0 ELSE this.Doupdate(lgUpDateVal) Return .T. Endif ENDPROC ENDDEFINE * *-- EndDefine: icgcommonsrchfk **************************************************