bfcxpas.~pas

来自「本软件是一套功能完整成熟的固定资产管理系统,具有固定资产管理系统的相应全部功能」· ~PAS 代码 · 共 505 行

unit bfcxpas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Grids, DBGrids, DB, ExtCtrls, ADODB,
  OleServer, Excel2000, QRCtrls, QuickRpt, QRPrntr, Menus;

type
  Tw_zcbfcx = class(TForm)
    Panel1: TPanel;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    Button5: TButton;
    lscx: TADOQuery;
    Button3: TButton;
    Label1: TLabel;
    sdate: TDateTimePicker;
    Label2: TLabel;
    edate: TDateTimePicker;
    ExcelApplication1: TExcelApplication;
    QuickRep1: TQuickRep;
    PageHeaderBand1: TQRBand;
    DetailBand1: TQRBand;
    bbbt: TQRLabel;
    QRLabel14: TQRLabel;
    QRSysData1: TQRSysData;
    PageFooterBand1: TQRBand;
    QRLabel1: TQRLabel;
    QRLabel15: TQRLabel;
    QRSysData2: TQRSysData;
    zys: TQRLabel;
    ColumnHeaderBand1: TQRBand;
    QRShape3: TQRShape;
    QRShape4: TQRShape;
    QRShape5: TQRShape;
    QRShape6: TQRShape;
    QRShape7: TQRShape;
    QRShape8: TQRShape;
    QRShape9: TQRShape;
    QRLabel2: TQRLabel;
    QRLabel3: TQRLabel;
    QRLabel4: TQRLabel;
    QRLabel6: TQRLabel;
    QRLabel9: TQRLabel;
    QRLabel5: TQRLabel;
    QRLabel7: TQRLabel;
    QRShape11: TQRShape;
    QRDBText1: TQRDBText;
    QRShape12: TQRShape;
    QRDBText2: TQRDBText;
    QRShape13: TQRShape;
    QRDBText3: TQRDBText;
    QRShape14: TQRShape;
    QRDBText4: TQRDBText;
    QRShape15: TQRShape;
    QRDBText8: TQRDBText;
    QRShape16: TQRShape;
    QRDBText12: TQRDBText;
    QRShape17: TQRShape;
    QRDBText6: TQRDBText;
    SummaryBand1: TQRBand;
    QRLabel8: TQRLabel;
    QRLabel16: TQRLabel;
    QRExpr1: TQRExpr;
    QRShape1: TQRShape;
    Button4: TButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure DBGrid1TitleClick(Column: TColumn);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure QuickRep1Preview(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
function cxjgmap(sourstr:string;detistr:string):string;
  { Private declarations }
  public
  cxjg:string;
//cxjg 为条件查询中所得到的结果
    { Public declarations }
  end;

var
  w_zcbfcx: Tw_zcbfcx;

implementation

uses datapas, cxtjpas,prinprevpas, wxpas, gysxxpas, zyxxbpas;
var cxstr:string;

{$R *.dfm}

function tw_zcbfcx.cxjgmap(sourstr:string;detistr:string):string;
begin
if sourstr='资产类别' then
begin
with lscx do
begin
close;
sql.clear;
sql.add('select 资产类别编码 from 固定资产类别表 where 固定资产类别=:gdzclb');
parameters.parambyname('gdzclb').value:=detistr;
prepared;
open;
if not isempty then
result:=inttostr(fields[0].asinteger);
end;
end else
if sourstr='资产名称' then
begin
with lscx do
begin
close;
sql.clear;
sql.add('select 资产名称编码 from 固定资产名称表 where 固定资产名称=:gdzclb');
parameters.parambyname('gdzclb').value:=detistr;
prepared;
open;
if not isempty then
result:=inttostr(fields[0].asinteger);
end;
end else
if sourstr='资产用途' then
begin
with lscx do
begin
close;
sql.clear;
sql.add('select 资产用途编码 from 固定资产用途表 where 固定资产用途=:gdzclb');
parameters.parambyname('gdzclb').value:=detistr;
prepared;
open;
if not isempty then
result:=inttostr(fields[0].asinteger);
end;
end else
if sourstr='资产型号' then
begin
with lscx do
begin
close;
sql.clear;
sql.add('select 资产型号编码 from 固定资产型号表 where 固定资产型号=:gdzclb');
parameters.parambyname('gdzclb').value:=detistr;
prepared;
open;
if not isempty then
result:=inttostr(fields[0].asinteger);
end;
end else
if sourstr='供应商' then
begin
with lscx do
begin
close;
sql.clear;
sql.add('select 供应商编码 from 供应商编码表 where 供应商名称=:gdzclb');
parameters.parambyname('gdzclb').value:=detistr;
prepared;
open;
if not isempty then
result:=inttostr(fields[0].asinteger);
end;
end else
if sourstr='使用者' then
begin
with lscx do
begin
close;
sql.clear;
sql.add('select 职员编码 from 职员编码表 where 职员姓名=:gdzclb');
parameters.parambyname('gdzclb').value:=detistr;
prepared;
open;
if not isempty then
result:=inttostr(fields[0].asinteger);
end;
end else
if sourstr='是否借出' then
begin
if detistr='是' then
result:='true' else result:='false';
end else
if (sourstr='存放地点') or (sourstr='序列号') or (sourstr='配置') then
result:='"'+detistr+'"' else
result:=detistr;
end;



function pxstrmap(sourstr:string):string;
begin
if sourstr='zclb' then
result:='资产类别编码' else
if sourstr='zcmc' then
result:='资产名称编码' else
if sourstr='zcyt' then
result:='资产用途编码' else
if sourstr='zcxh' then
result:='资产型号编码' else
if sourstr='gys' then
result:='供应商编码' else
if sourstr='zyxm' then
result:='职员编码'  else
result:=sourstr;
end;


procedure Tw_zcbfcx.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
end;

procedure Tw_zcbfcx.Button5Click(Sender: TObject);
begin
close;
end;

procedure Tw_zcbfcx.Button1Click(Sender: TObject);
begin
with hjzcdata.zcbfcx do
begin
close;
sql.clear;
sql.text:=cxstr;
parameters.ParamByName('sdate').value:=sdate.DateTime;
parameters.ParamByName('edate').value:=edate.DateTime;
prepared;
open;
end;
end;

procedure Tw_zcbfcx.DBGrid1TitleClick(Column: TColumn);
var s:string;
pxstr:string;
I:INTEGER;
ordexiststr:string;
begin
//将含箭头的题还原
FOR I:=0 TO hjzcdata.zcbfcx.FieldCount-1 DO
BEGIN
S:=HJZCDATA.zcbfcx.Fields[I].DisplayLabel;
IF (HJZCDATA.zcbfcx.FIELDS[I]<>column.Field) and ((copy(s,length(s)-1,2)='↑') OR (copy(s,length(s)-1,2)='↓')) THEN
HJZCDATA.zcbfcx.FIELDS[I].DISPLAYLABEL:=COPY(S,1,LENGTH(S)-2);
END;

pxstr:=column.FieldName;
s:=column.Field.DisplayLabel;
ordexiststr:=hjzcdata.zcbfcx.SQL.Text;   //保存原来查询字符串内容
if Pos('order',ordexiststr) > 0 then
ordexiststr:=copy(ordexiststr,1,pos('order',ordexiststr)-1);

if (copy(s,length(s)-1,2)<>'↑') and (copy(s,length(s)-1,2)<>'↓') then
begin
column.Field.DisplayLabel:=s+'↑';
hjzcdata.zcbfcx.close;
if (pxstr='zclb') or (pxstr='zcmc') or (pxstr='zcyt') or (pxstr='zcxh') or (pxstr='gys') or (pxstr='zyxm') then
pxstr:=pxstrmap(pxstr);
hjzcdata.zcbfcx.SQL.Text:=ordexiststr+' order by '+pxstr+' asc';
hjzcdata.zcbfcx.Prepared;
hjzcdata.zcbfcx.Open;
end else
if copy(s,length(s)-1,2)='↑' then
begin
//降序排列
column.Field.DisplayLabel:=copy(s,1,length(s)-2)+'↓';
hjzcdata.zcbfcx.close;
if (pxstr='zclb') or (pxstr='zcmc') or (pxstr='zcyt') or (pxstr='zcxh') or (pxstr='gys') or (pxstr='zyxm') then
pxstr:=pxstrmap(pxstr);
hjzcdata.zcbfcx.SQL.Text:=ordexiststr+' order by '+pxstr+' desc';
hjzcdata.zcbfcx.Prepared;
hjzcdata.zcbfcx.Open;
end else
if copy(s,length(s)-1,2)='↓' then
begin
//升序排列
column.Field.DisplayLabel:=copy(s,1,length(s)-2)+'↑';
hjzcdata.zcbfcx.close;
if (pxstr='zclb') or (pxstr='zcmc') or (pxstr='zcyt') or (pxstr='zcxh') or (pxstr='gys') or (pxstr='zyxm') then
pxstr:=pxstrmap(pxstr);
hjzcdata.zcbfcx.SQL.Text:=ordexiststr+' order by '+pxstr+' asc';
hjzcdata.zcbfcx.Prepared;
hjzcdata.zcbfcx.Open;
end;
end;

procedure Tw_zcbfcx.FormShow(Sender: TObject);
begin
cxstr:='select 固定资产编码,资产类别编码,资产名称编码,资产用途编码,资产型号编码,购买价格,使用年限,';
cxstr:=cxstr+'供应商编码,购买日期,职员编码,存放地点,报废日期,序列号,配置';
cxstr:=cxstr+' from 固定资产信息表 where 报废=true and 购买日期>=:sdate and 购买日期<=:edate';
sdate.Datetime:=strtodatetime('1900-01-01 00:00:00');
edate.DateTime:=strtodatetime(datetostr(now)+' 23:59:59');
end;

procedure Tw_zcbfcx.Button2Click(Sender: TObject);
var i,j:integer;
sortstr:string;
sortsour:string;
begin
w_tj:=tw_tj.create(application);
w_tj.tj.Items.Clear;
for i:=0 to dbgrid1.Columns.Count-1 do
w_tj.tj.Items.Add(dbgrid1.Columns.Items[i].Field.DisplayLabel);
if w_tj.showmodal=mrok then
begin
sortstr:='';
for i:=0 to dbgrid1.Columns.Count-1 do
for j:=1 to w_tj.sg1.RowCount-1 do
if (w_tj.sg1.cells[0,j]=dbgrid1.Columns.Items[i].Field.DisplayLabel) and (w_tj.sg1.cells[1,j]<>'') and (w_tj.sg1.cells[3,j]<>'') then
begin
if w_tj.sg1.cells[3,j]='并且' then
sortstr:=sortstr+' and' else
sortstr:=sortstr+' or';
sortsour:=dbgrid1.Columns.Items[i].FieldName;
sortstr:=sortstr+' '+pxstrmap(sortsour)+' '+w_tj.sg1.cells[1,j]+' ';
sortstr:=sortstr+cxjgmap(w_tj.sg1.cells[0,j],w_tj.sg1.Cells[2,j]);
end;
if sortstr<>'' then
with hjzcdata.zcbfcx do
begin
close;
SQL.text:=cxstr+sortstr;
parameters.ParamByName('sdate').value:=sdate.DateTime;
parameters.ParamByName('edate').value:=edate.DateTime;
prepared;
open;
end;
end;
end;

procedure Tw_zcbfcx.Button3Click(Sender: TObject);
var
RangeE: Excel2000.Range;
I, Row: Integer;
Bookmark: TBookmarkStr;
zdname:string;
bbgs:boolean;
begin
with lscx do
begin
close;
sql.clear;
sql.add('select 报表格式 from 参数表');
prepared;
open;
bbgs:=fields[0].value;
end;
if not bbgs then  //采用excel报表
begin
ExcelApplication1.Visible [0] := True;
ExcelApplication1.Workbooks.Add (NULL, 0);
// fill is the first row with field titles
RangeE := ExcelApplication1.ActiveCell;
for I := 0 to dbgrid1.Columns.Count - 1 do
begin
RangeE.Value := dbgrid1.Columns.Items[i].Field.DisplayLabel;
RangeE := RangeE.Next;
end;
// add field data in following rows
hjzcdata.zcbfcx.DisableControls;
try
Bookmark := hjzcdata.zcbfcx.Bookmark;
try
hjzcdata.zcbfcx.First;
Row := 2;
while not hjzcdata.zcbfcx.EOF do
begin
RangeE := ExcelApplication1.Range ['A' + IntToStr (Row),
'A' + IntToStr (Row)];
for I := 0 to dbgrid1.Columns.Count-1 do
begin
zdname:=dbgrid1.Columns.Items[i].FieldName;
RangeE.Value := hjzcdata.zcbfcx.Fieldbyname(zdname).value;
RangeE := RangeE.Next;
end;
hjzcdata.zcbfcx.Next;
Inc (Row);
end;
finally
hjzcdata.zcbfcx.Bookmark := Bookmark;
end;
finally
hjzcdata.zcbfcx.EnableControls;
end;
// format the section
RangeE := ExcelApplication1.Range ['A1', 'E' + IntToStr (Row - 1)];
//RangeE.AutoFormat (3, NULL, NULL, NULL, NULL, NULL, NULL);
end
else   //采用常规报表
begin
with lscx do
begin
close;
sql.clear;
sql.add('select 单位名称 from 参数表');
prepared;
open;
bbbt.Caption:=fields[0].Value+'固定资产报废情况表';
end;
quickrep1.Prepare;
zys.Caption:='共 '+inttostr(quickrep1.Printer.Pagecount)+' 页';
quickrep1.Preview;
end;
end;

procedure Tw_zcbfcx.QuickRep1Preview(Sender: TObject);
begin
bbbt.Left:=(PageHeaderBand1.Width-bbbt.Width) div 2;
  with Tprevform.Create(Application) do
begin
QRPreview1.QRPrinter := TQRPrinter(Sender);
   Show;
  end
end;

procedure Tw_zcbfcx.N5Click(Sender: TObject);
begin
close;
end;

procedure Tw_zcbfcx.N4Click(Sender: TObject);
begin
button3click(self);
end;

procedure Tw_zcbfcx.Button4Click(Sender: TObject);
var gdzcbm:integer;
begin
if hjzcdata.zcbfcx.IsEmpty then
begin
messagedlg('没有选中任何数据!',mterror,[mbok],0);
exit;
end;
gdzcbm:=hjzcdata.zcbfcx.fields[0].AsInteger;
if not hjzcdata.gdzcxxb.active then
hjzcdata.gdzcxxb.Active:=true;
hjzcdata.gdzcxxb.Locate('固定资产编码',gdzcbm,[lopartialkey]);
hjzcdata.gdzcxxb.Edit;
w_wx.button1.Enabled:=false;
w_wx.DBMemo1.Enabled:=false;
if w_wx.showmodal=mrok then
begin
hjzcdata.gdzcxxb.FieldByName('维修标志').AsBoolean:=true;
hjzcdata.gdzcxxb.Post;
end else
hjzcdata.gdzcxxb.cancel;


end;

procedure Tw_zcbfcx.N1Click(Sender: TObject);
begin
button4click(self);
end;

procedure Tw_zcbfcx.N2Click(Sender: TObject);
var
gysbm:integer;
begin
if hjzcdata.zcbfcx.isempty then
exit;
gysbm:=0;
gysbm:=hjzcdata.zcbfcx.fieldbyname('供应商编码').asinteger;
if not hjzcdata.gysbmb.active then
hjzcdata.gysbmb.active:=true;
if hjzcdata.gysbmb.Locate('供应商编码',gysbm,[lopartialkey]) then
w_gysxx.showmodal else
messagedlg('无此固定资产供应商信息!',mtconfirmation,[mbok],0); 

end;

procedure Tw_zcbfcx.N3Click(Sender: TObject);
var zybm:integer;
begin
zybm:=hjzcdata.zcbfcx.fieldbyname('职员编码').asinteger;
hjzcdata.zybmb.close;
hjzcdata.zybmb.open;
if hjzcdata.zybmb.Locate('职员编码',zybm,[lopartialkey]) then
begin
zyxxform.Panel2.Enabled:=false;
zyxxform.showmodal;
end else
messagedlg('无此固定资产使用者信息!',mtconfirmation,[mbok],0);
end;

end.