serial VHCtrlCNTs,KeyCodesCNTs,%Const Default %Library.TMEdit %Library.Boolean 0 %Library.Boolean 0 %Library.Boolean 0 %Library.Boolean 0 %Library.Boolean 0 %Library.Boolean 0 %Library.Boolean 0 %Library.Boolean 0 %Library.Boolean 0 %Library.Integer $$$clRed %Library.Integer $$$clYellow %Library.Integer $$$clWhite %Library.Integer $$$clBlack %Library.Integer 0 %Library.Integer 0 %Library.Integer 0 %Library.String $$$NULLOREF %Library.String %Library.String %Library.Integer %Library.Integer 0 %Library.Float %Library.Boolean 1 %Library.Integer 0 %Library.Float %Library.Boolean 1 %Library.String 200 %Library.Boolean 1 %Library.Boolean 1 %Library.String %Library.String %Library.List %Library.String %Library.Integer 0 %Library.Boolean 1 %Library.Integer $$$etNone %Library.List %Library.Boolean 1 3=Ctrl+C 22=Ctrl+V 24=Ctrl+X %Library.List $LB($$$keyBackspace,$$$keyTab,$$$keyEnter,$$$keyEsc,3,22,24) For internal use. generator initvalue:%String cache 0 %Library.Status document literal cache 0 document literal Origin,Type:%Library.Integer,Header,Body:%Library.String cache 0 document literal Value,RawValue:%Library.String cache 0 document literal Header,Body:%Library.String,Type:%Library.Integer cache 0 document literal Event:%Library.String,Args:%Library.List cache 0 document literal Key,ChangedKey:%Library.String,Type:%Library.Integer,Text:%Library.String cache 0 document literal readonly veld... ; *** INTEGER *** Else If Type=$$$etInteger Do . Quit:('$$keyCheckMaxLen(Text,.ChangedKey)) . If Key'?1N Do Quit .. Set ChangedKey=$C(0) .. Do SendSimpleKeyMsg(KeyAsNr,"Enkel cijfers zijn toegelaten.") . If (Key="0") && (Text="") Do Quit .. Set ChangedKey=$C(0) . Set ValidateOk=1 ; *** FLOAT *** Else If Type=$$$etFloat Do . Quit:('$$keyCheckMaxLen(Text,.ChangedKey)) . New KeyIsNr,KeyIsComma,KeyIsMin . Set KeyIsNr=(Key?1N), KeyIsComma=(Key="."), KeyIsMin=(Key="-") . If ('KeyIsNr && 'KeyIsComma && 'KeyIsMin) Do Quit ;Eerst de key checken of deze geldig is .. Set ChangedKey=$C(0) .. Do SendSimpleKeyMsg(KeyAsNr,"Enkel cijfers, een min-teken of een komma zijn toegelaten.") . If KeyIsMin && (Text'="") Do Quit ;Checken of '-' geldig is .. Set ChangedKey=$C(0) . If KeyIsComma && (Text="") Do Quit ;Checken of '.' geldig is (mag niet als eerste char staan) .. Set ChangedKey=$C(0) . If KeyIsNr && (Text="0") Do Quit ;Checken of niet reeds een '0' voorop staat .. Set ChangedKey=$C(0) . If KeyIsComma && ($F(Text,".")'=0) Do Quit ;Checken of komma geldig is (maximum één) .. Set ChangedKey=$C(0) . Set ValidateOk=1 ; *** ALPHA *** Else If Type=$$$etAlpha Do . Quit:('$$keyCheckMaxLen(Text,.ChangedKey)) . If Key'?1(1A,1" ") Do Quit .. Set ChangedKey=$C(0) .. Do SendSimpleKeyMsg(KeyAsNr,"Enkel letters en spaties zijn toegelaten.") . Set ValidateOk=1 ; *** ALPHA LOWER CASE *** Else If Type=$$$etAlphaLowerCase Do . Quit:('$$keyCheckMaxLen(Text,.ChangedKey)) . If Key'?1(1L,1" ") Do Quit .. If ..ChangeToType && (KeyAsNr>64) && (KeyAsNr<91) Do ;LowerCase->UpperCase ... Set ChangedKey=$C(KeyAsNr+32) ... Do SendSimpleKeyMsg(KeyAsNr,"Enkel kleine letters en spaties zijn toegelaten. De toets werd aangepast.") .. Else Do ... Set ChangedKey=$C(0) ... Do SendSimpleKeyMsg(KeyAsNr,"Enkel kleine letters en spaties zijn toegelaten.") . Set ValidateOk=1 ; *** ALPHA UPPER CASE *** Else If Type=$$$etAlphaUpperCase Do . Quit:('$$keyCheckMaxLen(Text,.ChangedKey)) . If Key'?1(1U,1" ") Do Quit .. If ..ChangeToType && (KeyAsNr>96) && (KeyAsNr<123) Do ;LowerCase->UpperCase ... Set ChangedKey=$C(KeyAsNr-32) ... Do SendSimpleKeyMsg(KeyAsNr,"Enkel hoofdletters en spaties zijn toegelaten. De toets werd aangepast.") .. Else Do ... Set ChangedKey=$C(0) ... Do SendSimpleKeyMsg(KeyAsNr,"Enkel hoofdletters en spaties zijn toegelaten.") . Set ValidateOk=1 ; *** PATTERN *** Else If Type=$$$etPattern Do . Quit:('$$keyCheckMaxLen(Text,.ChangedKey)) . If ..Pattern="" Do Quit .. Do ..FSendMessage($$$moCode,$$$MBICONERROR,"Interne fout","Er is geen pattern opgegeven.") .. Set ..Pattern=".E" ;Pattern tijdelijk veranderen in 'alles' . If Key'?@..Pattern Do Quit .. Set ChangedKey=$C(0) .. Do SendSimpleKeyMsg(KeyAsNr,..HelpStr) . Set ValidateOk=1 ; *** USER DEFINED SET *** Else If Type=$$$etUserDefinedSet Do . Quit:('$$keyCheckMaxLen(Text,.ChangedKey)) . If ..UserDefinedSet'[Key Do Quit .. Set ChangedKey=$C(0) .. New UDSStr .. Set UDSStr=$S(..HelpStr="":"Enkel volgende karakters zijn geldig: '"_..UserDefinedSet_"'.",1:..HelpStr) .. Do SendSimpleKeyMsg(KeyAsNr,UDSStr) . Set ValidateOk=1 ; *** CALC *** Else If Type=$$$etCalc Do . If "0123456789()+-*/."'[Key Do Quit .. Set ChangedKey=$C(0) .. Do SendSimpleKeyMsg(KeyAsNr,"Enkel een cijfer, haakje, komma of operator is toegelaten.") . Set ValidateOk=1 ; *** OWNER VALIDATE *** Else If Type=$$$etOwnerValidate Do . New SendMessage,MsgHeader,MsgBody . Set SendMessage=1 . Set MsgHeader="Ongeldige toets" . Set MsgBody="De toets is niet toegestaan." . New Args . Set Args=$LB(%this,Key,ValidateOk,SendMessage,MsgHeader,MsgBody) . Do ..FTriggerEvent(..OnValidateKey,.Args) . Set ChangedKey=$LG(Args,2,Key) . Set ValidateOk=$LG(Args,3,ValidateOk) . If 'ValidateOk Do .. Set SendMessage=$LG(Args,4,SendMessage) .. If SendMessage Do ... Do ..FSendMessage($$$moUser,$$$MBICONINFORMATION,$LG(Args,5,MsgHeader),$LG(Args,6,MsgBody)) Quit ValidateOk ;============================================================================== TranslateKey(KeyAsNr) If KeyAsNr=8 Do Quit "backspace" Else If KeyAsNr=9 Do Quit "tab" Else If KeyAsNr=13 Do Quit "enter" Else If KeyAsNr=27 Do Quit "escape" Quit "#"_KeyAsNr ;============================================================================== SendSimpleKeyMsg(KeyAsNr,AddToHelpStr) New HelpStr If (KeyAsNr=127) || (KeyAsNr<32) Do ;CONTROLE CHARs . Set HelpStr="De toets '"_$$TranslateKey(KeyAsNr)_"' is niet geldig" Else Do . Set HelpStr="De toets '"_Key_"' is niet geldig" Set HelpStr=HelpStr_$S($G(AddToHelpStr)="":".",1:": "_AddToHelpStr) Do ..FSendMessage($$$moUser,$$$MBICONEXCLAMATION,"Ongeldige toets",HelpStr) Quit ;============================================================================== keyCheckMaxLen(Val,ChangedKey) Quit:('..CheckMaxLen) 1 If ($L(Val)+1)>..MaxLen Do Quit 0 . Set ChangedKey=$C(0) . Do ..FSendMessage($$$moUser,$$$MBICONINFORMATION,"Maximum lengte","Het maximum aantal karakters is "_..MaxLen_".") Quit 1 ]]> Value,ChangedValue:%Library.String,MsgOrigin,Type:%Library.Integer cache 0 %Library.Boolean document literal ..Scale Do ... If +..Scale=0 Do .... Do ..FSendMessage($$$moCode,$$$MBICONERROR,"Interne fout","Er is geen scale-waarde opgegeven!") .... Set ..Scale=2 ;Tijdelijke waarde toekennen ... Else If ..Scale=1 Do .... Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,"Ongeldige waarde","Enkel 1 cijfer na de komma is toegestaan.") .... Set:(..ChangeToType) ChangedValue=$E(Value,1,$Find(Value,".")+..Scale-1) ... Else If ..Scale>1 Do .... Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,"Ongeldige waarde","Enkel "_..Scale_" cijfers na de komma zijn toegestaan.") .... Set:(..ChangeToType) ChangedValue=$E(Value,1,$Find(Value,".")+..Scale-1) ... Else Do .... Set ScaleError=0 .. Else Do ... Set ScaleError=0 . Else Do .. Set ScaleError=0 . Quit:(ScaleError) . Quit:('$$CheckMaxVal(Value,.ChangedValue)) . Quit:('$$CheckMinVal(Value,.ChangedValue)) . Quit:('$$CheckMaxLen(Value,.ChangedValue)) . Quit:('$$CheckMinLen(Value,.ChangedValue)) . Set ValidateOk=1 ; *** ALPHA *** Else If Type=$$$etAlpha Do . Quit:('$$CheckPattern(Value,".(1A,1"" "")","Enkel letters zijn toegelaten.")) . Quit:('$$CheckMaxLen(Value,.ChangedValue)) . Quit:('$$CheckMinLen(Value,.ChangedValue)) . Set ValidateOk=1 ; *** ALPHA LOWER CASE *** Else If Type=$$$etAlphaLowerCase Do . If '$$CheckPattern(Value,".(1L,1"" "")","Enkel kleine letters en spaties zijn toegelaten.") Do Quit .. Set:(..ChangeToType) ChangedValue=$ZCVT(Value,"L") . Quit:('$$CheckMaxLen(Value,.ChangedValue)) . Quit:('$$CheckMinLen(Value,.ChangedValue)) . Set ValidateOk=1 ; *** ALPHA UPPER CASE *** Else If Type=$$$etAlphaUpperCase Do . If '$$CheckPattern(Value,".(1U,1"" "")","Enkel hoofdletters en spaties zijn toegelaten.") Do Quit .. Set:(..ChangeToType) ChangedValue=$ZCVT(Value,"U") . Quit:('$$CheckMaxLen(Value,.ChangedValue)) . Quit:('$$CheckMinLen(Value,.ChangedValue)) . Set ValidateOk=1 ; *** PATTERN *** Else If Type=$$$etPattern Do . If ..Pattern="" Do Quit .. Do ..FSendMessage($$$moCode,$$$MBICONERROR,"Interne fout","Er is geen pattern opgegeven.") .. Set ..Pattern=".E" ;Pattern tijdelijk veranderen in 'alles' . Quit:('$$CheckPattern(Value,..Pattern,..HelpStr)) . Quit:('$$CheckMaxLen(Value,.ChangedValue)) . Quit:('$$CheckMinLen(Value,.ChangedValue)) . Set ValidateOk=1 ; *** USER DEFINED SET *** Else If Type=$$$etUserDefinedSet Do . If $TR(Value,..UserDefinedSet,"")'="" Do Quit .. New UDSStr .. Set UDSStr=$S(..HelpStr="":"Enkel volgende karakters zijn geldig: '"_..UserDefinedSet_"'.",1:..HelpStr) .. Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,"Ongeldige waarde",UDSStr) . Quit:('$$CheckMaxLen(Value,.ChangedValue)) . Quit:('$$CheckMinLen(Value,.ChangedValue)) . Set ValidateOk=1 ; *** CALC *** Else If Type=$$$etCalc Do . If Value="" Do Quit .. Set ChangedValue=0 . Quit:('$$CheckPattern(Value,".(1N,1""("",1"")"",1""*"",1""+"",1""/"",1""-"",1""."")","Enkel cijfers, haakjes, komma's en operators zijn toegelaten.")) . New Result,XStatus . Set XStatus=$$iXecute^vhLib("Set Result="_Value) . If XStatus'="" Do Quit .. Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,"Ongeldige expressie","De opgegeven expressie is niet geldig.") . Set ChangedValue=Result . Set ValidateOk=1 ; *** OWNER VALIDATE *** -> Schrijf uw eigen validatie-routine en koppel ah event OnValidate Else If Type=$$$etOwnerValidate Do . New SendMessage,MsgHeader,MsgBody . Set SendMessage=1 . Set MsgHeader="Ongeldige waarde" . Set MsgBody="De opgegeven waarde is niet toegestaan." . New Args . Set Args=$LB(%this,Value,ValidateOk,SendMessage,MsgHeader,MsgBody) . Do ..FTriggerEvent(..OnValidateValue,.Args) . Set ChangedValue=$LG(Args,2,Value) . Set ValidateOk=$LG(Args,3,ValidateOk) . If 'ValidateOk Do .. Set SendMessage=$LG(Args,4,SendMessage) .. If SendMessage Do ... Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,$LG(Args,5,MsgHeader),$LG(Args,6,MsgBody)) Quit ValidateOk ;============================================================================== CheckPattern(Val,Pattern,PatternHelpStr) ;PatternHelpStr is enkel een gebruiksvriendelijke vertaling van de pattern If Val'?@Pattern Do Quit 0 . New PatternStr . Set PatternStr="De opgegeven waarde is niet geldig"_$S($G(PatternHelpStr)="":".",1:": "_PatternHelpStr) . Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,"Ongeldige waarde",PatternStr) Quit 1 ;------------------------------------------------------------------------------ CheckMaxVal(Val,ChangedVal) Quit:('..CheckMaxVal) 1 Quit:(..MaxValIsAllowed && (Val=..MaxVal)) 1 If Val'<..MaxVal Do Quit 0 . New MaxStr . If ..MaxValIsAllowed Do .. Set MaxStr="De maximum waarde bedraagt "_..MaxVal_"." . Else Do .. Set MaxStr="De waarde moet kleiner zijn dan "_..MaxVal_"." . Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,"Maximum waarde",MaxStr) . Set:(..ChangeToMaxVal && ..MaxValIsAllowed) ChangedVal=..MaxVal Quit 1 ;------------------------------------------------------------------------------ CheckMinVal(Val,ChangedVal) Quit:('..CheckMinVal) 1 Quit:(..MinValIsAllowed && (Val=..MinVal)) 1 If Val'>..MinVal Do Quit 0 . New MinStr . If ..MinValIsAllowed Do .. Set MinStr="De minimum waarde bedraagt "_..MinVal_"." . Else Do .. Set MinStr="De waarde moet groter zijn dan "_..MinVal_"." . Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,"Minimum waarde",MinStr) . Set:(..ChangeToMinVal && ..MinValIsAllowed) ChangedVal=..MinVal Quit 1 ;============================================================================== CheckMaxLen(Val,ChangedVal) #Define ChangeToMaxLen Set:(..ChangeToMaxLen) ChangedVal=$E(Val,1,..MaxLen) If '..CheckMaxLen Do Quit 1 . $$$ChangeToMaxLen If $L(Val)>..MaxLen Do Quit 0 . Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,"Maximum lengte","Het maximum aantal karakters is "_..MaxLen_".") . $$$ChangeToMaxLen Quit 1 ;------------------------------------------------------------------------------ CheckMinLen(Val,ChangedVal) Quit:('..CheckMinLen) 1 If $L(Val)<..MinLen Do Quit 0 . Do ..FSendMessage(MsgOrigin,$$$MBICONINFORMATION,"Minimum lengte","Het minimum aantal karakters is "_..MinLen_".") Quit 1 ]]> Args:%Library.List cache 0 document literal Args:%Library.String cache 0 document literal Args:%String cache 0 document literal Value:%Library.String cache 0 %Library.Status document literal Parent:%Library.String,LeftOffset,TopOffset:%Library.Integer cache 0 document literal Method for getting 'Text' property. cache 0 %Library.String document literal Method for setting 'Text' property. Value:%String cache 0 %Library.Status document literal %Library.CacheSerialState Address ClassName CloseFromClient Parent PropName ClassNameAbsent Tag Constraints Font OnCanResize OnClick OnConstrainedResize OnDblClick OnDragDrop OnDragOver OnEndDock OnEndDrag OnMouseDown OnMouseMove OnMouseUp OnResize OnStartDock OnStartDrag PopupMenu Brush OnDockDrop OnDockOver OnEnter OnExit OnGetSiteInfo OnKeyDown OnKeyPress OnKeyUp OnMouseWheel OnMouseWheelDown OnMouseWheelUp OnChange OnMessage Type MaxVal MinVal MaxLen MinLen CheckMaxLen CheckMinLen CheckMaxVal CheckMinVal CommaDelimiter Pattern lbNavigationKeys Scale ShowMessages UserDefinedSet MaxValIsAllowed MinValIsAllowed ChangeToMaxVal ChangeToMinVal ChangeToMaxLen ChangeToType PatternHelpStr HelpStr CheckScale OnValidate FMsgHint MinimumHintWidth LastMO HintParent FHintLeftOffset FHintParent FHintTopOffset OnValidateValue ValidateKeyIsActive ValidateKeyEventIsActive OnValidateKey FRawText AdvancedORefType ErrorColor ErrorFontColor FBaseColor FBaseFontColor OnKeyPressEventIsActive OnExitEventIsActive CheckOnTextSet ValidateTextSet lbAllowedKeys