home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 January / Chip_2000-01_cd.bin / zkuste / Delphi / nastroje / browutil.exe / COMPNT / DBCUSTCB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-05-24  |  4.5 KB  |  180 lines

  1. unit DBCustCB;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   DBCtrls, Db, DBTables, StdCtrls, DBGrids;
  8.  
  9. type
  10.   TMSDBComboBox = class(TComboBox)
  11.   private
  12.     { Private declarations }
  13.     FDataSource  : TDataSource;
  14.     FDataField   : TField;
  15.     FFieldName   : String;
  16.     FDBGrid      : TDBGrid;
  17.     FCellClicked : Boolean;
  18.     FBookmark    : TBookmark;
  19.     FDBComboBoxOnEnter  : Boolean;
  20.     procedure CreateGridNColumn;
  21.     procedure Click(var message: TWMLButtonDown); message WM_LBUTTONDOWN;
  22.     procedure DBGridEnter(Sender : TObject);
  23.     procedure DBGridExit(Sender : TObject);
  24.     procedure CellClick(Column : TColumn);
  25.     procedure AssignText;
  26.   protected
  27.     { Protected declarations }
  28.     procedure Loaded; override;
  29.     procedure DoEnter; override;
  30.     procedure DoExit; override;
  31.   public
  32.     { Public declarations }
  33.     constructor Create(AOwner: TComponent); override;
  34.     destructor Destroy; override;
  35.   published
  36.     { Published declarations }
  37.     property DataField : String read FFieldName write FFieldName;
  38.     property DataSource : TDataSource read FDataSource write FDataSource;
  39.   end;
  40.  
  41. procedure Register;
  42.  
  43. implementation
  44.  
  45. constructor TMSDBComboBox.Create(AOwner: TComponent);
  46. begin
  47.   inherited Create(AOwner);
  48.   ControlStyle := ControlStyle + [csReplicatable];
  49.   CreateGridNColumn;
  50. end;
  51.  
  52. procedure TMSDBComboBox.DoEnter;
  53. begin
  54.   if not FDBComboBoxOnEnter then begin
  55.     inherited;
  56.     FDBComboBoxOnEnter := True;
  57.   end;
  58. end;
  59.  
  60. procedure TMSDBComboBox.DoExit;
  61. begin
  62.   inherited;
  63.   if not (Screen.ActiveControl = FDBGrid) then
  64.     FDBComboBoxOnEnter := False;
  65. end;
  66.  
  67. procedure TMSDBComboBox.Click(var message: TWMLButtonDown);
  68. var
  69.   SelfPoint : TPoint;
  70.   SelfExit : TNotifyEvent;
  71. begin
  72.   try
  73.     SelfExit := Self.OnExit;
  74.     Self.OnExit := nil;
  75.     FCellClicked := False;
  76.     FBookmark := DataSource.DataSet.GetBookmark;
  77.     if not FDBComboBoxOnEnter then
  78.       Self.DoEnter;
  79.     FDataField := DataSource.DataSet.FieldByName(FFieldName);
  80.     FDBGrid.Parent := Screen.ActiveForm;
  81.     FDBGrid.Width := Self.Width;
  82.     FDBGrid.DataSource := DataSource;
  83.     FDBGrid.Columns.Items[0].Field := FDataField;
  84.     FDBGrid.Columns.Items[0].Width := Self.Width - 22;
  85.     FDBGrid.Enabled := True;
  86.     SelfPoint := Screen.ActiveForm.ScreenToClient(Self.Parent.ClientToScreen(Point(Self.Left,Self.Top)));
  87.     FDBGrid.Left := SelfPoint.X;
  88.     if ((Screen.ActiveForm.Height - SelfPoint.Y) >= FDBGrid.Height) then begin
  89.         FDBGrid.Top := SelfPoint.Y + Self.Height
  90.       end
  91.     else
  92.       begin
  93.         FDBGrid.Top := SelfPoint.Y - FDBGrid.Height;
  94.       end;
  95.     FDBGrid.DataSource := Self.DataSource;
  96.     FDBGrid.BringToFront;
  97.     FDBGrid.Visible := True;
  98.     FDBGrid.SetFocus;
  99.   finally
  100.     Self.OnExit := SelfExit;
  101.   end;
  102. end;
  103.  
  104. procedure TMSDBComboBox.DBGridExit(Sender : TObject);
  105. begin
  106.   inherited;
  107.   FDBGrid.Parent := Self;
  108.   FDBGrid.Visible := False;
  109.   if not FCellClicked then begin
  110.     try
  111.       DataSource.DataSet.GotoBookmark(FBookmark);
  112.     finally
  113.       DataSource.DataSet.FreeBookmark(FBookmark);
  114.     end;
  115.   end;
  116.   Self.SetFocus;
  117. end;
  118.  
  119. procedure TMSDBComboBox.DBGridEnter(Sender : TObject);
  120. begin
  121. {  FCellClicked := False;
  122.   FBookmark := DataSource.DataSet.GetBookmark;
  123.   Self.OnEnter(Self);}
  124. end;
  125.  
  126. procedure TMSDBComboBox.CellClick(Column : TColumn);
  127. begin
  128.   FCellClicked := True;
  129.   AssignText;
  130.   FDBGrid.Visible := False;
  131.   Self.SetFocus;
  132.   Self.OnClick(Self);
  133. end;
  134.  
  135. procedure TMSDBComboBox.AssignText;
  136. begin
  137.   if (DataSource.DataSet.FindField(FFieldName) <> nil) then
  138.     Self.Text := DataSource.DataSet.FindField(FFieldName).AsString;
  139. end;
  140.  
  141. procedure TMSDBComboBox.Loaded;
  142. begin
  143.   inherited;
  144.   Self.ItemHeight := 0;
  145.   Self.Text := '';
  146. end;
  147.  
  148. procedure TMSDBComboBox.CreateGridNColumn;
  149. begin
  150.   FDBGrid := TDBGrid.Create(Self);
  151.   FDBGrid.Left := 1000;
  152.   FDBGrid.Top := 1000;
  153.   FDBGrid.Parent := Self;
  154.   FDBGrid.Options := FDBGrid.Options - [dgTitles,dgIndicator];
  155.   FDBGrid.Options := FDBGrid.Options + [dgRowSelect,dgTabs];
  156.   FDBGrid.Columns.Add;
  157.   FDBGrid.Visible := False;
  158.   FDBGrid.OnEnter := DBGridEnter;
  159.   FDBGrid.OnExit := DBGridExit;
  160.   FDBGrid.OnCellClick := CellClick;
  161.   FDBGrid.ReadOnly := True;
  162.   FDBGrid.TabStop := False;
  163. end;
  164.  
  165. destructor TMSDBComboBox.Destroy;
  166. begin
  167.   if (FDBGrid.Parent <> nil) then begin
  168.     FDBGrid.Free;
  169.     FDBGrid := nil;
  170.   end;
  171.   inherited;
  172. end;
  173.  
  174. procedure Register;
  175. begin
  176.   RegisterComponents('Delphi 3.0 Components', [TMSDBComboBox]);
  177. end;
  178.  
  179. end.
  180.