Компонент для отображения записей в ComboBox. Задача — выводить в компоненте содержимое определенного поля таблицы в виде списка.
unit DBCustCB;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCtrls, Db, DBTables, StdCtrls, DBGrids;
type
TMSDBComboBox = class(TComboBox)
private
{ Private declarations }
FDataSource : TDataSource;
FDataField : TField;
FFieldName : String;
FDBGrid : TDBGrid;
FCellClicked : Boolean;
FBookmark : TBookmark;
FDBComboBoxOnEnter : Boolean;
procedure CreateGridNColumn;
procedure Click(var message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure DBGridEnter(Sender : TObject);
procedure DBGridExit(Sender : TObject);
procedure CellClick(Column : TColumn);
procedure AssignText;
procedure WMPaste(var Message : TMessage);message WM_Paste;
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
protected
{ Protected declarations }
procedure Loaded; override;
procedure DoEnter; override;
procedure DoExit; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property DataField : String read FFieldName write FFieldName;
property DataSource : TDataSource read FDataSource write FDataSource;
end;
procedure Register;
implementation
constructor TMSDBComboBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
CreateGridNColumn;
end;
procedure TMSDBComboBox.DoEnter;
begin
if not FDBComboBoxOnEnter then begin
inherited;
FDBComboBoxOnEnter := True;
end;
end;
procedure TMSDBComboBox.DoExit;
begin
inherited;
if not (Screen.ActiveControl = FDBGrid) then
FDBComboBoxOnEnter := False;
end;
procedure TMSDBComboBox.Click(var message: TWMLButtonDown);
var
SelfPoint : TPoint;
SelfExit : TNotifyEvent;
begin
try
SelfExit := Self.OnExit;
Self.OnExit := nil;
FCellClicked := False;
FBookmark := DataSource.DataSet.GetBookmark;
if not FDBComboBoxOnEnter then
Self.DoEnter;
FDataField := DataSource.DataSet.FieldByName(FFieldName);
FDBGrid.Parent := Screen.ActiveForm;
FDBGrid.Width := Self.Width;
FDBGrid.DataSource := DataSource;
FDBGrid.Columns.Items[0].Field := FDataField;
FDBGrid.Columns.Items[0].Width := Self.Width - 22;
FDBGrid.Enabled := True;
SelfPoint := Screen.ActiveForm.ScreenToClient(
Self.Parent.ClientToScreen(Point(Self.Left,Self.Top)));
FDBGrid.Left := SelfPoint.X;
if ((Screen.ActiveForm.Height - SelfPoint.Y) >= FDBGrid.Height) then
begin
FDBGrid.Top := SelfPoint.Y + Self.Height
end
else
begin
FDBGrid.Top := SelfPoint.Y - FDBGrid.Height;
end;
FDBGrid.DataSource := Self.DataSource;
FDBGrid.BringToFront;
FDBGrid.Visible := True;
FDBGrid.SetFocus;
finally
Self.OnExit := SelfExit;
end;
end;
procedure TMSDBComboBox.DBGridExit(Sender : TObject);
begin
inherited;
FDBGrid.Parent := Self;
FDBGrid.Visible := False;
if not FCellClicked then begin
try
DataSource.DataSet.GotoBookmark(FBookmark);
finally
DataSource.DataSet.FreeBookmark(FBookmark);
end;
end;
Self.SetFocus;
end;
procedure TMSDBComboBox.DBGridEnter(Sender : TObject);
begin
{ FCellClicked := False;
FBookmark := DataSource.DataSet.GetBookmark;
Self.OnEnter(Self);}
end;
procedure TMSDBComboBox.CellClick(Column : TColumn);
begin
FCellClicked := True;
AssignText;
FDBGrid.Visible := False;
Self.SetFocus;
if Assigned(Self.OnClick) then
Self.OnClick(Self);
end;
procedure TMSDBComboBox.AssignText;
begin
if (DataSource.DataSet.FindField(FFieldName) <> nil) then
Self.Text := DataSource.DataSet.FindField(FFieldName).AsString;
end;
procedure TMSDBComboBox.Loaded;
begin
inherited;
Self.ItemHeight := 0;
Self.Text := '';
end;
procedure TMSDBComboBox.CreateGridNColumn;
begin
FDBGrid := TDBGrid.Create(Self);
FDBGrid.Left := 1000;
FDBGrid.Top := 1000;
FDBGrid.Parent := Self;
FDBGrid.Options := FDBGrid.Options - [dgTitles,dgIndicator];
FDBGrid.Options := FDBGrid.Options + [dgRowSelect,dgTabs];
FDBGrid.Columns.Add;
FDBGrid.Visible := False;
FDBGrid.OnEnter := DBGridEnter;
FDBGrid.OnExit := DBGridExit;
FDBGrid.OnCellClick := CellClick;
FDBGrid.ReadOnly := True;
FDBGrid.TabStop := False;
end;
procedure TMSDBComboBox.WMPaste(var Message : TMessage);
begin
inherited;
end;
procedure TMSDBComboBox.WMCut(var Message: TMessage);
begin
inherited;
end;
procedure TMSDBComboBox.WMKeyDown(var Message: TWMKeyDown);
begin
inherited;
end;
destructor TMSDBComboBox.Destroy;
begin
if (FDBGrid.Parent <> nil) then begin
FDBGrid.Free;
FDBGrid := nil;
end;
inherited;
end;
procedure Register;
begin
RegisterComponents('Delphi 3.0 Components', [TMSDBComboBox]);
end;
end.
Комментарии