Finally, here is a first attempt to extend the classic combobox. It is not working perfectly yet but it allows to add a resizable dropdown form to almost any control. I tried to find how the Lazarus team did the IDE Code Completion ToolTip implementation but I didn't find the right code till now.
I use a THintWindow and a TTimer to get the mouse msg when resizing outside the application window and I added a StatusBar. I can neither make the THintWindow automatically handle resizing (without the TTimer trick) nor I can have the SizeGrip appear on the StatusBar (even when I set the THintWindow borderStyle to bsSizable).
I'm missing some points there. Waiting for any advice to keep on working.
Any comments are welcome.
TODO : Hide the Dropdown form when parent window is moved or resized.
{--------------------------------------------------------------------------------
Description : TAdvxComboBox
Luc DAVID - 2013
--------------------------------------------------------------------------------}
unit AdvxCombobox;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
LResources,
{$IFDEF WINDOWS}
Windows,
{$ENDIF}
SysUtils, Classes, Controls, Forms,
ExtCtrls, StdCtrls, Graphics, ComCtrls,
LCLType, LCLIntf, LCLProc, LMessages, Messages;
type
{ TAdvxSizeablePanel }
TAdvxSizeablePanel = class(THintWindow)
private
FResizing: Boolean;
FStatusBar: TStatusBar;
FTopLeft: TPoint;
FTimer: TTimer;
procedure SetFResizing(AValue: Boolean);
procedure DoOnTimer(Sender: TObject);
protected
procedure DoOnMouseEnter(Sender: TObject);
procedure DoOnMouseLeave(Sender: TObject);
procedure DoOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure DoOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
public
constructor Create(AOwner: TComponent); override;
property Resizing: Boolean read FResizing write SetFResizing;
end;
TAdvxDropDownPanel = class(TAdvxSizeablePanel)
private
FEditCtrl: TEdit;
public
property EditCtrl: TEdit read FEditCtrl write FEditCtrl;
end;
{ TAdvxCustomComboBox }
TAdvxCustomComboBox = class(TPanel)
private
FEditBox: TEdit;
FDropDownBtn: TButton;
FDropDownPanel: TAdvxDropDownPanel;
protected
procedure DoShowDropDownPanel(Sender: TObject);
procedure DoHideDropDownPanel(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property DropDownPanel: TAdvxDropDownPanel read FDropDownPanel;
end;
implementation
{ TAdvxSizeablePanel }
procedure TAdvxSizeablePanel.DoOnMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FResizing then Exit;
Resizing := (Screen.cursor = crSizeNWSE);
Inherited;
end;
procedure TAdvxSizeablePanel.DoOnMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Resizing := False;
inherited;
end;
constructor TAdvxSizeablePanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Color := clWindow;
FStatusBar := TStatusBar.Create(Self);
FStatusBar.Parent := Self;
FStatusBar.OnMouseEnter:= DoOnMouseEnter;
FStatusBar.OnMouseLeave:= DoOnMouseLeave;
FStatusBar.OnMouseDown := DoOnMouseDown;
FStatusBar.OnMouseUp := DoOnMouseUp;
FTimer := TTimer.Create(Self);
FTimer.Enabled:=False;
FTimer.Interval:=5;
FTimer.OnTimer:= DoOnTimer;
end;
procedure TAdvxSizeablePanel.SetFResizing(AValue: Boolean);
begin
if FResizing=AValue then Exit;
FResizing:=AValue;
FTimer.Enabled := FResizing;
end;
procedure TAdvxSizeablePanel.DoOnTimer(Sender: TObject);
var
p: TPoint;
begin
p := Mouse.CursorPos;
P := ScreenToControl(p);
Width:= p.x+3;
Height := p.y+3;
invalidate;
Application.ProcessMessages;
end;
procedure TAdvxSizeablePanel.DoOnMouseEnter(Sender: TObject);
begin
Screen.cursor := crSizeNWSE;
end;
procedure TAdvxSizeablePanel.DoOnMouseLeave(Sender: TObject);
begin
Screen.Cursor := crDefault;
end;
{ TAdvxCustomComboBox }
constructor TAdvxCustomComboBox.Create(AOwner: TComponent);
Const
w = 180;
h = 27;
begin
inherited Create(AOwner);
ParentColor:=False;
Color := cl3DLight;
FEditBox := TEdit.Create(Self);
FDropDownBtn := TButton.Create(Self);
FDropDownPanel := TAdvxDropDownPanel.Create(Self);
Width := w;
Height:= h;
With FEditBox do
begin
Parent := Self;
SetBounds(2,2, w-24,22);
BorderStyle:= bsNone;
end;
With FDropDownBtn do
begin
Parent := Self;
SetBounds(FEditBox.Left+FEditBox.Width + 1, 4,20,20);
OnClick := DoShowDropDownPanel;
end;
With FDropDownPanel do
begin
EditCtrl := FEditBox;
Visible:=False;
Width := Self.Width+100;
Height := 300;
OnClick := DoHideDropDownPanel;
end;
end;
destructor TAdvxCustomComboBox.Destroy;
begin
inherited Destroy;
end;
procedure TAdvxCustomComboBox.DoShowDropDownPanel(Sender: TObject);
var
P: TPoint;
R: TRect;
F: TCustomForm;
begin
if FDropDownPanel.Showing
then FDropDownPanel.Hide
else begin
F := GetParentForm(Self);
P.x := Left;
P.y := Top + Height;
P := F.ControlToScreen(P);
R := Rect(p.x, p.y, p.x+FDropDownPanel.Width, p.y+FDropDownPanel.Height);
FDropDownPanel.FTopLeft := P;
FDropDownPanel.ActivateHint(R, '');
FDropDownPanel.SetFocus;
end;
end;
procedure TAdvxCustomComboBox.DoHideDropDownPanel(Sender: TObject);
begin
if FDropDownPanel.Showing and Not FDropDownPanel.Resizing
then FDropDownPanel.Hide
end;
initialization
end.
Note : On windows 8, Dropdown panel doesn't show up at the right screen position...
Recent
