home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 March / Chip_1999-03_cd.bin / zkuste / delphi / D234C13 / RALIB.ZIP / RALib / Lib / RACombo.pas < prev    next >
Pascal/Delphi Source File  |  1998-08-18  |  5KB  |  203 lines
  1. {***********************************************************
  2.                 R&A Library
  3.        Copyright (C) 1996-98 R&A
  4.  
  5.        components  : TRACombo
  6.        description : Special combo box
  7.  
  8.        programer   : white
  9.        e-mail      : blacknbs@chat.ru
  10.        www         : www.chat.ru\~blacknbs\ralib
  11. ************************************************************}
  12.  
  13. {$INCLUDE RA.INC}
  14.  
  15. unit RACombo;
  16.  
  17. interface
  18.  
  19. uses
  20.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  21.   ExtCtrls, Menus, Buttons;
  22.  
  23. type
  24.   TRACombo = class(TCustomPanel)
  25.   private
  26.     FItems     : TStrings;
  27.     FItemIndex : integer;
  28.     FButton    : TSpeedButton;
  29.     FPopupMenu : TPopupMenu;
  30.     FOnChange  : TNotifyEvent;
  31.     procedure SetItems(AItems : TStrings);
  32.     procedure SetItemIndex(AItemIndex : integer);
  33.   protected
  34.     procedure OnClick(Sender : TObject);
  35.     procedure ItemsChange(Sender : TObject);
  36.     procedure MenuClick(Sender : TObject);
  37.     procedure ShowMenu(Sender : TObject);
  38.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  39.   public
  40.     constructor Create(AOwner: TComponent); override;
  41.     destructor  Destroy; override;
  42.   published
  43.     property Items     : TStrings read FItems     write SetItems;
  44.     property ItemIndex : integer  read FItemIndex write SetItemIndex;
  45.     property OnChange  : TNotifyEvent read FOnChange write FOnChange;
  46.   published
  47.     property Align;
  48.     property Alignment;
  49.     property BorderStyle;
  50.     property Color;
  51.     property Ctl3D;
  52.     property DragCursor;
  53.     property DragMode;
  54.     property Enabled;
  55.     property Font;
  56.     property ParentColor;
  57.     property ParentCtl3D;
  58.     property ParentFont;
  59.     property ParentShowHint;
  60.     property ShowHint;
  61.     property TabOrder;
  62.     property TabStop;
  63.     property Visible;
  64.     property OnDblClick;
  65.     property OnDragDrop;
  66.     property OnDragOver;
  67.     property OnEndDrag;
  68.     property OnResize;
  69.     property OnStartDrag;
  70.  {$IFDEF RA_D4H}
  71.   public
  72.     property DockManager;
  73.   published
  74.     property Anchors;
  75.     property AutoSize;
  76.     property BiDiMode;
  77.     property Constraints;
  78.     property UseDockManager default True;
  79.     property DockSite;
  80.     property DragKind;
  81.     property ParentBiDiMode;
  82.     property OnCanResize;
  83.     property OnConstrainedResize;
  84.     property OnDockDrop;
  85.     property OnDockOver;
  86.     property OnEndDock;
  87.     property OnGetSiteInfo;
  88.     property OnStartDock;
  89.     property OnUnDock;
  90.  {$ENDIF RA_D4H}
  91.   end;
  92.  
  93. implementation
  94.  
  95. {$R *.RES}
  96.  
  97. constructor TRACombo.Create(AOwner: TComponent);
  98. begin
  99.   inherited Create(AOwner);
  100.   BevelInner  := bvLowered;
  101.   BevelOuter  := bvNone;
  102.   BorderWidth := 1;
  103.  
  104.   FPopupMenu := TPopupMenu.Create(Self);
  105.   FPopupMenu.OnPopup := ShowMenu;
  106.  
  107.   Height      := 21;
  108.   Width       := 300;
  109.  
  110.   FButton := TSpeedButton.Create(Self);
  111.   with FButton do begin
  112.    {$IFDEF RA_D3H}
  113.     Flat    := true;
  114.    {$ENDIF RA_D3H}
  115.     Glyph.LoadFromResourceName(HInstance, 'DOWN');
  116.     Margin  := 3;
  117.     Parent  := Self;
  118.     Top     := 2;
  119.     Left    := 2;
  120.   end;
  121.   FButton.Height  := Height - 4;
  122.   FButton.Width   := Width  - 4;
  123.   FButton.OnClick := OnClick;
  124.  
  125.   FItems      := TStringList.Create;
  126.   TStringList(FItems).OnChange := ItemsChange;
  127.   FItemIndex  := -1;
  128. end;
  129.  
  130. destructor TRACombo.Destroy;
  131. begin
  132.   while FPopupMenu.Items.Count <> 0 do FPopupMenu.Items.Remove(FPopupMenu.Items[0]);
  133.   FItems.Free;
  134.   FButton.Free;
  135.   FPopupMenu.Free;
  136.   inherited Destroy;
  137. end;
  138.  
  139. procedure TRACombo.OnClick(Sender: TObject);
  140. var
  141.   APoint : TPoint;
  142. begin
  143.   with FButton do APoint := ClientToScreen(Point(0, Height));
  144.   FPopupMenu.Popup(APoint.X, APoint.Y);
  145. end;
  146.  
  147. procedure TRACombo.SetItems(AItems : TStrings);
  148. begin
  149.   FItems.Assign(AItems);
  150. end;
  151.  
  152. procedure TRACombo.SetItemIndex(AItemIndex : integer);
  153. begin
  154.   if AItemIndex < -1 then AItemIndex := -1;
  155.   if AItemIndex >= FItems.Count then AItemIndex := FItems.Count - 1;
  156.   if FItemIndex <> AItemIndex then begin
  157.     FItemIndex := AItemIndex;
  158.     if FItemIndex >= 0 then FButton.Caption := FItems[FItemIndex]
  159.                        else FButton.Caption := '';
  160.     if Assigned(FOnChange) then FOnChange(Self);
  161.   end;
  162. end;
  163.  
  164. procedure TRACombo.ItemsChange(Sender : TObject);
  165. var
  166.   i       : integer;
  167.   NewItem : TMenuItem;
  168. begin
  169.   while FPopupMenu.Items.Count <> 0 do FPopupMenu.Items.Remove(FPopupMenu.Items[0]);
  170.   for i := 0 to FItems.Count -1 do begin
  171.     NewItem := TMenuItem.Create(Self);
  172.     NewItem.Caption := FItems[i];
  173.     NewItem.RadioItem := true;
  174.     NewItem.Tag     := i;
  175.     NewItem.OnClick := MenuClick;
  176.     FPopupMenu.Items.Add(NewItem);
  177.   end;
  178.   if ItemIndex >= FItems.Count then ItemIndex := FItems.Count -1;
  179. end;
  180.  
  181. procedure TRACombo.MenuClick(Sender : TObject);
  182. begin
  183.   ItemIndex := TMenuItem(Sender).Tag;
  184. end;
  185.  
  186. procedure TRACombo.ShowMenu(Sender : TObject);
  187. var
  188.   i : integer;
  189. begin
  190.   for i := 0 to FPopupMenu.Items.Count-1 do
  191.     with FPopupMenu.Items[i] do
  192.       Checked := (Tag = FItemIndex);
  193. end;
  194.  
  195. procedure TRACombo.WMSize(var Message: TWMSize);
  196. begin
  197.   inherited;
  198.   FButton.Height := Height - 4;
  199.   FButton.Width  := Width  - 4;
  200. end;
  201.  
  202. end.
  203.