baseinfo.pas

用delphi编写的数据库管理软件

unit BaseInfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MDIBase, Grids, DBGridEh, ExtCtrls, StdCtrls, Menus, ActnList,
  MSNPopUp, DB, DBClient, FR_Desgn, FR_DSet, FR_DBSet, FR_Class;

Const
  WM_USER_GETDATA = WM_USER+1024;
  WM_USER_SETFOOTER = WM_USER+8028;

type
  TfrmBaseinfo = class(TfrmMDIBase)
    Panel1: TPanel;
    Panel2: TPanel;
    grid: TDBGridEh;
    FormTitle: TLabel;
    Panel3: TPanel;
    btnExit: TButton;
    btnadd: TButton;
    btncopy: TButton;
    btnedit: TButton;
    btndelete: TButton;
    Panel4: TPanel;
    btnrefresh: TButton;
    btnsearch: TButton;
    btnprint: TButton;
    CDSBaseinfo: TClientDataSet;
    DSbaseinfo: TDataSource;
    ActionList1: TActionList;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    Action5: TAction;
    ppmreport: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    frBaseinfo: TfrReport;
    frDBDataSet1: TfrDBDataSet;
    ActionList2: TActionList;
    acinsert: TAction;
    accopy: TAction;
    acmodify: TAction;
    acdelete: TAction;
    acrefresh: TAction;
    acsearch: TAction;
    acfieldproperty: TAction;
    acexit: TAction;
    popupgrid: TPopupMenu;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    MSNSaveinfo: TMSNPopUp;
    procedure FormShow(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure Action4Execute(Sender: TObject);
    procedure btnprintClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure gridGetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure DSbaseinfoStateChange(Sender: TObject);
    procedure DSbaseinfoDataChange(Sender: TObject; Field: TField);
    procedure acexitExecute(Sender: TObject);
    procedure acinsertExecute(Sender: TObject);
    procedure accopyExecute(Sender: TObject);
    procedure acmodifyExecute(Sender: TObject);
    procedure acdeleteExecute(Sender: TObject);
    procedure acrefreshExecute(Sender: TObject);
    procedure acfieldpropertyExecute(Sender: TObject);
    procedure acsearchExecute(Sender: TObject);
    procedure frBaseinfoUserFunction(const Name: String; p1, p2,
      p3: Variant; var Val: Variant);
    procedure gridTitleBtnClick(Sender: TObject; ACol: Integer;
      Column: TColumnEh);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    function GetGridTitle(TableName:String):Boolean;
    procedure Getdata(var getdata:Tmessage);Message WM_USER_GETDATA;
    procedure setfooter(var setfooter:Tmessage);Message WM_USER_SETFOOTER;    
    { Private declarations }
  protected
    MainTable:string;
    KeyField:String;
    ReportName:string;
    ModifyForm:TformClass;
  public
    { Public declarations }
  end;

var
  frmBaseinfo: TfrmBaseinfo;

implementation

uses Global, DataProcess, Binterface, Bsearch;

{$R *.dfm}

procedure TfrmBaseinfo.FormShow(Sender: TObject);
begin
  inherited;
  FormTitle.Caption:=self.Caption;
  postmessage(handle,WM_USER_GETDATA,0,0);
  application.ProcessMessages;
  postmessage(handle,WM_USER_SETFOOTER,0,0);
end;

procedure TfrmBaseinfo.Getdata(var getdata: Tmessage);
var
  tiao:String;
begin
  tiao:=KeyField+'>='+vartosql(GetMaxid(Maintable,KeyField)-20);
  GetSqlData(CDSBaseinfo,MainTable,KeyField,tiao);
  GetGridTitle(MainTable);
end;

function TfrmBaseinfo.GetGridTitle(TableName: String): Boolean;
var
  i:integer;
  TMPCDS:TclientDataset;
begin
Result:=True;
if TableName='' then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    TMPCDS:=Tclientdataset.Create(nil);
    TMPCDS.FetchOnDemand:=False;
    GetsqlData(TMPCDS,'TTablefield','fid','ftableName='+vartosql(TableName),20);
    if TMPCDS.RecordCount > 0 then
      begin
        for i:=0 to CDSBaseinfo.Fields.Count - 1 do
          begin
           TMPCDS.First;
            while not TMPCDS.Eof do
              begin
                if UpperCase(CDSbaseinfo.fields[i].FieldName)=UpperCase(TMPCDS.FieldByName('fname').AsString) then
                  begin
                    CDSbaseinfo.Fields[i].DisplayLabel:=TMPCDS.fieldbyname('fdesc').AsString;
                    if (TMPCDS.FieldByName('ftype').AsString='int') or
                        (TMPCDS.FieldByName('ftype').AsString='bit') or
                        (TMPCDS.FieldByName('ftype').AsString='datetime') or
                        (TMPCDS.FieldByName('ftype').AsString='numeric') then
                        CDSbaseinfo.Fields[i].DisplayWidth := 12
                        else
                        CDSbaseinfo.Fields[i].DisplayWidth:=Trunc(TMPCDS.fieldbyname('flength').AsInteger/1.5);
                    if not TMPCDS.FieldByName('fisVisible').AsBoolean then
                      begin
                        CDSbaseinfo.Fields[i].Visible:=False;
                      end;
                  end;
                TMPCDS.Next;
              end;
            CDSBaseinfo.Next;
          end;
      end;
  finally
    TMPCDS.Close;
    TMPCDS.Free;
    CDSbaseinfo.EnableControls; 
  end;
end;

procedure TfrmBaseinfo.Action1Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.ShowReport;
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('打印预览出错 ！ '+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmBaseinfo.Action2Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.PrepareReport;
    frbaseinfo.PrintPreparedReport('',1,True,frAll);
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('直接打印出错  ！'+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmBaseinfo.Action3Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.PrepareReport;
    frbaseinfo.PrintPreparedReportDlg;
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('打印设置出错  ！ '+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmBaseinfo.Action4Execute(Sender: TObject);
begin
  inherited;
  if CDSbaseinfo.RecordCount = 0 then
    Exit;
  try
    CDSbaseinfo.DisableControls;
    frbaseinfo.LoadFromFile(GetLogDir('Prints')+ReportName);
    frbaseinfo.DesignReport;
    CDSbaseinfo.EnableControls;
  except
    on E:Exception do
      begin
        messagedlg('报表设计出错 ! '+#10#13+E.Message,mtError,[MBOK],0);
        Exit;
      end;
  end;
end;

procedure TfrmBaseinfo.btnprintClick(Sender: TObject);
var
  Point:Tpoint;
begin
  inherited;
  Point:=GetScreenPoint(btnprint);
  ppmreport.Popup(point.X,point.Y);
end;

procedure TfrmBaseinfo.FormDestroy(Sender: TObject);
begin
  inherited;
  frmBaseinfo:=nil;
end;

procedure TfrmBaseinfo.gridGetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
  inherited;
  if grid.SumList.RecNo mod 2=1 then
    BackGround:=$00EAEFED