home *** CD-ROM | disk | FTP | other *** search
- 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;
- 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;
- 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;
-
- 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.