Внешний вид сайта:

Вывести записи одного поля в DBComboBox

Компонент для отображения записей в 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. 

Комментарии

Нет комментариев. Ваш будет первым!