home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / listings / v_02_11 / 2n11032a < prev    next >
Text File  |  1991-10-11  |  9KB  |  334 lines
  1. unit MaskEdit;
  2.  
  3. interface
  4.  
  5. uses WObjects, WinTypes, WinProcs, Strings;
  6.  
  7. const
  8.     MAX_MASK_EDIT = 32;
  9.  
  10. type
  11.     TMaskEdit = object(TEdit)
  12.         EditLength
  13.             : integer;
  14.         Mask, Pattern
  15.             : array [0..MAX_MASK_EDIT] of char;
  16.         constructor Init(AParent : PWindowsObject;
  17.             Id : integer; MaskPattern : PChar;
  18.             x, y, w, h, TextLength : integer);
  19.         procedure ValidateCursor(Forward:boolean);
  20.         procedure PutChar(AChar : char);
  21.         procedure Delete(Forward:boolean; Message:TMessage);
  22.         procedure InputChar(Pressed:char;
  23.             StartPos, EndPos : integer); virtual;
  24.     private
  25.         procedure WM_Char(var Message:TMessage);
  26.             virtual wm_First + wm_Char;
  27.         procedure WMLButtonUp(var Message:TMessage);
  28.             virtual wm_First + wm_LButtonUp;
  29.         procedure WMKeyDown(var Message:TMessage);
  30.             virtual wm_First + wm_KeyDown;
  31.         procedure WMSetFocus(var Message:TMessage);
  32.             virtual wm_First + wm_SetFocus;
  33.     end;
  34.     PMaskEdit = ^TMaskEdit;
  35.  
  36. implementation
  37.  
  38. { Shifted - TRUE if Shift key is pressed }
  39.  
  40. function Shifted:boolean;
  41. begin
  42.     Shifted := (GetKeyState(VK_SHIFT) AND $8000) <> 0;
  43. end;
  44.  
  45. { Control - TRUE if Control key is pressed }
  46.  
  47. function Control:boolean;
  48. begin
  49.     Control := (GetKeyState(VK_CONTROL) AND $8000) <> 0;
  50. end;
  51.  
  52. { Init - Constructor for TMaskEdit }
  53.  
  54. constructor TMaskEdit.Init(AParent : PWindowsObject; Id : integer;
  55.     MaskPattern : PChar; x, y, w, h, TextLength : integer);
  56.  
  57. var
  58.     i, iMask, iPattern
  59.         : integer;
  60.     CharCode
  61.         : char;
  62.     Special
  63.         : boolean;
  64. begin
  65.     iMask        := 0;
  66.     i            := 0;
  67.     while (MaskPattern[i] <> #0)
  68.             AND (i < MAX_MASK_EDIT)
  69.             AND (i < TextLength) do
  70.         begin
  71.         CharCode    := MaskPattern[i];
  72.         { Alphabetics are pattern characters }
  73.         Special        := CharCode in ['A'..'Z','a'..'z'];
  74.         { Unless preceded by backslash }
  75.         if CharCode = '\' then
  76.             begin
  77.             i    := i + 1;
  78.             if i <= TextLength then
  79.                 CharCode    := MaskPattern[i];
  80.             end;
  81.         if Special then
  82.             begin
  83.             Mask[iMask]       := ' ';
  84.             Pattern[iMask]    := CharCode;
  85.             end
  86.         else
  87.             begin
  88.             Mask[iMask]       := CharCode;
  89.             Pattern[iMask]    := ' ';
  90.             end;
  91.         iMask    := iMask+1;
  92.         i        := i+1;
  93.         end;
  94.     Mask[iMask]    := #0;
  95.     Pattern[iMask]    := #0;
  96.     EditLength    := iMask;
  97.     TEdit.Init(AParent, Id, @Mask, x, y, w, h, iMask+1, FALSE);
  98. end;
  99.  
  100. { ValidateCursor - Position cursor on non-literal }
  101.  
  102. procedure TMaskEdit.ValidateCursor(Forward:boolean);
  103. var
  104.     StartPos, EndPos, iMask, Increment
  105.         : integer;
  106.     FoundStart
  107.         : integer;
  108.  
  109. function  ValidatePos : boolean;
  110. var
  111.     Pos    : integer;
  112. begin
  113.     Pos        := iMask;
  114.     if (Pos < 0) or (Pos >= EditLength) then
  115.         ValidatePos    := FALSE
  116.     else
  117.  
  118.         ValidatePos    := (Pattern[Pos] <> ' ');
  119. end;
  120. begin
  121.     GetSelection(StartPos, EndPos);
  122.     FoundStart    := -1;
  123.     if Forward then Increment := 1 else Increment := -1;
  124.     iMask        := StartPos;
  125.     while iMask <> FoundStart do
  126.         if ValidatePos then
  127.             FoundStart    := iMask
  128.         else
  129.             begin
  130.             iMask        := iMask + Increment;
  131.             { Reverse direction, if necessary }
  132.             if (iMask < 0) or (iMask >= EditLength) then
  133.                 begin
  134.                 Increment    := -Increment;
  135.                 iMask        := iMask + Increment;
  136.                 end;
  137.             end;
  138.     SetSelection(FoundStart, FoundStart+1);
  139. end;
  140.  
  141. { Delete - Delete current selection, maintain mask }
  142.  
  143. procedure TMaskEdit.Delete(Forward:boolean; Message:TMessage);
  144. var
  145.     StartPos, EndPos, iMask
  146.         : Integer;
  147.     Finished    : boolean;
  148.     Buffer      : array[0..MAX_MASK_EDIT] of char;
  149. begin
  150.     GetSelection(StartPos, EndPos);
  151.     for iMask := StartPos to EndPos-1 do
  152.         Buffer[iMask-StartPos]    := Mask[iMask];
  153.     Buffer[EndPos-StartPos]    := #0;
  154.     DefWndProc(Message);
  155.     Insert(@Buffer);
  156.     SetSelection(StartPos, StartPos+1);
  157.  
  158.     { Special futzing for backspace }
  159.     if not(Forward) then
  160.         begin
  161.         if StartPos > 0 then  StartPos := StartPos-1;
  162.         SetSelection(StartPos, StartPos);
  163.         ValidateCursor(Forward);
  164.         Insert(' ');
  165.         SetSelection(StartPos, StartPos+1);
  166.         ValidateCursor(Forward);
  167.         end;
  168. end;
  169.  
  170. { PutChar - Replace current selection with a character }
  171.  
  172. procedure TMaskEdit.PutChar(AChar:char);
  173. var
  174.     StartPos, EndPos
  175.         : Integer;
  176.     Dummy
  177.         : array[0..2] of char;
  178.  
  179. begin
  180.     Dummy[0]    := AChar;
  181.     Dummy[1]    := chr(0);
  182.     Insert(@Dummy);
  183.     ValidateCursor(TRUE);
  184. end;
  185.  
  186. { WMKeyDown - Handle delete and insert and
  187.               maintain overwrite mode }
  188.  
  189. procedure TMaskEdit.WMKeyDown(var Message:TMessage);
  190. var
  191.     StartPos, EndPos, CursorPos, MaxPos
  192.         : integer;
  193.     ClipDataPtr
  194.         : PChar;
  195.     ClipData
  196.         : array [0..MAX_MASK_EDIT] of char;
  197.     ClipDataHandle
  198.         : THandle;
  199. begin
  200.     { If Pasting into control, handle it ourselves }
  201.     if (Message.WParam = VK_INSERT) AND not(Control) then
  202.         begin
  203.         if not(Shifted) then
  204.             { We don't support insert mode, so beep }
  205.             MessageBeep(0)
  206.         else
  207.             if not(OpenClipboard(HWindow)) then
  208.                 MessageBeep(0)
  209.             else
  210.                 begin
  211.                 ClipDataHandle   := GetClipboardData(CF_TEXT);
  212.                 if ClipDataHandle = 0 then
  213.                     begin
  214.                     MessageBeep(0);
  215.                     CloseClipBoard;
  216.                     end
  217.                 else
  218.                     begin
  219.                     ClipDataPtr := GlobalLock(ClipDataHandle);
  220.                     StrLCopy(ClipData,ClipDataPtr,MAX_MASK_EDIT);
  221.                     GlobalUnlock(ClipDataHandle);
  222. { Always close clipboard before generating Windows messages }
  223.                     CloseClipBoard;
  224.                     GetSelection(StartPos,EndPos);
  225.                     MaxPos    := StartPos + StrLen(ClipData);
  226.                     if MaxPos > EditLength then
  227.                         MaxPos   := EditLength;
  228.                     if MaxPos > EndPos-1 then
  229.                         MaxPos   := EndPos-1;
  230.                     for CursorPos := StartPos to MaxPos do
  231.                         begin
  232.                         SetSelection(CursorPos, CursorPos+1);
  233.                         InputChar(ClipData[CursorPos-StartPos],
  234.                             CursorPos, CursorPos+1);
  235.                         end;
  236.                     end;
  237.                 end;
  238.         end
  239.  
  240.     else if Message.WParam = VK_DELETE then
  241.         Delete(TRUE, Message)
  242.     else
  243.         DefWndProc(Message);
  244.  
  245.     GetSelection(StartPos, EndPos);
  246.  
  247.     if Message.WParam = VK_LEFT then
  248.         begin
  249.         if not(Shifted) then
  250.             begin
  251.             if StartPos > 0 then
  252.                 StartPos    := StartPos - 1;
  253.             EndPos        := StartPos + 1;
  254.             SetSelection(StartPos, EndPos);
  255.             end
  256.         end
  257.     else if Message.WParam = VK_RIGHT then
  258.         begin
  259.         if (StartPos = EndPos) AND not(Shifted) then
  260.             SetSelection(StartPos-1,StartPos);
  261.         end;
  262.  
  263. end;
  264.  
  265. { WMLButtonUp - Ensure we stay in overwrite mode }
  266.  
  267. procedure TMaskEdit.WMLButtonUp(var Message:TMessage);
  268. var
  269.     StartPos, EndPos
  270.         : integer;
  271. begin
  272.     DefWndProc(Message);
  273.     GetSelection(StartPos, EndPos);
  274.     if StartPos = EndPos then
  275.         SetSelection(StartPos, StartPos+1);
  276. end;
  277.  
  278. { WMSetFocus - Position cursor on non-literal character }
  279.  
  280. procedure TMaskEdit.WMSetFocus(var Message:TMessage);
  281. begin
  282.     DefWndProc(Message);
  283.     ValidateCursor(TRUE);
  284. end;
  285.  
  286. { InputChar - Virtual handler for input characters }
  287.  
  288. procedure TMaskEdit.InputChar(Pressed:char; StartPos, EndPos : integer);
  289. begin
  290.     case Pattern[StartPos] of
  291.         'n' :   { Only allow numerics }
  292.             if Pressed in ['0'..'9'] then
  293.                 PutChar(Pressed)
  294.             else
  295.                 MessageBeep(0);
  296.         'a' :   { Only allow alphabetics }
  297.             if Pressed in ['a'..'z','A'..'Z'] then
  298.                 PutChar(Pressed)
  299.             else
  300.  
  301.                 MessageBeep(0);
  302.         else
  303.             if Pressed = Mask[StartPos] then
  304.                 PutChar(Pressed)
  305.             else
  306.                 MessageBeep(0);
  307.         end;
  308. end;
  309.  
  310. { WM_Char - Handle input characters }
  311.  
  312. procedure TMaskEdit.WM_Char(var Message:TMessage);
  313. var
  314.     StartPos, EndPos
  315.         : integer;
  316.     Pressed
  317.         : char;
  318. begin
  319.     Pressed    := Chr(Message.WParam);
  320.     GetSelection(StartPos, EndPos);
  321.     if Message.WParam = VK_BACK then
  322.         Delete(FALSE, Message)
  323.     else
  324.         InputChar(Pressed, StartPos, EndPos);
  325.     GetSelection(StartPos, EndPos);
  326.     if StartPos = EndPos then
  327.         SetSelection(StartPos, StartPos+1);
  328. end;
  329.  
  330. end.
  331.  
  332. { End of File } 
  333.  
  334.