zcmcfltjunit.~pas

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

~PAS
486
字号
unit zcmcfltjUnit;
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_zcmcfltj = 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;
    Button4: TButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    QuickRep1: TQuickRep;
    SummaryBand1: TQRBand;
    QRLabel8: TQRLabel;
    QRLabel16: TQRLabel;
    QRExpr1: TQRExpr;
    QRShape1: TQRShape;
    PageHeaderBand1: TQRBand;
    bbbt: TQRLabel;
    QRLabel14: TQRLabel;
    QRSysData1: TQRSysData;
    DetailBand1: TQRBand;
    QRShape11: TQRShape;
    QRDBText2: TQRDBText;
    QRShape13: TQRShape;
    QRDBText3: TQRDBText;
    QRShape14: TQRShape;
    QRDBText4: TQRDBText;
    QRShape16: TQRShape;
    QRDBText12: TQRDBText;
    QRShape18: TQRShape;
    QRDBText7: TQRDBText;
    PageFooterBand1: TQRBand;
    QRSysData2: TQRSysData;
    QRLabel1: TQRLabel;
    QRLabel15: TQRLabel;
    zys: TQRLabel;
    ColumnHeaderBand1: TQRBand;
    QRShape3: TQRShape;
    QRShape5: TQRShape;
    QRShape6: TQRShape;
    QRShape8: TQRShape;
    QRShape9: TQRShape;
    QRLabel3: TQRLabel;
    QRLabel4: TQRLabel;
    QRLabel6: TQRLabel;
    QRLabel5: TQRLabel;
    QRLabel7: TQRLabel;
    QRLabel17: TQRLabel;
    QRGroup1: TQRGroup;
    QRBand1: TQRBand;
    QRLabel18: TQRLabel;
    QRLabel19: TQRLabel;
    QRExpr5: TQRExpr;
    QRLabel20: TQRLabel;
    QRShape2: TQRShape;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    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);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
  private
function cxjgmap(sourstr:string;detistr:string):string;
  { Private declarations }
  public
  cxjg:string;
//cxjg 为条件查询中所得到的结果
    { Public declarations }
  end;

var
  w_zcmcfltj: Tw_zcmcfltj;

implementation

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

{$R *.dfm}

function tw_zcmcfltj.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_zcmcfltj.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
end;

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

procedure Tw_zcmcfltj.Button1Click(Sender: TObject);
begin
  with hjzcdata.zcfltj do
  begin
    close;
    sql.clear;
    sql.text:=cxstr+' order by 资产名称编码';
    parameters.ParamByName('sdate').value:=sdate.DateTime;
    parameters.ParamByName('edate').value:=edate.DateTime;
    prepared;
    open;
  end;
end;

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

procedure Tw_zcmcfltj.Button2Click(Sender: TObject);
var i,j:integer;
s,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
begin
s:=dbgrid1.Columns.Items[i].Field.DisplayLabel;
if (copy(s,length(s)-1,2)='↑') OR (copy(s,length(s)-1,2)='↓') then
w_tj.tj.Items.Add(copy(s,1,length(s)-2)) else
w_tj.tj.Items.Add(s);
end;
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.zcfltj do
begin
close;
SQL.text:=cxstr+sortstr+' order by 资产名称编码';
parameters.ParamByName('sdate').value:=sdate.DateTime;
parameters.ParamByName('edate').value:=edate.DateTime;
prepared;
open;
end;
end;
end;

procedure Tw_zcmcfltj.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.zcfltj.DisableControls;
try
Bookmark := hjzcdata.zcfltj.Bookmark;
try
hjzcdata.zcfltj.First;
Row := 2;
while not hjzcdata.zcfltj.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.zcfltj.Fieldbyname(zdname).value;
RangeE := RangeE.Next;
end;
hjzcdata.zcfltj.Next;
Inc (Row);
end;
finally
hjzcdata.zcfltj.Bookmark := Bookmark;
end;
finally
hjzcdata.zcfltj.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_zcmcfltj.QuickRep1Preview(Sender: TObject);
begin

  with Tprevform.Create(Application) do
begin
QRPreview1.QRPrinter := TQRPrinter(Sender);
   Show;
  end
end;

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

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

procedure Tw_zcmcfltj.Button4Click(Sender: TObject);
var gdzcbm:integer;
begin
if hjzcdata.zcfltj.IsEmpty then
begin
messagedlg('没有选中任何数据!',mterror,[mbok],0);
exit;
end;
gdzcbm:=hjzcdata.zcfltj.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_zcmcfltj.N1Click(Sender: TObject);
begin
button4click(self);
end;

procedure Tw_zcmcfltj.N2Click(Sender: TObject);
var
gysbm:integer;
begin
if hjzcdata.zcfltj.isempty then
exit;
gysbm:=0;
gysbm:=hjzcdata.zcfltj.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_zcmcfltj.N3Click(Sender: TObject);
var zybm:integer;
begin
zybm:=hjzcdata.zcfltj.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;

procedure Tw_zcmcfltj.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
var  sylx:integer;
begin
  sylx:=hjzcdata.zcfltj.fieldbyname('使用年限').asinteger*30;
  if hjzcdata.zcfltj.fieldbyname('购买日期').asdatetime+sylx<now then
  begin
    dbGrid1.Canvas.Brush.color:=clred;
    dbGrid1.Canvas.pen.mode:=pmmask;
    dbGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;

procedure Tw_zcmcfltj.FormCreate(Sender: TObject);
var
  i:integer;
  s:string;
begin
if hjzcdata.zcfltj.Active then hjzcdata.zcfltj.Active:=false;
//将含箭头的题还原
FOR I:=0 TO hjzcdata.zcfltj.FieldCount-1 DO
BEGIN
S:=hjzcdata.zcfltj.Fields[I].DisplayLabel;
IF (copy(s,length(s)-1,2)='↑') OR (copy(s,length(s)-1,2)='↓') THEN
hjzcdata.zcfltj.FIELDS[I].DISPLAYLABEL:=COPY(S,1,LENGTH(S)-2);
END;
end;

end.

⌨️ 快捷键说明

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