home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / SQLBUILD.ZIP / BTNEDIT.ZIP / BTNEDIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-26  |  9.6 KB  |  376 lines
  1. {*********************************************************}
  2. {*                  BTNEDIT.PAS 1.00                     *}
  3. {*            COMPONENT FOR DELPHI Ver 1.x and 2.0       *}
  4. {*          Copyright (c) Jeffrey Cooke 1996             *}
  5. {*          email:100026.3107@compuserve.com             *}
  6. {*                 All rights reserved.                  *}
  7. {*********************************************************}
  8.  
  9. {-Simple Borland Delphi component that is derived from TCustomEdit
  10. and is basically an edit box with a speedbutton, glyph property
  11. and a OnBtnClick event. Standard glyph in Glyph property is an
  12. ellipsis. Minimun button width is 15 pixels otherwise button width
  13. is always 0.6 x Height}
  14.  
  15. {- WIN32 conditional define controls which code is compiled}
  16.  
  17. unit BtnEdit;
  18.  
  19. interface
  20.  
  21. uses WinTypes, WinProcs, Classes, StdCtrls, ExtCtrls, Controls, Messages, SysUtils,
  22.   Forms, Graphics, Menus, Buttons;
  23.  
  24. type
  25.   TBtnEditButton = class (TWinControl)
  26.   private
  27.     FEditButton: TSpeedButton;
  28.     FFocusControl: TWinControl;
  29.     FOnBtnClick: TNotifyEvent;
  30.     function CreateButton: TSpeedButton;
  31.     function GetGlyph: TBitmap;
  32.     procedure SetGlyph(Value: TBitmap);
  33.     procedure BtnClick(Sender: TObject);
  34.     procedure AdjustSize (var W: Integer; var H: Integer);
  35.     procedure WMSize(var Message: TWMSize);  message WM_SIZE;
  36.   protected
  37.     procedure Loaded; override;
  38.   public
  39.     constructor Create(AOwner: TComponent); override;
  40.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  41.   published
  42.     property Align;
  43.     property Ctl3D;
  44.     property DragCursor;
  45.     property DragMode;
  46.     property Enabled;
  47.     property FocusControl: TWinControl read FFocusControl write FFocusControl;
  48.     property ParentCtl3D;
  49.     property ParentShowHint;
  50.     property PopupMenu;
  51.     property ShowHint;
  52.     property TabOrder;
  53.     property TabStop;
  54.     property Glyph: TBitmap read GetGlyph write SetGlyph;
  55.     property Visible;
  56.     property OnDragDrop;
  57.     property OnDragOver;
  58.     property OnEndDrag;
  59.     property OnEnter;
  60.     property OnExit;
  61.     property OnBtnClick: TNotifyEvent read FOnBtnClick write FOnBtnClick;
  62.   end;
  63.  
  64. { TBtnEdit }
  65.  
  66.   TBtnEdit = class(TCustomEdit)
  67.   private
  68.     FCanvas: TCanvas;
  69.     FButton: TBtnEditButton;
  70.     FEditorEnabled: Boolean;
  71.     function GetMinHeight: Integer;
  72.     procedure SetEditRect;
  73.     function GetGlyph: TBitmap;
  74.     procedure SetGlyph(Value: TBitmap);
  75.     Function GetOnBtnClick: TNotifyEvent;
  76.     Procedure SetOnBtnClick(Value:TNotifyEvent);
  77.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  78.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  79.     procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
  80.     procedure WMCut(var Message: TWMCut);   message WM_CUT;
  81.   protected
  82.     procedure BtnClick (Sender: TObject); virtual;
  83.     procedure CreateParams(var Params: TCreateParams); override;
  84.     procedure CreateWnd; override;
  85.   public
  86.     constructor Create(AOwner: TComponent); override;
  87.     destructor Destroy; override;
  88.     property Button: TBtnEditButton read FButton;
  89.   published
  90.     property AutoSelect;
  91.     property AutoSize;
  92.     property Color;
  93.     property Ctl3D;
  94.     property DragCursor;
  95.     property DragMode;
  96.     property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
  97.     property Enabled;
  98.     property Font;
  99.     property Glyph: TBitmap read GetGlyph write SetGlyph;
  100.     property MaxLength;
  101.     property ParentColor;
  102.     property ParentCtl3D;
  103.     property ParentFont;
  104.     property ParentShowHint;
  105.     property PopupMenu;
  106.     property ReadOnly;
  107.     property ShowHint;
  108.     property TabOrder;
  109.     property TabStop;
  110.     property Text;
  111.     property Visible;
  112.     property OnChange;
  113.     property OnClick;
  114.     property OnBtnClick: TNotifyEvent read GetOnBtnClick write SetOnBtnClick;
  115.     property OnDblClick;
  116.     property OnDragDrop;
  117.     property OnDragOver;
  118.     property OnEndDrag;
  119.     property OnEnter;
  120.     property OnExit;
  121.     property OnKeyDown;
  122.     property OnKeyPress;
  123.     property OnKeyUp;
  124.     property OnMouseDown;
  125.     property OnMouseMove;
  126.     property OnMouseUp;
  127.   end;
  128.  
  129. procedure Register;
  130.  
  131. implementation
  132.  
  133. {$IFDEF WIN32}
  134.   {$R BTNEDT32}
  135. {$ELSE}
  136.   {$R BTNEDT16}
  137. {$ENDIF}
  138.  
  139. { TBtnEditButton }
  140.  
  141. constructor TBtnEditButton.Create(AOwner: TComponent);
  142. begin
  143.   inherited Create(AOwner);
  144.   ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] +
  145.     [csFramed, csOpaque];
  146.  
  147.   FEditButton := CreateButton;
  148.   Glyph := nil;
  149.   Width := 20;
  150.   Height := 25;
  151.   FOnBtnClick := Nil;
  152. end;
  153.  
  154. function TBtnEditButton.CreateButton: TSpeedButton;
  155. begin
  156.   Result := TSpeedButton.Create (Self);
  157.   Result.OnClick := BtnClick;
  158.   Result.Visible := True;
  159.   Result.Enabled := True;
  160.   Result.NumGlyphs := 1;
  161.   Result.Parent := Self;
  162. end;
  163.  
  164. procedure TBtnEditButton.AdjustSize (var W: Integer; var H: Integer);
  165. begin
  166.   if (FEditButton = nil) or (csLoading in ComponentState) then Exit;
  167.   if W < 15 then W := 15;
  168.   FEditButton.SetBounds (0, 0, W, H);
  169. end;
  170.  
  171. procedure TBtnEditButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  172. var
  173.   W, H: Integer;
  174. begin
  175.   W := AWidth;
  176.   H := AHeight;
  177.   AdjustSize (W, H);
  178.   inherited SetBounds (ALeft, ATop, W, H);
  179. end;
  180.  
  181. procedure TBtnEditButton.WMSize(var Message: TWMSize);
  182. var
  183.   W, H: Integer;
  184. begin
  185.   inherited;
  186.  
  187.   { check for minimum size }
  188.   W := Width;
  189.   H := Height;
  190.   AdjustSize (W, H);
  191.   if (W <> Width) or (H <> Height) then
  192.     inherited SetBounds(Left, Top, W, H);
  193.   Message.Result := 0;
  194. end;
  195.  
  196. procedure TBtnEditButton.BtnClick(Sender: TObject);
  197. begin
  198.   if Assigned(FOnBtnClick) then
  199.     FOnBtnClick(Self);
  200. end;
  201.  
  202. procedure TBtnEditButton.Loaded;
  203. var
  204.   W, H: Integer;
  205. begin
  206.   inherited Loaded;
  207.   W := Width;
  208.   H := Height;
  209.   AdjustSize (W, H);
  210.   if (W <> Width) or (H <> Height) then
  211.     inherited SetBounds (Left, Top, W, H);
  212. end;
  213.  
  214. function TBtnEditButton.GetGlyph: TBitmap;
  215. begin
  216.   Result := FEditButton.Glyph;
  217. end;
  218.  
  219. procedure TBtnEditButton.SetGlyph(Value: TBitmap);
  220. begin
  221.   if Value <> nil then
  222.     FEditButton.Glyph := Value
  223.   else
  224.   begin
  225.     FEditButton.Glyph.Handle := LoadBitmap(HInstance, 'Ellipsis');
  226.     FEditButton.NumGlyphs := 1;
  227.     FEditButton.Invalidate;
  228.   end;
  229. end;
  230.  
  231. { TBtnEdit }
  232.  
  233. constructor TBtnEdit.Create(AOwner: TComponent);
  234. begin
  235.   inherited Create(AOwner);
  236.   FButton := TBtnEditButton.Create (Self);
  237.   FButton.Width := 15;
  238.   FButton.Height := 17;
  239.   FButton.Visible := True;
  240.   FButton.Parent := Self;
  241.   FButton.FocusControl := Self;
  242.   FButton.OnBtnClick := BtnClick;
  243.   Text := '';
  244.   ControlStyle := ControlStyle - [csSetCaption];
  245.   FEditorEnabled := True;
  246. end;
  247.  
  248. destructor TBtnEdit.Destroy;
  249. begin
  250.   FButton.Free;
  251.   FButton := nil;
  252.   inherited Destroy;
  253. end;
  254.  
  255. procedure TBtnEdit.CreateParams(var Params: TCreateParams);
  256. begin
  257.   inherited CreateParams(Params);
  258.   Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
  259. end;
  260.  
  261. procedure TBtnEdit.CreateWnd;
  262. begin
  263.   inherited CreateWnd;
  264.   SetEditRect;
  265. end;
  266.  
  267. procedure TBtnEdit.SetEditRect;
  268. var
  269.   Loc: TRect;
  270. begin
  271.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
  272.   Loc.Bottom := ClientHeight + 1;  {+1 is workaround for windows paint bug}
  273.   Loc.Right := ClientWidth - FButton.Width - 2;
  274.   Loc.Top := 0;
  275.   Loc.Left := 0;
  276.   SendMessage(Handle, EM_SETRECT, 0, LongInt(@Loc));
  277.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));  {debug}
  278. end;
  279.  
  280. function TBtnEdit.GetGlyph: TBitmap;
  281. begin
  282.   Result := FButton.Glyph;
  283. end;
  284.  
  285. procedure TBtnEdit.SetGlyph(Value: TBitmap);
  286. begin
  287.   FButton.Glyph := Value;
  288. end;
  289.  
  290. procedure TBtnEdit.WMSize(var Message: TWMSize);
  291. var
  292.   MinHeight: Integer;
  293. begin
  294.   inherited;
  295.   MinHeight := GetMinHeight;
  296.     { text edit bug: if size to less than minheight, then edit ctrl does
  297.       not display the text }
  298.   if Autosize and (Height < MinHeight) then
  299.     Height := MinHeight
  300.   else if FButton <> nil then
  301.   begin
  302.     {adjust button to right size}
  303.     FButton.width := Round(Height*0.6);
  304.     if NewStyleControls then
  305.     {$IFDEF WIN32}
  306.       FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 5)
  307.      {$ELSE}
  308.       FButton.SetBounds(Width - FButton.Width, 0, FButton.Width, Height)
  309.     {$ENDIF}
  310.     else FButton.SetBounds (Width - FButton.Width, 0, FButton.Width, Height);
  311.     SetEditRect;
  312.   end;
  313. end;
  314.  
  315. function TBtnEdit.GetMinHeight: Integer;
  316. var
  317.   DC: HDC;
  318.   SaveFont: HFont;
  319.   I: Integer;
  320.   SysMetrics, Metrics: TTextMetric;
  321. begin
  322.   DC := GetDC(0);
  323.   GetTextMetrics(DC, SysMetrics);
  324.   SaveFont := SelectObject(DC, Font.Handle);
  325.   GetTextMetrics(DC, Metrics);
  326.   SelectObject(DC, SaveFont);
  327.   ReleaseDC(0, DC);
  328.   I := SysMetrics.tmHeight;
  329.   if I > Metrics.tmHeight then I := Metrics.tmHeight;
  330.   Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
  331. end;
  332.  
  333. procedure TBtnEdit.BtnClick (Sender: TObject);
  334. begin
  335.   if ReadOnly then MessageBeep(0)
  336. end;
  337.  
  338. procedure TBtnEdit.WMPaste(var Message: TWMPaste);
  339. begin
  340.   if not FEditorEnabled or ReadOnly then Exit;
  341.   inherited;
  342. end;
  343.  
  344. procedure TBtnEdit.WMCut(var Message: TWMPaste);
  345. begin
  346.   if not FEditorEnabled or ReadOnly then Exit;
  347.   inherited;
  348. end;
  349.  
  350. Procedure TBtnEdit.SetOnBtnClick(Value:TNotifyEvent);
  351. begin
  352.   FButton.OnBtnClick := Value;
  353. end;
  354.  
  355. Function TBtnEdit.GetOnBtnClick:TNotifyEvent;
  356. begin
  357.   Result := FButton.OnBtnClick;
  358. end;
  359.  
  360. procedure TBtnEdit.CMEnter(var Message: TCMGotFocus);
  361. begin
  362.   if AutoSelect and not (csLButtonDown in ControlState) then
  363.     SelectAll;
  364.   inherited;
  365. end;
  366.  
  367. procedure Register;
  368. begin
  369.   RegisterComponents('Samples', [TBtnEdit]);
  370. end;
  371.  
  372. end.
  373.  
  374.  
  375.  
  376.