home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmSpinCombo.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  14KB  |  551 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmSpinCombo
  5. Purpose  : An edit control with a Spin and combo button combination.
  6. Date     : 07-20-00
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. ================================================================================}
  10.  
  11. unit rmSpinCombo;
  12.  
  13.  
  14. interface
  15.  
  16. {$I CompilerDefines.INC}
  17.  
  18. uses Windows, Classes, StdCtrls, Controls, Messages, SysUtils,
  19.   Forms, Graphics, Buttons, rmBaseEdit, rmSpeedBtns, rmScrnCtrls {$ifDef rmDebug}, rmMsgList{$endif};
  20.  
  21. type
  22. { TrmCustomSpinCombo }
  23.  
  24.   TrmCustomSpinCombo = class(TrmCustomEdit)
  25.   private
  26.     FScreenListBox: TrmCustomScreenListBox;
  27.     fDropDownWidth: integer;
  28.     FDropDownHeight: integer;
  29.     FSpinBtn: TrmSpinButton;
  30.     FComboBtn: TrmSpeedButton;
  31.     FEditorEnabled: Boolean;
  32.     fMaxValue: integer;
  33.     fMinValue: integer;
  34.     fRanges: boolean;
  35.     FOnDropDown: TNotifyEvent;
  36.     FOnChanged : TNotifyEvent;
  37. {$ifdef rmDebug}
  38.     fMsg: TrmMsgEvent;
  39. {$endif}
  40.  
  41.     procedure DoLBKeyDown(Sender: TObject; var Key: Word;
  42.       Shift: TShiftState);
  43.     procedure DoLBMouseDown(Sender: TObject; Button: TMouseButton;
  44.       Shift: TShiftState; X, Y: Integer);
  45.     procedure DoLBExit(Sender: Tobject);
  46.  
  47.     procedure ToggleListBox(Sender: TObject);
  48.     procedure SetEditRect;
  49.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  50.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  51.     procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
  52.     procedure WMCut(var Message: TWMCut); message WM_CUT;
  53.  
  54.     procedure CMFontchanged(var Message: TMessage); message CM_FontChanged;
  55.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
  56.     procedure wmKillFocus(var Message: TMessage); message wm_killfocus;
  57.  
  58. {$IFDEF D4_OR_HIGHER}
  59.     procedure SetEnabled(value: Boolean); reintroduce; (* reintroduce is D4 Modification *)
  60.     function GetEnabled: Boolean; reintroduce; (* reintroduce is D4 Modification *)
  61. {$ELSE}
  62.     procedure SetEnabled(value: Boolean);
  63. {$ENDIF}
  64.     procedure SetComboItems(const Value: TStrings);
  65.     procedure SetMaxValue(const Value: integer);
  66.     procedure SetMinValue(const Value: integer);
  67.     procedure SetRanges(const Value: boolean);
  68.     procedure CheckRanges;
  69.     function GetComboItems: TStrings;
  70.   protected
  71.     procedure UpClick(Sender: TObject);
  72.     procedure DownClick(Sender: TObject);
  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.     property DropDownHeight: integer read FDropDownHeight write fDropDownHeight default 0;
  79.     property DropDownWidth: integer read fDropDownWidth write fDropDownWidth default 0;
  80.  
  81.     property MaxValue: integer read fMaxValue write SetMaxValue default 0;
  82.     property MinValue: integer read fMinValue write SetMinValue default 0;
  83.     property UseRanges: boolean read fRanges write SetRanges default false;
  84.  
  85.     property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
  86.     property Enabled: Boolean read GetEnabled write SetEnabled default True;
  87.     property Items: TStrings read GetComboItems write SetComboItems;
  88.  
  89.     property OnChanged: TNotifyEvent read fOnChanged write fOnChanged;
  90.     property OnDropDown: TNotifyEvent read FOnDropDown write fOnDropDown;
  91.   public
  92.     constructor Create(AOwner: TComponent); override;
  93.     destructor Destroy; override;
  94.     procedure WndProc(var Message: TMessage); override;
  95. {$ifdef rmDebug}
  96.     property OnMessage:TrmMsgEvent read fMsg write fMsg;
  97. {$endif}
  98.   end;
  99.  
  100.   TrmSpinCombo = class(TrmCustomSpinCombo)
  101.   published
  102.     property EditorEnabled;
  103.     property Enabled;
  104.     property DropDownHeight;
  105.     property DropDownWidth;
  106.     property Items;
  107.     property UseRanges;
  108.     property MaxValue;
  109.     property MinValue;
  110.     property Text;
  111.  
  112. {$IFDEF D4_OR_HIGHER}
  113.     property Anchors;
  114.     property Constraints;
  115. {$ENDIF}
  116.     property Font;
  117.     property ParentColor;
  118.     property ParentCtl3D;
  119.     property ParentFont;
  120.     property ParentShowHint;
  121.     property PopupMenu;
  122.     property ShowHint;
  123.     property TabOrder;
  124.     property TabStop;
  125.     property Visible;
  126.  
  127.     property OnChanged;
  128.     property OnDropDown;
  129.   end;
  130.  
  131. implementation
  132.  
  133. uses rmLibrary;
  134.  
  135. { TrmCustomSpinCombo }
  136.  
  137. constructor TrmCustomSpinCombo.Create(AOwner: TComponent);
  138. begin
  139.   inherited Create(AOwner);
  140.  
  141.   FComboBtn := TrmSpeedButton.Create(Self);
  142.   with FComboBtn do
  143.   begin
  144.     Height := 17;
  145.     Width := 16;
  146.     Style := sbsComboButton;
  147.     Cursor := crArrow;
  148.     Parent := Self;
  149.     OnClick := ToggleListBox;
  150.     Layout := blGlyphTop;
  151.     enabled := true;
  152.  
  153.     Font.name := 'Marlett';
  154.     font.size := 10;
  155.     Font.color := clBtnText;
  156.     Caption := '6';
  157.     Glyph := nil;
  158.   end;
  159.  
  160.   FSpinBtn := TrmSpinButton.Create(Self);
  161.   with FSpinBtn do
  162.   begin
  163.     Width := 15;
  164.     Height := 16;
  165.     Visible := True;
  166.     Parent := Self;
  167.     FocusControl := Self;
  168.     OnUpClick := UpClick;
  169.     OnDownClick := DownClick;
  170.     enabled := true;
  171.   end;
  172.  
  173.   FScreenListBox := TrmCustomScreenListBox.create(nil);
  174.   with FScreenListBox do
  175.   begin
  176.     width := self.width;
  177.     height := self.height * 8;
  178.     visible := false;
  179.     Parent := self;
  180.     OnKeyDown := DoLBKeyDown;
  181.     OnMousedown := DoLBMouseDown;
  182.   end;
  183.   FScreenListBox.hide;
  184.  
  185.   OnExit := doLBExit;
  186.  
  187.   fMaxValue := 0;
  188.   fMinValue := 0;
  189.   fRanges := false;
  190.   Text := '';
  191.   ControlStyle := ControlStyle - [csSetCaption];
  192.   FEditorEnabled := True;
  193. end;
  194.  
  195. destructor TrmCustomSpinCombo.Destroy;
  196. begin
  197.   FSpinBtn.free;
  198.   FComboBtn.free;
  199.   FScreenListBox.free;
  200.   inherited Destroy;
  201. end;
  202.  
  203. procedure TrmCustomSpinCombo.KeyDown(var Key: Word; Shift: TShiftState);
  204. begin
  205.   if not FEditorEnabled then
  206.   begin
  207.      if (key in [vk_delete]) then
  208.         key := 0;
  209.   end;
  210.   if (((Key = VK_DOWN) or (key = VK_UP)) and (ssAlt in Shift)) or
  211.       ((key = vk_f4) and (shift = [])) then
  212.   begin
  213.     if not FScreenListbox.visible then
  214.       ToggleListBox(self)
  215.     else
  216.       FScreenListbox.hide;
  217.   end
  218.   else if ((Key = VK_DOWN) or (key = VK_UP)) and (shift = []) then
  219.   begin
  220.     if not fScreenListbox.visible then
  221.     begin
  222.       if key = vk_up then
  223.         UpClick(self);
  224.  
  225.       if key = vk_down then
  226.         DownClick(self);
  227.     end;
  228.   end
  229.   else
  230.   inherited KeyDown(Key, Shift);
  231. end;
  232.  
  233. procedure TrmCustomSpinCombo.CreateParams(var Params: TCreateParams);
  234. begin
  235.   inherited CreateParams(Params);
  236.   Params.Style := Params.Style or WS_CLIPCHILDREN or ES_MULTILINE;
  237. end;
  238.  
  239. procedure TrmCustomSpinCombo.CreateWnd;
  240. begin
  241.   inherited CreateWnd;
  242.   SetEditRect;
  243. end;
  244.  
  245. procedure TrmCustomSpinCombo.SetEditRect;
  246. var
  247.   R: TRect;
  248. begin
  249.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@R));
  250.   R.Right := clientwidth - FSpinBtn.Width - FComboBtn.width - 1;
  251.   R.Top := 0;
  252.   R.Left := 0;
  253.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  254.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@R)); {debug}
  255. end;
  256.  
  257. procedure TrmCustomSpinCombo.WMSize(var Message: TWMSize);
  258. begin
  259.   inherited;
  260.   if NewStyleControls and Ctl3D then
  261.   begin
  262.     FSpinBtn.SetBounds((width - (FSpinBtn.width + FComboBtn.width)) - 4, 0, FSpinBtn.width, Height - 4);
  263.     FComboBtn.SetBounds((width - (FComboBtn.width)) - 4, 0, FComboBtn.width, Height - 4);
  264.   end
  265.   else
  266.   begin
  267.     FSpinBtn.SetBounds((width - (FSpinBtn.width + FComboBtn.width)), 1, FSpinBtn.width, Height - 2);
  268.     FComboBtn.SetBounds((width - (FComboBtn.width)), 1, FComboBtn.width, Height - 2);
  269.   end;
  270.   SetEditRect;
  271. end;
  272.  
  273. procedure TrmCustomSpinCombo.WMPaste(var Message: TWMPaste);
  274. begin
  275.   if not FEditorEnabled or ReadOnly then Exit;
  276.   inherited;
  277. end;
  278.  
  279. procedure TrmCustomSpinCombo.WMCut(var Message: TWMPaste);
  280. begin
  281.   if not FEditorEnabled or ReadOnly then Exit;
  282.   inherited;
  283. end;
  284.  
  285. procedure TrmCustomSpinCombo.CMEnter(var Message: TCMGotFocus);
  286. begin
  287.   if AutoSelect and not (csLButtonDown in ControlState) then
  288.     SelectAll;
  289.   inherited;
  290. end;
  291.  
  292. procedure TrmCustomSpinCombo.SetEnabled(value: Boolean);
  293. begin
  294.   inherited enabled := value;
  295.   FSpinBtn.enabled := value;
  296.   FComboBtn.Enabled := value;
  297. end;
  298.  
  299. function TrmCustomSpinCombo.GetEnabled: Boolean;
  300. begin
  301.   result := inherited Enabled;
  302. end;
  303.  
  304. procedure TrmCustomSpinCombo.DownClick(Sender: TObject);
  305. var
  306.   wInt: integer;
  307. begin
  308.   try
  309.     wInt := StrToInt(text);
  310.     dec(wInt);
  311.   except
  312.     wInt := 0;
  313.   end;
  314.   text := inttostr(wInt);
  315.   CheckRanges;
  316.   if assigned(fonchanged) then
  317.      fOnchanged(self);
  318. end;
  319.  
  320. procedure TrmCustomSpinCombo.UpClick(Sender: TObject);
  321. var
  322.   wInt: integer;
  323. begin
  324.   try
  325.     wInt := StrToInt(text);
  326.     inc(wInt);
  327.   except
  328.     wInt := 0;
  329.   end;
  330.   text := inttostr(wInt);
  331.   CheckRanges;
  332.   if assigned(fonchanged) then
  333.      fOnchanged(self);
  334. end;
  335.  
  336. procedure TrmCustomSpinCombo.SetComboItems(const Value: TStrings);
  337. begin
  338.   FScreenListBox.Items.assign(Value);
  339. end;
  340.  
  341. procedure TrmCustomSpinCombo.SetMaxValue(const Value: integer);
  342. begin
  343.   fMaxValue := Value;
  344.   if (maxvalue < fMinvalue) then
  345.     fMinValue := fMaxValue;
  346.   CheckRanges;
  347. end;
  348.  
  349. procedure TrmCustomSpinCombo.SetMinValue(const Value: integer);
  350. begin
  351.   fMinValue := value;
  352.   if (fMinvalue > fMaxValue) then
  353.     fMaxValue := Value;
  354.   CheckRanges;
  355. end;
  356.  
  357. procedure TrmCustomSpinCombo.SetRanges(const Value: boolean);
  358. begin
  359.   if franges <> value then
  360.   begin
  361.     fRanges := Value;
  362.     CheckRanges;
  363.   end;
  364. end;
  365.  
  366. procedure TrmCustomSpinCombo.CheckRanges;
  367. var
  368.   wInt: integer;
  369. begin
  370.   if UseRanges then
  371.   begin
  372.     try
  373.       wInt := strtoint(text);
  374.       if (wInt <= fMinValue) then
  375.       begin
  376.         wInt := fMinValue;
  377.         FSpinBtn.DownEnabled := false;
  378.       end
  379.       else
  380.         fSpinBtn.DownEnabled := true;
  381.  
  382.       if (wInt >= fMaxValue) then
  383.       begin
  384.         wInt := fMaxValue;
  385.         fSpinBtn.UpEnabled := false;
  386.       end
  387.       else
  388.         fSpinBtn.UpEnabled := true;
  389.       text := inttostr(wInt);
  390.     except
  391.     end;
  392.   end;
  393. end;
  394.  
  395. procedure TrmCustomSpinCombo.ToggleListBox(Sender: TObject);
  396. var
  397.   CP, SP: TPoint;
  398. begin
  399.   CP.X := Left;
  400.   CP.Y := Top + Height;
  401.   SP := parent.ClientToScreen(CP);
  402.  
  403.   if assigned(fonDropdown) then
  404.      fOnDropDown(self);
  405.  
  406.   SetFocus;
  407.   SelectAll;
  408.  
  409.   FScreenListBox.Font := Font;
  410.  
  411.   with FScreenListBox do
  412.   begin
  413.     if fDropDownWidth = 0 then
  414.       Width := self.width
  415.     else
  416.       width := fDropDownWidth;
  417.  
  418.     if fDropDownHeight = 0 then
  419.       Height := self.Height * 8
  420.     else
  421.       Height := fDropDownHeight;
  422.  
  423.     Left := SP.X;
  424.  
  425.     if assigned(screen.ActiveForm) then
  426.     begin
  427.       if (SP.Y + FScreenListBox.height < screen.activeForm.Monitor.Height) then
  428.         FScreenListBox.Top := SP.Y
  429.       else
  430.         FScreenListBox.Top := (SP.Y - self.height) - FScreenListBox.height;
  431.     end
  432.     else
  433.     begin
  434.       if (SP.Y + FScreenListBox.height < screen.Height) then
  435.         FScreenListBox.Top := SP.Y
  436.       else
  437.         FScreenListBox.Top := (SP.Y - self.height) - FScreenListBox.height;
  438.     end;
  439.  
  440.     Show;
  441.     SetWindowPos(handle, hwnd_topMost, 0, 0, 0, 0, swp_nosize or swp_NoMove);
  442.   end;
  443. end;
  444.  
  445. procedure TrmCustomSpinCombo.DoLBMouseDown(Sender: TObject; Button: TMouseButton;
  446.   Shift: TShiftState; X, Y: Integer);
  447. begin
  448.   FScreenListBox.hide;
  449.   if FScreenListBox.ItemIndex <> -1 then
  450.     Text := FScreenListBox.items[fscreenlistbox.itemindex];
  451.   self.setfocus;
  452.   self.SelectAll;
  453.   if (FScreenListBox.ItemIndex <> -1) and assigned(fonchanged) then
  454.      fOnchanged(self);
  455. end;
  456.  
  457. procedure TrmCustomSpinCombo.DoLBExit(Sender: Tobject);
  458. begin
  459.   if FScreenListBox.visible then
  460.     FScreenListBox.visible := false;
  461. end;
  462.  
  463. procedure TrmCustomSpinCombo.DoLBKeyDown(Sender: TObject; var Key: Word;
  464.   Shift: TShiftState);
  465. begin
  466.   if (key = vk_escape) then
  467.   begin
  468.     FScreenListBox.hide;
  469.     self.setfocus;
  470.     self.SelectAll;
  471.     key := 0;
  472.   end
  473.   else
  474.     if (key = vk_Return) then
  475.     begin
  476.       key := 0;
  477.       FScreenListBox.hide;
  478.       if FScreenListBox.ItemIndex <> -1 then
  479.         Text := FScreenListBox.items[fscreenlistbox.itemindex];
  480.       self.setfocus;
  481.       self.SelectAll;
  482.       if assigned(fonchanged) then
  483.          fOnchanged(self);
  484.     end
  485. end;
  486.  
  487. procedure TrmCustomSpinCombo.WndProc(var Message: TMessage);
  488. begin
  489. {$ifdef rmDebug}
  490.   if assigned(OnMessage) then
  491.   try
  492.      OnMessage(Message);
  493.   except
  494.   end;
  495. {$endif}
  496.  
  497.   case Message.Msg of
  498.     WM_CHAR,
  499.       WM_KEYDOWN,
  500.       WM_KEYUP: if (FScreenListBox.visible) then
  501.       begin
  502.         if GetCaptureControl = nil then
  503.         begin
  504.           Message.result := SendMessage(FScreenListBox.Handle, message.msg, message.wParam, message.LParam);
  505.           if message.result = 0 then exit;
  506.         end;
  507.       end;
  508.   end;
  509.   inherited WndProc(message);
  510. end;
  511.  
  512. procedure TrmCustomSpinCombo.CMCancelMode(var Message: TCMCancelMode);
  513. begin
  514.    inherited;
  515.    if Message.Sender = FScreenListBox then
  516.       exit;
  517.    if FScreenListBox.visible then
  518.       FScreenListBox.Hide;
  519. end;
  520.  
  521. function TrmCustomSpinCombo.GetComboItems: TStrings;
  522. begin
  523.    Result := fscreenlistbox.Items;
  524. end;
  525.  
  526. procedure TrmCustomSpinCombo.keyPress(var key: char);
  527. begin
  528.   if not FEditorEnabled then
  529.      key := #0
  530.   else if key = #13 then
  531.      key := #0;
  532.  
  533.   inherited;
  534. end;
  535.  
  536. procedure TrmCustomSpinCombo.wmKillFocus(var Message: TMessage);
  537. begin
  538.    inherited;
  539.    if FScreenListBox.visible then
  540.       FScreenListBox.Hide;
  541. end;
  542.  
  543. procedure TrmCustomSpinCombo.CMFontchanged(var Message: TMessage);
  544. begin
  545.    inherited;
  546.    FScreenListBox.Font.Assign(self.font);
  547. end;
  548.  
  549. end.
  550.  
  551.