zccxpas.~pas
来自「本软件是一套功能完整成熟的固定资产管理系统,具有固定资产管理系统的相应全部功能」· ~PAS 代码 · 共 551 行
~PAS
551 行
unit zccxpas;
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_gdzccx = 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;
QRShape10: TQRShape;
QRLabel2: TQRLabel;
QRLabel3: TQRLabel;
QRLabel4: TQRLabel;
QRLabel6: TQRLabel;
QRLabel9: TQRLabel;
QRLabel5: TQRLabel;
QRLabel7: TQRLabel;
QRLabel11: 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;
QRShape18: TQRShape;
QRDBText7: TQRDBText;
SummaryBand1: TQRBand;
QRLabel8: TQRLabel;
QRLabel10: TQRLabel;
QRLabel12: TQRLabel;
QRLabel13: TQRLabel;
QRLabel16: TQRLabel;
QRExpr1: TQRExpr;
QRExpr2: TQRExpr;
QRExpr3: TQRExpr;
QRExpr4: 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);
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_gdzccx: Tw_gdzccx;
implementation
uses datapas, cxtjpas,prinprevpas, wxpas, gysxxpas, zyxxbpas;
var cxstr:string;
{$R *.dfm}
function tw_gdzccx.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_gdzccx.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=cafree;
end;
procedure Tw_gdzccx.Button5Click(Sender: TObject);
begin
close;
end;
procedure Tw_gdzccx.Button1Click(Sender: TObject);
begin
with hjzcdata.gdzccx 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_gdzccx.DBGrid1TitleClick(Column: TColumn);
var s:string;
pxstr:string;
I:INTEGER;
ordexiststr:string;
begin
//将含箭头的题还原
FOR I:=0 TO hjzcdata.gdzccx.FieldCount-1 DO
BEGIN
S:=HJZCDATA.gdzccx.Fields[I].DisplayLabel;
IF (HJZCDATA.gdzccx.FIELDS[I]<>column.Field) and ((copy(s,length(s)-1,2)='↑') OR (copy(s,length(s)-1,2)='↓')) THEN
HJZCDATA.gdzccx.FIELDS[I].DISPLAYLABEL:=COPY(S,1,LENGTH(S)-2);
END;
pxstr:=column.FieldName;
s:=column.Field.DisplayLabel;
ordexiststr:=hjzcdata.gdzccx.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.gdzccx.close;
if (pxstr='zclb') or (pxstr='zcmc') or (pxstr='zcyt') or (pxstr='zcxh') or (pxstr='gys') or (pxstr='zyxm') then
pxstr:=pxstrmap(pxstr);
hjzcdata.gdzccx.SQL.Text:=ordexiststr+' order by '+pxstr+' asc';
hjzcdata.gdzccx.Prepared;
hjzcdata.gdzccx.Open;
end else
if copy(s,length(s)-1,2)='↑' then
begin
//降序排列
column.Field.DisplayLabel:=copy(s,1,length(s)-2)+'↓';
hjzcdata.gdzccx.close;
if (pxstr='zclb') or (pxstr='zcmc') or (pxstr='zcyt') or (pxstr='zcxh') or (pxstr='gys') or (pxstr='zyxm') then
pxstr:=pxstrmap(pxstr);
hjzcdata.gdzccx.SQL.Text:=ordexiststr+' order by '+pxstr+' desc';
hjzcdata.gdzccx.Prepared;
hjzcdata.gdzccx.Open;
end else
if copy(s,length(s)-1,2)='↓' then
begin
//升序排列
column.Field.DisplayLabel:=copy(s,1,length(s)-2)+'↑';
hjzcdata.gdzccx.close;
if (pxstr='zclb') or (pxstr='zcmc') or (pxstr='zcyt') or (pxstr='zcxh') or (pxstr='gys') or (pxstr='zyxm') then
pxstr:=pxstrmap(pxstr);
hjzcdata.gdzccx.SQL.Text:=ordexiststr+' order by '+pxstr+' asc';
hjzcdata.gdzccx.Prepared;
hjzcdata.gdzccx.Open;
end;
end;
procedure Tw_gdzccx.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_gdzccx.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.gdzccx 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_gdzccx.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.gdzccx.DisableControls;
try
Bookmark := hjzcdata.gdzccx.Bookmark;
try
hjzcdata.gdzccx.First;
Row := 2;
while not hjzcdata.gdzccx.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.gdzccx.Fieldbyname(zdname).value;
RangeE := RangeE.Next;
end;
hjzcdata.gdzccx.Next;
Inc (Row);
end;
finally
hjzcdata.gdzccx.Bookmark := Bookmark;
end;
finally
hjzcdata.gdzccx.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_gdzccx.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_gdzccx.N5Click(Sender: TObject);
begin
close;
end;
procedure Tw_gdzccx.N4Click(Sender: TObject);
begin
button3click(self);
end;
procedure Tw_gdzccx.Button4Click(Sender: TObject);
var gdzcbm:integer;
begin
if hjzcdata.gdzccx.IsEmpty then
begin
messagedlg('没有选中任何数据!',mterror,[mbok],0);
exit;
end;
gdzcbm:=hjzcdata.gdzccx.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_gdzccx.N1Click(Sender: TObject);
begin
button4click(self);
end;
procedure Tw_gdzccx.N2Click(Sender: TObject);
var
gysbm:integer;
begin
if hjzcdata.gdzccx.isempty then
exit;
gysbm:=0;
gysbm:=hjzcdata.gdzccx.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_gdzccx.N3Click(Sender: TObject);
var zybm:integer;
begin
zybm:=hjzcdata.gdzccx.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_gdzccx.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
var sylx:integer;
begin
sylx:=hjzcdata.gdzccx.fieldbyname('使用年限').asinteger*30;
if hjzcdata.gdzccx.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_gdzccx.FormCreate(Sender: TObject);
var
i:integer;
s:string;
begin
//将含箭头的题还原
FOR I:=0 TO hjzcdata.gdzccx.FieldCount-1 DO
BEGIN
S:=HJZCDATA.gdzccx.Fields[I].DisplayLabel;
IF (copy(s,length(s)-1,2)='↑') OR (copy(s,length(s)-1,2)='↓') THEN
HJZCDATA.gdzccx.FIELDS[I].DISPLAYLABEL:=COPY(S,1,LENGTH(S)-2);
END;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?