⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit2.pas

📁 最新的 DBGRIDEH4.0
💻 PAS
字号:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBGridEh, Buttons, Db, DBTables, ExtCtrls, ComCtrls, GridsEh;

type
  TForm2 = class(TForm)
    DataSource1: TDataSource;
    Table1: TTable;
    Panel2: TPanel;
    DBGridEh1: TDBGridEh;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure DBGridEh1DblClick(Sender: TObject);
    procedure DBGridEh1ColWidthsChanged(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    procedure OnActivate(var msg: TWMActivate); message WM_ACTIVATE;
    { Private declarations }
  public
    function Execute(HostControl: TControl; var VendorNo: String; var VendorName: String):Boolean;
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

{ TForm2 }

procedure AdjustDropDownForm(AControl : TControl; HostControl: TControl);
var
   WorkArea: TRect;
   HostP, PDelpta: TPoint;
begin
   SystemParametersInfo(SPI_GETWORKAREA,0,@WorkArea,0);
   HostP := HostControl.ClientToScreen(Point(0,0));
   PDelpta := AControl.ClientToScreen(Point(0,0));

   AControl.Left := HostP.x;
   AControl.Top := HostP.y + HostControl.Height + 1;

   if (AControl.Width > WorkArea.Right - WorkArea.Left) then
     AControl.Width := WorkArea.Right - WorkArea.Left;

   if (AControl.Left + AControl.Width > WorkArea.Right) then
     AControl.Left := WorkArea.Right - AControl.Width;
   if (AControl.Left < WorkArea.Left) then
     AControl.Left := WorkArea.Left;


   if (AControl.Top + AControl.Height > WorkArea.Bottom) then
   begin
     if (HostP.y - WorkArea.Top > WorkArea.Bottom - HostP.y - HostControl.Height) then
       AControl.Top := HostP.y - AControl.Height;
   end;

   if (AControl.Top < WorkArea.Top) then
   begin
     AControl.Height := AControl.Height - (WorkArea.Top - AControl.Top);
     AControl.Top := WorkArea.Top;
   end;

   if (AControl.Top + AControl.Height > WorkArea.Bottom) then
   begin
     AControl.Height := WorkArea.Bottom - AControl.Top;
   end;

end;

function TForm2.Execute(HostControl: TControl; var VendorNo: String; var VendorName: String):Boolean;
begin
  if VendorNo <> '' then
    Table1.Locate('VendorNo',VendorNo,[]);

  AdjustDropDownForm(Self,HostControl);
  Visible := True;
  ModalResult := mrCancel;
  while (Visible) do Application.ProcessMessages;
  Result := False;
  if ModalResult = mrOk then
  begin
    VendorNo := Table1.FieldByName('VendorNo').AsString;
    VendorName := Table1.FieldByName('VendorName').AsString;
    Result := True;
  end;
end;

procedure TForm2.SpeedButton1Click(Sender: TObject);
begin
  ModalResult := mrOk;
  Close;
end;

procedure TForm2.SpeedButton2Click(Sender: TObject);
begin
  Close;
end;

procedure TForm2.DBGridEh1DblClick(Sender: TObject);
begin
  SpeedButton1Click(Sender);
end;

procedure TForm2.OnActivate(var msg: TWMActivate);
begin
  inherited;
  if (msg.Active=WA_INACTIVE) then
    Close;
end;

procedure TForm2.DBGridEh1ColWidthsChanged(Sender: TObject);
begin
  ClientWidth := DBGridEh1.Columns[0].Width + DBGridEh1.Columns[1].Width +
  (DBGridEh1.Width-DBGridEh1.ClientWidth) + Panel1.Width + 3;
end;

procedure TForm2.FormShow(Sender: TObject);
begin
  DBGridEh1ColWidthsChanged(Sender);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -