unit UWEditAction;
//------------------------------------------------------------------------------
{$mode ObjFPC}{$H+}
interface
uses
Classes, Controls, StdCtrls, Forms, LCLType, SysUtils, Math, ActnList,
LazarusPackageIntf, LCLProc;
type
{ TUWEditAction }
TOnSelectActionEvent = procedure(Sender: TObject; const AAction: TAction) of object;
TUWEditAction = class;
TUWEditPopupList = class(TCustomForm)
private
FOnSelectActionEvent: TOnSelectActionEvent;
FEditAction: TUWEditAction;
FListBox: TListBox;
procedure ListBoxClick(Sender: TObject);
procedure DoActionEvent;
procedure CloseAndReturnAction;
procedure UpdateText;
protected
procedure DoClose(var CloseAction: TCloseAction); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure MoveSelection(const APrevious: Boolean);
end;
{ TUWEditAction }
TUWEditAction = class(TCustomEdit)
private
FActionList : TActionList;
procedure FillListWithFilter(const AText: String);
protected
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Change; override;
public
UpdatingFromCode : Boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ActionList : TActionList read FActionList write FActionList;
property Align;
property Alignment;
property Anchors;
property AutoSelect;
property BorderSpacing;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property EchoMode;
property Enabled;
property Font;
property HideSelection;
property ParentBidiMode;
property OnChange;
property OnChangeBounds;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEditingDone;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnStartDrag;
property ParentColor;
property ParentFont;
property ParentShowHint;
property ShowHint;
property TabStop;
property TabOrder;
property TextHint;
property Visible;
end;
//------------------------------------------------------------------------------
implementation
var
PopupList: TUWEditPopupList;
// -----------------------------------------------------------------------------
{ TUWEditPopupList }
// -----------------------------------------------------------------------------
constructor TUWEditPopupList.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
BorderStyle := bsNone;
FormStyle := fsStayOnTop;
ShowInTaskBar := stNever;
FOnSelectActionEvent := NIL;
FEditAction := NIL;
FListBox := TListBox.Create(Self);
with FListBox do
begin
Parent := Self;
Align := alClient;
OnClick := @ListBoxClick;
end;
end;
// -----------------------------------------------------------------------------
destructor TUWEditPopupList.Destroy;
begin
FOnSelectActionEvent := NIL;
FEditAction := NIL;
FListBox.Free;
inherited Destroy;
end;
// -----------------------------------------------------------------------------
procedure TUWEditPopupList.DoClose(var CloseAction: TCloseAction);
begin
CloseAction := caFree;
PopupList := NIL;
inherited DoClose(CloseAction);
end;
// -----------------------------------------------------------------------------
procedure TUWEditPopupList.ListBoxClick(Sender: TObject);
begin
if TListBox(Sender).Items.Count > 0 then
begin
UpdateText;
CloseAndReturnAction;
end;
end;
// -----------------------------------------------------------------------------
procedure TUWEditPopupList.DoActionEvent;
begin
with FEditAction do
if Assigned(FOnSelectActionEvent) and Assigned(FActionList) and (FListBox.ItemIndex >= 0) then
FOnSelectActionEvent(Self, TAction(FActionList.Actions[PtrUInt(FListBox.Items.Objects[FListBox.ItemIndex])]));
end;
// -----------------------------------------------------------------------------
procedure TUWEditPopupList.CloseAndReturnAction;
begin
DoActionEvent;
Close;
end;
// -----------------------------------------------------------------------------
procedure TUWEditPopupList.UpdateText;
begin
with FEditAction do
if Assigned(FActionList) then
begin
UpdatingFromCode := True;
Text := TAction(FActionList.Actions[PtrInt(FListBox.Items.Objects[FListBox.ItemIndex])]).Caption;
UpdatingFromCode := False;
end;
end;
// -----------------------------------------------------------------------------
procedure TUWEditPopupList.MoveSelection(const APrevious: Boolean);
var
i: Integer;
begin
if FListBox.Items.Count > 0 then
begin
i := FListBox.ItemIndex;
if APrevious then
Dec(i)
else
Inc(i);
i := EnsureRange(i, 0, FListBox.Items.Count-1);
if i <> FListBox.ItemIndex then
begin
FListBox.ItemIndex := i;
UpdateText;
end;
end;
end;
// -----------------------------------------------------------------------------
{ TUWEditAction }
// -----------------------------------------------------------------------------
constructor TUWEditAction.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FActionList := NIL;
PopupList := NIL;
UpdatingFromCode := False;
end;
// -----------------------------------------------------------------------------
destructor TUWEditAction.Destroy;
begin
if Assigned(PopupList) then
PopupList.Close;
FActionList := NIL;
inherited Destroy;
end;
// -----------------------------------------------------------------------------
procedure TUWEditAction.KeyDown(var Key: Word; Shift: TShiftState);
procedure UpDown(const AUp: Boolean);
begin
if Assigned(PopupList) then PopupList.MoveSelection(AUp);
end;
begin
case Key of
VK_UP : UpDown(True);
VK_DOWN : UpDown(False);
VK_RETURN,
VK_ESCAPE : if Assigned(PopupList) then PopupList.Close;
end;
end;
// -----------------------------------------------------------------------------
procedure TUWEditAction.Change;
begin
if not UpdatingFromCode then
FillListWithFilter(Text);
end;
// -----------------------------------------------------------------------------
procedure TUWEditAction.FillListWithFilter(const AText: String);
var
i : Integer;
s : String;
xy : TPoint;
begin
if not Assigned(PopupList) then
begin
xy := ControlToScreen(Point(0, ClientHeight));
PopupList := TUWEditPopupList.Create(Application);
PopupList.FEditAction := Self;
PopupList.SetBounds(xy.x, xy.y + BorderWidth, Width, Height * 5);
end;
with PopupList do
begin
FListBox.Items.Clear;
if AText.IsEmpty then
begin
PopupList.Close;
Exit;
end;
FListBox.Items.BeginUpdate;
try
if Assigned(FActionList) then
for i := 0 to FActionList.ActionCount-1 do
begin
s := TAction(FActionList.Actions[i]).Caption;
if s.ToLower.Contains(AText.ToLower) then
FListBox.Items.AddObject(s, TObject(PtrInt(i)));
end;
finally
FListBox.Items.EndUpdate;
end;
if (FListBox.Items.Count = 0) then
PopupList.Close
else if not PopupList.Visible then
PopupList.Visible := True;
end;
end;
// -----------------------------------------------------------------------------
WIKI Timeout issues
