uselect.pas

中式财务栏 表格式录入 运行时设置可显示列、列名、列宽

{*******************************************************}
{                                                       }
{       选择                                            }
{                                                       }
{       版权所有 (C) 2008 陈新光                        }
{                                                       }
{*******************************************************}

unit uSelect;

interface

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

type
  TFormSelect = class(TForm)
    DataSource1: TDataSource;
    Panel2: TPanel;
    DBGridEh1: TDBGridEh;
    Panel1: TPanel;
    SpeedButton1: TBitBtn;
    SpeedButton2: TBitBtn;
    SpeedButton3: TBitBtn;
    BitBtn1: TBitBtn;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure DBGridEh1DblClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DBGridEh1KeyPress(Sender: TObject; var Key: Char);
    procedure SpeedButton3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    FP,FP2:Pointer;              
    FDataSet:TDataSet;
    FFieldList:TStringList;
    procedure OnActivate(var msg: TWMActivate); message WM_ACTIVATE;
    procedure SetFieldList;
    { Private declarations }
  end;

var
  FormSelect: TFormSelect;

procedure Execute(HostControl: TControl;ADataSet:TDataSet;
  AFieldList:TStringList;AP,AP2:Pointer);

implementation

uses uGlobal;

{$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;

procedure Execute(HostControl: TControl;ADataSet:TDataSet;
  AFieldList:TStringList;AP,AP2:Pointer);
begin
  if FormSelect=nil then
    FormSelect:=TFormSelect.Create(nil);
  FormSelect.FFieldList:=AFieldList;
  FormSelect.FDataSet:=ADataSet;
  FormSelect.FP:=AP;
  FormSelect.FP2:=AP2;
  FormSelect.DataSource1.DataSet:=FormSelect.FDataSet;
  AdjustDropDownForm(FormSelect,HostControl);
  FormSelect.ShowModal;
end;

procedure TFormSelect.SpeedButton1Click(Sender: TObject);
begin
  SetFieldList;
  Close;
end;

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

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

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

procedure TFormSelect.FormShow(Sender: TObject);
var
  i:Integer;
begin
  for i:=0 to DBGridEh1.Columns.Count-1 do
  begin
    if DBGridEh1.Columns[i].Width>120 then
      DBGridEh1.Columns[i].Width:=120;
  end;
end;

procedure TFormSelect.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
  FormSelect:=nil;
end;

procedure TFormSelect.SetFieldList;
var
  i:Integer;
  FieldList:TStringList;
begin
  FieldList:=TStringList.Create;
  for i:=0 to FFieldList.Count-1 do
    FieldList.Add(FDataSet.fieldbyname(FFieldList.Strings[i]).AsString);
  g_FieldList:=FieldList;
end;

procedure TFormSelect.DBGridEh1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key=#13 then SpeedButton1Click(nil);
end;

procedure TFormSelect.SpeedButton3Click(Sender: TObject);
var
  myAdd:procedure;
begin
  @myAdd:=FP;
  myAdd;
end;

procedure TFormSelect.BitBtn1Click(Sender: TObject);
var
  MyEdit:procedure;
begin
  @MyEdit:=FP2;
  MyEdit;
end;

end.