base_panel.pas

一个MRPII系统源代码版本

unit Base_Panel;

Interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Base_Common, ExtCtrls, ComCtrls, ToolWin, ActnList, Db, AdODB, Mask, DBGridEh,
  StdCtrls, Grids, jpeg,dbCtrls,vAriants;

Type
  TFrm_Base_Panel = Class(TFrm_Base_Common)
    ControlBar: TControlBar;
    ToolBar: TToolBar;
    Pnl_Title: TPanel;
    Pnl_Head: TPanel;
    Pnl_Hint: TPanel;
    Pnl_Body: TPanel;
    ActionList: TActionList;
    Act_New: TAction;
    Act_Modify: TAction;
    Act_Save: TAction;
    Act_Quit: TAction;
    Act_Filter: TAction;
    Act_Cancel: TAction;
    Act_Preview: TAction;
    Act_Print: TAction;
    Act_Hint: TAction;
    Act_DeleteLine: TAction;
    Act_Property: TAction;
    Act_Sum: TAction;
    Act_Check: TAction;
    Act_CancelCheck: TAction;
    Act_Look: TAction;
    Act_Mange: TAction;
    Act_Close: TAction;
    Act_InsertLine: TAction;
    Act_Delete: TAction;
    Act_Copy: TAction;
    Act_Help: TAction;
    Act_Expend: TAction;
    Act_CollApse: TAction;
    Act_ShowGrid: TAction;
    Act_Locate: TAction;
    Act_auto: TAction;
    Act_SetCount: TAction;
    Act_Open: TAction;
    Act_First: TAction;
    Act_Prior: TAction;
    Act_next: TAction;
    Act_last: TAction;
    Act_Order: TAction;
    Act_error: TAction;
    Act_all: TAction;
    Act_CheckDebt: TAction;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    Act_Excel: TAction;
    Act_SetColumn: TAction;
    TlBtn_Help: TToolButton;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    PnlTitleLabel: TLabel;
    procedure Act_QuitExecute(Sender: TObject);
    procedure Act_HelpExecute(Sender: TObject);
    procedure Act_HintExecute(Sender: TObject);
    procedure DBGridEhDrawDataCell(Sender: TObject; const Rect: TRect;
      Field: TField; State: TGridDrawState);      
    procedure AdoQueryAfterOpen(DataSet: TDataSet);
    procedure DBGridEhGetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; vAr Background: TColor; State: TGridDrawState);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    PriceLen,AmountLen,QtyLen:Integer;
  protected
    { protected declarations }
    AmountFields,PriceFields,FreeFields:String;
    //ZeroToNullFields:String;
    procedure DBGridEhToExcel(DBGridEh:TDBGridEh;Panel:TPanel=nil);
  public
    { Public declarations }
    procedure SetDBConnect(AdOConnection:TAdOConnection); Override;
  end;

vAr
  Frm_Base_Panel: TFrm_Base_Panel;

implementation

uses Sys_Global,comobj;

{$R *.DFM}

procedure TFrm_Base_Panel.Act_QuitExecute(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TFrm_Base_Panel.Act_HelpExecute(Sender: TObject);
begin
  inherited;
  //DispInfo('对不起，暂不提供在线帮助功能！',3);
end;

procedure TFrm_Base_Panel.Act_HintExecute(Sender: TObject);
begin
  inherited;
  Keybd_Event(VK_F9,VK_F9,0,0);
end;

procedure TFrm_Base_Panel.DBGridEhToExcel(DBGridEh: TDBGridEh;Panel:TPanel=Nil);
vAr
  Excel,Sheet:vAriant;
  KeyList:String;
  i,j,x,y,z,K,N,M:Integer;
begin//输出Excel
  Screen.Cursor:=CrAppStArt;
  try
    Excel:=UnAssigned;
    Excel:=CreateOleObject('Excel.Application');
    Excel.Visible:=False;
    Excel.WorkBooks.Add;
  except
    Excel:=UnAssigned;
    Screen.Cursor:=CrDefault;
    DispInfo('本机未安装EXCEL,本功能必须在安装有EXCEL的电脑上才能运行!',1);
    Abort;
  end;
  if vArIsEmpty(Excel) then
  begin
    Screen.Cursor:=CrDefault;
    DispInfo('建立Excel对象不成功，请重试!',1);
    Excel:=UnAssigned;
    Abort;
  end;
  x:=DbGridEh.FrozenCols;
  DbGridEh.FrozenCols:=0;//设置锁定列为0
  j:=0;
  for i:=0 to DBGridEh.Columns.Count-1 do
  begin
    if DBGridEh.Columns[I].Visible Then
     j:=j+1;
  end; //取得显示列总列数
  i:=Round(j/2);
  Sheet:=Excel.WorkSheets[1];
  //Sheet.Name:=TForm(DbGridEh.Parent.Parent).Caption;
  Sheet.Cells[1,i]:=''''+TForm(DbGridEh.Parent.Parent).Caption;
  If Assigned(Panel) Then 
  begin
    K := Panel.ControlCount;
    K := Round(K/2);
    N := 1;
    M := 1;
    For I:=0 To Panel.ControlCount-1 do
    begin
      If (Panel.Controls[i] Is TLabel )  then 
      If (I<=K) then 
      begin
        Sheet.Cells[2,n]:=TLabel(Panel.Controls[i]).Caption;
        N := N+1;
      end
      else begin
        Sheet.Cells[3,M]:=TLabel(Panel.Controls[i]).Caption;
        M := M+1;
      end;
      If (Panel.Controls[i] Is TcustomEdit )  then 
      If (I<=K) then 
      begin
        Sheet.Cells[2,n]:=TCustomEdit(Panel.Controls[i]).Text;
        N := N+1;
      end
      else begin
        Sheet.Cells[3,M]:=TCustomEdit(Panel.Controls[i]).Text;
        M := M+1;
      end;
      If (Panel.Controls[i] Is TCombobox )  then 
      If (I<=K) then 
      begin
        Sheet.Cells[2,n]:=TCombobox(Panel.Controls[i]).Text;
        N := N+1;
      end
      else begin
        Sheet.Cells[3,M]:=TCombobox(Panel.Controls[i]).Text;
        M := M+1;
      end;
      
    end;
  end;
  Sheet.cells[4,1]:='日期:'+FormatDateTime('yyyy"年"mm"月"dd"日"',Now);
  Sheet.Cells[4,j-1]:='制表:'+UserCode;    //以上为表头输出
  J:=1;
  for I:=0 To DBGridEh.Columns.Count-1  Do
    if DBGridEh.Columns[I].Visible Then
    begin
      Sheet.Cells[5,J]:=''''+DbGridEh.Columns[I].Title.Caption;  //设置列标题
      j:=j+1;
    end;
  if not DbGridEh.DataSource.DataSet.Active Then
  begin
    Excel.Quit;
    Excel:=UnAssigned;
    Screen.Cursor:=CrDefault;
    Abort;
  end;
  with DBGridEh.DataSource.DataSet do
  begin
    First;
    I:=6; //行记数
    While Not Eof Do
    begin
      Y:=1;
      For J:=0 To DbgridEh.Columns.Count-1 Do //列记数
      begin
      If DbGridEh.Columns[J].Visible Then
      begin
        KeyList:='';
        If (DbgridEh.Columns[J].KeyList.Count>0) Then
          For z:=0 To DbgridEh.Columns[J].KeyList.Count-1 Do
           If KeyList='' Then
             KeyList:=DbgridEh.Columns[J].KeyList.Strings[z]
           Else
             KeyList:=KeyList+','+DbgridEh.Columns[J].KeyList.Strings[z];
        If (DbgridEh.Columns[J].KeyList.Count>0) And (Pos(fieldbyname(DbGridEh.Columns[J].FieldName).AsString,KeyList)>0)
           And (DbgridEh.Columns[J].PickList.Count>=DbGridEh.Columns[J].KeyList.IndexOf(fieldbyname(DbGridEh.Columns[J].FieldName).AsString))  then
             Sheet.Cells[I,Y]:=''''+DbGridEh.Columns[J].PickList.Strings[DbGridEh.Columns[J].KeyList.IndexOf(fieldbyname(DbGridEh.Columns[J].FieldName).AsString)]
        Else
        begin
          If (fieldbyname(DbGridEh.Columns[J].FieldName).DataType=FtDateTime)
            or (fieldbyname(DbGridEh.Columns[J].FieldName).DataType=FtDate)
            Or (fieldbyname(DbGridEh.Columns[J].FieldName).DataType=FtTime)Then
            begin
              if fieldbyname(DbGridEh.Columns[J].FieldName).Asstring<>'' then
              begin
                if length(fieldbyname(DbGridEh.Columns[J].FieldName).Asstring)<=10 then
                  Sheet.Cells[I,Y]:=FormatDateTime('yyyy.mm.dd',fieldbyname(DbGridEh.Columns[J].FieldName).AsDateTime)
                else
                  Sheet.Cells[I,Y]:=FormatDateTime('yyyy.mm.dd hh.nn.ss',fieldbyname(DbGridEh.Columns[J].FieldName).AsDateTime)
              end
              else Sheet.Cells[I,Y]:='';
            end
          Else If (fieldbyname(DbGridEh.Columns[J].FieldName).DataType<>FtString) Then
            Sheet.Cells[I,Y]:=fieldbyname(DbGridEh.Columns[J].FieldName).AsString
          Else
            Sheet.Cells[I,Y]:=''''+fieldbyname(DbGridEh.Columns[J].FieldName).AsString;
        end;
        Y:=Y+1;
      end;
      end;
      I:=I+1;
      Next;
    end;
  end;
  Screen.Cursor:=CrDefault;
  Excel.Visible:=True;
  DbGridEh.FrozenCols:=X;
  Excel:=UnAssigned;
end;

procedure TFrm_Base_Panel.DBGridEhDrawDataCell(Sender: TObject;
  const Rect: TRect; Field: TField; State: TGridDrawState);
begin
  {if((ZeroToNullFields='')or(Pos(Field.FieldName+',',ZeroToNullFields)<>0))
    and(Field.DataType in [ftFloat])and(Field.AsString='0')then
  begin
    TDBGridEh(Sender).Canvas.FillRect(Rect);
    TDBGridEh(Sender).Canvas.TextOut(Rect.Left+2,Rect.Top+3,' ');
  end;}
end;

procedure TFrm_Base_Panel.SetDBConnect(AdOConnection: TAdOConnection);
begin//读取数据显示格式
  inherited;
  AdoQry_Tmp.Close;
  AdoQry_Tmp.SQL.Text:='Select SysParamValueN From SysParam'
    +' Where SysParamCode=''PriceLen''';
  AdoQry_Tmp.Open;
  PriceLen:=AdoQry_Tmp.fieldbyname('SysParamValueN').AsInteger;
  AdoQry_Tmp.Close;
  AdoQry_Tmp.SQL.Text:='Select SysParamValueN From SysParam'
    +' Where SysParamCode=''AmountLen''';
  AdoQry_Tmp.Open;
  if AdoQry_Tmp.fieldbyname('SysParamValueN').AsString<>'' then
    AmountLen:=AdoQry_Tmp.fieldbyname('SysParamValueN').AsInteger
  else
    AmountLen:=2;
  AdoQry_Tmp.Close;
  AdoQry_Tmp.SQL.Text:='Select SysParamValueN From SysParam'
    +' Where SysParamCode=''QtyLen''';
  AdoQry_Tmp.Open;
  QtyLen:=AdoQry_Tmp.fieldbyname('SysParamValueN').AsInteger;
end;

procedure TFrm_Base_Panel.AdoQueryAfterOpen(DataSet: TDataSet);
vAr
  i:Integer;
  PriceFormat,AmountFormat,QtyFormat:String;
begin//数据显示格式统一处理过程
  if PriceLen<0 then
    PriceFormat:=''
  else if PriceLen=0 then
    PriceFormat:='0'
  else
  begin
    PriceFormat:='0.#';
    for i:=2 to PriceLen do
      PriceFormat:=PriceFormat+'#';
  end;
  if AmountLen<0 then
    AmountFormat:=''
  else if AmountLen=0 then
    AmountFormat:='0'
  else
  begin
    AmountFormat:='0.#';
    for i:=2 to AmountLen do
      AmountFormat:=AmountFormat+'#';
  end;
  if QtyLen<0 then
    QtyFormat:=''
  else if QtyLen=0 then
    QtyFormat:='0'
  else
  begin
    QtyFormat:='0.#';
    for i:=2 to QtyLen do
      QtyFormat:=QtyFormat+'#';
  end;
  for i:=0 to DataSet.FieldCount-1 do
    if (DataSet.Fields[i].DataType in [ftFloat,ftBCD])then
    begin
      if Pos(LowerCase(DataSet.Fields[i].FieldName+','),LowerCase(PriceFields))<>0 then
        TFloatField(DataSet.Fields[i]).DisplayFormat:=PriceFormat
      else if Pos(LowerCase(DataSet.Fields[i].FieldName+','),LowerCase(AmountFields))<>0 then
        TFloatField(DataSet.Fields[i]).DisplayFormat:=AmountFormat
      else if Pos(LowerCase(DataSet.Fields[i].FieldName+','),LowerCase(FreeFields))=0 then
        TFloatField(DataSet.Fields[i]).DisplayFormat:=QtyFormat;
    end;
end;

procedure TFrm_Base_Panel.DBGridEhGetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; vAr Background: TColor;
  State: TGridDrawState);
begin//DBGrid条纹显示处理过程
  if TDBGridEh(Sender).DataSource.DataSet.RecNo mod 2=1 then
    Background:=$f0f0f0
  else
    Background:=clWindow;
  if (gdSelected in State)or(gdFocused in State) then
  begin
    Background:=clNavy;
    AFont.Color:=clWindow;
  end
  else
  begin
    AFont.Color:=clBlack;
  end;
end;

procedure TFrm_Base_Panel.FormActivate(Sender: TObject);
vAr i:integer;
begin
  inherited;
  PnlTitleLabel.Caption:=Pnl_Title.Caption;
  for i:=0 to pnl_Head.ControlCount-1 do
    begin
      if (Pnl_Head.Controls[i] is TLabel)  then
        Tlabel(Pnl_Head.Controls[i]).transParent:=True;
      if   (Pnl_Head.Controls[i] is TDBtext) then
        Tdbtext(Pnl_Head.Controls[i]).transParent:=True;
        
    end;
  for i:=0 to pnl_Hint.ControlCount-1 do
    begin
      if (Pnl_Hint.Controls[i] is TLabel)  then
        Tlabel(Pnl_Hint.Controls[i]).transParent:=True;
      if (Pnl_Hint.Controls[i] is TDBtext) then
        Tdbtext(Pnl_Hint.Controls[i]).transParent:=True;
        
    end;

end;

end.