source: trunk/Sibyl/SPCC/MASK.PAS@ 145

Last change on this file since 145 was 7, checked in by RBRi, 19 years ago

+ sibyl staff
  • Property svn:eol-style set to native
File size: 38.8 KB
Line 
1Unit Mask;
2
3Interface
4
5Uses Dos,Messages,SysUtils,Classes,Buttons,Forms,StdCtrls,Dialogs;
6
7Const
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
31Type
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
78Function InsertMaskEdit(parent:TControl;Left,Bottom,Width,Height:LongInt;
79 Text,Hint:String):TMaskEdit;
80
81Implementation
82
83Function InsertMaskEdit(parent:TControl;Left,Bottom,Width,Height:LongInt;
84 Text,Hint:String):TMaskEdit;
85Begin
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;
92End;
93
94
95{$IFDEF OS2}
96Uses 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
115Procedure TMaskEdit.SetupComponent;
116Begin
117 Inherited SetupComponent;
118
119 Name:='MaskEdit';
120 FMaskBlank:=DefaultBlank;
121 FMaskSave:=False;
122 InsertMode:=False;
123 OnCloseQuery:=CloseQuery;
124End;
125
126Procedure TMaskEdit.EditTextInvalid;
127Begin
128 If FOnEditTextInvalid<>Nil Then FOnEditTextInvalid(Self)
129 Else Raise EEditTextInvalid.Create(EditTextExceptionMsg);
130End;
131
132Procedure TMaskEdit.ParentNotification(Var Msg:TMessage);
133Begin
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}
152End;
153
154Procedure TMaskEdit.CloseQuery(Sender:TObject;Var CanClose:Boolean);
155Begin
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;
167End;
168
169Function TMaskEdit.ValidateEdit:Boolean;
170Var s,s1:String;
171 t:LongInt;
172 t1:LongInt;
173 CurrentMask:^CString;
174 UpLowCase:Byte;
175 Blanks:Boolean;
176Label error;
177Begin
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
276error:
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;
313End;
314
315Function TMaskEdit.GetText:String;
316Var t,t1:Longint;
317 CurrentMask:^CString;
318Begin
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;
358End;
359
360Procedure TMaskEdit.SetText(Const NewValue:String);
361Var s,s1:String;
362 t,t1:LongInt;
363 CurrentMask:^CString;
364 UpLowCase:Byte;
365 Blanks:Boolean;
366Begin
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;
499End;
500
501Function TMaskEdit.GetIsMasked:Boolean;
502Begin
503 Result:=FEditMask<>'';
504End;
505
506Function TMaskEdit.GetEditText:String;
507Begin
508 Result:=Inherited Text;
509End;
510
511Procedure TMaskEdit.SetEditText(Const NewValue:String);
512Var s:String;
513Begin
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;
523End;
524
525Procedure TMaskEdit.SetEditMask(Const NewValue:String);
526Var s,s1:String;
527 t:LongInt;
528 SepCount:Byte;
529Begin
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;
601End;
602
603Procedure TMaskEdit.SetupShow;
604Begin
605 Inherited SetupShow;
606
607 FCanvas.Create(Self);
608 FCanvas.Init;
609End;
610
611Function TMaskEdit.GetCursorPos:LongInt;
612Var
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;
621Begin
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}
650End;
651
652Procedure TMaskEdit.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
653Begin
654End;
655
656Function TMaskEdit.GetCurrentMask(Position:LongInt;
657 Var UpLowCase:Byte;Var Blanks:Boolean):PChar;
658Var t:LongInt;
659 EditPos:LongInt;
660Begin
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;
709End;
710
711Procedure TMaskEdit.UpdateCursorPos;
712Var Position,Pos1:LongInt;
713 CurrentMask:^CString;
714 UpLowCase:Byte;
715 Blanks:Boolean;
716Label again;
717Begin
718 Position:=GetCursorPos;
719again:
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;
741End;
742
743Procedure TMaskEdit.CharEvent(Var key:Char;RepeatCount:Byte);
744Var Position:LongInt;
745 CurrentMask:PChar;
746 UpLowCase:Byte;
747 Blanks:Boolean;
748 Valid:Boolean;
749 s:String;
750 Msg:PMessage;
751Begin
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;
835End;
836
837Procedure TMaskEdit.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
838Var Position,Pos1:LongInt;
839 CurrentMask:PChar;
840 UpLowCase:Byte;
841 Blanks:Boolean;
842 s:String;
843 t:LongInt;
844 SStart,SLen:LongInt;
845Label again;
846Begin
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
980again:
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;
1008End;
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
1027Type
1028 TMaskEditTextPropertyEditor=Class(TStringPropertyEditor)
1029 Public
1030 Function Execute(Var Value:String;ValueLen:LONGINT):TPropertyEditorReturn;Override;
1031 End;
1032
1033Type
1034 TMaskEditTextPropEditDialog=Class(TDialog)
1035 Procedure SetupDlg;
1036 End;
1037
1038
1039Procedure TMaskEditTextPropEditDialog.SetupDlg;
1040Begin
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');
1053End;
1054
1055
1056Function TMaskEditTextPropertyEditor.Execute(Var Value:String;ValueLen:LONGINT):TPropertyEditorReturn;
1057VAR
1058 MaskEdit:TMaskEdit;
1059 Dlg:TMaskEditTextPropEditDialog;
1060Begin
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;
1073End;
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
1091Type
1092 TMaskEditMaskPropertyEditor=CLASS(TStringPropertyEditor)
1093 Public
1094 Function Execute(Var Value:String;ValueLen:LONGINT):TPropertyEditorReturn;Override;
1095 End;
1096
1097Type
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
1116Procedure TMaskEditMaskPropEditDialog.EditTextInvalid(Sender:TObject);
1117Begin
1118 //do nothing
1119End;
1120
1121Procedure TMaskEditMaskPropEditDialog.LiteralChanged(Sender:TObject);
1122Var s:String;
1123 b:Byte;
1124 s1,s2:String;
1125 Blank:Char;
1126Begin
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);
1138End;
1139
1140
1141Procedure TMaskEditMaskPropEditDialog.BlankChanged(Sender:TObject);
1142Var s:String;
1143 b:Byte;
1144 s1,s2:String;
1145 Blank:String;
1146Begin
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);
1158End;
1159
1160Procedure TMaskEditMaskPropEditDialog.SetEditMask(NewMask:String);
1161Begin
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;
1170End;
1171
1172Procedure TMaskEditMaskPropEditDialog.MaskChanged(Sender:TObject);
1173Begin
1174 SetEditMask(Edit1.Text);
1175End;
1176
1177
1178Procedure TMaskEditMaskPropEditDialog.ListBoxItemFocus(Sender:TObject;Index:LongInt);
1179Var p:^String;
1180Begin
1181 p:=Pointer(ListBox.Items.Objects[Index]);
1182 SetEditMask(p^);
1183End;
1184
1185Procedure TMaskEditMaskPropEditDialog.ClearItems;
1186Var t:LongInt;
1187 p:^String;
1188Begin
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;
1195End;
1196
1197Procedure TMaskEditMaskPropEditDialog.LoadMask(Const FileName:String);
1198Var f:System.Text;
1199 s,s1,s2:String;
1200 p:^String;
1201 Mask:TMaskEdit;
1202 Save:Boolean;
1203Begin
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+}
1265End;
1266
1267Procedure TMaskEditMaskPropEditDialog.MasksClick(Sender:TObject);
1268Var OpenDialog:TOpenDialog;
1269 Dir,Name,Ext:String;
1270 OldDir:String;
1271Begin
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+}
1289End;
1290
1291Procedure TMaskEditMaskPropEditDialog.SetupDlg;
1292Var Button:TButton;
1293 Dir,Name,Ext:String;
1294 GroupBox:TGroupBox;
1295Begin
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');
1334End;
1335
1336
1337Function TMaskEditMaskPropertyEditor.Execute(Var Value:String;ValueLen:LONGINT):TPropertyEditorReturn;
1338VAR
1339 MaskEdit:TMaskEdit;
1340 Dlg:TMaskEditMaskPropEditDialog;
1341Begin
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;
1356End;
1357
1358
1359Initialization
1360 AddPropertyEditor(TMaskEdit,'EditMask',TMaskEditMaskPropertyEditor);
1361 AddPropertyEditor(TMaskEdit,'Text',TMaskEditTextPropertyEditor);
1362End.
Note: See TracBrowser for help on using the repository browser.