类似于VB的DROPDOWN控件

Question

请问在 DELPHY 里面有没有 下拉控件可直接连数据库的。

Answer 1

unit RDBLookupComboBox;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBCtrls;type
  TRDBLookupComboBox = class(TDBLookupComboBox)
  private
    { Private declarations }
    HiBkColorSaved:boolean;
    HiBkColor:TColor;
    MouseEntered: Boolean;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure DrawFocused;
    procedure DrawUnfocus;    procedure OnPaint(var Message: TWMPaint); message WM_PAINT ;
    procedure OnCreate(var Message: TWMCreate); message WM_CREATE;  protected
    { Protected declarations }
    procedure DoEnter;override;
    procedure DoExit;override;
  end;procedure Register;implementation
//const
//    ParentBkColor = $00F6FEFF;procedure Register;
begin
  RegisterComponents('Ross', [TRDBLookupComboBox]);
end;procedure TRDBLookupComboBox.OnCreate(var Message: TWMCreate);
begin
  inherited;
  tag :=1;
end;
procedure TRDBLookupComboBox.DoEnter;
begin
  inherited;
  DrawFocused;
end;procedure TRDBLookupComboBox.DoExit;
begin
  inherited;
  DrawUnfocus;
end;procedure TRDBLookupComboBox.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if not MouseEntered and Enabled  then begin
    MouseEntered := True;
    DrawFocused;
  end;
end;procedure TRDBLookupComboBox.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if MouseEntered and Enabled  then begin
    MouseEntered := False;
    DrawUnfocus;
  end;
end;procedure TRDBLookupComboBox.DrawFocused;
var
  DC: HDC;
  R: TRect;
  WindowBrush,b: HBRUSH;
begin
//  if not(focused or mouseEntered) then exit;
  if not HiBkColorSaved then
  begin
    HiBkColor := color;
    HiBkColorSaved := true;
  end;
  color := ColorToRGB(HiBkColor);  DC := GetWindowDC(Handle);
  GetWindowRect(Handle, R);
  OffsetRect(R, -R.Left, -R.Top);
  try
//    WindowBrush := CreateSolidBrush(getParentForm(self).color );
    WindowBrush := CreateSolidBrush( ColorToRGB(Parent.Brush.Color) );
    FrameRect(DC, R, WindowBrush);    b := CreateSolidBrush(clOlive );
    InflateRect(R, -1, -1);
    FrameRect(DC, R, b);  finally
    ReleaseDC(Handle, DC);
  end;  DeleteObject(WindowBrush);
  DeleteObject(b);
end;
procedure TRDBLookupComboBox.DrawUnfocus;
var
  DC: HDC;
  R: TRect;
  WindowBrush,b: HBRUSH;
  //tc:TCustomForm;
begin
  if focused or mouseEntered then exit;  if not HiBkColorSaved then
  begin
    HiBkColor := color;
    HiBkColorSaved := true;
  end;//  tc := getParentForm(self);
  if [csDesigning] <> ComponentState then
    color := ColorToRGB(parent.brush.color);
  DC := GetWindowDC(Handle);  GetWindowRect(Handle, R);
  OffsetRect(R, -R.Left, -R.Top);
//  Dec(R.Right, 1);
  try    WindowBrush := CreateSolidBrush(ColorToRGB(parent.Brush.Color ));
    FrameRect(DC, R, WindowBrush);    InflateRect(R, -1, -1);
    FrameRect(DC, R, WindowBrush);    R.Top := r.Bottom -1;    b := CreateSolidBrush(clOlive );
    FrameRect(DC, R, b);  finally
    ReleaseDC(Handle, DC);
  end;
  DeleteObject(WindowBrush);
  DeleteObject(b);//  color := getparentform(self).Color;
end;procedure TRDBLookupComboBox.OnPaint(var Message: TWMPaint);
begin
  inherited;
  if MouseEntered or Focused then
    DrawFocused
  else
    DrawUnfocus;
end;end.