Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

MASK.PAS@ 376

Last change on this file since 376 was 7, checked in by RBRi, 19 years ago
+ sibyl staff
Property svn:eol-style set to `native`
File size: 38.8 KB

Line
1	Unit Mask;
2
3	Interface
4
5	Uses Dos,Messages,SysUtils,Classes,Buttons,Forms,StdCtrls,Dialogs;
6
7	Const
8	DefaultBlank:Char='_';
9	MaskFieldSeparator:Char=';';
10	MaskNoSave:Char='0';
11
12	mMskTimeSeparator=':';
13	mMskDateSeparator='/';
14	mMskAlpha='L';
15	mMskAlphaOpt='l';
16	mMskAlphaNum='A';
17	mMskAlphaNumOpt='a';
18	mMskAscii='C';
19	mMskAsciiOpt='c';
20	mMskNumeric='0';
21	mMskNumericOpt='9';
22	mMskNumSymOpt='#';
23
24	mDirReverse='!';
25	mDirUpperCase='>';
26	mDirLowerCase='<';
27	mDirLiteral='\';
28
29	EditTextExceptionMsg='Value in the edit field is invalid.'#13#10'Use escape key to cancel changes !';
30
31	Type
32	EEditTextInvalid=Class(Exception);
33
34	TOnEditTextInvalid=Procedure(Sender:TObject) Of Object;
35
36	TMaskEdit=Class(TEdit)
37	Private
38	FEditMask:String;
39	FCanvas:TCanvas;
40	FMaskBlank:Char;
41	FMaskSave:Boolean;
42	FOnEditTextInvalid:TOnEditTextInvalid;
43	Private
44	Procedure SetEditMask(Const NewValue:String);
45	Function GetCursorPos:LongInt;
46	Function GetCurrentMask(Position:LongInt;Var UpLowCase:Byte;Var Blanks:Boolean):PChar;
47	Procedure UpdateCursorPos;
48	Function GetText:String;
49	Procedure SetText(Const NewValue:String);
50	Function GetIsMasked:Boolean;
51	Function GetEditText:String;
52	Procedure SetEditText(Const NewValue:String);
53	Procedure CloseQuery(Sender:TObject;Var CanClose:Boolean);
54	Protected
55	Procedure EditTextInvalid;Virtual;
56	Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
57	Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
58	Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
59	Procedure SetupComponent;Override;
60	Procedure SetupShow;Override;
61	Procedure ParentNotification(Var Msg:TMessage);Override;
62	Public
63	Function ValidateEdit:Boolean;
64	Protected
65	Property InsertMode;
66	Property OnCloseQuery;
67	Public
68	Property IsMasked:Boolean read GetIsMasked;
69	Property EditText:String read GetEditText write SetEditText;
70	Property MaskBlank:Char read FMaskBlank;
71	Property MaskSave:Boolean read FMaskSave;
72	Published
73	Property EditMask:String read FEditMask write SetEditMask;
74	Property Text:String read GetText write SetText;
75	Property OnEditTextInvalid:TOnEditTextInvalid read FOnEditTextInvalid write FOnEditTextInvalid;
76	End;
77
78	Function InsertMaskEdit(parent:TControl;Left,Bottom,Width,Height:LongInt;
79	Text,Hint:String):TMaskEdit;
80
81	Implementation
82
83	Function InsertMaskEdit(parent:TControl;Left,Bottom,Width,Height:LongInt;
84	Text,Hint:String):TMaskEdit;
85	Begin
86	Result.Create(parent);
87	Result.SetWindowPos(Left,Bottom,Width,Height);
88	Result.Text:=Text;
89	Result.Hint:=Hint;
90	Result.AutoSize:=True;
91	Result.parent := parent;
92	End;
93
94
95	{$IFDEF OS2}
96	Uses PmWin;
97	{$ENDIF}
98
99	{
100	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
101	º º
102	º Speed-Pascal/2 Version 2.0 º
103	º º
104	º Speed-Pascal Component Classes (SPCC) º
105	º º
106	º This section: TMaskEdit Class implementation º
107	º º
108	º Last modified: January 1998 º
109	º º
110	º (C) 1998 SpeedSoft. All rights reserved. Disclosure probibited ! º
111	º º
112	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
113	}
114
115	Procedure TMaskEdit.SetupComponent;
116	Begin
117	Inherited SetupComponent;
118
119	Name:='MaskEdit';
120	FMaskBlank:=DefaultBlank;
121	FMaskSave:=False;
122	InsertMode:=False;
123	OnCloseQuery:=CloseQuery;
124	End;
125
126	Procedure TMaskEdit.EditTextInvalid;
127	Begin
128	If FOnEditTextInvalid<>Nil Then FOnEditTextInvalid(Self)
129	Else Raise EEditTextInvalid.Create(EditTextExceptionMsg);
130	End;
131
132	Procedure TMaskEdit.ParentNotification(Var Msg:TMessage);
133	Begin
134	Inherited ParentNotification(Msg);
135
136	{$IFDEF OS2}
137	If Msg.Param1Hi=EN_KILLFOCUS Then
138	Begin
139	Try
140	If not ValidateEdit Then EditTextInvalid;
141	InsertMode:=True;
142	Except
143	On E:EEditTextInvalid Do
144	Begin
145	ErrorBox(E.Message);
146	Focus;
147	End;
148	End;
149	End
150	Else If Msg.Param1Hi=EN_SETFOCUS Then InsertMode:=False;
151	{$ENDIF}
152	End;
153
154	Procedure TMaskEdit.CloseQuery(Sender:TObject;Var CanClose:Boolean);
155	Begin
156	CanClose:=True;
157	Try
158	If not ValidateEdit Then EditTextInvalid;
159	Except
160	On E:EEditTextInvalid Do
161	Begin
162	ErrorBox(E.Message);
163	Focus;
164	CanClose:=False;
165	End;
166	End;
167	End;
168
169	Function TMaskEdit.ValidateEdit:Boolean;
170	Var s,s1:String;
171	t:LongInt;
172	t1:LongInt;
173	CurrentMask:^CString;
174	UpLowCase:Byte;
175	Blanks:Boolean;
176	Label error;
177	Begin
178	//validate EditText
179	Result:=True; //Blanks are ok (required characters versus optional characters)
180	s:=EditText;
181
182	t:=1;
183	t1:=1;
184	While t<=254 Do
185	Begin
186	If t1>length(FEditMask) Then
187	Begin
188	SetLength(s,t-1);
189	break;
190	End;
191	CurrentMask:=@FEditMask[t1];
192	If t>length(s) Then break;
193
194	If CurrentMask^[0]=MaskFieldSeparator Then
195	Begin
196	SetLength(s,t-1);
197	break;
198	End
199	Else If CurrentMask<>Nil Then
200	Begin
201	Case CurrentMask^[0] Of
202	mDirLiteral:
203	Begin
204	if s[t]<>CurrentMask^[1] Then goto error;
205	t:=t+1;
206	t1:=t1+1;
207	End;
208	mDirUpperCase,mDirLowerCase,mDirReverse:;
209	mMskAlpha,mMskAlphaOpt:
210	Begin
211	If s[t] In ['A'..'Z','a'..'z'] Then
212	Begin
213	End
214	Else If s[t]=FMaskBlank Then
215	Begin
216	If CurrentMask^[0]<>mMskAlphaOpt Then Result:=False;
217	End
218	Else goto error;
219	t:=t+1;
220	End;
221	mMskAlphaNum,mMskAlphaNumOpt:
222	Begin
223	If s[t] In ['A'..'Z','a'..'z','0'..'9'] Then
224	Begin
225	End
226	Else If s[t]=FMaskBlank Then
227	Begin
228	If CurrentMask^[0]<>mMskAlphaNumOpt Then Result:=False;
229	End
230	Else goto error;
231	t:=t+1;
232	End;
233	mMskAscii,mMskAsciiOpt:
234	Begin
235	t:=t+1;
236	End;
237	mMskNumeric,mMskNumericOpt:
238	Begin
239	If s[t] In ['0'..'9'] Then
240	Begin
241	End
242	Else If s[t]=FMaskBlank Then
243	Begin
244	If CurrentMask^[0]<>mMskNumericOpt Then Result:=False;
245	End
246	Else goto error;
247	t:=t+1;
248	End;
249	mMskNumSymOpt:
250	Begin
251	If s[t] In ['+','-','0'..'9'] Then
252	Begin
253	End
254	Else If s[t]<>FMaskBlank Then goto error;
255	t:=t+1;
256	End;
257	mMskTimeSeparator:
258	Begin
259	If s[t]<>TimeSeparator Then goto error;
260	t:=t+1;
261	End;
262	mMskDateSeparator:
263	Begin
264	If s[t]<>DateSeparator Then goto error;
265	t:=t+1;
266	End;
267	Else
268	Begin
269	If s[t]<>CurrentMask^[0] Then goto error;
270	t:=t+1;
271	End;
272	End; //case
273	End
274	Else
275	Begin
276	error:
277	EditTextInvalid;
278	break;
279	End;
280	t1:=t1+1;
281	End;
282
283	If t<=length(s) Then goto error;
284	If t1<=length(FEditMask) Then
285	If FEditMask[t1]<>MaskFieldSeparator Then
286	Begin
287	While t1<=length(FEditMask) Do
288	Begin
289	CurrentMask:=@FEditMask[t1];
290	Case CurrentMask^[0] Of
291	mDirLiteral:
292	Begin
293	s:=s+CurrentMask^[1];
294	t1:=t1+1;
295	End;
296	mDirUpperCase,mDirLowerCase,mDirReverse:;
297	mMskTimeSeparator:s:=s+TimeSeparator;
298	mMskDateSeparator:s:=s+DateSeparator;
299	mMskAlpha,mMskAlphaNum,mMskAscii,mMskNumeric:goto error;
300	mMskAlphaOpt,mMskAlphaNumOpt,mMskAsciiOpt,
301	mMskNumericOpt,mMskNumSymOpt:s:=s+FMaskBlank;
302	Else
303	Begin
304	s:=s+CurrentMask^[0];
305	End;
306	End; //Case
307
308	t1:=t1+1;
309	End;
310	End;
311
312	If s<>EditText Then EditText:=s;
313	End;
314
315	Function TMaskEdit.GetText:String;
316	Var t,t1:Longint;
317	CurrentMask:^CString;
318	Begin
319	Result:=EditText;
320
321	//delete optional literals and blanks if they're part of the mask
322	//and they should not be included into text
323	If Result<>'' Then If not FMaskSave Then
324	Begin
325	t1:=1;
326	t:=1;
327	While t1<=Length(FEditMask) Do
328	Begin
329	CurrentMask:=@FEditMask[t1];
330	Case CurrentMask^[0] Of
331	mDirLiteral:
332	Begin
333	System.Delete(Result,t,1);
334	t1:=t1+1;
335	End;
336	mDirUpperCase,mDirLowerCase,mDirReverse:;
337	mMskAlpha,mMskAlphaOpt,
338	mMskAlphaNum,mMskAlphaNumOpt,
339	mMskAscii,mMskAsciiOpt,
340	mMskNumeric,mMskNumericOpt,
341	mMskNumSymOpt:
342	Begin
343	If Result[t]=FMaskBlank Then System.Delete(Result,t,1)
344	Else t:=t+1;
345	End;
346	mMskTimeSeparator,mMskDateSeparator:
347	Begin
348	System.Delete(Result,t,1);
349	End;
350	Else
351	Begin
352	System.Delete(Result,t,1);
353	End;
354	End; //case
355	t1:=t1+1;
356	End;
357	End;
358	End;
359
360	Procedure TMaskEdit.SetText(Const NewValue:String);
361	Var s,s1:String;
362	t,t1:LongInt;
363	CurrentMask:^CString;
364	UpLowCase:Byte;
365	Blanks:Boolean;
366	Begin
367	s:=NewValue;
368	t:=1;
369	t1:=1;
370	While t<=254 Do
371	Begin
372	If t1>length(FEditMask) Then
373	Begin
374	SetLength(s,t-1);
375	break;
376	End;
377	CurrentMask:=@FEditMask[t1];
378	If t>length(s) Then
379	Begin
380	SetLength(s,t);
381	s[t]:=#32;
382	End;
383	If s[t]=#32 Then s[t]:=FMaskBlank;
384
385	If CurrentMask^[0]=MaskFieldSeparator Then
386	Begin
387	SetLength(s,t-1);
388	break;
389	End
390	Else If CurrentMask<>Nil Then
391	Begin
392	Case CurrentMask^[0] Of
393	mDirLiteral:
394	Begin
395	If FMaskSave Then s[t]:=CurrentMask^[1]
396	Else
397	Begin
398	s1:=CurrentMask^[1];
399	System.Insert(s1,s,t);
400	End;
401	t:=t+1;
402	t1:=t1+1;
403	End;
404	mDirUpperCase,mDirLowerCase,mDirReverse:;
405	mMskAlpha,mMskAlphaOpt:
406	Begin
407	If s[t] In ['A'..'Z','a'..'z'] Then
408	Begin
409	If UpLowCase=1 Then s[t]:=Upcase(s[t])
410	Else If UpLowCase=2 Then
411	Begin
412	s1:=s[t];
413	s1:=LowerCase(s1);
414	s[t]:=s1[1];
415	End;
416	End
417	Else s[t]:=FMaskBlank;
418	t:=t+1;
419	End;
420	mMskAlphaNum,mMskAlphaNumOpt:
421	Begin
422	If s[t] In ['A'..'Z','a'..'z','0'..'9'] Then
423	Begin
424	If UpLowCase=1 Then s[t]:=Upcase(s[t])
425	Else If UpLowCase=2 Then
426	Begin
427	s1:=s[t];
428	s1:=LowerCase(s1);
429	s[t]:=s1[1];
430	End;
431	End
432	Else s[t]:=FMaskBlank;
433	t:=t+1;
434	End;
435	mMskAscii,mMskAsciiOpt:
436	Begin
437	If UpLowCase=1 Then s[t]:=Upcase(s[t])
438	Else If UpLowCase=2 Then
439	Begin
440	s1:=s[t];
441	s1:=LowerCase(s1);
442	s[t]:=s1[1];
443	End;
444	t:=t+1;
445	End;
446	mMskNumeric,mMskNumericOpt:
447	Begin
448	If s[t] In ['0'..'9'] Then
449	Begin
450	End
451	Else s[t]:=FMaskBlank;
452	t:=t+1;
453	End;
454	mMskNumSymOpt:
455	Begin
456	If s[t] In ['+','-','0'..'9'] Then
457	Begin
458	End
459	Else s[t]:=FMaskBlank;
460	t:=t+1;
461	End;
462	mMskTimeSeparator:
463	Begin
464	If FMaskSave Then s[t]:=TimeSeparator
465	Else
466	Begin
467	s1:=TimeSeparator;
468	Insert(s1,s,t);
469	End;
470	t:=t+1;
471	End;
472	mMskDateSeparator:
473	Begin
474	If FMaskSave Then s[t]:=DateSeparator
475	Else
476	Begin
477	s1:=DateSeparator;
478	Insert(s1,s,t);
479	End;
480	t:=t+1;
481	End;
482	Else
483	Begin
484	If FMaskSave Then s[t]:=CurrentMask^[0]
485	Else
486	Begin
487	s1:=CurrentMask^[0];
488	System.Insert(s1,s,t);
489	End;
490	t:=t+1;
491	End;
492	End; //case
493	End
494	Else break;
495	t1:=t1+1;
496	End;
497
498	EditText:=s;
499	End;
500
501	Function TMaskEdit.GetIsMasked:Boolean;
502	Begin
503	Result:=FEditMask<>'';
504	End;
505
506	Function TMaskEdit.GetEditText:String;
507	Begin
508	Result:=Inherited Text;
509	End;
510
511	Procedure TMaskEdit.SetEditText(Const NewValue:String);
512	Var s:String;
513	Begin
514	s:=Inherited Text;
515	Inherited Text:=NewValue;
516	//check if the text is valid
517	Try
518	ValidateEdit;
519	Except
520	//Ignore error
521	Inherited Text:=s;
522	End;
523	End;
524
525	Procedure TMaskEdit.SetEditMask(Const NewValue:String);
526	Var s,s1:String;
527	t:LongInt;
528	SepCount:Byte;
529	Begin
530	FEditMask:=NewValue;
531
532	s:=FEditMask;
533	t:=1;
534	SepCount:=0;
535
536	s1:=s;
537	For t:=1 To Length(s) Do s1[t]:=#0;
538
539	t:=1;
540	While t<=length(s) Do
541	Begin
542	If s[t]=MaskFieldSeparator Then
543	Begin
544	If SepCount=0 Then
545	Begin
546	t:=t+1;
547	If ((t<=length(s))And(s[t]<>MaskNoSave)) Then
548	FMaskSave:=True
549	Else
550	FMaskSave:=False;
551	t:=t+1;
552	If s[t]<>MaskFieldSeparator Then
553	Begin
554	SetLength(s,t-1);
555	SetLength(s1,t-1);
556	End;
557	inc(SepCount);
558	End
559	Else
560	Begin
561	t:=t+1;
562	If t<=length(s) Then
563	Begin
564	FMaskBlank:=s[t];
565	SetLength(s,t-4);
566	SetLength(s1,t-4);
567	End
568	Else
569	Begin
570	SetLength(s,t-5);
571	SetLength(s1,t-5);
572	End;
573	End;
574	End
575	Else Case s[t] Of
576	mDirLiteral:
577	Begin
578	Delete(s,t,1);
579	Delete(s1,t,1);
580	t:=t+1;
581	End;
582	mDirUpperCase,mDirLowerCase,mDirReverse:
583	Begin
584	Delete(s,t,1);
585	Delete(s1,t,1);
586	End;
587	mMskAlpha,mMskAlphaOpt,mMskAlphaNum,mMskAlphaNumOpt,
588	mMskAscii,mMskAsciiOpt,mMskNumeric,mMskNumericOpt,mMskNumSymOpt:
589	Begin
590	s1[t]:=FMaskBlank;
591	t:=t+1;
592	End;
593	mMskTimeSeparator,mMskDateSeparator:t:=t+1;
594	Else t:=t+1;
595	End; //case
596	End;
597
598	For t:=1 To length(s) Do If s1[t]<>#0 Then s[t]:=FMaskBlank;
599
600	Text:=s;
601	End;
602
603	Procedure TMaskEdit.SetupShow;
604	Begin
605	Inherited SetupShow;
606
607	FCanvas.Create(Self);
608	FCanvas.Init;
609	End;
610
611	Function TMaskEdit.GetCursorPos:LongInt;
612	Var
613	{$IFDEF OS2}
614	Info:CursorInfo;
615	{$ENDIF}
616	s,s1:String;
617	X:LongInt;
618	t:LongInt;
619	H:LongInt;
620	Add,Start:LongInt;
621	Begin
622	Result:=-1;
623	{$IFDEF OS2}
624	If FCanvas=Nil Then exit;
625	Info.hwnd:=Handle;
626	If WinQueryCursorInfo(HWND_DESKTOP,Info) Then
627	If Info.hwnd=Handle Then
628	Begin
629	Result:=Info.X;
630	s:=Text;
631	If BorderStyle=bsNone Then Add:=0
632	Else Add:=3;
633	X:=Add;
634	t:=0;
635	Start:=WinSendMsg(Handle,EM_QUERYFIRSTCHAR,0,0);
636	FCanvas.Font:=Font;
637
638	While ((Start+t+1<=length(s))And(X<Result)) Do
639	Begin
640	t:=t+1;
641	s1:=Copy(s,Start+1,t);
642	FCanvas.GetTextExtent(s1,X,H);
643	X:=X+Add;
644	End;
645
646	If X>=Result Then Result:=Start+t
647	Else Result:=0;
648	End;
649	{$ENDIF}
650	End;
651
652	Procedure TMaskEdit.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
653	Begin
654	End;
655
656	Function TMaskEdit.GetCurrentMask(Position:LongInt;
657	Var UpLowCase:Byte;Var Blanks:Boolean):PChar;
658	Var t:LongInt;
659	EditPos:LongInt;
660	Begin
661	Result:=Nil;
662	UpLowCase:=0;
663	Blanks:=False;
664
665	If Position>=0 Then
666	Begin
667	EditPos:=0;
668	t:=1;
669	While t<=length(FEditMask) Do
670	Begin
671	If FEditMask[t]=MaskFieldSeparator Then exit;
672
673	If Position=EditPos Then
674	If not (FEditMask[t] In [mDirUpperCase,mDirLowerCase,mDirReverse]) Then
675	Begin
676	Result:=@FEditMask[t];
677	exit;
678	End;
679
680	Case FEditMask[t] Of
681	mDirLiteral: //Literal character
682	Begin
683	t:=t+2;
684	inc(EditPos);
685	End;
686	mDirUpperCase: //all upcase
687	Begin
688	UpLowCase:=1;
689	t:=t+1;
690	End;
691	mDirLowerCase: //all lowcase
692	Begin
693	UpLowCase:=2;
694	t:=t+1;
695	End;
696	mDirReverse: //blanks
697	Begin
698	Blanks:=True;
699	t:=t+1;
700	End;
701	Else
702	Begin
703	t:=t+1;
704	inc(EditPos);
705	End;
706	End;
707	End;
708	End;
709	End;
710
711	Procedure TMaskEdit.UpdateCursorPos;
712	Var Position,Pos1:LongInt;
713	CurrentMask:^CString;
714	UpLowCase:Byte;
715	Blanks:Boolean;
716	Label again;
717	Begin
718	Position:=GetCursorPos;
719	again:
720	If ((Position<0)Or(Position>length(FEditMask))) Then exit;
721	CurrentMask:=GetCurrentMask(Position,UpLowCase,Blanks);
722	If CurrentMask=Nil Then exit;
723
724	Case CurrentMask^[0] Of
725	mMskAlpha,mMskAlphaOpt,mMskAlphaNum,mMskAlphaNumOpt,
726	mMskAscii,mMskAsciiOpt,mMskNumeric,mMskNumericOpt,mMskNumSymOpt:;
727	Else
728	Begin
729	{$IFDEF OS2}
730	WinSendMsg(Handle,WM_CHAR,KC_VIRTUALKEY OR KC_SCANCODE OR KC_TOGGLE,
731	224 Or (VK_RIGHT SHL 16));
732	{$ENDIF}
733	Pos1:=GetCursorPos;
734	If Pos1<>Position Then
735	Begin
736	Position:=Pos1;
737	goto again;
738	End;
739	End;
740	End;
741	End;
742
743	Procedure TMaskEdit.CharEvent(Var key:Char;RepeatCount:Byte);
744	Var Position:LongInt;
745	CurrentMask:PChar;
746	UpLowCase:Byte;
747	Blanks:Boolean;
748	Valid:Boolean;
749	s:String;
750	Msg:PMessage;
751	Begin
752	If not IsMasked Then
753	Begin
754	Inherited CharEvent(key,RepeatCount);
755	exit;
756	End;
757
758	UpdateCursorPos;
759
760	Position:=GetCursorPos;
761
762	If ((Position<0)Or(Position>length(FEditMask))) Then
763	Begin
764	key:=#0;
765	exit;
766	End;
767
768	CurrentMask:=GetCurrentMask(Position,UpLowCase,Blanks);
769	If CurrentMask=Nil Then
770	Begin
771	key:=#0;
772	exit;
773	End;
774
775	If key=#32 Then
776	Begin
777	key:=FMaskBlank;
778	Valid:=True;
779	End
780	Else
781	Begin
782	Valid:=False;
783	Case CurrentMask^[0] Of
784	mDirLiteral:;
785	mMskAlpha,mMskAlphaOpt: //Alpha
786	Begin
787	If Key In ['A'..'Z','a'..'z'] Then
788	Valid:=True;
789	End;
790	mMskAlphaNum,mMskAlphaNumOpt: //Alpha and Num
791	Begin
792	If Key In ['A'..'Z','a'..'z','0'..'9'] Then
793	Valid:=True;
794	End;
795	mMskNumeric,mMskNumericOpt: //any number
796	Begin
797	If Key In ['0'..'9'] Then
798	Valid:=True;
799	End;
800	mMskNumSymOpt: //any number and +,-
801	Begin
802	If Key In ['0'..'9','+','-'] Then
803	Valid:=True;
804	End;
805	mMskAscii,mMskAsciiOpt: //Any Char
806	Begin
807	Valid:=True;
808	End;
809	End;
810	End;
811
812	If Valid Then
813	Begin
814	If UpLowCase=1 Then Key:=Upcase(Key)
815	Else If UpLowCase=2 Then
816	Begin
817	s:=LowerCase(Key);
818	Key:=s[1];
819	End;
820	Inherited CharEvent(key,RepeatCount);
821	End
822	Else key:=#0;
823
824	If key<>#0 Then
825	Begin
826	Asm
827	PUSH DWORD PTR SELF
828	CALLN32 Forms.GetLastMsgAdr
829	MOV Msg,EAX
830	End;
831	If Msg<>Nil Then TWMCHAR(Msg^).CharCode:=ord(key);
832	LastMsg.CallDefaultHandler;
833	UpdateCursorPos;
834	End;
835	End;
836
837	Procedure TMaskEdit.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
838	Var Position,Pos1:LongInt;
839	CurrentMask:PChar;
840	UpLowCase:Byte;
841	Blanks:Boolean;
842	s:String;
843	t:LongInt;
844	SStart,SLen:LongInt;
845	Label again;
846	Begin
847	If not IsMasked Then
848	Begin
849	Inherited ScanEvent(KeyCode,RepeatCount);
850	exit;
851	End;
852
853	If keycode<>kbNull Then
854	Begin
855	Case keycode of
856	kbIns:
857	Begin
858	KeyCode:=kbNull;
859	exit;
860	End;
861	kbShiftIns: //Insert from clipboard
862	Begin
863	{$IFDEF OS2}
864	If ClipBoard.HasFormat(CF_TEXT) Then
865	Begin
866	s:=Inherited Text;
867	ClipBoard.Open(Handle);
868	CurrentMask:=PChar(ClipBoard.GetData(CF_TEXT));
869	If CurrentMask<>Nil Then Inherited Text:=CurrentMask^;
870	ClipBoard.Close;
871	//check if the text is valid
872	Try
873	ValidateEdit;
874	Except
875	//Ignore error
876	Inherited Text:=s;
877	End;
878	End;
879	{$ENDIF}
880	KeyCode:=kbNull;
881	exit;
882	End;
883	kbBkSp:
884	Begin
885	{$IFDEF OS2}
886	WinSendMsg(Handle,WM_CHAR,KC_VIRTUALKEY OR KC_SCANCODE OR KC_TOGGLE,
887	224 Or (VK_LEFT SHL 16));
888	WinSendMsg(Handle,WM_CHAR,KC_CHAR OR KC_TOGGLE OR KC_SCANCODE OR KC_VIRTUALKEY Or
889	(57 Shl 24),
890	32 Or (VK_SPACE Shl 16));
891	WinSendMsg(Handle,WM_CHAR,KC_VIRTUALKEY OR KC_SCANCODE OR KC_TOGGLE,
892	224 Or (VK_LEFT SHL 16));
893	{$ENDIF}
894	keycode:=kbNull;
895	exit;
896	End;
897	kbDel:
898	Begin
899	//check selection
900	If ((SelStart>=0)And(SelLength>1)) Then
901	Begin
902	SStart:=SelStart;
903	SLen:=SelLength;
904
905	s:=Text;
906	For t:=SelStart+1 To SelStart+SelLength Do
907	Begin
908	CurrentMask:=GetCurrentMask(t-1,UpLowCase,Blanks);
909	If CurrentMask<>Nil Then
910	Begin
911	If CurrentMask^[0] In
912	[mMskAlpha,mMskAlphaOpt,mMskAlphaNum,mMskAlphaNumOpt,
913	mMskAscii,mMskAsciiOpt,mMskNumeric,mMskNumericOpt,mMskNumSymOpt] Then
914	s[t]:=FMaskBlank;
915	End;
916	End;
917	Inherited Text:=s;
918	keycode:=kbNull;
919
920	SelStart:=SStart;
921	SelLength:=SLen;
922
923	exit;
924	End;
925
926	{$IFDEF OS2}
927	WinSendMsg(Handle,WM_CHAR,KC_CHAR OR KC_TOGGLE OR KC_SCANCODE OR KC_VIRTUALKEY Or
928	(57 Shl 24),
929	32 Or (VK_SPACE Shl 16));
930	WinSendMsg(Handle,WM_CHAR,KC_VIRTUALKEY OR KC_SCANCODE OR KC_TOGGLE,
931	224 Or (VK_LEFT SHL 16));
932	{$ENDIF}
933	keycode:=kbNull;
934	exit;
935	End;
936	kbCLeft:
937	Begin
938	Position:=GetCursorPos;
939	If Position=1 Then
940	Begin
941	CurrentMask:=GetCurrentMask(Position-1,UpLowCase,Blanks);
942	If CurrentMask=Nil Then
943	Begin
944	keycode:=kbNull;
945	exit;
946	End;
947
948	Case CurrentMask^[0] Of
949	mMskAlpha,mMskAlphaOpt,mMskAlphaNum,mMskAlphaNumOpt,
950	mMskAscii,mMskAsciiOpt,mMskNumeric,mMskNumericOpt,mMskNumSymOpt:;
951	Else If Position>0 Then
952	Begin
953	keycode:=kbNull;
954	exit;
955	End;
956	End;
957	End;
958	End;
959	End; //case
960
961	LastMsg.CallDefaultHandler;
962
963	If KeyCode In [kbCR{$IFDEF OS2},kbEnter{$ENDIF}] Then
964	Begin
965	KeyCode:=kbNull;
966	exit;
967	End;
968	End;
969
970	Position:=GetCursorPos;
971
972	If ((Position<0)Or(Position>length(FEditMask))) Then
973	Begin
974	keycode:=kbNull;
975	exit;
976	End;
977
978	If keycode=kbCLeft Then
979	Begin
980	again:
981	CurrentMask:=GetCurrentMask(Position,UpLowCase,Blanks);
982	If CurrentMask=Nil Then
983	Begin
984	keycode:=kbNull;
985	exit;
986	End;
987
988	Case CurrentMask^[0] Of
989	mMskAlpha,mMskAlphaOpt,mMskAlphaNum,mMskAlphaNumOpt,
990	mMskAscii,mMskAsciiOpt,mMskNumeric,mMskNumericOpt,mMskNumSymOpt:;
991	Else If Position>0 Then
992	Begin
993	{$IFDEF OS2}
994	WinSendMsg(Handle,WM_CHAR,KC_VIRTUALKEY OR KC_SCANCODE OR KC_TOGGLE,
995	224 Or (VK_LEFT SHL 16));
996	{$ENDIF}
997	Pos1:=GetCursorPos;
998	If Pos1<>Position Then If Pos1>0 Then
999	Begin
1000	Position:=Pos1;
1001	goto again;
1002	End;
1003	End;
1004	End;
1005	End;
1006
1007	UpdateCursorPos;
1008	End;
1009
1010	{
1011	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1012	º º
1013	º Speed-Pascal/2 Version 2.0 º
1014	º º
1015	º Speed-Pascal Component Classes (SPCC) º
1016	º º
1017	º This section: TMaskEditTextPropertyEditor Class implementation º
1018	º º
1019	º Last modified: January 1998 º
1020	º º
1021	º (C) 1998 SpeedSoft. All rights reserved. Disclosure probibited ! º
1022	º º
1023	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1024	}
1025
1026
1027	Type
1028	TMaskEditTextPropertyEditor=Class(TStringPropertyEditor)
1029	Public
1030	Function Execute(Var Value:String;ValueLen:LONGINT):TPropertyEditorReturn;Override;
1031	End;
1032
1033	Type
1034	TMaskEditTextPropEditDialog=Class(TDialog)
1035	Procedure SetupDlg;
1036	End;
1037
1038
1039	Procedure TMaskEditTextPropEditDialog.SetupDlg;
1040	Begin
1041	Caption:='Maked Text Editor';
1042	Width:=420;
1043	Height:=400;
1044	XAlign:=xaCenter;
1045	YAlign:=yaCenter;
1046	Color:=clLtGray;
1047	BorderStyle := bsDialog;
1048	BorderIcons := [biSystemMenu];
1049
1050	InsertBitBtn(Self,20,10,90,30,bkOk,'~Ok','Click here to accept');
1051	InsertBitBtn(Self,120,10,90,30,bkCancel,'~Cancel','Click here to cancel');
1052	InsertBitBtn(Self,220,10,90,30,bkHelp,'~Help','Click here to get help');
1053	End;
1054
1055
1056	Function TMaskEditTextPropertyEditor.Execute(Var Value:String;ValueLen:LONGINT):TPropertyEditorReturn;
1057	VAR
1058	MaskEdit:TMaskEdit;
1059	Dlg:TMaskEditTextPropEditDialog;
1060	Begin
1061	MaskEdit:=TMaskEdit(Owner);
1062
1063	Dlg.Create(Nil);
1064	Dlg.SetupDlg;
1065
1066	If Dlg.Execute Then
1067	Begin
1068	Value:='';
1069	result:=edOk;
1070	End
1071	Else result:=edCancel;
1072	Dlg.Destroy;
1073	End;
1074
1075	{
1076	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1077	º º
1078	º Speed-Pascal/2 Version 2.0 º
1079	º º
1080	º Speed-Pascal Component Classes (SPCC) º
1081	º º
1082	º This section: TMaskEditTextPropertyEditor Class implementation º
1083	º º
1084	º Last modified: January 1998 º
1085	º º
1086	º (C) 1998 SpeedSoft. All rights reserved. Disclosure probibited ! º
1087	º º
1088	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1089	}
1090
1091	Type
1092	TMaskEditMaskPropertyEditor=CLASS(TStringPropertyEditor)
1093	Public
1094	Function Execute(Var Value:String;ValueLen:LONGINT):TPropertyEditorReturn;Override;
1095	End;
1096
1097	Type
1098	TMaskEditMaskPropEditDialog=Class(TDialog)
1099	Procedure SetupDlg;
1100	Procedure MasksClick(Sender:TObject);
1101	Procedure LoadMask(Const FileName:String);
1102	Procedure ClearItems;
1103	Procedure SetEditMask(NewMask:String);
1104	Procedure ListBoxItemFocus(Sender:TObject;Index:LongInt);
1105	Procedure EditTextInvalid(Sender:TObject);
1106	Procedure MaskChanged(Sender:TObject);
1107	Procedure BlankChanged(Sender:TObject);
1108	Procedure LiteralChanged(Sender:TObject);
1109
1110	ListBox:TListBox;
1111	Edit1,Edit2:TEdit;
1112	CheckBox:TCheckBox;
1113	MaskEdit:TMaskEdit;
1114	End;
1115
1116	Procedure TMaskEditMaskPropEditDialog.EditTextInvalid(Sender:TObject);
1117	Begin
1118	//do nothing
1119	End;
1120
1121	Procedure TMaskEditMaskPropEditDialog.LiteralChanged(Sender:TObject);
1122	Var s:String;
1123	b:Byte;
1124	s1,s2:String;
1125	Blank:Char;
1126	Begin
1127	s:=MaskEdit.EditMask;
1128	b:=pos(';',s);
1129	If b=0 Then exit;
1130	s1:=Copy(s,1,b-1);
1131	Delete(s,1,b);
1132	b:=pos(';',s);
1133	If b=0 Then exit;
1134	Delete(s,1,b);
1135	If CheckBox.Checked Then s1:=s1+';1'
1136	Else s1:=s1+';0';
1137	SetEditMask(s1+';'+s);
1138	End;
1139
1140
1141	Procedure TMaskEditMaskPropEditDialog.BlankChanged(Sender:TObject);
1142	Var s:String;
1143	b:Byte;
1144	s1,s2:String;
1145	Blank:String;
1146	Begin
1147	s:=MaskEdit.EditMask;
1148	b:=pos(';',s);
1149	If b=0 Then exit;
1150	s1:=Copy(s,1,b-1);
1151	Delete(s,1,b);
1152	b:=pos(';',s);
1153	If b=0 Then exit;
1154	s2:=Copy(s,1,b-1);
1155	If Edit2.Text='' Then Blank:=' '
1156	Else Blank:=Edit2.Text[1];
1157	SetEditMask(s1+';'+s2+';'+Blank);
1158	End;
1159
1160	Procedure TMaskEditMaskPropEditDialog.SetEditMask(NewMask:String);
1161	Begin
1162	Edit1.OnChange:=Nil;
1163	If Edit1.Text<>NewMask Then Edit1.Text:=NewMask;
1164	Edit1.OnChange:=MaskChanged;
1165	MaskEdit.EditMask:=NewMask;
1166	Edit2.OnChange:=Nil;
1167	If Edit2.Text<>MaskEdit.MaskBlank Then Edit2.Text:=MaskEdit.MaskBlank;
1168	Edit2.OnChange:=BlankChanged;
1169	CheckBox.Checked:=MaskEdit.MaskSave;
1170	End;
1171
1172	Procedure TMaskEditMaskPropEditDialog.MaskChanged(Sender:TObject);
1173	Begin
1174	SetEditMask(Edit1.Text);
1175	End;
1176
1177
1178	Procedure TMaskEditMaskPropEditDialog.ListBoxItemFocus(Sender:TObject;Index:LongInt);
1179	Var p:^String;
1180	Begin
1181	p:=Pointer(ListBox.Items.Objects[Index]);
1182	SetEditMask(p^);
1183	End;
1184
1185	Procedure TMaskEditMaskPropEditDialog.ClearItems;
1186	Var t:LongInt;
1187	p:^String;
1188	Begin
1189	For t:=0 To ListBox.Items.Count-1 Do
1190	Begin
1191	p:=Pointer(ListBox.Items.Objects[t]);
1192	DisposeStr(p);
1193	End;
1194	ListBox.Items.Clear;
1195	End;
1196
1197	Procedure TMaskEditMaskPropEditDialog.LoadMask(Const FileName:String);
1198	Var f:System.Text;
1199	s,s1,s2:String;
1200	p:^String;
1201	Mask:TMaskEdit;
1202	Save:Boolean;
1203	Begin
1204	System.Assign(f,FileName);
1205	{$I-}
1206	Reset(f);
1207	{$I+}
1208	If IoResult<>0 Then
1209	Begin
1210	ErrorBox('Cannot open:'+FileName);
1211	exit;
1212	End;
1213
1214	ClearItems;
1215	Mask.Create(Self);
1216	While not Eof(f) Do
1217	Begin
1218	{$I-}
1219	Readln(f,s);
1220	{$I+}
1221	If IoResult<>0 Then
1222	Begin
1223	ErrorBox('Cannot read file:'+FileName);
1224	break;
1225	End;
1226
1227	While s[length(s)]=#32 do dec(s[0]);
1228	If s='' Then continue;
1229
1230	If pos(';',s)=0 Then
1231	Begin
1232	ErrorBox('Illegal file format:'+FileName);
1233	break;
1234	End;
1235
1236	s1:=Copy(s,1,pos(';',s)-1);
1237	Delete(s,1,pos(';',s));
1238
1239	If pos(';',s)=0 Then
1240	Begin
1241	ErrorBox('Illegal file format:'+FileName);
1242	break;
1243	End;
1244
1245	s2:=Copy(s,1,pos(';',s)-1);
1246	Delete(s,1,pos(';',s));
1247
1248	Mask.EditMask:=s;
1249	p:=Nil;
1250	AssignStr(p,s);
1251
1252	Save:=Mask.FMaskSave;
1253	Mask.FMaskSave:=False;
1254	Mask.Text:=s2;
1255	Mask.FMaskSave:=True;
1256	s2:=Mask.Text;
1257	Mask.FMaskSave:=Save;
1258	ListBox.Items.AddObject(s1+' ('+s2+')',TObject(p));
1259	End;
1260	Mask.Destroy;
1261
1262	{$I-}
1263	System.Close(f);
1264	{$I+}
1265	End;
1266
1267	Procedure TMaskEditMaskPropEditDialog.MasksClick(Sender:TObject);
1268	Var OpenDialog:TOpenDialog;
1269	Dir,Name,Ext:String;
1270	OldDir:String;
1271	Begin
1272	OpenDialog.Create(Nil);
1273	OpenDialog.AddFilter('Edit Masks','*.msk');
1274
1275	FSplit(ParamStr(0),Dir,Name,Ext);
1276	If Dir[length(Dir)]='\' Then dec(Dir[0]);
1277
1278	GetDir(0,OldDir);
1279	{$I-}
1280	ChDir(Dir);
1281	{$I+}
1282
1283	OpenDialog.FileName:=Dir+'\*.msk';
1284	If OpenDialog.Execute Then LoadMask(OpenDialog.FileName);
1285
1286	{$I-}
1287	ChDir(OldDir);
1288	{$I+}
1289	End;
1290
1291	Procedure TMaskEditMaskPropEditDialog.SetupDlg;
1292	Var Button:TButton;
1293	Dir,Name,Ext:String;
1294	GroupBox:TGroupBox;
1295	Begin
1296	Caption:='EditMask Editor';
1297	Width:=460;
1298	Height:=350;
1299	XAlign:=xaCenter;
1300	YAlign:=yaCenter;
1301	Color:=clLtGray;
1302	BorderStyle := bsDialog;
1303	BorderIcons := [biSystemMenu];
1304
1305	Button:=InsertButton(Self,20,10,90,30,'~Masks...','Click here to load masks');
1306	Button.OnClick:=MasksClick;
1307
1308	InsertLabel(Self,200,275,100,20,'Sample Masks');
1309	ListBox:=InsertListBox(Self,200,60,240,215,'');
1310	ListBox.OnItemFocus:=ListBoxItemFocus;
1311
1312	InsertLabel(Self,15,275,100,20,'Input Mask');
1313	Edit1:=InsertEdit(Self,15,250,170,20,'','');
1314	Edit1.OnChange:=MaskChanged;
1315
1316	InsertLabel(Self,15,220,120,20,'Character for blanks:');
1317	Edit2:=InsertEdit(Self,145,220,30,20,'','');
1318	Edit2.OnChange:=BlankChanged;
1319
1320	CheckBox:=InsertCheckBox(Self,15,190,160,20,'Save literal characters','');
1321	CheckBox.OnClick:=LiteralChanged;
1322
1323	GroupBox:=InsertGroupBox(Self,15,130,170,50,'Test Input');
1324	MaskEdit:=InsertMaskEdit(GroupBox,10,10,150,20,'','');
1325	MaskEdit.OnEditTextInvalid:=EditTextInvalid;
1326
1327	InsertBitBtn(Self,120,10,90,30,bkOk,'~Ok','Click here to accept');
1328	InsertBitBtn(Self,220,10,90,30,bkCancel,'~Cancel','Click here to cancel');
1329	InsertBitBtn(Self,320,10,90,30,bkHelp,'~Help','Click here to get help');
1330
1331	FSplit(ParamStr(0),Dir,Name,Ext);
1332	If Dir[length(Dir)]='\' Then dec(Dir[0]);
1333	LoadMask(Dir+'\Germany.msk');
1334	End;
1335
1336
1337	Function TMaskEditMaskPropertyEditor.Execute(Var Value:String;ValueLen:LONGINT):TPropertyEditorReturn;
1338	VAR
1339	MaskEdit:TMaskEdit;
1340	Dlg:TMaskEditMaskPropEditDialog;
1341	Begin
1342	MaskEdit:=TMaskEdit(Owner);
1343
1344	Dlg.Create(Nil);
1345	Dlg.SetupDlg;
1346	Dlg.SetEditMask(MaskEdit.EditMask);
1347
1348	If Dlg.Execute Then
1349	Begin
1350	Value:=Dlg.MaskEdit.EditMask;
1351	result:=edOk;
1352	End
1353	Else result:=edCancel;
1354	Dlg.ClearItems;
1355	Dlg.Destroy;
1356	End;
1357
1358
1359	Initialization
1360	AddPropertyEditor(TMaskEdit,'EditMask',TMaskEditMaskPropertyEditor);
1361	AddPropertyEditor(TMaskEdit,'Text',TMaskEditTextPropertyEditor);
1362	End.

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format