home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d56 / TDSOFT.ZIP / TDSuperEdit.pas < prev    next >
Pascal/Delphi Source File  |  2001-05-30  |  8KB  |  332 lines
  1. unit TDSuperEdit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TTDSuperEdit = class(TEdit)
  11.   private
  12.     OldWidth, OldHeight: Cardinal;
  13.     OldColor: TColor;
  14.     FDialogFrame: Boolean;
  15.     FSizeBox: Boolean;
  16.     FMultiLine: Boolean;
  17.     FOnlyNumber: Boolean;
  18.     FAlignment: TAlignment;
  19.     FFloat: Boolean;
  20.     FHScroll: Boolean;
  21.     FVScroll: Boolean;
  22.     FOnFocusColor: TColor;
  23.     FToRightWinControl: TWinControl;
  24.     FToLeftWinControl: TWinControl;
  25.     FToUpWinControl: TWinControl;
  26.     FToDownWinControl: TWinControl;
  27.     FUseArrowNavigation: Boolean;
  28.     procedure SetDialogFrame(const Value: Boolean);
  29.     procedure SetSizeBox(const Value: Boolean);
  30.     procedure SetMultiLine(const Value: Boolean);
  31.     procedure SetOnlyNumber(const Value: Boolean);
  32.     procedure SetAlignment(const Value: TAlignment);
  33.     procedure SetFloat(const Value: Boolean);
  34.     procedure SetHScroll(const Value: Boolean);
  35.     procedure SetVScroll(const Value: Boolean);
  36.     procedure SetOnFocusColor(const Value: TColor);
  37.     procedure SetToDownWinControl(const Value: TWinControl);
  38.     procedure SetToLeftWinControl(const Value: TWinControl);
  39.     procedure SetToRightWinControl(const Value: TWinControl);
  40.     procedure SetToUpWinControl(const Value: TWinControl);
  41.     { Private declarations }
  42.   protected
  43.     { Protected declarations }
  44.     procedure CreateParams(var Params: TCreateParams); override;
  45.     procedure WMLBUTTONDOWN (var Msg: TMessage); message WM_LBUTTONDOWN;
  46.     procedure WMLBUTTONUP (var Msg: TMessage); message WM_LBUTTONUP;    
  47.     procedure WMSETFOCUS (var Msg: TMessage); message WM_SETFOCUS;
  48.     procedure WMKILLFOCUS (var Msg: TMessage); message WM_KILLFOCUS;
  49.     procedure WMKEYDOWN (var Msg: TMessage); message WM_KEYDOWN;
  50.  
  51.     procedure SaveSize;
  52.     procedure RestoreSize;
  53.   public
  54.     { Public declarations }
  55.     constructor Create(AOwner: TComponent); override;
  56.   published
  57.     { Published declarations }
  58.     property DialogFrame: Boolean read FDialogFrame write SetDialogFrame;
  59.     property SizeBox: Boolean read FSizeBox write SetSizeBox;
  60.     property MultiLine: Boolean read FMultiLine Write SetMultiLine;
  61.     property OnlyNumber: Boolean read FOnlyNumber write SetOnlyNumber;
  62.     property Alignment: TAlignment read FAlignment write SetAlignment;
  63.     property Float: Boolean read FFloat write SetFloat;
  64.     property HScroll: Boolean read FHScroll write SetHScroll;
  65.     property VScroll: Boolean read FVScroll write SetVScroll;
  66.  
  67.     property OnFocusColor: TColor read FOnFocusColor write SetOnFocusColor;
  68.     property ToUpControl: TWinControl read FToUpWinControl write SetToUpWinControl;
  69.     property ToDownControl: TWinControl read FToDownWinControl write SetToDownWinControl;
  70.     property ToLeftControl: TWinControl read FToLeftWinControl write SetToLeftWinControl;
  71.     property ToRightControl: TWinControl read FToRightWinControl write SetToRightWinControl;
  72.     property UseArrowNavigation: Boolean read FUseArrowNavigation write FUseArrowNavigation;
  73.  
  74.   end;
  75.  
  76. procedure Register;
  77.  
  78. implementation
  79.  
  80. procedure Register;
  81. begin
  82.   RegisterComponents('TDSoft', [TTDSuperEdit]);
  83. end;
  84.  
  85. { TTDSuperEdit }
  86.  
  87. constructor TTDSuperEdit.Create(AOwner: TComponent);
  88. begin
  89.   inherited;
  90.   FOnFocusColor:=clGreen;
  91.   FUseArrowNavigation:=True;
  92. end;
  93.  
  94. procedure TTDSuperEdit.CreateParams(var Params: TCreateParams);
  95. begin
  96.   inherited;
  97.   Params.Style:= WS_CHILD or WS_OVERLAPPED;
  98.  
  99.   if FFloat then
  100.     Params.Style:= Params.Style or WS_CAPTION
  101.   else
  102.     Params.Style:= Params.Style and (not WS_CAPTION);
  103.  
  104.  
  105.   if FMultiLine then
  106.     Params.Style:= Params.Style or ES_MULTILINE
  107.   else
  108.     Params.Style:= Params.Style and (not ES_MULTILINE);
  109.  
  110.   if FDialogFrame then
  111.     Params.Style:= Params.Style or WS_DLGFRAME
  112.   else
  113.     Params.Style:= Params.Style and (not WS_DLGFRAME);
  114.  
  115.   if FSizeBox then
  116.     Params.Style:= Params.Style or WS_SIZEBOX
  117.   else
  118.     Params.Style:= Params.Style and (not WS_SIZEBOX);
  119.  
  120.   if FOnlyNumber then
  121.     Params.Style:= Params.Style or ES_NUMBER
  122.   else
  123.     Params.Style:= Params.Style and (not ES_NUMBER);
  124.  
  125.   if FHScroll then
  126.     Params.Style:= Params.Style or WS_HSCROLL
  127.   else
  128.     Params.Style:= Params.Style and (not WS_HSCROLL);
  129.  
  130.   if FVScroll then
  131.     Params.Style:= Params.Style or WS_VSCROLL
  132.   else
  133.     Params.Style:= Params.Style and (not WS_VSCROLL);
  134.  
  135.  
  136.  
  137.    case FAlignment of
  138.       taLeftJustify:
  139.       begin
  140.         Params.Style:= Params.Style or ES_LEFT;
  141.         Params.Style:= Params.Style and (not ES_RIGHT);
  142.         Params.Style:= Params.Style and (not ES_CENTER);
  143.       end;
  144.       taCenter:
  145.       begin
  146.         Params.Style:= Params.Style or ES_CENTER;
  147.         Params.Style:= Params.Style and (not ES_RIGHT);
  148.         Params.Style:= Params.Style and (not ES_LEFT);
  149.       end;
  150.       taRightJustify:
  151.       begin
  152.         Params.Style:= Params.Style or ES_RIGHT;
  153.         Params.Style:= Params.Style and (not ES_LEFT);
  154.         Params.Style:= Params.Style and (not ES_CENTER);
  155.       end;
  156.    end;
  157. end;
  158.  
  159.  
  160. procedure TTDSuperEdit.RestoreSize;
  161. begin
  162.   SetWindowPos(handle,HWND_TOP,
  163.                Left,Top,OldWidth,OldHeight,
  164.                SWP_SHOWWINDOW    );
  165. end;
  166.  
  167. procedure TTDSuperEdit.SaveSize;
  168. begin
  169.   OldWidth:=Width;
  170.   OldHeight:=Height;
  171. end;
  172.  
  173. procedure TTDSuperEdit.SetAlignment(const Value: TAlignment);
  174. begin
  175.   FAlignment := Value;
  176.   SaveSize;
  177.   RecreateWnd;
  178.   RestoreSize;
  179. end;
  180.  
  181. procedure TTDSuperEdit.SetDialogFrame(const Value: Boolean);
  182. begin
  183.   FDialogFrame := Value;
  184.   SaveSize;
  185.   RecreateWnd;
  186.   RestoreSize;
  187. end;
  188.  
  189. procedure TTDSuperEdit.SetFloat(const Value: Boolean);
  190. begin
  191.   FFloat := Value;
  192.   if Value then FDialogFrame:=Value;
  193.   
  194.   SaveSize;
  195.   RecreateWnd;
  196.   RestoreSize;
  197. end;
  198.  
  199. procedure TTDSuperEdit.SetHScroll(const Value: Boolean);
  200. begin
  201.   FHScroll := Value;
  202.   SaveSize;
  203.   RecreateWnd;
  204.   RestoreSize;
  205. end;
  206.  
  207. procedure TTDSuperEdit.SetMultiLine(const Value: Boolean);
  208. begin
  209.   FMultiLine := Value;
  210.   SaveSize;
  211.   RecreateWnd;
  212.   RestoreSize;
  213. end;
  214.  
  215. procedure TTDSuperEdit.SetOnFocusColor(const Value: TColor);
  216. begin
  217.   FOnFocusColor := Value;
  218. end;
  219.  
  220. procedure TTDSuperEdit.SetOnlyNumber(const Value: Boolean);
  221. begin
  222.   FOnlyNumber := Value;
  223.   SaveSize;
  224.   RecreateWnd;
  225.   RestoreSize;
  226. end;
  227.  
  228. procedure TTDSuperEdit.SetSizeBox(const Value: Boolean);
  229. begin
  230.   FSizeBox := Value;
  231.   SaveSize;
  232.   RecreateWnd;
  233.   RestoreSize;
  234. end;
  235.  
  236. procedure TTDSuperEdit.SetToDownWinControl(const Value: TWinControl);
  237. begin
  238.   FToDownWinControl := Value;
  239. end;
  240.  
  241. procedure TTDSuperEdit.SetToLeftWinControl(const Value: TWinControl);
  242. begin
  243.   FToLeftWinControl := Value;
  244. end;
  245.  
  246. procedure TTDSuperEdit.SetToRightWinControl(const Value: TWinControl);
  247. begin
  248.   FToRightWinControl := Value;
  249. end;
  250.  
  251. procedure TTDSuperEdit.SetToUpWinControl(const Value: TWinControl);
  252. begin
  253.   FToUpWinControl := Value;
  254. end;
  255.  
  256.  
  257. procedure TTDSuperEdit.SetVScroll(const Value: Boolean);
  258. begin
  259.   FVScroll := Value;
  260.   SaveSize;
  261.   RecreateWnd;
  262.   RestoreSize;
  263. end;
  264.  
  265. procedure TTDSuperEdit.WMKEYDOWN(var Msg: TMessage);
  266. begin
  267.   if not FUseArrowNavigation then Exit;
  268.   case Msg.wParam of
  269.       VK_RETURN:
  270.         begin
  271.             SelStart:=0;
  272.         SelLength:=0;
  273.       end;
  274.       
  275.     VK_UP:
  276.       if Assigned(ToUpControl) then
  277.       begin
  278.         ToUpControl.SetFocus;
  279.       end;
  280.  
  281.     VK_DOWN:
  282.       if Assigned(ToDownControl) then
  283.       begin
  284.         ToDownControl.SetFocus;
  285.       end;
  286.  
  287.     VK_LEFT:
  288.         if Assigned(ToLeftControl) then
  289.           if (SelStart=0) or (SelLength=Length(Text)) then
  290.           begin
  291.             ToLeftControl.SetFocus;
  292.           end;
  293.  
  294.     VK_RIGHT:
  295.         if Assigned(ToRightControl) then
  296.           if Length(Text)=SelStart + SelLength then
  297.           begin
  298.             ToRightControl.SetFocus;
  299.           end;
  300.  
  301.   end;
  302.  
  303.   inherited;
  304. end;
  305.  
  306. procedure TTDSuperEdit.WMKILLFOCUS(var Msg: TMessage);
  307. begin
  308.   inherited;
  309.   Color:=OldColor;
  310. end;
  311.  
  312. procedure TTDSuperEdit.WMLBUTTONDOWN(var Msg: TMessage);
  313. begin
  314.   Windows.SetFocus(handle);
  315.   inherited;
  316. end;
  317.  
  318. procedure TTDSuperEdit.WMLBUTTONUP(var Msg: TMessage);
  319. begin
  320.   inherited;
  321.   Perform(WM_PAINT,0,0);
  322. end;
  323.  
  324. procedure TTDSuperEdit.WMSETFOCUS(var Msg: TMessage);
  325. begin
  326.   inherited;
  327.   OldColor:=Color;
  328.   Color:=FOnFocusColor;
  329. end;
  330.  
  331. end.
  332.