Using some answers in StackOverflow I've created a searcheable TComboBox in Delphi. It works fine when you add it directly to a Form, but breaks as soon as you add it to a TPanel and I can't seem to figure out why.
Directly on the form:
After typing t:
Inside a panel:
After typing t:
Here is the component's code:
unit uSmartCombo;
interface
uses
Vcl.StdCtrls, Classes, Winapi.Messages, Controls;
type
TSmartComboBox = class(TComboBox)
private
FStoredItems: TStringList;
procedure FilterItems;
procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
procedure RedefineCombo;
procedure SetStoredItems(const Value: TStringList);
procedure StoredItemsChange(Sender: TObject);
protected
procedure KeyPress(var Key: Char); override;
procedure CloseUp; override;
procedure Loaded; override;
procedure DoExit; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property StoredItems: TStringList read FStoredItems write SetStoredItems;
end;
procedure Register;
implementation
uses
SysUtils, Winapi.Windows, Vcl.Forms;
procedure Register;
begin
RegisterComponents('Standard', [TSmartComboBox]);
end;
constructor TSmartComboBox.Create(AOwner: TComponent);
begin
inherited;
FStoredItems := TStringList.Create;
FStoredItems.OnChange := StoredItemsChange;
end;
destructor TSmartComboBox.Destroy;
begin
FStoredItems.Free;
inherited;
end;
procedure TSmartComboBox.DoExit;
begin
inherited;
RedefineCombo;
end;
procedure TSmartComboBox.Loaded;
var LParent: TWinControl;
LPoint: TPoint;
begin
inherited;
if Items.Count > 0 then
FStoredItems.Assign(Items);
AutoComplete := False;
Style := csDropDownList;
// The ComboBox doesn't behave properly if the parent is not the form.
// Workaround to pull it from any parenting
//if not (Parent is TForm) then
//begin
// LParent := Parent;
// while (not (LParent is TForm)) and Assigned(LParent) do
// LParent := LParent.Parent;
// LPoint := ClientToParent(Point(0,0), LParent);
// Parent := LParent;
// Left := LPoint.X;
// Top := LPoint.Y;
// BringToFront;
//end;
end;
procedure TSmartComboBox.RedefineCombo;
var S: String;
begin
if Style = csDropDown then
begin
if ItemIndex <> -1 then
S := Items[ItemIndex];
Style := csDropDownList;
Items.Assign(FStoredItems);
if S <> '' then
ItemIndex := Items.IndexOf(S);
end;
end;
procedure TSmartComboBox.SetStoredItems(const Value: TStringList);
begin
if Assigned(FStoredItems) then
FStoredItems.Assign(Value)
else
FStoredItems := Value;
end;
procedure TSmartComboBox.StoredItemsChange(Sender: TObject);
begin
if Assigned(FStoredItems) then
begin
RedefineCombo;
Items.Assign(FStoredItems);
end;
end;
procedure TSmartComboBox.KeyPress(var Key: Char);
begin
if CharInSet(Key, ['a'..'z']) and not (Style = csDropDown) then
begin
DroppedDown := False;
Style := csDropDown;
end;
inherited;
if not (Ord(Key) in [13,27]) then
DroppedDown := True;
end;
procedure TSmartComboBox.CloseUp;
begin
if Style = csDropDown then
RedefineCombo;
inherited;
end;
procedure TSmartComboBox.CNCommand(var AMessage: TWMCommand);
begin
inherited;
if (AMessage.Ctl = Handle) and (AMessage.NotifyCode = CBN_EDITUPDATE) then
FilterItems;
end;
procedure TSmartComboBox.FilterItems;
var I: Integer;
Selection: TSelection;
begin
SendMessage(Handle, CB_GETEDITSEL, WPARAM(#Selection.StartPos), LPARAM(#Selection.EndPos));
Items.BeginUpdate;
Try
if Text <> '' then
begin
Items.Clear;
for I := 0 to FStoredItems.Count - 1 do
if (Pos(Uppercase(Text), Uppercase(FStoredItems[I])) > 0) then
Items.Add(FStoredItems[I]);
end
else
Items.Assign(FStoredItems);
Finally
Items.EndUpdate;
End;
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;
end.
Any help in how I can proceed to figure out why this is happening would be greatly appreciated!
Edit 1:
After doing some extra debugging, I've noticed the messages being sent to the ComboBox differ from the ones inside the panel.
A CBN_EDITUPDATE is never sent, like #Sherlock70 mentioned in the comments, which makes the FilterItems procedure never trigger.
I've also noticed the form behaves strangely after using the ComboBox inside the panel, sometimes freezing and even not responding, like it gets stuck in a loop.
This unpredictable behavior has made me move away from this approach, and I'm probably going to take an alternate route to create a "searchable ComboBox".
Going to leave the question open if someone wants to figure it out and maybe even use the component.
I hope this will help someone in future even after 7 months of the question. Setting the style of a Combobox will destroy the window handle of that Combobox and create a new one. This means windows will free your control's Window Handle and create a new one.
You are setting your Combobx style while searching and this is wrong. Try removing Style := from your code and test it again you will get the same results for Combobox on a form and Combobox on a panel or other TWinControl. As you can see in the following code, setting Style will call RecreateWnd.
procedure TCustomComboBox.SetStyle(Value: TComboBoxStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
if Value = csSimple then
ControlStyle := ControlStyle - [csFixedHeight] else
ControlStyle := ControlStyle + [csFixedHeight];
RecreateWnd;
end;
end;
RecreateWnd will call DestroyHandle()
procedure TWinControl.CMRecreateWnd(var Message: TMessage);
var
WasFocused: Boolean;
begin
WasFocused := Focused;
DestroyHandle;
UpdateControlState;
if WasFocused and (FHandle <> 0) then Windows.SetFocus(FHandle);
end;
Then DestroyHandle will call DestroyWnd() which will call DestroyWindowHandle().
As the title says, I'd like a component (say, a label) to be notified when it's parent (say, a panel) receives and loses focus. I wandered a bit in Delphi source, in hope of using TControl.Notify, but it's only used to notify child controls of some property changes like font and color. Any suggestions?
Whenever the active control in an application changes, a CM_FOCUSCHANGED message is broadcast to all controls. Simply intercept it, and act accordingly.
Also, I assumed that by when it's parent (say, a panel) receives and loses focus you mean whenever a (nested) child control on that parent/panel receives or loses focus.
type
TLabel = class(StdCtrls.TLabel)
private
function HasCommonParent(AControl: TWinControl): Boolean;
procedure CMFocusChanged(var Message: TCMFocusChanged);
message CM_FOCUSCHANGED;
end;
procedure TLabel.CMFocusChanged(var Message: TCMFocusChanged);
const
FontStyles: array[Boolean] of TFontStyles = ([], [fsBold]);
begin
inherited;
Font.Style := FontStyles[HasCommonParent(Message.Sender)];
end;
function TLabel.HasCommonParent(AControl: TWinControl): Boolean;
begin
Result := False;
while AControl <> nil do
begin
if AControl = Parent then
begin
Result := True;
Break;
end;
AControl := AControl.Parent;
end;
end;
If you don't like to subclass TJvGradientHeader, then it is possible to design this generically by the use of Screen.OnActiveControlChange:
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FHeaders: TList;
procedure ActiveControlChanged(Sender: TObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FHeaders := TList.Create;
FHeaders.Add(Label1);
FHeaders.Add(Label2);
Screen.OnActiveControlChange := ActiveControlChanged;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FHeaders.Free;
end;
function HasCommonParent(AControl: TWinControl; AMatch: TControl): Boolean;
begin
Result := False;
while AControl <> nil do
begin
if AControl = AMatch.Parent then
begin
Result := True;
Break;
end;
AControl := AControl.Parent;
end;
end;
procedure TForm1.ActiveControlChanged(Sender: TObject);
const
FontStyles: array[Boolean] of TFontStyles = ([], [fsBold]);
var
I: Integer;
begin
for I := 0 to FHeaders.Count - 1 do
TLabel(FHeaders[I]).Font.Style :=
FontStyles[HasCommonParent(Screen.ActiveControl, TLabel(FHeaders[I]))];
end;
Note that I chose TLabel to demonstrate this works also for TControl derivatives.
I would like a user to be able to type in the second or third word from a TComboBox item and for that item to appear in the AutoSuggest dropdown options
For example, a combo box contains the items:
Mr John Brown
Mrs Amanda Brown
Mr Brian Jones
Mrs Samantha Smith
When the user types "Br" the dropdown displays:
Mr John Brown
Mrs Amanda Brown
Mr Brian Jones
and when the user types "Jo" the dropdown displays:
Mr John Brown
Mr Brian Jones
The problem is that the AutoSuggest functionality only includes items in the dropdown list that begin with what the user has input and so in the examples above nothing will appear in the dropdown.
Is it possible to use the IAutoComplete interface and/or other related interfaces to get around this issue?
The following example uses the interposed class of the TComboBox component. The main difference from the original class is that the items are stored in the separate StoredItems property instead ofthe Items as usually (used because of simplicity).
The StoredItems are being watched by the OnChange event and whenever you change them (for instance by adding or deleting from this string list), the current filter will reflect it even when the combolist is dropped down.
The main point here is to catch the WM_COMMAND message notification CBN_EDITUPDATE which is being sent whenever the combo edit text is changed but not rendered yet. When it arrives, you just search through the StoredItems list for what you have typed in your combo edit and fill the Items property with matches.
For text searching is used the ContainsText so the search is case insensitive. Forgot to mention,the AutoComplete feature has to be turned off because it has its own, unwelcomed, logic for this purpose.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, StrUtils, ExtCtrls;
type
TComboBox = class(StdCtrls.TComboBox)
private
FStoredItems: TStringList;
procedure FilterItems;
procedure StoredItemsChange(Sender: TObject);
procedure SetStoredItems(const Value: TStringList);
procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property StoredItems: TStringList read FStoredItems write SetStoredItems;
end;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TComboBox.Create(AOwner: TComponent);
begin
inherited;
AutoComplete := False;
FStoredItems := TStringList.Create;
FStoredItems.OnChange := StoredItemsChange;
end;
destructor TComboBox.Destroy;
begin
FStoredItems.Free;
inherited;
end;
procedure TComboBox.CNCommand(var AMessage: TWMCommand);
begin
// we have to process everything from our ancestor
inherited;
// if we received the CBN_EDITUPDATE notification
if AMessage.NotifyCode = CBN_EDITUPDATE then
// fill the items with the matches
FilterItems;
end;
procedure TComboBox.FilterItems;
var
I: Integer;
Selection: TSelection;
begin
// store the current combo edit selection
SendMessage(Handle, CB_GETEDITSEL, WPARAM(#Selection.StartPos),
LPARAM(#Selection.EndPos));
// begin with the items update
Items.BeginUpdate;
try
// if the combo edit is not empty, then clear the items
// and search through the FStoredItems
if Text <> '' then
begin
// clear all items
Items.Clear;
// iterate through all of them
for I := 0 to FStoredItems.Count - 1 do
// check if the current one contains the text in edit
if ContainsText(FStoredItems[I], Text) then
// and if so, then add it to the items
Items.Add(FStoredItems[I]);
end
// else the combo edit is empty
else
// so then we'll use all what we have in the FStoredItems
Items.Assign(FStoredItems)
finally
// finish the items update
Items.EndUpdate;
end;
// and restore the last combo edit selection
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos,
Selection.EndPos));
end;
procedure TComboBox.StoredItemsChange(Sender: TObject);
begin
if Assigned(FStoredItems) then
FilterItems;
end;
procedure TComboBox.SetStoredItems(const Value: TStringList);
begin
if Assigned(FStoredItems) then
FStoredItems.Assign(Value)
else
FStoredItems := Value;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
ComboBox: TComboBox;
begin
// here's one combo created dynamically
ComboBox := TComboBox.Create(Self);
ComboBox.Parent := Self;
ComboBox.Left := 10;
ComboBox.Top := 10;
ComboBox.Text := 'Br';
// here's how to fill the StoredItems
ComboBox.StoredItems.BeginUpdate;
try
ComboBox.StoredItems.Add('Mr John Brown');
ComboBox.StoredItems.Add('Mrs Amanda Brown');
ComboBox.StoredItems.Add('Mr Brian Jones');
ComboBox.StoredItems.Add('Mrs Samantha Smith');
finally
ComboBox.StoredItems.EndUpdate;
end;
// and here's how to assign the Items of the combo box from the form
// to the StoredItems; note that if you'll use this, you have to do
// it before you type something into the combo's edit, because typing
// may filter the Items, so they would get modified
ComboBox1.StoredItems.Assign(ComboBox1.Items);
end;
end.
This code was quite good actually, I just fixed bug with handling messages when combo is dropped down, some minor interactions with TComboBox behavior and made it a little user-friendlier. To use it just invoke InitSmartCombo after filling the Items list.
TSmartComboBox is drop in replacement for TComboBox, if you invoke InitSmartCombo it behaves as smart combo, otherwise it acts as standard TComboBox
unit SmartCombo;
interface
uses stdctrls,classes,messages,controls,windows,sysutils;
type
TSmartComboBox = class(TComboBox)
// Usage:
// Same as TComboBox, just invoke InitSmartCombo after Items list is filled with data.
// After InitSmartCombo is invoked, StoredItems is assigned and combo starts to behave as a smart combo.
// If InitSmartCombo is not invoked it acts as standard TComboBox, it is safe to bulk replace all TComboBox in application with TSmartComboBox
private
FStoredItems: TStringList;
dofilter:boolean;
storeditemindex:integer;
procedure FilterItems;
procedure StoredItemsChange(Sender: TObject);
procedure SetStoredItems(const Value: TStringList);
procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
protected
procedure KeyPress(var Key: Char); override;
procedure CloseUp; override;
procedure Click; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property StoredItems: TStringList read FStoredItems write SetStoredItems;
procedure InitSmartCombo;
end;
implementation
procedure TSmartComboBox.KeyPress(var Key: Char); // combo dropdown must be done in keypress, if its done on CBN_EDITUPDATE it messes up whole message processing mumbo-jumbo
begin
inherited;
if dofilter and not (ord(key) in [13,27]) then begin
if (items.Count<>0) and not droppeddown then SendMessage(Handle, CB_SHOWDROPDOWN, 1, 0) // something matched -> dropdown combo to display results
end;
end;
procedure TSmartComboBox.CloseUp; // ugly workaround for some wierd combobox/modified code interactions
var x:string;
begin
if dofilter then begin
if (items.count=1) and (itemindex=0) then text:=items[itemindex]
else if ((text<>'') and (itemindex<>-1) and (text<>items[itemindex])) or ((text='') and(itemindex=0)) then begin
storeditemindex:=itemindex;
x:=text;
itemindex:=items.indexof(text);
if itemindex=-1 then text:=x;
end
else storeditemindex:=-1;
end;
inherited;
end;
procedure TSmartComboBox.Click; // ugly workaround for some weird combobox/modified code interactions
begin
if dofilter then begin
if storeditemindex<>-1 then itemindex:=storeditemindex;
storeditemindex:=-1;
end;
inherited;
end;
procedure TSmartComboBox.InitSmartCombo;
begin
FStoredItems.OnChange:=nil;
StoredItems.Assign(Items);
AutoComplete := False;
FStoredItems.OnChange := StoredItemsChange;
dofilter:=true;
storeditemindex:=-1;
end;
constructor TSmartComboBox.Create(AOwner: TComponent);
begin
inherited;
FStoredItems := TStringList.Create;
dofilter:=false;
end;
destructor TSmartComboBox.Destroy;
begin
FStoredItems.Free;
inherited;
end;
procedure TSmartComboBox.CNCommand(var AMessage: TWMCommand);
begin
// we have to process everything from our ancestor
inherited;
// if we received the CBN_EDITUPDATE notification
if (AMessage.NotifyCode = CBN_EDITUPDATE) and dofilter then begin
// fill the items with the matches
FilterItems;
end;
end;
procedure TSmartComboBox.FilterItems;
var
I: Integer;
Selection: TSelection;
begin
// store the current combo edit selection
SendMessage(Handle, CB_GETEDITSEL, WPARAM(#Selection.StartPos), LPARAM(#Selection.EndPos));
// begin with the items update
Items.BeginUpdate;
try
// if the combo edit is not empty, then clear the items
// and search through the FStoredItems
if Text <> '' then begin
// clear all items
Items.Clear;
// iterate through all of them
for I := 0 to FStoredItems.Count - 1 do begin
// check if the current one contains the text in edit, case insensitive
if (Pos( uppercase(Text), uppercase(FStoredItems[I]) )>0) then begin
// and if so, then add it to the items
Items.Add(FStoredItems[I]);
end;
end;
end else begin
// else the combo edit is empty
// so then we'll use all what we have in the FStoredItems
Items.Assign(FStoredItems);
end;
finally
// finish the items update
Items.EndUpdate;
end;
// and restore the last combo edit selection
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;
procedure TSmartComboBox.StoredItemsChange(Sender: TObject);
begin
if Assigned(FStoredItems) then
FilterItems;
end;
procedure TSmartComboBox.SetStoredItems(const Value: TStringList);
begin
if Assigned(FStoredItems) then
FStoredItems.Assign(Value)
else
FStoredItems := Value;
end;
procedure Register;
begin
RegisterComponents('Standard', [TSmartComboBox]);
end;
end.
Thanks for the heart! With a little reworking, I think that is quite right.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, StrUtils, ExtCtrls;
type
TComboBox = class(StdCtrls.TComboBox)
private
FStoredItems: TStringList;
procedure FilterItems;
procedure StoredItemsChange(Sender: TObject);
procedure SetStoredItems(const Value: TStringList);
procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property StoredItems: TStringList read FStoredItems write SetStoredItems;
end;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{}constructor TComboBox.Create(AOwner: TComponent);
begin
inherited;
AutoComplete := False;
FStoredItems := TStringList.Create;
FStoredItems.OnChange := StoredItemsChange;
end;
{}destructor TComboBox.Destroy;
begin
FStoredItems.Free;
inherited;
end;
{}procedure TComboBox.CNCommand(var AMessage: TWMCommand);
begin
// we have to process everything from our ancestor
inherited;
// if we received the CBN_EDITUPDATE notification
if AMessage.NotifyCode = CBN_EDITUPDATE then begin
// fill the items with the matches
FilterItems;
end;
end;
{}procedure TComboBox.FilterItems;
type
TSelection = record
StartPos, EndPos: Integer;
end;
var
I: Integer;
Selection: TSelection;
xText: string;
begin
// store the current combo edit selection
SendMessage(Handle, CB_GETEDITSEL, WPARAM(#Selection.StartPos), LPARAM(#Selection.EndPos));
// begin with the items update
Items.BeginUpdate;
try
// if the combo edit is not empty, then clear the items
// and search through the FStoredItems
if Text <> '' then begin
// clear all items
Items.Clear;
// iterate through all of them
for I := 0 to FStoredItems.Count - 1 do begin
// check if the current one contains the text in edit
// if ContainsText(FStoredItems[I], Text) then
if Pos( Text, FStoredItems[I])>0 then begin
// and if so, then add it to the items
Items.Add(FStoredItems[I]);
end;
end;
end else begin
// else the combo edit is empty
// so then we'll use all what we have in the FStoredItems
Items.Assign(FStoredItems)
end;
finally
// finish the items update
Items.EndUpdate;
end;
// and restore the last combo edit selection
xText := Text;
SendMessage(Handle, CB_SHOWDROPDOWN, Integer(True), 0);
if (Items<>nil) and (Items.Count>0) then begin
ItemIndex := 0;
end else begin
ItemIndex := -1;
end;
Text := xText;
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;
{}procedure TComboBox.StoredItemsChange(Sender: TObject);
begin
if Assigned(FStoredItems) then
FilterItems;
end;
{}procedure TComboBox.SetStoredItems(const Value: TStringList);
begin
if Assigned(FStoredItems) then
FStoredItems.Assign(Value)
else
FStoredItems := Value;
end;
//=====================================================================
{}procedure TForm1.FormCreate(Sender: TObject);
var
ComboBox: TComboBox;
xList:TStringList;
begin
// here's one combo created dynamically
ComboBox := TComboBox.Create(Self);
ComboBox.Parent := Self;
ComboBox.Left := 8;
ComboBox.Top := 8;
ComboBox.Width := Width-16;
// ComboBox.Style := csDropDownList;
// here's how to fill the StoredItems
ComboBox.StoredItems.BeginUpdate;
try
xList:=TStringList.Create;
xList.LoadFromFile('list.txt');
ComboBox.StoredItems.Assign( xList);
finally
ComboBox.StoredItems.EndUpdate;
end;
ComboBox.DropDownCount := 24;
// and here's how to assign the Items of the combo box from the form
// to the StoredItems; note that if you'll use this, you have to do
// it before you type something into the combo's edit, because typing
// may filter the Items, so they would get modified
ComboBox.StoredItems.Assign(ComboBox.Items);
end;
end.
Added code for Unicode users.
Actually, it was only tested in Korean :(
Applied function
Prevents bugs that appear when OnExit or DropDown occurs while entering Unicode
Prevents bugs that occur when text correction or additional input after selecting an item
Modified code content
#Prevents a bug - typing values are appended when selecting a list while typing in Unicode
#Filtering is applied to each Unicode being typed if it is being entered after the end of the text.
#Exception handling in case of entering Unicode after selecting several texts
#Exception handling in case of additional input of Unicode when there is already a character in edit and the listbox is closed
Source...
unit SmartCombo;
interface
uses StdCtrls, Classes, Messages, Controls, Windows, SysUtils, StrUtils;
type
TSmartComboBox = class(TComboBox)
// Usage:
// Same as TComboBox, just invoke InitSmartCombo after Items list is filled with data.
// After InitSmartCombo is invoked, StoredItems is assigned and combo starts to behave as a smart combo.
// If InitSmartCombo is not invoked it acts as standard TComboBox, it is safe to bulk replace all TComboBox in application with TSmartComboBox
private
FChar: Char; // #for UNICODE Filter
FIgnoreChar: boolean; // #for UNICODE Edit
FStoredItems: TStringList;
doFilter: boolean;
StoredItemIndex: Integer;
procedure StoredItemsChange(Sender: TObject);
procedure SetStoredItems(const Value: TStringList);
procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
function GetXText(var Key: Char): string;
function GetXSelStart: Integer;
protected
procedure KeyPress(var Key: Char); override;
// #Prevents a bug - typing values are appended when selecting a list while typing in Unicode
procedure EditWndProc(var Message: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure FilterItems;
procedure InitSmartCombo;
property StoredItems: TStringList read FStoredItems write SetStoredItems;
end;
implementation
function TSmartComboBox.GetXText(var Key: Char): string;
var
tmp: string;
begin
if (Text = '') then // empty edit box
result := ''
else if SelLength > 0 then // has selection
begin
tmp := Copy(Text, SelStart + 1, SelLength);
result := ReplaceStr(Text, tmp, '');
end
else // not empty edit box and no selection
begin
tmp := Copy(Text, 1, SelStart);
result := tmp + Key;
result := result + Copy(Text, SelStart + 1, Length(Text) - SelStart);
Key := #0;
end;
end;
function TSmartComboBox.GetXSelStart: Integer;
begin
// empty edit box or has selection
if (Text = '') or (SelLength > 0) then
result := SelStart
else // not empty edit box and no selection
result := SelStart + 1;
end;
procedure TSmartComboBox.KeyPress(var Key: Char);
// combo dropdown must be done in keypress, if its done on CBN_EDITUPDATE it messes up whole message processing mumbo-jumbo
var
xSelStart: Integer;
xText: string;
begin
inherited;
if Ord(Key) = 8 then
FChar := Key;
if doFilter and not(Ord(Key) in [8, 13, 27]) then // BackSpace, Enter, ESC
begin
FChar := Key;
if DroppedDown then
Exit;
if Items.Count = 0 then
Exit;
// backup
xSelStart := GetXSelStart;
xText := GetXText(Key);
// dropdown
SendMessage(Handle, CB_SHOWDROPDOWN, 1, 0);
if xText.IsEmpty then
Exit;
// restore
Text := xText;
SelStart := xSelStart;
end;
end;
procedure TSmartComboBox.InitSmartCombo;
begin
FStoredItems.OnChange := nil;
StoredItems.Assign(Items);
AutoComplete := False;
FStoredItems.OnChange := StoredItemsChange;
doFilter := True;
StoredItemIndex := -1;
end;
constructor TSmartComboBox.Create(AOwner: TComponent);
begin
inherited;
FStoredItems := TStringList.Create;
FIgnoreChar := False;
doFilter := False;
end;
destructor TSmartComboBox.Destroy;
begin
FStoredItems.Free;
inherited;
end;
procedure TSmartComboBox.EditWndProc(var Message: TMessage);
var
OldText: string;
begin
case Message.Msg of
WM_IME_ENDCOMPOSITION:
begin
OldText := Self.Text;
inherited;
FIgnoreChar := Self.Text = OldText;
end;
WM_CHAR:
begin
FIgnoreChar := False;
inherited;
end;
WM_IME_CHAR:
begin
if FIgnoreChar then
FIgnoreChar := False
else
inherited;
end;
else
inherited;
end;
end;
procedure TSmartComboBox.CNCommand(var AMessage: TWMCommand);
begin
// we have to process everything from our ancestor
inherited;
// #Filtering is applied to each Unicode being typed if it is being entered after the end of the text.
// #If you are typing in the middle of the text, do not apply filtering to the Unicode being typed
// (filtering is applied in units of completed Unicode characters)
if (SelStart < Length(Text)) and (FChar = #0) then
Exit;
// if we received the CBN_EDITUPDATE notification
if (AMessage.NotifyCode = CBN_EDITUPDATE) and doFilter then
begin
// fill the items with the matches
FilterItems;
end;
FChar := #0;
end;
procedure TSmartComboBox.FilterItems;
var
I: Integer;
Selection: TSelection;
begin
// store the current combo edit selection
SendMessage(Handle, CB_GETEDITSEL, WPARAM(#Selection.StartPos), LPARAM(#Selection.EndPos));
// begin with the items update
Items.BeginUpdate;
try
// if the combo edit is not empty, then clear the items
// and search through the FStoredItems
if Text <> '' then
begin
// clear all items
Items.Clear;
// iterate through all of them
for I := 0 to FStoredItems.Count - 1 do
begin
// check if the current one contains the text in edit, case insensitive
if ContainsText(FStoredItems[I], Text) then
begin
// and if so, then add it to the items
Items.Add(FStoredItems[I]);
end;
end;
end
else
begin
// else the combo edit is empty
// so then we'll use all what we have in the FStoredItems
Items.Assign(FStoredItems);
end;
finally
// finish the items update
Items.EndUpdate;
end;
// and restore the last combo edit selection
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;
procedure TSmartComboBox.StoredItemsChange(Sender: TObject);
begin
if Assigned(FStoredItems) then
FilterItems;
end;
procedure TSmartComboBox.SetStoredItems(const Value: TStringList);
begin
if Assigned(FStoredItems) then
FStoredItems.Assign(Value)
else
FStoredItems := Value;
end;
end.
In handled OnDropDown event setup TComboBox items filtered by:
Pos function,
RegEx
or something even more advanced
from external full string list. Or better write your own TComboBox(TCustomComboBox) descendant.
I've modified the TLama's component and created one for my specific use case. I'm going to leave the source here if someone has similar needs.
It's basically a TComboBox which only allows it's text to be set to an actual valid value.
It behaves like a normal ComboBox with it's Style set to csDropDownList until you start typing in it. After typing, it'll search the StoredItems values and populate the Items with it.
When the component is loaded, it'll assign the Items defined in design time to the StoredItems property. Further modifications to the list in runtime have to be done using the StoredItems property.
The only issues that've found and was not able to fix is that for some reason it only works if the parent of the ComboBox is the actual form (only tested in XE2, may not be a problem in other versions).
I've added some code that pulls the ComboBox out of any nesting while keeping it's relative position, but it loses any other parenting feature.
unit uSmartCombo;
interface
uses
Vcl.StdCtrls, Classes, Winapi.Messages, Controls;
type
TSmartComboBox = class(TComboBox)
private
FStoredItems: TStringList;
procedure FilterItems;
procedure CNCommand(var AMessage: TWMCommand); message CN_COMMAND;
procedure RedefineCombo;
procedure SetStoredItems(const Value: TStringList);
procedure StoredItemsChange(Sender: TObject);
protected
procedure KeyPress(var Key: Char); override;
procedure CloseUp; override;
procedure Loaded; override;
procedure DoExit; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property StoredItems: TStringList read FStoredItems write SetStoredItems;
end;
procedure Register;
implementation
uses
SysUtils, Winapi.Windows, Vcl.Forms;
procedure Register;
begin
RegisterComponents('Standard', [TSmartComboBox]);
end;
constructor TSmartComboBox.Create(AOwner: TComponent);
begin
inherited;
FStoredItems := TStringList.Create;
FStoredItems.OnChange := StoredItemsChange;
end;
destructor TSmartComboBox.Destroy;
begin
FStoredItems.Free;
inherited;
end;
procedure TSmartComboBox.DoExit;
begin
inherited;
RedefineCombo;
end;
procedure TSmartComboBox.Loaded;
var LParent: TWinControl;
LPoint: TPoint;
begin
inherited;
if Items.Count > 0 then
FStoredItems.Assign(Items);
AutoComplete := False;
Style := csDropDownList;
// The ComboBox doesn't behave properly if the parent is not the form.
if not (Parent is TForm) then
begin
LParent := Parent;
while (not (LParent is TForm)) and Assigned(LParent) do
LParent := LParent.Parent;
LPoint := ClientToParent(Point(0,0), LParent);
Parent := LParent;
Left := LPoint.X;
Top := LPoint.Y;
BringToFront;
end;
end;
procedure TSmartComboBox.RedefineCombo;
var S: String;
begin
if Style = csDropDown then
begin
if ItemIndex <> -1 then
S := Items[ItemIndex];
Style := csDropDownList;
Items.Assign(FStoredItems);
if S <> '' then
ItemIndex := Items.IndexOf(S);
end;
end;
procedure TSmartComboBox.SetStoredItems(const Value: TStringList);
begin
if Assigned(FStoredItems) then
FStoredItems.Assign(Value)
else
FStoredItems := Value;
end;
procedure TSmartComboBox.StoredItemsChange(Sender: TObject);
begin
if Assigned(FStoredItems) then
begin
RedefineCombo;
Items.Assign(FStoredItems);
end;
end;
procedure TSmartComboBox.KeyPress(var Key: Char);
begin
if CharInSet(Key, ['a'..'z']) and not (Style = csDropDown) then
begin
DroppedDown := False;
Style := csDropDown;
end;
inherited;
if not (Ord(Key) in [13,27]) then
DroppedDown := True;
end;
procedure TSmartComboBox.CloseUp;
begin
if Style = csDropDown then
RedefineCombo;
inherited;
end;
procedure TSmartComboBox.CNCommand(var AMessage: TWMCommand);
begin
inherited;
if (AMessage.Ctl = Handle) and (AMessage.NotifyCode = CBN_EDITUPDATE) then
FilterItems;
end;
procedure TSmartComboBox.FilterItems;
var I: Integer;
Selection: TSelection;
begin
SendMessage(Handle, CB_GETEDITSEL, WPARAM(#Selection.StartPos), LPARAM(#Selection.EndPos));
Items.BeginUpdate;
Try
if Text <> '' then
begin
Items.Clear;
for I := 0 to FStoredItems.Count - 1 do
if (Pos(Uppercase(Text), Uppercase(FStoredItems[I])) > 0) then
Items.Add(FStoredItems[I]);
end
else
Items.Assign(FStoredItems);
Finally
Items.EndUpdate;
End;
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(Selection.StartPos, Selection.EndPos));
end;
end.
I need to hide a form to the system tray, but in the same time I want to use hotkey, such a "ctrl+3" to get text from tEdit on my hiden form being inserted to Firefox SendText(edit1.Text); // in such method'. I know how to insert text, but i don't know anything about hotkeys/ Any suggestions? Thank you. Code of text inserting below
procedure SendText(const Value: WideString);
var
I: Integer;
S: WideString;
TI: TInput;
KI: TKeybdInput;
const
KEYEVENTF_UNICODE = $0004;
begin
S := WideUpperCase(Value);
TI.Itype := INPUT_KEYBOARD;
for I := 1 to Length(S) do
begin
KI.wVk := 0;
KI.dwFlags := KEYEVENTF_UNICODE;
KI.wScan := Ord(S[I]);
TI.ki := KI;
SendInput(1, TI, SizeOf(TI));
end;
end;
To Register a system wide hotkey you must use the RegisterHotKey and UnRegisterHotKey functions.
Check this sample
type
TForm125 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
HotKey1 : Integer;
procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
public
end;
var
Form125: TForm125;
implementation
{$R *.dfm}
procedure TForm125.FormCreate(Sender: TObject);
begin
HotKey1 := GlobalAddAtom('MyAppHotkey1');//create a unique value for identify the hotkey
if not RegisterHotKey(Handle, HotKey1, MOD_CONTROL, VK_F1) then //register the hotkey CTRL + F1
ShowMessage('Sorry can not register the hotkey');
end;
procedure TForm125.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey(Handle, HotKey1);//unregister the hotkey
GlobalDeleteAtom(HotKey1);//remove the atom
end;
procedure TForm125.WMHotKey(var Msg: TWMHotKey);
begin
if Msg.HotKey = HotKey1 then
ShowMessage('Hello'); // do your stuff
end;
Just be carefull about the key combination which you choose, because can be used internally for another app. for example the combination Ctrl Number is used by Firefox to switch the tabs.
I programming with adodb/dbgo and try to use this code:
procedure TfrMain.dbeNoMejaKeyPress(Sender: TObject; var Key: Char);
begin
dmWarbam.TblTrans_temp.Filtered := False;
dmWarbam.TblTrans_temp.Filter := 'ID_ITEM = ' + QuotedStr(dbeNoMeja.Text);
dmWarbam.TblTrans_temp.Filtered := True;
end;
and
procedure TfrMain.dbeNoMejaChange(Sender: TObject);
begin
dmWarbam.TblTrans_temp.Filtered := False;
dmWarbam.TblTrans_temp.Filter := 'ID_ITEM = ' + QuotedStr(dbeNoMeja.Text);
dmWarbam.TblTrans_temp.Filtered := True;
end;
But none of above can work, when i press key on dbeNoMeja it didn't filter but instead the dataset inserting broken/incomplete data to database.
Can someone give me some example that working (full code)
If the dbedit is connected to the same table as the one you want to filter you have a problem, because the table goes into the dsEdit state once you start entering text.
Use a normal TEdit, and append a wildcard (*) to the string in the filter
dmWarbam.TblTrans_temp.Filter := 'ID_ITEM = ' + QuotedStr(edtNoMeja.Text+'*');
Code example adapted from Delphi-NeftalĂ. Nice and simple!
procedure TForm1.Edit1Change(Sender: TObject);
begin
// incremental search
ClientDataSet1.Locate('FirstName', Edit1.Text, [loCaseInsensitive, loPartialKey]);
Exit;
// actual data filtering
if (Edit1.Text = '') then begin
ClientDataSet1.Filtered := False;
ClientDataSet1.Filter := '';
end
else begin
ClientDataSet1.Filter := 'FirstName >= ' + QuotedStr(Edit1.Text);
ClientDataSet1.Filtered := True;
end;
end;
Setting ClientDataSet's provider to ADO DB (in your case):
Path := ExtractFilePath(Application.ExeName) + 'Data.MDB';
// Exist the MDB?
if FileExists(path) then begin
ClientDataSet1.ProviderName := 'DSProvider';
ADOQ.Open;
ClientDataSet1.Active := True;
ADOQ.Close;
ClientDataSet1.ProviderName := '';
lbldata.Caption := ExtractFileName(path);
Exit;
end;
I found a good solution in Expert Exchange,
unit dbg_filter_u;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, DBGrids, DBTables, Db, StdCtrls;
type
TForm1 = class(TForm)
Table1: TTable;
DataSource1: TDataSource;
Query1: TQuery;
DBGrid1: TDBGrid;
cbFilterBox: TComboBox; //a hidden combobox (Style = csDropDownList)
procedure Table1AfterOpen(DataSet: TDataSet);
procedure Table1AfterPost(DataSet: TDataSet);
procedure DBGrid1TitleClick(Column: TColumn);
procedure cbFilterBoxChange(Sender: TObject);
procedure cbFilterBoxClick(Sender: TObject);
procedure cbFilterBoxExit(Sender: TObject);
private
Procedure FillPickLists(ADBGrid : TDBGrid);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//For Accessing some Protected Methods
type TCDBGrid = class(TCustomDBGrid);
//Storing the Values into the Picklist-Propertys of the asscociated Columns,
//this may cost time depending on the amount of the dataset
Procedure TForm1.FillPickLists(ADBGrid : TDBGrid);
const
SQL_Text = 'Select Distinct %s From %s';
var
q : TQuery;
i : integer;
Begin
If (Assigned(ADBGrid)) and
(Assigned(ADBGrid.Datasource)) and
(Assigned(ADBGrid.Datasource.DataSet)) Then
Begin
If (ADBGrid.Datasource.DataSet is ttable) Then
begin
q := TQuery.Create(self);
try
try
q.DatabaseName := TTable(ADBGrid.Datasource.DataSet).DataBaseName;
for i := 0 to ADBGrid.Columns.Count - 1 do //for each column
begin
if ADBGrid.Columns[i].Field.FieldKind = fkData then //only physical fields
begin
ADBGrid.Columns[i].ButtonStyle := cbsNone; //avoid button-showing
ADBGrid.Columns[i].PickList.Clear;
q.Close;
q.SQL.text := Format(SQL_Text,[ADBGrid.Columns[i].Field.FieldName,TTable(ADBGrid.Datasource.DataSet).TableName]);
q.Open;
While not q.eof do
begin
ADBGrid.Columns[i].PickList.Add(q.Fields[0].AsString);
q.next;
end;
q.close;
end;
end;
finally
q.free;
end;
except
raise;
end;
end else
Raise exception.Create('This Version works only for TTables');
end else
Raise Exception.Create('Grid not properly Assigned');
end;
//Initial-Fill
procedure TForm1.Table1AfterOpen(DataSet: TDataSet);
begin
FillPickLists(DBGrid1);
end;
//Refill after a change
procedure TForm1.Table1AfterPost(DataSet: TDataSet);
begin
FillPickLists(DBGrid1);
end;
//Show a Dropdownbox for selecting, instead the title on Titleclick
procedure TForm1.DBGrid1TitleClick(Column: TColumn);
var
ARect : Trect;
DummyTC : TColumn;
begin
If column.PickList.Count > 0 then
begin
cbFilterbox.Items.Assign(column.PickList);
ARect := TCDBGrid(Column.Grid).CalcTitleRect(Column,0,DummyTC);
cbfilterBox.top := Column.Grid.Top+1;
cbfilterBox.left := Column.Grid.left+Arect.Left+1;
cbFilterbox.Width := Column.Width;
cbFilterBox.Tag := Integer(Column); //Store the columnPointer
cbFilterBox.Show;
cbFilterBox.BringToFront;
cbFilterBox.DroppedDown := True;
end;
end;
//Build up the Filter
procedure TForm1.cbFilterBoxChange(Sender: TObject);
begin
cbFilterBox.Hide;
if cbFilterBox.Text <> TColumn(cbFilterBox.Tag).Title.Caption then
begin
Case TColumn(cbFilterBox.Tag).Field.DataType of
//Some Fieldtypes
ftstring :
TTable(TDBGrid(TColumn(cbFilterBox.Tag).Grid).Datasource.Dataset).Filter :=
TColumn(cbFilterBox.Tag).Field.FieldName+' = '+QuotedStr(cbFilterBox.Text);
ftInteger,
ftFloat :
TTable(TDBGrid(TColumn(cbFilterBox.Tag).Grid).Datasource.Dataset).Filter :=
TColumn(cbFilterBox.Tag).Field.FieldName+' = '+cbFilterBox.Text;
end;
TTable(TDBGrid(TColumn(cbFilterBox.Tag).Grid).Datasource.Dataset).Filtered := True;
end;
end;
//some Hiding-events
procedure TForm1.cbFilterBoxClick(Sender: TObject);
begin
cbFilterBox.Hide;
end;
procedure TForm1.cbFilterBoxExit(Sender: TObject);
begin
cbFilterBox.Hide;
end;
end.