home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmBtnEdit.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  15KB  |  525 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmBtnEdit
  5. Purpose  : An edit control with a combo type button (or two).  Also used as a
  6.            basis for a couple of the "rm" combo boxes.
  7. Date     : 03-15-1999
  8. Author   : Ryan J. Mills
  9. Version  : 1.80
  10. ================================================================================}
  11.  
  12. unit rmBtnEdit;
  13.  
  14. interface
  15.  
  16. {$I CompilerDefines.INC}
  17.  
  18. uses Windows, Classes, StdCtrls, Controls, Messages, SysUtils,
  19.   Forms, Graphics, Buttons, rmSpeedBtns, rmBaseEdit;
  20.  
  21. type
  22.  
  23. { TrmCustomBtnEdit }
  24.  
  25.   TrmCustomBtnEdit = class(TrmCustomEdit)
  26.   private
  27.     fundo : string;
  28.     FButton1, FButton2: TrmSpeedButton;
  29.     fOnBtn1Click,
  30.     fOnBtn2Click : TNotifyEvent;
  31.     FEditorEnabled: Boolean;
  32.     FBtnWidth : integer;
  33.     fBtn2IsVisible,
  34.     fBtn1IsEnabled,
  35.     fBtn2IsEnabled : boolean;
  36.     fBtn1DefaultGlyph,
  37.     fBtn2DefaultGlyph : boolean;
  38.     fUseDefaultGlyphs : boolean;
  39.     procedure SetEditRect;
  40.     procedure SetBtnWidth(value:integer);
  41.     function GetBtn1Enabled: boolean;
  42.     function GetBtn1Glyph:TBitMap;
  43.     function GetBtn1NumGlyphs:TNumGlyphs;
  44.     function GetBtn1Visible:boolean;
  45.     function GetBtn2Enabled: boolean;
  46.     function GetBtn2Glyph:TBitMap;
  47.     function GetBtn2NumGlyphs:TNumGlyphs;
  48.     function GetBtn2Visible: boolean;
  49.     procedure SetBtn1Enabled(const Value: boolean);
  50.     procedure SetBtn1Glyph(value:TBitMap);
  51.     procedure SetBtn1NumGlyphs(value:TNumGlyphs);
  52.     procedure SetBtn1Visible(value:boolean);
  53.     procedure SetBtn2Enabled(const Value: boolean);
  54.     procedure SetBtn2Glyph(value:TBitMap);
  55.     procedure SetBtn2NumGlyphs(value:TNumGlyphs);
  56.     procedure SetBtn2Visible(const Value: boolean);
  57.     procedure ResetDefaultGlyphs;
  58.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  59.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  60.     procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
  61.     procedure WMCut(var Message: TWMCut);   message WM_CUT;
  62.     procedure CMSysColorChange(var Message:TMessage); message CM_SYSCOLORCHANGE;
  63.     {$ifdef D4_OR_HIGHER}
  64.     procedure SetEnabled(value:Boolean); reintroduce; (* reintroduce is D4 Modification *)
  65.     function GetEnabled:Boolean; reintroduce; (* reintroduce is D4 Modification *)
  66.     {$else}
  67.     procedure SetEnabled(value:Boolean);
  68.     function GetEnabled:Boolean;
  69.     {$endif}
  70.     procedure SetUseDefaultGlyphs(const Value: boolean);
  71.   protected
  72.     procedure BtnClick (Sender: TObject); virtual;
  73.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  74.     procedure KeyPress(var Key: Char); override;
  75.     procedure CreateParams(var Params: TCreateParams); override;
  76.     procedure CreateWnd; override;
  77.  
  78.     function GetButton(index:integer):TrmSpeedButton;
  79.     property BtnWidth:integer read FBtnWidth write setBtnWidth stored true default 16;
  80.     property Btn1Enabled : boolean read GetBtn1Enabled write SetBtn1Enabled stored true default true;
  81.     property Btn1Glyph:TBitmap read GetBtn1Glyph write SetBtn1Glyph stored True;
  82.     property Btn1NumGlyphs: TNumGlyphs read GetBtn1NumGlyphs write SetBtn1NumGlyphs stored true;
  83.     property Btn1Visible:boolean read GetBtn1Visible write SetBtn1Visible stored true default true;
  84.     property Btn2Enabled : boolean read GetBtn2Enabled write SetBtn2Enabled stored true default true;
  85.     property Btn2Glyph:TBitmap read GetBtn2Glyph write SetBtn2Glyph stored True;
  86.     property Btn2NumGlyphs: TNumGlyphs read GetBtn2NumGlyphs write SetBtn2NumGlyphs stored true;
  87.     Property Btn2Visible:boolean read GetBtn2Visible write SetBtn2Visible stored true default false;
  88.     property UseDefaultGlyphs : boolean read fUseDefaultGlyphs write SetUseDefaultGlyphs default true;
  89.     property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
  90.     property Enabled: Boolean read GetEnabled write SetEnabled default True;
  91.     property OnBtn1Click:TNotifyEvent read fOnBtn1Click write fOnBtn1Click;
  92.     property OnBtn2Click:TNotifyEvent read fOnBtn2Click write fOnBtn2Click;
  93.   public
  94.     constructor Create(AOwner: TComponent); override;
  95.     destructor Destroy; override;
  96.     procedure SetFocus; override;
  97.   end;
  98.  
  99.   TrmBtnEdit = class(TrmCustomBtnEdit)
  100.   published
  101.     property Align; 
  102.     {$ifdef D4_OR_HIGHER}
  103.     property Anchors;
  104.     property Constraints;
  105.     {$endif}
  106.     property AutoSelect;
  107.     property AutoSize;
  108.     property BtnWidth;
  109.     property Btn1Enabled;
  110.     property Btn1Glyph;
  111.     property Btn1NumGlyphs;
  112.     property Btn1Visible;
  113.     property Btn2Enabled;
  114.     property Btn2Glyph;
  115.     property Btn2NumGlyphs;
  116.     Property Btn2Visible;
  117.     property BorderStyle;
  118.     property Color;
  119.     property Ctl3D;
  120.     property DragCursor;
  121.     property DragMode;
  122.     property EditorEnabled;
  123.     property Enabled;
  124.     property Font;
  125.     property MaxLength;
  126.     property ParentColor;
  127.     property ParentCtl3D;
  128.     property ParentFont;
  129.     property ParentShowHint;
  130.     property PopupMenu;
  131.     property ReadOnly;
  132.     property ShowHint;
  133.     property TabOrder;
  134.     property TabStop;
  135.     property Text;
  136.     property Visible;
  137.     property OnChange;
  138.     property OnClick;
  139.     property OnDblClick;
  140.     property OnDragDrop;
  141.     property OnDragOver;
  142.     property OnEndDrag;
  143.     property OnEnter;
  144.     property OnExit;
  145.     property OnKeyDown;
  146.     property OnKeyPress;
  147.     property OnKeyUp;
  148.     property OnMouseDown;
  149.     property OnMouseMove;
  150.     property OnMouseUp;
  151.     property OnStartDrag;
  152.     property OnBtn1Click;
  153.     property OnBtn2Click;
  154.   end;
  155.  
  156. implementation
  157.  
  158. {$R rmBtnEdit.res}
  159.  
  160. uses rmLibrary;
  161.  
  162. { TrmCustomBtnEdit }
  163.  
  164. constructor TrmCustomBtnEdit.Create(AOwner: TComponent);
  165. begin
  166.   inherited Create(AOwner);
  167.  
  168.   fUseDefaultGlyphs := true;
  169.  
  170.   FButton1 := TrmSpeedButton.Create (Self);
  171.   with FButton1 do
  172.   begin
  173.      Visible := True;
  174.      Style := sbsComboButton;
  175.      Cursor := crArrow;
  176.      Parent := Self;
  177.      Align := alRight;
  178.      OnClick := BtnClick;
  179.      enabled := true;
  180.      Layout := blGlyphTop;
  181.   end;
  182.   fBtn1IsEnabled := true;
  183.   fBtn1DefaultGlyph := true;
  184.   Btn1Glyph := nil;
  185.  
  186.   FButton2 := TrmSpeedButton.Create (Self);
  187.   with FButton2 do
  188.   begin
  189.      Visible := false;
  190.      Style := sbsComboButton;
  191.      Cursor := crArrow;
  192.      Parent := Self;
  193.      Align := alRight;
  194.      OnClick := BtnClick;
  195.      Layout := blGlyphTop;
  196.      enabled := true;
  197.   end;
  198.   fBtn2IsEnabled := true;
  199.   fBtn2IsVisible := false;
  200.   fBtn2DefaultGlyph := true;
  201.   Btn2Glyph := nil;
  202.  
  203.   BtnWidth := 16;
  204.   Text := '';
  205.   ControlStyle := ControlStyle - [csSetCaption];
  206.   FEditorEnabled := True;
  207. end;
  208.  
  209. destructor TrmCustomBtnEdit.Destroy;
  210. begin
  211.   FButton1.free; // := nil;
  212.   FButton2.free; // := nil;
  213.   inherited Destroy;
  214. end;
  215.  
  216. procedure TrmCustomBtnEdit.KeyDown(var Key: Word; Shift: TShiftState);
  217. begin
  218.   if (Key = VK_RETURN) then
  219.   begin
  220.        if ([ssCtrl] = Shift) then BtnClick (FButton1)
  221.        else
  222.        if ([ssctrl, ssShift] = Shift) then BtnClick (FButton2)
  223.        else
  224.        if (shift = []) then
  225.        begin
  226.             setfocus;
  227.             inherited KeyDown(key, shift);
  228.        end;
  229.   end
  230.   else
  231.   if (key = vk_escape) then
  232.   begin
  233.        if (shift = []) and (text <> fundo) then
  234.        begin
  235.             text := fundo;
  236.             selectall;
  237.        end;
  238.   end
  239.   else
  240.   inherited KeyDown(Key, Shift);
  241. end;
  242.  
  243. procedure TrmCustomBtnEdit.setfocus;
  244. begin
  245.      fundo := text;
  246.      inherited;
  247. end;
  248.  
  249. procedure TrmCustomBtnEdit.CreateParams(var Params: TCreateParams);
  250. begin
  251.   inherited CreateParams(Params);
  252. {  Params.Style := Params.Style and not WS_BORDER;  }
  253.   Params.Style := Params.Style or WS_CLIPCHILDREN or ES_MULTILINE;
  254. end;
  255.  
  256. procedure TrmCustomBtnEdit.CreateWnd;
  257. begin
  258.   inherited CreateWnd;
  259.   SetEditRect;
  260. end;
  261.  
  262. procedure TrmCustomBtnEdit.SetEditRect;
  263. var
  264.   R: TRect;
  265. begin
  266.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@R));
  267.   if FButton1.visible then
  268.      R.Right := ClientWidth - fBtnWidth - 1
  269.   else
  270.      R.right := ClientWidth;
  271.  
  272.   if FButton2.visible then
  273.      R.Right := R.right - fBtnWidth;
  274.  
  275.   R.Top := 0;
  276.   R.Left := 0;
  277.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  278.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@R));  {debug}
  279. end;
  280.  
  281. procedure TrmCustomBtnEdit.WMSize(var Message: TWMSize);
  282. begin
  283.   inherited;
  284.   if NewStyleControls and Ctl3D then
  285.   begin
  286.        if fButton2.Visible then
  287.        begin
  288.             FButton1.SetBounds((width - (fBtnWidth shl 1)) - 4, 0, fBtnWidth, Height - 4);
  289.             FButton2.SetBounds((width - fBtnWidth) - 4, 0, fBtnWidth, Height - 4);
  290.        end
  291.        else
  292.            FButton1.SetBounds((width - fBtnWidth) - 4, 0, fBtnWidth, Height - 4);
  293.   end
  294.   else
  295.   begin
  296.        if fButton2.Visible then
  297.        begin
  298.             FButton1.SetBounds (width - (fBtnWidth shl 1), 1, fBtnWidth, Height - 2);
  299.             FButton2.SetBounds (width - fBtnWidth, 1, fBtnWidth, Height - 2);
  300.        end
  301.        else
  302.            FButton1.SetBounds (width - fBtnWidth, 1, fBtnWidth, Height - 2);
  303.   end;
  304.   if csdesigning in componentstate then
  305.   begin
  306.        if not fbutton1.visible then fbutton1.width := 0;
  307.        if not fbutton2.visible then fbutton2.width := 0;
  308.   end;
  309.   SetEditRect;
  310. end;
  311.  
  312. procedure TrmCustomBtnEdit.BtnClick (Sender: TObject);
  313. begin
  314.      SetFocus;
  315.      if (Sender is TrmSpeedButton) and (TrmSpeedButton(Sender) = fbutton1) and assigned(fOnBtn1Click) then
  316.         fOnBtn1Click(self)
  317.      else
  318.      if (Sender is TrmSpeedButton) and (TrmSpeedButton(Sender) = fbutton2) and assigned(fOnBtn2Click) then
  319.         fOnBtn2Click(self)
  320. end;
  321.  
  322. procedure TrmCustomBtnEdit.WMPaste(var Message: TWMPaste);
  323. begin
  324.   if not FEditorEnabled or ReadOnly then Exit;
  325.   inherited;
  326. end;
  327.  
  328. procedure TrmCustomBtnEdit.WMCut(var Message: TWMPaste);   
  329. begin
  330.   if not FEditorEnabled or ReadOnly then Exit;
  331.   inherited;
  332. end;
  333.  
  334. procedure TrmCustomBtnEdit.CMEnter(var Message: TCMGotFocus);
  335. begin
  336.   if AutoSelect and not (csLButtonDown in ControlState) then
  337.     SelectAll;
  338.   inherited;
  339. end;
  340.  
  341. procedure TrmCustomBtnEdit.SetBtn1Glyph(value:TBitMap);
  342. var
  343.    bmp : TBitmap;
  344. begin
  345.    FButton1.glyph := value;
  346.    fBtn1DefaultGlyph := false;
  347.    if fUseDefaultGlyphs and (value = nil) then
  348.    begin
  349.       fBtn1DefaultGlyph := true;
  350.       bmp := tbitmap.create;
  351.       try
  352.          bmp.LoadFromResourceName(HInstance,'RM_ELLIPSIS');
  353.          ReplaceColors(bmp, clBtnFace, clBtnText);
  354.          fButton1.Glyph.Assign(bmp);
  355.       finally
  356.          bmp.free;
  357.       end;
  358.    end;
  359. end;
  360.  
  361. function TrmCustomBtnEdit.GetBtn1Glyph:TBitMap;
  362. begin
  363.      result := FButton1.glyph;
  364. end;
  365.  
  366. procedure TrmCustomBtnEdit.SetBtn2Glyph(value:TBitMap);
  367. var
  368.    bmp : TBitmap;
  369. begin
  370.      FButton2.glyph := value;
  371.      fBtn2DefaultGlyph := false;
  372.  
  373.      if fUseDefaultGlyphs and (value = nil) then
  374.      begin
  375.         fBtn2DefaultGlyph := true;
  376.  
  377.         bmp := tbitmap.create;
  378.         try
  379.            bmp.LoadFromResourceName(HInstance,'RM_ELLIPSIS');
  380.            ReplaceColors(bmp, clBtnFace, clBtnText);
  381.            fButton2.Glyph.Assign(bmp);
  382.         finally
  383.            bmp.free;
  384.         end;
  385.      end;
  386. end;
  387.  
  388. function TrmCustomBtnEdit.GetBtn2Glyph:TBitMap;
  389. begin
  390.      result := FButton2.glyph;
  391. end;
  392.  
  393. procedure TrmCustomBtnEdit.SetBtn1Visible(value:boolean);
  394. begin
  395.    FButton1.visible := value;
  396.    fButton2.Visible := FBtn2IsVisible and fButton1.visible;
  397.    if fButton2.Visible then
  398.       fButton2.Left := fButton1.left+1;
  399.    recreatewnd;
  400. end;
  401.  
  402. function TrmCustomBtnEdit.GetBtn1Visible:boolean;
  403. begin
  404.      result := FButton1.visible;
  405. end;
  406.  
  407. procedure TrmCustomBtnEdit.SetEnabled(value:Boolean);
  408. begin
  409.      inherited enabled := value;
  410.      FButton1.enabled := fBtn1IsEnabled and value;
  411.      FButton2.Enabled := fBtn2IsEnabled and value;
  412. end;
  413.  
  414. procedure TrmCustomBtnEdit.KeyPress(var Key: Char);
  415. begin
  416.      if key in [#10,#13] then key := #0;
  417.      inherited;
  418. end;
  419.  
  420. function TrmCustomBtnEdit.GetEnabled:Boolean;
  421. begin
  422.      result := inherited Enabled;
  423. end;
  424.  
  425. procedure TrmCustomBtnEdit.SetBtnWidth(value:integer);
  426. begin
  427.      if value <> FBtnWidth then
  428.      begin
  429.           FBtnWidth := value;
  430.           FButton1.width := FBtnWidth;
  431.           FButton2.Width := FBtnWidth;
  432.           recreatewnd;
  433.      end;
  434. end;
  435.  
  436. procedure TrmCustomBtnEdit.SetBtn2Visible(const Value: boolean);
  437. begin
  438.      fBtn2IsVisible := Value;
  439.      fButton2.Visible := FBtn2IsVisible and FButton1.visible;
  440.      if fButton2.Visible then
  441.         fButton2.Left := fButton1.left+1;
  442.      if csdesigning in componentstate then
  443.         fButton2.Visible := FBtn2IsVisible and FButton1.visible;
  444.      recreatewnd;
  445. end;
  446.  
  447. function TrmCustomBtnEdit.GetBtn2Visible: boolean;
  448. begin
  449.      result := fBtn2IsVisible;
  450. end;
  451.  
  452. function TrmCustomBtnEdit.GetBtn1Enabled: boolean;
  453. begin
  454.      result := fBtn1IsEnabled;
  455. end;
  456.  
  457. function TrmCustomBtnEdit.GetBtn2Enabled: boolean;
  458. begin
  459.      result := fBtn2IsEnabled;
  460. end;
  461.  
  462. procedure TrmCustomBtnEdit.SetBtn1Enabled(const Value: boolean);
  463. begin
  464.      fbutton1.enabled := enabled and value;
  465.      fBtn1IsEnabled := value;
  466. end;
  467.  
  468. procedure TrmCustomBtnEdit.SetBtn2Enabled(const Value: boolean);
  469. begin
  470.      fbutton2.enabled := enabled and value;
  471.      fBtn2IsEnabled := value;
  472. end;
  473.  
  474. function TrmCustomBtnEdit.GetBtn1NumGlyphs: TNumGlyphs;
  475. begin
  476.      result := fbutton1.NumGlyphs;
  477. end;
  478.  
  479. function TrmCustomBtnEdit.GetBtn2NumGlyphs: TNumGlyphs;
  480. begin
  481.      result := fbutton2.NumGlyphs;
  482. end;
  483.  
  484. procedure TrmCustomBtnEdit.SetBtn1NumGlyphs(value: TNumGlyphs);
  485. begin
  486.      FButton1.numglyphs := value;
  487. end;
  488.  
  489. procedure TrmCustomBtnEdit.SetBtn2NumGlyphs(value: TNumGlyphs);
  490. begin
  491.      FButton2.numGlyphs := value;
  492. end;
  493.  
  494. function TrmCustomBtnEdit.GetButton(index: integer): TrmSpeedButton;
  495. begin
  496.      case index of
  497.           1: result := FButton1;
  498.           2: result := FButton2;
  499.      else
  500.          result := nil;
  501.      end;
  502. end;
  503.  
  504. procedure TrmCustomBtnEdit.CMSysColorChange(var Message: TMessage);
  505. begin
  506.    ResetDefaultGlyphs;  
  507. end;
  508.  
  509. procedure TrmCustomBtnEdit.SetUseDefaultGlyphs(const Value: boolean);
  510. begin
  511.   fUseDefaultGlyphs := Value;
  512.   ResetDefaultGlyphs;
  513. end;
  514.  
  515. procedure TrmCustomBtnEdit.ResetDefaultGlyphs;
  516. begin
  517.    if fBtn1DefaultGlyph then
  518.       SetBtn1Glyph(nil);
  519.  
  520.    if fBtn2DefaultGlyph then
  521.       SetBtn2Glyph(nil);
  522. end;
  523.  
  524. end.
  525.