mirror of
https://github.com/moparisthebest/Simba
synced 2024-08-13 16:53:59 -04:00
582 lines
14 KiB
ObjectPascal
582 lines
14 KiB
ObjectPascal
unit v_AutoCompleteForm;
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, ExtCtrls,
|
|
|
|
{$IFDEF FPC}
|
|
LMessages,
|
|
lcltype
|
|
{$ELSE}
|
|
Windows,
|
|
Messages
|
|
{$ENDIF};
|
|
|
|
type
|
|
TInsertProc = procedure(Str: string) of object;
|
|
|
|
TAutoCompleteListBox = class(TListBox)
|
|
protected
|
|
fIndexList: array of Integer;
|
|
fList: TStrings;
|
|
fInsertList: TStrings;
|
|
fFilter: string;
|
|
|
|
procedure setItemList(List: TStrings);
|
|
procedure setInsertList(List: TStrings);
|
|
procedure setFilter(Filter: string);
|
|
|
|
procedure DblClick; override;
|
|
procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
|
|
{$IFDEF FPC}
|
|
procedure WMEraseBkgnd(var message: TLMEraseBkgnd); message LM_ERASEBKGND;
|
|
procedure WMVScroll(var message: TLMVScroll); message LM_VSCROLL;
|
|
procedure CNChar(var message: TLMessage); message CN_CHAR;
|
|
{$ELSE}
|
|
procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
procedure WMVScroll(var message: TWMVScroll); message WM_VSCROLL;
|
|
procedure CNChar(var message: TMessage); message CN_CHAR;
|
|
{$ENDIF}
|
|
public
|
|
ColumnSizes: array of Integer;
|
|
Redirect: TWinControl;
|
|
InsertProc: TInsertProc;
|
|
|
|
procedure setLists(ItemList, InsertList: TStrings);
|
|
function getInsert: string;
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property ItemList: TStrings read fList write setItemList;
|
|
property InsertList: TStrings read fInsertList write setInsertList;
|
|
property Filter: string read fFilter write setFilter;
|
|
end;
|
|
|
|
TAutoCompletePopup = class(TForm)
|
|
protected
|
|
l: TAutoCompleteListBox;
|
|
procedure DoShow; override;
|
|
|
|
function getRedirect: TWinControl;
|
|
procedure setRedirect(Control: TWinControl);
|
|
function getInsertProc: TInsertProc;
|
|
procedure setInsertProc(Proc: TInsertProc);
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
procedure Show(Pos: TPoint; ItemList, InsertList: TStrings; Filter: string = ''; Editor: TWinControl = nil); reintroduce;
|
|
procedure DoHide; override;
|
|
|
|
procedure HandleKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure HandleKeyPress(Sender: TObject; var Key: char);
|
|
published
|
|
property ListBox: TAutoCompleteListBox read l;
|
|
property Redirect: TWinControl read getRedirect write setRedirect;
|
|
property InsertProc: TInsertProc read getInsertProc write setInsertProc;
|
|
end;
|
|
|
|
TParamHint = class(THintWindow)
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
procedure Paint; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
StrUtils {$IFDEF FPC}, lclintf{$ENDIF}, Themes;
|
|
|
|
procedure TAutoCompleteListBox.setItemList(List: TStrings);
|
|
begin
|
|
fList.Assign(List);
|
|
end;
|
|
|
|
procedure TAutoCompleteListBox.setInsertList(List: TStrings);
|
|
begin
|
|
fInsertList.Assign(List);
|
|
end;
|
|
|
|
procedure TAutoCompleteListBox.setLists(ItemList, InsertList: TStrings);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
//fList.Assign(ItemList);
|
|
//fInsertList.Assign(InsertList);
|
|
{$IFDEF FPC}LockSelectionChange;{$ENDIF}
|
|
|
|
fList.BeginUpdate;
|
|
try
|
|
fList.Clear;
|
|
fList.AddStrings(ItemList);
|
|
finally
|
|
fList.EndUpdate;
|
|
end;
|
|
|
|
fInsertList.BeginUpdate;
|
|
try
|
|
fInsertList.Clear;
|
|
fInsertList.AddStrings(InsertList);
|
|
finally
|
|
fInsertList.EndUpdate;
|
|
end;
|
|
|
|
Items.BeginUpdate;
|
|
try
|
|
Items.Clear;
|
|
Items.AddStrings(ItemList);
|
|
finally
|
|
Items.EndUpdate;
|
|
end;
|
|
|
|
fFilter := '';
|
|
|
|
SetLength(fIndexList, fList.Count);
|
|
for i := 0 to fList.Count - 1 do
|
|
fIndexList[i] := i;
|
|
|
|
if (fList.Count > 0) then
|
|
ItemIndex := 0
|
|
else
|
|
ItemIndex := -1;
|
|
|
|
{$IFDEF FPC}UnlockSelectionChange;{$ENDIF}
|
|
end;
|
|
|
|
procedure TAutoCompleteListBox.setFilter(Filter: string);
|
|
var
|
|
i, c, l, del: Integer;
|
|
begin
|
|
Filter := LowerCase(Filter);
|
|
if (Filter = fFilter) then
|
|
Exit;
|
|
|
|
{$IFDEF FPC}LockSelectionChange;{$ENDIF}
|
|
|
|
c := 0;
|
|
if (LeftStr(Filter, Length(fFilter)) = fFilter) then
|
|
begin
|
|
fFilter := Filter;
|
|
|
|
Items.BeginUpdate;
|
|
try
|
|
l := Length(fFilter);
|
|
del := 0;
|
|
|
|
for i := 0 to Items.Count - 1 do
|
|
if (LowerCase(LeftStr(fInsertList[fIndexList[i]], l)) <> fFilter) then
|
|
begin
|
|
Items.Delete(i - del);
|
|
Inc(del);
|
|
end
|
|
else
|
|
begin
|
|
if (ItemIndex = i) or (LowerCase(fInsertList[fIndexList[i]]) = fFilter) then
|
|
ItemIndex := c;
|
|
|
|
fIndexList[c] := fIndexList[i];
|
|
Inc(c);
|
|
end;
|
|
|
|
SetLength(fIndexList, c + 1);
|
|
finally
|
|
Items.EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
fFilter := Filter;
|
|
|
|
Items.BeginUpdate;
|
|
try
|
|
Items.Clear;
|
|
l := Length(fFilter);
|
|
SetLength(fIndexList, fInsertList.Count);
|
|
|
|
for i := 0 to fInsertList.Count - 1 do
|
|
if (LowerCase(LeftStr(fInsertList[i], l)) = fFilter) then
|
|
begin
|
|
Items.Append(fList[i]);
|
|
|
|
if (LowerCase(fInsertList[i]) = fFilter) then
|
|
ItemIndex := i;
|
|
|
|
fIndexList[c] := i;
|
|
Inc(c);
|
|
end;
|
|
SetLength(fIndexList, c + 1);
|
|
finally
|
|
Items.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF FPC}UnlockSelectionChange;{$ENDIF}
|
|
end;
|
|
|
|
function TAutoCompleteListBox.getInsert: string;
|
|
begin
|
|
if (ItemIndex < 0) or (ItemIndex > Length(fIndexList)) then
|
|
Result := ''
|
|
else
|
|
Result := fInsertList[fIndexList[ItemIndex]];
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure TAutoCompleteListBox.WMEraseBkgnd(var message: TLMEraseBkgnd);
|
|
{$ELSE}
|
|
procedure TAutoCompleteListBox.WMEraseBkgnd(var message: TWMEraseBkgnd);
|
|
{$ENDIF}
|
|
begin
|
|
if (Count < Round(Height / ItemHeight)) then
|
|
begin
|
|
Canvas.Brush.Color := clYellow;
|
|
FillRect(message.DC, Rect(0, Count * ItemHeight, Width, Height), HBRUSH({$IFDEF FPC}Brush.Reference.Handle{$ELSE}Parent.Brush.Handle{$ENDIF}));
|
|
end;
|
|
|
|
message.Result := 1;
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure TAutoCompleteListBox.WMVScroll(var message: TLMVScroll);
|
|
{$ELSE}
|
|
procedure TAutoCompleteListBox.WMVScroll(var message: TWMVScroll);
|
|
{$ENDIF}
|
|
var
|
|
c: Integer;
|
|
begin
|
|
{$IFDEF FPC}LockSelectionChange;{$ENDIF}
|
|
if (ItemIndex < TopIndex) then
|
|
ItemIndex := TopIndex
|
|
else
|
|
begin
|
|
c := Round(Height / ItemHeight) - 1;
|
|
if (ItemIndex > TopIndex + c) then
|
|
ItemIndex := TopIndex + c;
|
|
end;
|
|
{$IFDEF FPC}UnlockSelectionChange;{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure TAutoCompleteListBox.CNChar(var message: TLMessage);
|
|
{$ELSE}
|
|
procedure TAutoCompleteListBox.CNChar(var message: TMessage);
|
|
{$ENDIF}
|
|
begin
|
|
inherited;
|
|
|
|
{$IFDEF FPC}
|
|
if (message.Result = 0) and (Redirect <> nil) and (TLMChar(message).CharCode <> VK_DOWN) and (TLMChar(message).CharCode <> VK_UP) and (TLMChar(message).CharCode <> VK_RETURN) then
|
|
{$ELSE}
|
|
if (message.Result = 0) and (Redirect <> nil) and (TWMChar(message).CharCode <> VK_DOWN) and (TWMChar(message).CharCode <> VK_UP) and (TWMChar(message).CharCode <> VK_RETURN) then
|
|
{$ENDIF}
|
|
begin
|
|
Redirect.SetFocus;
|
|
Application.ProcessMessages;
|
|
SendMessage(Redirect.Handle, CN_Char, message.wParam, message.lParam);
|
|
end;
|
|
end;
|
|
|
|
procedure TAutoCompleteListBox.DblClick;
|
|
begin
|
|
if (Assigned(InsertProc)) then
|
|
InsertProc(GetInsert);
|
|
if (Owner is TForm) then
|
|
TForm(Owner).Hide;
|
|
end;
|
|
|
|
procedure TAutoCompleteListBox.DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState);
|
|
var
|
|
p1, p2, p3, tl, col: Integer;
|
|
s, c: string;
|
|
begin
|
|
if (ItemIndex = -1) and (Count > 0) then
|
|
begin
|
|
{$IFDEF FPC}LockSelectionChange;{$ENDIF}
|
|
ItemIndex := TopIndex;
|
|
{$IFDEF FPC}UnlockSelectionChange;{$ENDIF}
|
|
end;
|
|
|
|
if {$IFDEF FPC}(odPainted in State) or{$ENDIF} (not Visible) or (ARect.Left > ClientRect.Right) or (ARect.Top > ClientRect.Bottom) or (Index < 0) or (Index >= Items.Count) then
|
|
Exit;
|
|
|
|
tl := ARect.Left;
|
|
col := 0;
|
|
with Canvas do
|
|
begin
|
|
Font.Style := [];
|
|
Font.Color := clBlack;
|
|
if (odSelected in State) then
|
|
Brush.Color := clHighlight
|
|
else if (odHotLight in State) then
|
|
Brush.Color := clHotLight
|
|
else if Odd(Index) then
|
|
Brush.Color := $F0F0F0
|
|
else
|
|
Brush.Color := clWhite;
|
|
FillRect(ARect);
|
|
|
|
s := Items[Index];
|
|
p1 := Pos('{', s);
|
|
p3 := 1;
|
|
while (p1 > 0) do
|
|
begin
|
|
p2 := PosEx('}', s, p1 + 1);
|
|
if (p2 > 0) then
|
|
begin
|
|
if (s[p2 - 1] <> '\') then
|
|
begin
|
|
c := Copy(s, p3, p1 - p3);
|
|
TextOut(tl, ARect.Top + Round((ItemHeight - TextHeight(c) + 0.001) / 2) , c);
|
|
tl := tl + TextWidth(c) + 1;
|
|
|
|
p3 := p2 + 1;
|
|
if ((p2 - p1 - 2) > 0) then
|
|
begin
|
|
c := LowerCase(Copy(s, p1 + 2, p2 - p1 - 2));
|
|
case Char(CharUpper({$IFNDEF FPC}PChar{$ELSE}Char{$ENDIF}(s[p1 + 1]))) of
|
|
'#', 'C': Font.Color := StringToColor(c);
|
|
'B':
|
|
if (c = '+') then
|
|
Font.Style := Font.Style + [fsBold]
|
|
else
|
|
Font.Style := Font.Style - [fsBold];
|
|
'I':
|
|
if (c = '+') then
|
|
Font.Style := Font.Style + [fsItalic]
|
|
else
|
|
Font.Style := Font.Style - [fsItalic];
|
|
'U':
|
|
if (c = '+') then
|
|
Font.Style := Font.Style + [fsUnderline]
|
|
else
|
|
Font.Style := Font.Style - [fsUnderline];
|
|
end;
|
|
end
|
|
else if (s[p1 + 1] = '|') then
|
|
begin
|
|
if (ColumnSizes[col] = -1) then
|
|
ColumnSizes[col] := Canvas.TextWidth('constructor') + 5;
|
|
tl := ColumnSizes[col];
|
|
Inc(Col);
|
|
end;
|
|
p1 := PosEx('{', s, p2 + 1);
|
|
end;
|
|
end
|
|
else
|
|
Break;
|
|
end;
|
|
|
|
if ((Length(s) - p3 + 1) > 0) then
|
|
begin
|
|
c := Copy(s, p3, Length(s) - p3 + 1);
|
|
TextOut(tl, ARect.Top + Round((ItemHeight - TextHeight(c) + 0.001) / 2), c);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TAutoCompleteListBox.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
DoubleBuffered := True;
|
|
ControlStyle := ControlStyle + [csOpaque];
|
|
BorderStyle := bsNone;
|
|
Style := lbOwnerDrawFixed;
|
|
|
|
IntegralHeight := True;
|
|
{$IFDEF FPC}
|
|
ItemHeight := CalculateStandardItemHeight + 4;
|
|
{$ELSE}
|
|
ItemHeight := 19;
|
|
{$ENDIF}
|
|
Constraints.MinHeight := ItemHeight;
|
|
|
|
SetLength(ColumnSizes, 1);
|
|
ColumnSizes[0] := -1;
|
|
Redirect := nil;
|
|
InsertProc := nil;
|
|
|
|
Items.Clear;
|
|
fList := TStringList .Create;
|
|
fInsertList := TStringList.Create;
|
|
fFilter := '';
|
|
end;
|
|
|
|
destructor TAutoCompleteListBox.Destroy;
|
|
begin
|
|
FreeAndNil(fList);
|
|
FreeAndNil(fInsertList);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TAutoCompletePopup.DoShow;
|
|
begin
|
|
//ClientHeight := Max(Min(Round(ClientHeight / l.ItemHeight), l.Count), 1) * l.ItemHeight;
|
|
//ClientHeight := Max(Round(ClientHeight / l.ItemHeight), 1) * l.ItemHeight;
|
|
end;
|
|
|
|
function TAutoCompletePopup.getRedirect: TWinControl;
|
|
begin
|
|
Result := ListBox.Redirect;
|
|
end;
|
|
|
|
procedure TAutoCompletePopup.setRedirect(Control: TWinControl);
|
|
begin
|
|
ListBox.Redirect := Control;
|
|
end;
|
|
|
|
function TAutoCompletePopup.getInsertProc: TInsertProc;
|
|
begin
|
|
Result := ListBox.InsertProc;
|
|
end;
|
|
|
|
procedure TAutoCompletePopup.setInsertProc(Proc: TInsertProc);
|
|
begin
|
|
ListBox.InsertProc := Proc;
|
|
end;
|
|
|
|
constructor TAutoCompletePopup.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
l := TAutoCompleteListBox.Create(Self);
|
|
with l do
|
|
begin
|
|
Parent := Self;
|
|
Align := alClient;
|
|
OnKeyDown := {$IFDEF FPC}@{$ENDIF}HandleKeyDown;
|
|
OnKeyPress := {$IFDEF FPC}@{$ENDIF}HandleKeyPress;
|
|
end;
|
|
|
|
DefaultMonitor := dmMainForm;
|
|
FormStyle := fsStayOnTop;
|
|
|
|
{$IFDEF FPC}
|
|
ShowInTaskBar := stNever;
|
|
{$ENDIF}
|
|
|
|
BorderStyle := bsSizeToolWin;
|
|
BorderIcons := [];
|
|
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and (not WS_CAPTION) or WS_BORDER);
|
|
Height := Height - GetSystemMetrics(SM_CYCAPTION);
|
|
|
|
DoubleBuffered := True;
|
|
ControlStyle := ControlStyle + [csOpaque];
|
|
|
|
ClientHeight := Round(ClientHeight / l.ItemHeight) * l.ItemHeight;
|
|
Constraints.MinHeight := l.ItemHeight;
|
|
Constraints.MinWidth := 100;
|
|
end;
|
|
|
|
procedure TAutoCompletePopup.DoHide;
|
|
begin
|
|
ListBox.Clear;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TAutoCompletePopup.HandleKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if Visible then
|
|
begin
|
|
case Key of
|
|
VK_UP:
|
|
if (ListBox.Count > 0) and (ListBox.ItemIndex > 0) then
|
|
ListBox.ItemIndex := ListBox.ItemIndex - 1;
|
|
VK_DOWN:
|
|
if (ListBox.Count > 0) and (ListBox.ItemIndex + 1 < ListBox.Count) then
|
|
ListBox.ItemIndex := ListBox.ItemIndex + 1;
|
|
VK_RETURN:
|
|
ListBox.DblClick;
|
|
VK_ESCAPE:
|
|
Hide;
|
|
else
|
|
Exit;
|
|
end;
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TAutoCompletePopup.HandleKeyPress(Sender: TObject; var Key: char);
|
|
begin
|
|
if Visible and (not (Key in ['a'..'z', 'A'..'Z', '0'..'9', '_'])) then
|
|
if (Key in ['.', '(', '[', ';', ':']) then
|
|
ListBox.DblClick
|
|
else
|
|
Hide;
|
|
end;
|
|
|
|
procedure TAutoCompletePopup.Show(Pos: TPoint; ItemList, InsertList: TStrings; Filter: string = ''; Editor: TWinControl = nil);
|
|
begin
|
|
ListBox.setLists(ItemList, InsertList);
|
|
ListBox.Redirect := Editor;
|
|
ListBox.Filter := Filter;
|
|
Left := Pos.x;
|
|
Top := Pos.y;
|
|
|
|
inherited Show;
|
|
|
|
if (Editor <> nil) then
|
|
Editor.SetFocus;
|
|
end;
|
|
|
|
constructor TParamHint.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
{$IFDEF FPC}
|
|
AutoHide := False;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TParamHint.Paint;
|
|
|
|
function GetDrawTextFlags: Cardinal;
|
|
var
|
|
EffectiveAlignment: TAlignment;
|
|
begin
|
|
Result := DT_NOPREFIX or DT_VCENTER or DT_WORDBREAK;
|
|
EffectiveAlignment := Alignment;
|
|
if BiDiMode <> bdLeftToRight then
|
|
begin
|
|
Result := Result or DT_RTLREADING;
|
|
//change alignment if is RTL
|
|
if BiDiMode = bdRightToLeft then
|
|
begin
|
|
case Alignment of
|
|
taLeftJustify: EffectiveAlignment := taRightJustify;
|
|
taRightJustify: EffectiveAlignment := taLeftJustify;
|
|
end;
|
|
end;
|
|
end;
|
|
case EffectiveAlignment of
|
|
taLeftJustify: Result := Result or DT_LEFT;
|
|
taCenter: Result := Result or DT_CENTER;
|
|
taRightJustify: Result := Result or DT_RIGHT;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
ARect: TRect;
|
|
Details: TThemedElementDetails;
|
|
begin
|
|
ARect := ClientRect;
|
|
if Color = clInfoBk then // draw using themes
|
|
begin
|
|
Details := ThemeServices.GetElementDetails(tttStandardLink);
|
|
ThemeServices.DrawElement(Canvas.Handle, Details, ARect);
|
|
end
|
|
else
|
|
begin
|
|
Canvas.Brush.Color := Color;
|
|
Canvas.Pen.Width := 1;
|
|
Canvas.FillRect(ARect);
|
|
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT);
|
|
end;
|
|
InflateRect(ARect, - 4, - 4);
|
|
Canvas.TextOut(ARect.Left, ARect.Top, Caption);
|
|
end;
|
|
|
|
end.
|
|
|