home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmComboBox.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  23KB  |  946 lines

  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmComboBox
  5. Purpose  : Standard Combobox or MRU with registry save.
  6. Date     : 01-01-1999
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. ================================================================================}
  10.  
  11. unit rmComboBox;
  12.  
  13. interface
  14.  
  15. {$I CompilerDefines.inc}
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  19.   StdCtrls, buttons, rmBtnEdit, rmSpeedBtns, rmScrnCtrls{$IFDEF rmDebug}, rmMsgList{$ENDIF};
  20.  
  21. type
  22.   TRegKey = (rkHKEY_CLASSES_ROOT, rkHKEY_CURRENT_USER, rkHKEY_LOCAL_MACHINE, rkHKEY_USERS);
  23.  
  24.   TrmCustomComboBox = class(TrmCustomBtnEdit)
  25.   private
  26.     FScreenListBox: TrmCustomScreenListBox;
  27.     fDropDownIndex : integer;
  28.     fDropDownWidth: integer;
  29.     fDropDownCount: integer;
  30.     FEditorEnabled: Boolean;
  31.     FOnDropDown: TNotifyEvent;
  32.     fOnCloseUp: TNotifyEvent;
  33.     FOnChanged: TNotifyEvent;
  34. {$IFDEF rmDebug}
  35.     fMsg: TrmMsgEvent;
  36. {$ENDIF}
  37.  
  38.     procedure DoLBKeyDown(Sender: TObject; var Key: Word;
  39.       Shift: TShiftState);
  40.     procedure DoLBMouseDown(Sender: TObject; Button: TMouseButton;
  41.       Shift: TShiftState; X, Y: Integer);
  42.     procedure DoLBExit(Sender: Tobject);
  43.  
  44.     procedure ToggleListBox(Sender: TObject);
  45.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  46.     procedure CMFontchanged(var Message: TMessage); message CM_FontChanged;
  47.     procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
  48.     procedure WMCut(var Message: TWMCut); message WM_CUT;
  49.  
  50.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
  51.     procedure wmKillFocus(var Message: TMessage); message wm_killfocus;
  52.     procedure SetComboItems(const Value: TStrings);
  53.     function GetComboItems: TStrings;
  54.     function GetItemHeight: integer;
  55.  
  56.     function GetItemIndex: integer;
  57.  
  58.     procedure SetItemIndex(const Value: integer);
  59.   protected
  60.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  61.     procedure keyPress(var key: char); override;
  62.     procedure CreateParams(var Params: TCreateParams); override;
  63.  
  64.     procedure InternalChanged; virtual;
  65.  
  66.     function GetEnabled: Boolean; override;
  67.     procedure SetEnabled(Value: Boolean); override;
  68.  
  69.     property DropDownCount: integer read FDropDownCount write fDropDownCount default 8;
  70.     property DropDownWidth: integer read fDropDownWidth write fDropDownWidth default 0;
  71.  
  72.     property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
  73.     property Enabled default True;
  74.     property Items: TStrings read GetComboItems write SetComboItems;
  75.     property ItemHeight: integer read GetItemHeight;
  76.  
  77.     property OnChanged: TNotifyEvent read fOnChanged write fOnChanged;
  78.     property OnDropDown: TNotifyEvent read FOnDropDown write fOnDropDown;
  79.     property OnCloseUp: TNotifyEvent read fOnCloseUp write fOnCloseUp;
  80.   public
  81.     constructor Create(AOwner: TComponent); override;
  82.     destructor Destroy; override;
  83.     procedure WndProc(var Message: TMessage); override;
  84.  
  85.     function DroppedDown: boolean;
  86. {$IFDEF rmDebug}
  87.     property OnMessage: TrmMsgEvent read fMsg write fMsg;
  88. {$ENDIF}
  89.     property ItemIndex : integer read GetItemIndex write SetItemIndex;
  90.   end;
  91.  
  92.   TrmNewComboBox = class(TrmCustomComboBox)
  93.   published
  94. {$IFDEF D4_OR_HIGHER}
  95.     property Anchors;
  96.     property Constraints;
  97. {$ENDIF}
  98.     property BiDiMode;
  99.     property BorderStyle;
  100.     property CharCase;
  101.     property Color;
  102.     property Ctl3D;
  103.     property DragCursor;
  104.     property DragKind;
  105.     property DragMode;
  106.     property Enabled;
  107.     property Font;
  108.     property HideSelection;
  109.     property ImeMode;
  110.     property ImeName;
  111.     property MaxLength;
  112.     property OEMConvert;
  113.     property ParentBiDiMode;
  114.     property ParentColor;
  115.     property ParentCtl3D;
  116.     property ParentFont;
  117.     property ParentShowHint;
  118.     property PopupMenu;
  119.     property ReadOnly;
  120.     property ShowHint;
  121.     property TabOrder;
  122.     property TabStop;
  123.     property Text;
  124.     property Visible;
  125.  
  126.     property EditorEnabled;
  127.     property DropDownCount;
  128.     property DropDownWidth;
  129.     property Items;
  130.     property ItemHeight;
  131.  
  132.     property OnChanged;
  133.     property OnDropDown;
  134.     property OnCloseUp;
  135.  
  136.     property OnChange;
  137.     property OnClick;
  138.     property OnContextPopup;
  139.     property OnDblClick;
  140.     property OnDragDrop;
  141.     property OnDragOver;
  142.     property OnEndDock;
  143.     property OnEndDrag;
  144.     property OnEnter;
  145.     property OnExit;
  146.     property OnKeyDown;
  147.     property OnKeyPress;
  148.     property OnKeyUp;
  149.     property OnMouseDown;
  150.     property OnMouseMove;
  151.     property OnMouseUp;
  152.     property OnStartDock;
  153.     property OnStartDrag;
  154.  
  155.   end;
  156.  
  157.   TrmComboBox = class(TCustomComboBox)
  158.   private
  159.     { Private declarations }
  160.     FTextCompletion: Boolean;
  161.     fHistory: TStringList;
  162.     fEditText: string;
  163.     fKeyBuffer: char;
  164.     fMaxHistory: integer;
  165.     fRegKey: TRegKey;
  166.     fRegPath: string;
  167.     fRegName: string;
  168.     fMRUCombo: boolean;
  169.     fCompletionInProgress: boolean;
  170.     fAutoUpdateHistory: boolean;
  171.     fLastCharIndex: integer;
  172.     fLastCompletionIndex: integer;
  173.     fDroppedDown: boolean;
  174.     FOnCloseUp: TNotifyEvent;
  175.     procedure FixRegPath;
  176.     procedure SetMaxHistory(const Value: integer);
  177.     procedure SetHistory(const Value: TStringList);
  178.     procedure SetRegPath(const value: string);
  179.     procedure SetRegName(const Value: string);
  180.     procedure SetText;
  181.     function GetTextCompletion: Boolean;
  182.     procedure SetTextCompletion(const Value: Boolean);
  183.     procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  184.   protected
  185.     { Protected declarations }
  186.     procedure Change; override;
  187.     procedure KeyPress(var Key: Char); override;
  188.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  189.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  190.     procedure DoEnter; override;
  191.     procedure DoExit; override;
  192.   public
  193.     { Public declarations }
  194.     constructor create(AOwner: TComponent); override;
  195.     destructor destroy; override;
  196.     procedure loaded; override;
  197.     procedure DropDown; override;
  198.     procedure InsertText(NewText: string);
  199.     procedure LoadHistory;
  200.     procedure SaveHistory;
  201.     procedure UpdateHistory;
  202.     procedure ClearHistory;
  203.     {$IFNDEF BD6}
  204.     procedure CloseUp; dynamic;
  205.     {$ENDIF}
  206.   published
  207.     { Published declarations }
  208.     property Style; {Must be published before Items}
  209.     property Anchors;
  210.     property AutoUpdateHistory: boolean read fAutoUpdateHistory write fAutoUpdateHistory default true;
  211.     property BiDiMode;
  212.     property CharCase;
  213.     property Color;
  214.     property Constraints;
  215.     property Ctl3D;
  216.     property DragCursor;
  217.     property DragKind;
  218.     property DragMode;
  219.     property DropDownCount;
  220.     property Enabled;
  221.     property Font;
  222.     property ImeMode;
  223.     property ImeName;
  224.     property ItemHeight;
  225.     property Items;
  226.     property MRUCombo: boolean read fMRUCombo write fMRUCombo default False;
  227.     property MaxHistory: integer read fMaxHistory write SetMaxHistory default 20;
  228.     property History: TStringList read fHistory write SetHistory;
  229.     property MaxLength;
  230.     property ParentBiDiMode;
  231.     property ParentColor;
  232.     property ParentCtl3D;
  233.     property ParentFont;
  234.     property ParentShowHint;
  235.     property PopupMenu;
  236.     property RegKey: TRegKey read fRegKey write fRegKey;
  237.     property RegPath: string read fRegPath write SetRegPath;
  238.     property RegName: string read fRegName write SetRegName;
  239.     property ShowHint;
  240.     property Sorted;
  241.     property TabOrder;
  242.     property TabStop;
  243.     property Text;
  244.     property TextCompletion: Boolean read GetTextCompletion write SetTextCompletion default false;
  245.     property Visible;
  246.     property OnChange;
  247.     property OnClick;
  248.     property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
  249.     property OnDblClick;
  250.     property OnDragDrop;
  251.     property OnDragOver;
  252.     property OnDrawItem;
  253.     property OnDropDown;
  254.     property OnEndDock;
  255.     property OnEndDrag;
  256.     property OnEnter;
  257.     property OnExit;
  258.     property OnKeyDown;
  259.     property OnKeyPress;
  260.     property OnKeyUp;
  261.     property OnMeasureItem;
  262.     property OnStartDock;
  263.     property OnStartDrag;
  264.   end;
  265.  
  266. implementation
  267.  
  268. uses
  269.   Registry;
  270.  
  271. { TrmComboBox }
  272.  
  273. procedure TrmComboBox.Change;
  274. begin
  275.   case fKeyBuffer of
  276.     #13:
  277.       begin
  278.         if fAutoUpdateHistory then
  279.           SetText;
  280.       end;
  281.     #27:
  282.       begin
  283.         Text := fEditText;
  284.         SelectAll;
  285.       end;
  286.   end;
  287.  
  288.   inherited;
  289. end;
  290.  
  291. procedure TrmComboBox.ClearHistory;
  292. begin
  293.   fHistory.Clear;
  294. end;
  295.  
  296. {$IFNDEF BD6}
  297. procedure TrmComboBox.CloseUp;
  298. begin
  299.   if Assigned(FOnCloseUp) then
  300.     FOnCloseUp(Self);
  301. end;
  302. {$ENDIF}
  303.  
  304. procedure TrmComboBox.CNCommand(var Message: TWMCommand);
  305. begin
  306.   inherited;
  307.   if Message.NotifyCode = CBN_CLOSEUP then
  308.   begin
  309.     fDroppedDown := false;
  310.     CloseUp;
  311.   end;
  312. end;
  313.  
  314. constructor TrmComboBox.create(AOwner: TComponent);
  315. begin
  316.   inherited create(AOwner);
  317.   fHistory := TStringList.create;
  318.   fMaxHistory := 20;
  319.   fMRUCombo := false;
  320.   FTextCompletion := false;
  321.   fCompletionInProgress := false;
  322.   fAutoUpdateHistory := true;
  323.   fLastCharIndex := 0;
  324.   fLastCompletionIndex := -1;
  325.   fDroppedDown := false;
  326. end;
  327.  
  328. destructor TrmComboBox.destroy;
  329. begin
  330.   fHistory.free;
  331.   inherited;
  332. end;
  333.  
  334. procedure TrmComboBox.DoEnter;
  335. begin
  336.   fEditText := Text;
  337.   inherited;
  338. end;
  339.  
  340. procedure TrmComboBox.DoExit;
  341. begin
  342.   if fAutoUpdateHistory and (Text <> fEditText) then
  343.     UpdateHistory;
  344.  
  345.   inherited;
  346. end;
  347.  
  348. procedure TrmComboBox.DropDown;
  349. begin
  350.   if fMRUCombo then LoadHistory;
  351.   fDroppedDown := true;
  352.   inherited;
  353. end;
  354.  
  355. procedure TrmComboBox.FixRegPath;
  356. begin
  357.   if (fRegName <> '') then
  358.   begin
  359.     if length(RegPath) > 0 then
  360.     begin
  361.       if fRegPath[length(fRegPath)] <> '\' then
  362.         fRegPath := fRegPath + '\';
  363.     end;
  364.   end
  365.   else
  366.   begin
  367.     if length(RegPath) > 0 then
  368.     begin
  369.       if fRegPath[length(fRegPath)] = '\' then
  370.         Delete(fRegPath, length(fRegPath), 1);
  371.     end;
  372.   end
  373. end;
  374.  
  375. function TrmComboBox.GetTextCompletion: Boolean;
  376. begin
  377.   Result := fTextCompletion;
  378. end;
  379.  
  380. procedure TrmComboBox.InsertText(NewText: string);
  381. begin
  382.   text := NewText;
  383.   SetText;
  384. end;
  385.  
  386. procedure TrmComboBox.KeyDown(var Key: Word; Shift: TShiftState);
  387. var
  388.   Index, TextLength: Integer;
  389.   wText: string;
  390. begin
  391.   inherited;
  392.   if FTextCompletion then
  393.   begin
  394.     if (key = vk_left) then
  395.     begin
  396.       SelLength := 0;
  397.       key := 0;
  398.       selstart := fLastCharIndex;
  399.       fCompletionInProgress := false;
  400.     end
  401.     else if (key = vk_right) then
  402.     begin
  403.       selLength := 0;
  404.       selstart := length(text);
  405.       flastcharindex := selstart;
  406.       fCompletionInProgress := false;
  407.       key := 0;
  408.     end
  409.     else if (key = vk_down) and not (ssalt in shift) and not (fDroppedDown) then
  410.     begin
  411.       fCompletionInProgress := true;
  412.       wText := copy(text, 0, selstart);
  413.       Index := Perform(CB_FINDSTRING, fLastCompletionIndex, Integer(PChar(wText)));
  414.       if Index <> CB_ERR then
  415.       begin
  416.         fLastCompletionIndex := index;
  417.         TextLength := Length(wText);
  418.         ItemIndex := Index;
  419.         SelStart := TextLength;
  420.         SelLength := Length(Text) - TextLength;
  421.         fLastCharIndex := selstart;
  422.       end;
  423.       key := 0;
  424.     end;
  425.   end;
  426. end;
  427.  
  428. procedure TrmComboBox.KeyPress(var Key: Char);
  429. begin
  430.   inherited;
  431.   fKeyBuffer := key;
  432.   if ((fKeyBuffer = #13) or (fKeyBuffer = #27)) and (text <> fEditText) then
  433.     Change;
  434. end;
  435.  
  436. procedure TrmComboBox.KeyUp(var Key: Word; Shift: TShiftState);
  437. var
  438.   Index, TextLength: Integer;
  439. begin
  440.   inherited;
  441.   fCompletionInProgress := false;
  442.   if FTextCompletion then
  443.   begin
  444.     if (key <> vk_delete) and (key <> VK_BACK) then
  445.     begin
  446.       if (SelStart = Length(Text)) then
  447.       begin
  448.         fCompletionInProgress := true;
  449.         Index := Perform(CB_FINDSTRING, -1, Integer(PChar(Text)));
  450.         if Index <> CB_ERR then
  451.         begin
  452.           fLastCompletionIndex := index;
  453.           TextLength := Length(Text);
  454.           ItemIndex := Index;
  455.           SelStart := TextLength;
  456.           SelLength := Length(Text) - TextLength;
  457.           fLastCharIndex := selstart;
  458.         end
  459.       end
  460.     end;
  461.   end;
  462. end;
  463.  
  464. procedure TrmComboBox.loaded;
  465. begin
  466.   inherited;
  467.   if not (csdesigning in componentstate) then
  468.   begin
  469.     if fMRUCombo then LoadHistory;
  470.   end;
  471. end;
  472.  
  473. procedure TrmComboBox.LoadHistory;
  474. const
  475.   Keys: array[TRegKey] of HKEY = (HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS);
  476. var
  477.   Reg: TRegistry;
  478.   loop: integer;
  479.   wStr : string;
  480. begin
  481.   if fHistory.Text = '' then
  482.   begin
  483.     if (fRegPath <> '') and (fRegName <> '') then
  484.     begin
  485.       Reg := TRegistry.create;
  486.       try
  487.         Reg.RootKey := Keys[fRegKey];
  488.         if Reg.OpenKeyReadOnly(fRegPath + fRegName) then
  489.         begin
  490.           try
  491.             loop := 0;
  492.             while loop < fMaxHistory do
  493.             begin
  494.               if Reg.ValueExists('Item_' + inttostr(loop)) then
  495.               begin
  496.                 wstr := Reg.ReadString('Item_' + inttostr(loop));
  497.                 if fHistory.IndexOf(wstr) = -1 then
  498.                    fHistory.Add(wstr);
  499.               end;
  500.               inc(loop);
  501.             end;
  502.           finally
  503.             Reg.CloseKey;
  504.           end;
  505.         end;
  506.       finally
  507.         Reg.free;
  508.       end;
  509.     end;
  510.   end;
  511.   Items.Text := fHistory.Text;
  512. end;
  513.  
  514. procedure TrmComboBox.SaveHistory;
  515. const
  516.   Keys: array[TRegKey] of HKEY = (HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS);
  517. var
  518.   Reg: TRegistry;
  519.   loop: integer;
  520. begin
  521.   Reg := TRegistry.create;
  522.   try
  523.     Reg.RootKey := Keys[fRegKey];
  524.     if Reg.OpenKey(fRegPath + fRegName, True) then
  525.     begin
  526.       try
  527.         loop := 0;
  528.         while (loop < fMaxHistory) and (loop < fHistory.Count) do
  529.         begin
  530.           Reg.WriteString('Item_' + inttostr(loop), fHistory.Strings[loop]);
  531.           inc(loop);
  532.         end;
  533.       finally
  534.         Reg.CloseKey;
  535.       end;
  536.     end;
  537.   finally
  538.     Reg.free;
  539.   end;
  540. end;
  541.  
  542. procedure TrmComboBox.SetHistory(const Value: TStringList);
  543. begin
  544.   fHistory.assign(Value);
  545. end;
  546.  
  547. procedure TrmComboBox.SetMaxHistory(const Value: integer);
  548. begin
  549.   fMaxHistory := Value;
  550. end;
  551.  
  552. procedure TrmComboBox.SetRegName(const Value: string);
  553. begin
  554.   fRegName := Value;
  555.   FixRegPath;
  556. end;
  557.  
  558. procedure TrmComboBox.SetRegPath(const value: string);
  559. begin
  560.   fRegPath := value;
  561.   FixRegPath;
  562. end;
  563.  
  564. procedure TrmComboBox.SetText;
  565. var
  566.   index: integer;
  567. begin
  568.   fEditText := Text;
  569.   SelectAll;
  570.   try
  571.     if fMRUCombo then
  572.     begin
  573.       index := fHistory.IndexOf(fEditText);
  574.       if index = -1 then
  575.         fHistory.Insert(0, fEditText)
  576.       else
  577.         fHistory.Move(index, 0);
  578.       SaveHistory;
  579.     end;
  580.   finally
  581.     SelLength := 0;
  582.     SelStart := length(text);
  583.   end;
  584. end;
  585.  
  586. procedure TrmComboBox.SetTextCompletion(const Value: Boolean);
  587. begin
  588.   fTextCompletion := Value;
  589. end;
  590.  
  591. procedure TrmComboBox.UpdateHistory;
  592. begin
  593.   SetText;
  594. end;
  595.  
  596. { TrmCustomComboBox }
  597.  
  598. constructor TrmCustomComboBox.Create(AOwner: TComponent);
  599. begin
  600.   inherited Create(AOwner);
  601.  
  602.   fDropDownCount := 8;
  603.  
  604.   OnBtn1Click := ToggleListBox;
  605.   UseDefaultGlyphs := false;
  606.   Btn1Glyph := nil;
  607.   with GetButton(1) do
  608.   begin
  609.      font.name := 'Marlett';
  610.      font.size := 10;
  611.      caption := '6';
  612.   end;
  613.  
  614.   FScreenListBox := TrmCustomScreenListBox.create(nil);
  615.   with FScreenListBox do
  616.   begin
  617.     width := self.width;
  618.     height := self.height * 8;
  619.     visible := false;
  620.     Parent := self;
  621.     OnKeyDown := DoLBKeyDown;
  622.     OnMousedown := DoLBMouseDown;
  623.     Font.assign(self.font);
  624.   end;
  625.   FScreenListBox.hide;
  626.  
  627.   OnExit := doLBExit;
  628.  
  629.   Text := '';
  630.   ControlStyle := ControlStyle - [csSetCaption];
  631.   FEditorEnabled := True;
  632. end;
  633.  
  634. destructor TrmCustomComboBox.Destroy;
  635. begin
  636.   FScreenListBox.free;
  637.   inherited Destroy;
  638. end;
  639.  
  640. procedure TrmCustomComboBox.KeyDown(var Key: Word; Shift: TShiftState);
  641. var
  642.   wIndex: integer;
  643. begin
  644.   if not FEditorEnabled then
  645.   begin
  646.     if (key in [vk_delete]) then
  647.       key := 0;
  648.   end;
  649.   if (((Key = VK_DOWN) or (key = VK_UP)) and (ssAlt in Shift)) or
  650.     ((key = vk_f4) and (shift = [])) then
  651.   begin
  652.     if not FScreenListbox.visible then
  653.       ToggleListBox(self)
  654.     else
  655.     begin
  656.       Try
  657.         if assigned(fOnCloseUp) then
  658.           fOnCloseUp(self);
  659.       except
  660.          //Do Nothing...
  661.       end;
  662.       FScreenListbox.hide;
  663.     end;
  664.     key := 0;
  665.   end
  666.   else if ((Key = VK_DOWN) or (key = VK_UP)) and (shift = []) then
  667.   begin
  668.     if not fScreenListbox.visible then
  669.     begin
  670.       wIndex := FScreenListBox.ItemIndex;
  671.       if (key = vk_up) and (wIndex > 0) then
  672.       begin
  673.         fScreenListBox.itemIndex := wIndex - 1;
  674.       end;
  675.  
  676.       if (key = vk_down) and (wIndex < FScreenListBox.Items.Count) then
  677.       begin
  678.         fScreenListBox.itemIndex := wIndex + 1;
  679.       end;
  680.  
  681.       if fScreenListBox.itemIndex <> wIndex then
  682.       begin
  683.         Self.Text := fScreenListBox.items[fScreenListBox.itemIndex];
  684.         InternalChanged;
  685.         Self.SelectAll;
  686.       end;
  687.     end;
  688.     key := 0;
  689.   end
  690.   else
  691.     inherited KeyDown(Key, Shift);
  692. end;
  693.  
  694. procedure TrmCustomComboBox.CreateParams(var Params: TCreateParams);
  695. begin
  696.   inherited CreateParams(Params);
  697.   Params.Style := Params.Style or WS_CLIPCHILDREN or ES_MULTILINE;
  698. end;
  699.  
  700. procedure TrmCustomComboBox.WMPaste(var Message: TWMPaste);
  701. begin
  702.   if not FEditorEnabled or ReadOnly then Exit;
  703.   inherited;
  704. end;
  705.  
  706. procedure TrmCustomComboBox.WMCut(var Message: TWMPaste);
  707. begin
  708.   if not FEditorEnabled or ReadOnly then Exit;
  709.   inherited;
  710. end;
  711.  
  712. procedure TrmCustomComboBox.CMEnter(var Message: TCMGotFocus);
  713. begin
  714.   inherited;
  715.   if AutoSelect and not (csLButtonDown in ControlState) then
  716.     SelectAll;
  717. end;
  718.  
  719. procedure TrmCustomComboBox.SetComboItems(const Value: TStrings);
  720. begin
  721.   FScreenListBox.Items.assign(Value);
  722. end;
  723.  
  724. procedure TrmCustomComboBox.ToggleListBox(Sender: TObject);
  725. var
  726.   CP, SP: TPoint;
  727. begin
  728.   CP.X := Left;
  729.   CP.Y := Top + Height;
  730.   SP := parent.ClientToScreen(CP);
  731.  
  732.   if assigned(fonDropdown) then
  733.     fOnDropDown(self);
  734.  
  735.   SetFocus;
  736.   SelectAll;
  737.  
  738.   with FScreenListBox do
  739.   begin
  740.     if fDropDownWidth = 0 then
  741.       Width := self.width
  742.     else
  743.       width := fDropDownWidth;
  744.  
  745.     if Items.Count > fDropDownCount then
  746.       Height := itemheight * fDropDownCount
  747.     else
  748.     begin
  749.       Height := itemheight * Items.Count;
  750.       if height = 0 then
  751.         height := itemheight;
  752.     end;
  753.  
  754.     height := height + 2;
  755.  
  756.     fDropDownIndex := ItemIndex;
  757.     FScreenListBox.itemindex := fDropDownIndex;
  758.  
  759.     Left := SP.X;
  760.  
  761.     if assigned(screen.ActiveForm) then
  762.     begin
  763.       if (SP.Y + FScreenListBox.height < screen.activeForm.Monitor.Height) then
  764.         FScreenListBox.Top := SP.Y
  765.       else
  766.         FScreenListBox.Top := (SP.Y - self.height) - FScreenListBox.height;
  767.     end
  768.     else
  769.     begin
  770.       if (SP.Y + FScreenListBox.height < screen.Height) then
  771.         FScreenListBox.Top := SP.Y
  772.       else
  773.         FScreenListBox.Top := (SP.Y - self.height) - FScreenListBox.height;
  774.     end;
  775.  
  776.     Show;
  777.     SetWindowPos(handle, hwnd_topMost, 0, 0, 0, 0, swp_nosize or swp_NoMove);
  778.   end;
  779. end;
  780.  
  781. procedure TrmCustomComboBox.DoLBMouseDown(Sender: TObject; Button: TMouseButton;
  782.   Shift: TShiftState; X, Y: Integer);
  783. begin
  784.   if (FScreenListBox.ItemIndex <> -1) then
  785.   begin
  786.     FScreenListBox.hide;
  787.     Text := FScreenListBox.items[fscreenlistbox.itemindex];
  788.     self.setfocus;
  789.     self.SelectAll;
  790.   end;
  791.   if (FScreenListBox.ItemIndex <> fDropDownIndex) then
  792.     InternalChanged;
  793. end;
  794.  
  795. procedure TrmCustomComboBox.DoLBExit(Sender: Tobject);
  796. begin
  797.   if FScreenListBox.visible then
  798.     FScreenListBox.visible := false;
  799. end;
  800.  
  801. procedure TrmCustomComboBox.DoLBKeyDown(Sender: TObject; var Key: Word;
  802.   Shift: TShiftState);
  803. begin
  804.   if (key = vk_escape) then
  805.   begin
  806.     FScreenListBox.hide;
  807.     self.setfocus;
  808.     self.SelectAll;
  809.     key := 0;
  810.   end
  811.   else if (key = vk_Return) then
  812.   begin
  813.     key := 0;
  814.     FScreenListBox.hide;
  815.     if FScreenListBox.ItemIndex <> fDropDownIndex then
  816.        Text := FScreenListBox.items[fscreenlistbox.itemindex];
  817.     if Self.CanFocus then
  818.        self.setfocus;
  819.     self.SelectAll;
  820.     InternalChanged;
  821.   end
  822. end;
  823.  
  824. procedure TrmCustomComboBox.WndProc(var Message: TMessage);
  825. begin
  826. {$IFDEF rmDebug}
  827.   if assigned(OnMessage) then
  828.   try
  829.     OnMessage(Message);
  830.   except
  831.   end;
  832. {$ENDIF}
  833.   case Message.Msg of
  834.     WM_CHAR,
  835.       WM_KEYDOWN,
  836.       WM_KEYUP:
  837.       if (FScreenListBox.visible) then
  838.       begin
  839.         if GetCaptureControl = nil then
  840.         begin
  841.           Message.result := SendMessage(FScreenListBox.Handle, message.msg, message.wParam, message.LParam);
  842.           if message.result = 0 then exit;
  843.         end;
  844.       end;
  845.   end;
  846.   inherited WndProc(message);
  847. end;
  848.  
  849. procedure TrmCustomComboBox.CMCancelMode(var Message: TCMCancelMode);
  850. begin
  851.   inherited;
  852.   if message.sender = fScreenListbox then
  853.     exit;
  854.   if (FScreenListBox.visible) then
  855.   begin
  856.     try
  857.       if assigned(fOnCloseUp) then
  858.         fOnCloseUp(self);
  859.     except
  860.          //Do Nothing.
  861.     end;
  862.     FScreenListBox.Hide;
  863.   end;
  864. end;
  865.  
  866. function TrmCustomComboBox.GetComboItems: TStrings;
  867. begin
  868.   Result := fscreenlistbox.Items;
  869. end;
  870.  
  871. procedure TrmCustomComboBox.keyPress(var key: char);
  872. begin
  873.   if not FEditorEnabled then
  874.     key := #0
  875.   else if key = #13 then
  876.     key := #0;
  877.  
  878.   inherited;
  879. end;
  880.  
  881. function TrmCustomComboBox.DroppedDown: boolean;
  882. begin
  883.   Result := FScreenListBox.Visible;
  884. end;
  885.  
  886. procedure TrmCustomComboBox.CMFontchanged(var Message: TMessage);
  887. begin
  888.   inherited;
  889.   fScreenListBox.Font.assign(self.Font);
  890. end;
  891.  
  892. function TrmCustomComboBox.GetItemHeight: integer;
  893. begin
  894.   Result := FScreenListBox.ItemHeight;
  895. end;
  896.  
  897. procedure TrmCustomComboBox.wmKillFocus(var Message: TMessage);
  898. begin
  899.   inherited;
  900.   if (FScreenListBox.visible) then
  901.   begin
  902.     try
  903.       if assigned(fOnCloseUp) then
  904.         fOnCloseUp(self);
  905.     except
  906.          //Do Nothing.
  907.     end;
  908.     FScreenListBox.Hide;
  909.   end;
  910. end;
  911.  
  912. function TrmCustomComboBox.GetEnabled: Boolean;
  913. begin
  914.    result := inherited GetEnabled;
  915. end;
  916.  
  917. function TrmCustomComboBox.GetItemIndex: integer;
  918. begin
  919.    result := FScreenListBox.Items.indexof(text);
  920. end;
  921.  
  922. procedure TrmCustomComboBox.SetEnabled(Value: Boolean);
  923. begin
  924.    inherited Setenabled(value);
  925.    Btn1Enabled := value;
  926. end;
  927.  
  928. procedure TrmCustomComboBox.SetItemIndex(const Value: integer);
  929. begin
  930.    text := FScreenListBox.Items[Value];
  931. end;
  932.  
  933. procedure TrmCustomComboBox.InternalChanged;
  934. begin
  935.    try
  936.      modified := true;
  937.      if assigned(fOnchanged) then
  938.        fOnchanged(self);
  939.    except
  940.        //do nothing
  941.    end;
  942. end;
  943.  
  944. end.
  945.  
  946.