Mega Code Archive
Lookup ComboBox Component
<![CDATA[
Title: Lookup ComboBox Component
Question: ** UPDATED ** Feb 2006
1) Fixed ItemIndex now works
2) DropDownWidth Property Added
3) Sorted property changed to Rutime method Sort
I recently had a requirement for a TComboLookUp. This is similar in functionality to the Delphi TDBLookupComboBox whereby the drop down list displays lookup fields and the edit box is populated by a different value. The requirement I had was to have a combobox that allowed a user to type in an E-Mail address, but the dropdown box must display peoples names (more meaningfull than a dropdown box of E-Mail addresses), and populate the combo box's edit field with the corresponding E-Mail address.
The solution was relatively simple in that a new component TComboLookUp was created as a descendant of TCustomComboBox. All that was required was to override a few virtual methods and switch the contents of the (now hidden) Items property with either ItemsLookUp or ItemsDisplay properties.
TComboLookUp introduces 3 new properties
ItemsLookUp : TStringList - List of names for Dropdown Box
ItemsDisplay : TStringList - Corresponding name to put into edit box portion.
DropDownWidth - Width of drop down box (it can now be wider than the text box). If it is 0 then DropDownWidth = Width
Obviously both of these lists must contain the same number of lines, if this is not so then an Exception will be raised at runtime.
Answer:
unit ComboLookUp;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TComboLookUp = class(TCustomComboBox)
private
{ Private declarations }
FItemIndex : integer;
FSaveWidth,
FDropDownWidth : integer;
FSortList,
FLookUpList,
FDisplayList : TStringList;
procedure SetFLookUpList(NewValue : TStringList);
procedure SetFDisplayList(NewValue : TStringList);
protected
{ Protected declarations }
procedure AdjustDropdown; override;
procedure DropDown; override;
procedure CloseUp; override;
procedure DoExit; override;
procedure SetList(TS : TStringList); virtual;
procedure CheckListLens; virtual;
function GetItemIndex: Integer; override;
procedure SetItemIndex(const Value: Integer); override;
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Loaded; override;
procedure Sort;
published
{ Published new declarations }
property ItemsLookUp : TstringList read FLookUpList
write SetFLookUpList;
property ItemsDisplay : TstringList read FDisplayList
write SetFDisplayList;
property DropDownWidth : integer read FDropDownWidth write FDropDownWidth;
{ Surface hidden properties }
property Anchors;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property DropDownCount;
property Enabled;
property Font;
property ItemHeight;
property MaxLength;
property ParentColor;
property ParentFont;
property PopupMenu;
property ShowHint;
property Style;
property TabOrder;
property Text;
property Visible;
{ Surface hidden events }
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnDropDown;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
// ------------------------------------------------------------------------------
implementation
procedure Register;
begin
RegisterComponents('MahExtra', [TComboLookUp]);
end;
// ===================================
// Create and Destroy Component
// ===================================
constructor TComboLookUp.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FItemIndex := -1;
FLookUpList := TStringList.Create;
FDisplayList := TStringList.Create;
FSortList := TStringList.Create;
FDropDownWidth := 0;
end;
destructor TComboLookUp.Destroy;
begin
FDisplayList.Free;
FLookUpList.Free;
FSortList.Free;
inherited Destroy;
end;
// ===========================================
// Assign initial items to FLookUpList
// ===========================================
procedure TComboLookUp.Loaded;
begin
inherited Loaded;
if not (csDesigning in ComponentState) then begin
Items.Assign(FLookUpList);
if FItemIndex -1 then SetItemIndex(FItemIndex);
end;
end;
// ======================================
// TStringList Set Property Methods
// ======================================
procedure TComboLookUp.SetFLookUpList(NewValue : TStringList);
begin
FLookUpList.Assign(NewValue);
end;
procedure TComboLookUp.SetFDisplayList(NewValue : TStringList);
begin
FDisplayList.Assign(NewValue);
end;
// ======================
// Override events
// ======================
procedure TComboLookUp.SetList(TS : TStringList);
var i : integer;
begin
if not (csDesigning in ComponentState) then begin
CheckListLens;
i := ItemIndex;
Items.Assign(TS);
ItemIndex := i;
end;
end;
function TComboLookUp.GetItemIndex: Integer;
begin
if csLoading in ComponentState then
Result := FItemIndex
else
Result := SendMessage(Handle, CB_GETCURSEL, 0, 0);
end;
procedure TComboLookUp.SetItemIndex(const Value: Integer);
begin
if Items.Text = '' then Items.Assign(FDisplayList);
if csLoading in ComponentState then
FItemIndex := Value
else
if GetItemIndex Value then
SendMessage(Handle, CB_SETCURSEL, Value, 0);
end;
procedure TComboLookUp.AdjustDropdown;
var Count: Integer;
iWidth : integer;
begin
if FDropDownWidth iWidth := Width
else
iWidth := FDropDownWidth;
FSaveWidth := Width;
Count := ItemCount;
if Count DropDownCount then Count := DropDownCount;
if Count FDroppingDown := True;
try
SetWindowPos(FDropHandle, 0, 0, 0, iWidth, ItemHeight * Count +
Height + 2, SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOREDRAW or
SWP_HIDEWINDOW);
finally
FDroppingDown := False;
end;
SetWindowPos(FDropHandle, 0, 0, 0, 0 , 0, SWP_NOMOVE or SWP_NOSIZE or
SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOREDRAW or SWP_SHOWWINDOW);
Invalidate;
end;
procedure TComboLookUp.DropDown;
begin
SetList(FLookUpList);
inherited DropDown;
end;
procedure TComboLookUp.CloseUp;
begin
Width := FSaveWidth;
SetList(FDisplayList);
inherited CloseUp;
end;
procedure TComboLookUp.DoExit;
begin
SetList(FDisplayList);
inherited DoExit;
end;
// ==========================================
// Sort lists if property Sorted is set
// ==========================================
procedure TComboLookUp.CheckListLens;
begin
if (FLookUpList.Count FDisplayList.Count) then
raise Exception.Create(#13#10'TComboLookUp - ' +
'Lookup items Display items');
end;
procedure TComboLookUp.Sort;
var i,p : integer;
begin
FSortList.Clear;
CheckListLens;
for i := 0 to FLookUpList.Count - 1 do
FSortList.Add(FLookUpList[i] + #254 + FDisplayList[i]);
FSortList.Sort;
FLookUpList.Clear;
FDisplayList.Clear;
for i := 0 to FSortList.Count - 1 do begin
p := pos(#254,FSortList[i]);
FLookUpList.Add(Copy(FSortList[i],1,P - 1));
FDisplayList.Add(Copy(FSortList[i],p + 1,MAX_PATH));
end;
end;
end.
]]>