下面是我刚学delphi时写的 见笑了
type
Pfbp=^Tfbt;
Tfbt=record
fr : integer
//row
fc : Integer
//col
ft : Integer
//celltype
end;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
...
procedure Timer1Timer(Sender: TObject)
//状态栏显示时间
procedure FormCreate(Sender: TObject)
//创建主窗口
procedure TreeView1Change(Sender: TObject
Node: TTreeNode);//树列框变换节点
procedure TreeView1DblClick(Sender: TObject)
//打开样表或是报表
procedure ToolButton4Click(Sender: TObject)
// ////////////////
procedure copyselectExecute(Sender: TObject)
// 事
procedure pasteexecute(sender :tobject)
//
procedure cutExecute(Sender: TObject)
// 件
procedure clearExecute(Sender: TObject)
//
procedure deleteExecute(Sender: TObject)
//
procedure FormatExecute(Sender: TObject)
// 列
procedure OptionsExecute(Sender: TObject)
//
procedure insertExecute(Sender: TObject)
//
procedure replaceExecute(Sender: TObject)
// 表
procedure findExecute(Sender: TObject)
///////////////////
//procedure save
// 菜
procedure ToolButton3Click(Sender: TObject)
//
procedure N12Click(Sender: TObject)
// 单
procedure N10Click(Sender: TObject)
//
procedure N22Click(Sender: TObject)
// 处
procedure Save1Click(Sender: TObject)
//
procedure ToolButton17Click(Sender: TObject)
// 理
procedure Close1Click(Sender: TObject)
///////////////////
procedure TreeView1Edited(Sender: TObject
Node: TTreeNode
//节点改名
var S: String);
procedure N4Click(Sender: TObject);
procedure openfile1Click(Sender: TObject)
//打开引入的文件来引入样表
procedure SelectAll1Click(Sender: TObject)
//全选
procedure N38Click(Sender: TObject)
//删除样表
procedure N37Click(Sender: TObject)
//引入样表
procedure N36Click(Sender: TObject)
//引出样表
procedure ColorComboBox1Change(Sender: TObject);
procedure FBook1SelChange(Sender: TObject);
procedure ToolButton16Click(Sender: TObject);
procedure LMDFontComboBox1Change(Sender: TObject);
procedure LMDFontSizeComboBox1Change(Sender: TObject);
procedure ToolButton21Click(Sender: TObject);
procedure ToolButtonClick(Sender: TObject);
procedure dfsColorButton1Exit(Sender: TObject);
procedure FBook1EndEdit(Sender: TObject
var EditString: WideString;
var Cancel: Smallint);
procedure ToolButton32Click(Sender: TObject);
procedure ToolButton33Click(Sender: TObject);
procedure ToolButton38Click(Sender: TObject);
procedure ToolButton39Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N111DrawItem(Sender: TObject
ACanvas: TCanvas
ARect: TRect;
Selected: Boolean);
procedure N211DrawItem(Sender: TObject
ACanvas: TCanvas
ARect: TRect;
Selected: Boolean);
procedure N111MeasureItem(Sender: TObject
ACanvas: TCanvas
var Width,
Height: Integer);
procedure N110MeasureItem(Sender: TObject
ACanvas: TCanvas
var Width,
Height: Integer);
procedure N110DrawItem(Sender: TObject
ACanvas: TCanvas
ARect: TRect;
Selected: Boolean);
procedure N210DrawItem(Sender: TObject
ACanvas: TCanvas
ARect: TRect;
Selected: Boolean);
procedure N111Click(Sender: TObject);
procedure N211Click(Sender: TObject);
procedure N110Click(Sender: TObject);
procedure N210Click(Sender: TObject);
procedure ToolButton15Click(Sender: TObject);
procedure StatusBar1MouseMove(Sender: TObject
Shift: TShiftState
X,
Y: Integer);
procedure ToolButton40Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N39Click(Sender: TObject);
procedure N40Click(Sender: TObject);
procedure ToolButton41Click(Sender: TObject);
procedure ToolButton42Click(Sender: TObject);
procedure FBook1Click(Sender: TObject
nRow, nCol: Integer);
procedure N41Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N30Click(Sender: TObject);
procedure N31Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure N43Click(Sender: TObject);
procedure ToolButton46Click(Sender: TObject);
procedure ToolButton47Click(Sender: TObject)
//对所选中的区域求和
procedure ToolButton45Click(Sender: TObject);
procedure ToolButton44Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure N45Click(Sender: TObject);
procedure N46Click(Sender: TObject);
procedure ToolButton13Click(Sender: TObject);
procedure N50Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure crshgsClick(Sender: TObject);
procedure crhzgsClick(Sender: TObject);
procedure N25Click(Sender: TObject);
procedure N44Click(Sender: TObject);
procedure N52Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure N23Click(Sender: TObject);
procedure N29Click(Sender: TObject);
procedure FBook1Modified(Sender: TObject);
procedure FormClose(Sender: TObject
var Action: TCloseAction);
procedure N15Click(Sender: TObject);
procedure N18Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure N33Click(Sender: TObject);
procedure N53Click(Sender: TObject);
procedure N51Click(Sender: TObject);
procedure N54Click(Sender: TObject);
procedure TreeView1MouseUp(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
procedure N1Click(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure N58Click(Sender: TObject);
procedure N59Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure N63Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject
var CanClose: Boolean);
private
{ Private declarations }
procedure WMQueryEndSession(var Msg: TMessage)
message WM_QueryEndSession
//截获关闭Windows 的消息
procedure menuclick(sender:tobject);
procedure createlabel(sender:tobject)
//创建工具栏上的链接标签
procedure createtoolbar(sender:tobject)
//创建放按钮的工具栏
procedure createbutton(sender:tobject)
//创建工具栏上的按钮
procedure clicklabel(sender:tobject)
//单击状态栏上的链接
procedure clickbutton(sender:tobject)
//单击状态栏上的计算器按钮
procedure movelabel(Sender: TObject
Shift: TShiftState
X,Y: Integer)
//移动到标签
public
{ Public declarations }
dllid :array of integer;
toolbar:ttoolbar;
button:ttoolbutton;
tempname,repname,shtname,apppath:string;
//样表名报表名用户名单位名程序路径
copymonth,copyyear,step : string;
steptype : Integer
//小数位数
openfilename : string;
saveed,isnew,changed,opened,repsave:Boolean;
lab:tlabel;
tempid,repid : Integer
//样表报表的编号
status : Integer;
TempNode :TtreeNode;
end;
function showselfunfrm(hasfunction : Boolean): String stdcall;external'formula.dll'
procedure savetempformula;
procedure opentempformula;
const
root=HKEY_LOCAL_MACHINE;
formcaption='通用财务软件-报表系统';
var
Form1: TForm1;
implementation
{$R *.DFM}
uses delete, wandh,command,password, about, openandsave, deletemodule,
copyout, copyinto,Math, hsxd, gtdatamodule, tablecreat, tableopen,
tablecrtsh, tablecrthz, tablehz, tableqry, repinto, repout, tablesave
procedure tform1.menuclick(sender:tobject);
var
r1,r2,c1,c2 : Integer;
hasfunction : boolean;
s : string;
reg:tregistry;
dllfrm
levariant;
begin
s:=(sender as tmenuitem).caption;
if pos('(',s)>0 then s:=copy(s,1,pos('(',s)-1);
reg:=tregistry.Create;
form1.FBook1.GetSelection(0,r1,c1,r2,c2);
if form1.fbook1.FormulaRC[r1,c1]<>'' then hasfunction:=true
else
hasfunction:=false;
with reg do
begin
RootKey:=root;
if openkey('Software/通用科技有限公司/通用财会软件/Report/AddIns'+'/'+s,false) then
s:=readstring('classname');
closekey;
destroy;
end
// with
dllfrm:=createoleobject(s);
s:=dllfrm.showselfunfrm(hasfunction);
if s<>'' then form1.fbook1.FormulaRC[r1,c1]:=form1.fbook1.formularc[r1,c1]+s;
end;
//打开计算器
procedure tform1.clickbutton(sender:tobject);
var
HWndCalculator : HWnd;
begin
HWndCalculator :=FindWindow(nil, '计算器');
if HWndCalculator = 0 then shellexecute(application.MainForm.Handle,nil,'calc.exe',nil,nil,sw_show);
end;
//打开公司主页
procedure tform1.clicklabel (sender:tobject);
begin
shellexecute(application.MainForm.Handle,nil,'www.generware.com.cn',nil,nil,sw_show);
end;
//创建状态栏按钮
procedure tform1.createbutton (sender:tobject);
begin
form1.button:=ttoolbutton.Create (form1.toolbar);
with form1.button do
begin
parent:=form1.toolbar;
top:=0;
left:=1;
// style:=tbscheck;
height:=form1.toolbar.Height;
ImageIndex :=17;
onclick:=clickbutton;
hint:='计算器|计算器';
end;
statusbar1.Panels [2].Width :=form1.button.Height+5
end;
//状态栏上创建工具栏
procedure tform1.createtoolbar(sender:tobject);
begin
form1.toolbar:=ttoolbar.Create (statusbar1);
with form1.toolbar do
begin
parent:=statusbar1;
align:=alnone;
top:=2;
left:=613;
height:=statusbar1.Height-1
flat:=true;
images:=imagelist1;
width:=height;
end;
end;
//在状态栏上创建标签
procedure tform1.createlabel(sender:tobject);
begin
lab:=tlabel.create(statusbar1);
with lab do
begin
parent:=statusbar1;
top:=7;
left:=215;
width:=statusbar1.Panels [1].Width -10;
caption:=' 通用科技有限公司 010:62189721 http://www.generware.com.cn';
cursor:=crhandpoint;
onclick:=clicklabel;
onmousemove:=movelabel;
hint:='网上通用';
end;
end;
procedure Tform1.movelabel(Sender: TObject
Shift: TShiftState
X,
Y: Integer);
begin
lab.Font.Color:=clblue;
end;
//显示时间
procedure TForm1.Timer1Timer(Sender: TObject);
begin
statusbar1.Panels [3].Text := formatdatetime(' yyyy-mm-dd',date)+formatdatetime(' hh:mm',time);
end;
//创建主窗体
procedure TForm1.FormCreate(Sender: TObject);
var
cellformat:F1CellFormat;
CurTime:LongWord;
DelayTime:LongWord;
reg:tregistry;
subkeyname:tstringlist;
subkeycount:integer;
Val: TRegKeyInfo;
i,j : Integer;
MyItem: array of TMenuItem;
s : string;
begin
// 设置延迟时间为2秒
DelayTime:=2000;
CurTime:=GetTickCount;
while (GetTickCount < (CurTime+DelayTime)) do
reg:=tregistry.Create;
subkeyname:=tstringlist.Create;
with reg do //从注册表中读取并加入dll
begin
rootkey:=root;
if openkey('Software/通用科技有限公司/通用财会软件/Report/AddIns',false) then
begin
getkeyinfo(val);
getkeynames(subkeyname);
closekey;
for subkeycount := 0 to val.numsubkeys-1 do // Iterate
begin
if openkey('Software/通用科技有限公司/通用财会软件/Report/AddIns'+'/'+subkeyname[subkeycount],false) then
begin
setlength(dllid,val.numsubkeys);
s:=readstring('path');
dllid[subkeycount]:=form1.FBook1.LoadAddIn(s,true);//向formula one 加载dll文件扩冲函数功能
end;
closekey;
end
// for
end;
destroy;
end
// with
for j := 0 to mainmenu1.items.Count-1 do // Iterate
begin
if mainmenu1.Items[j].Caption='公式[&O]' then
begin
for i := 0 to val.numsubkeys-1 do // Iterate
begin
setlength(myitem,val.numsubkeys);
MyItem
:= TMenuItem.Create(Self);
MyItem.Caption :=subkeyname
myitem.OnClick:=menuclick;
myitem.Visible:=false;
myitem.Name:='new'+inttostr(i);
MainMenu1.Items[j].Add(MyItem);
end
// for
end;
end
// for
crshgs.Visible:=false;
crhzgs.Visible:=false;
toolbutton6.Visible:=false;
form1.apppath:=extractfilepath(application.exename);
form1.isnew:=true;
form1.saveed :=false;
Form1.repsave:=false;
form1.opened:=false;
caption:=formcaption;
toolbutton4.Down :=false;
Panel1.Visible :=true;
panel4.Visible:=false;
n50.Checked:=false;
TreeViewrefresh
//树列表框的刷新
createlabel(statusbar1);
createtoolbar(statusbar1);
createbutton(form1.toolbar);
cellformat:=fbook1.GetCellFormat;
ColorComboBox1.ColorValue:=cellformat.FontColor;
LMDFontComboBox1.SelectedFont:=cellformat.FontName;
LMDFontSizeComboBox1.FontSize:=cellformat.FontSize;
toolbutton21.Down:=cellformat.FontBold
toolbutton22.down:=cellformat.FontItalic
toolbutton23.Down :=cellformat.FontUnderline
toolbutton3.Down:=not fbook1.ShowEditBar;
n41.Checked:=fbook1.ShowEditBar;
newtemp;
end;
//树形列表框的节点变换
procedure TForm1.TreeView1Change(Sender: TObject
Node: TTreeNode);
begin
case node.Level of //
0: begin
treeview1.PopupMenu:=popupmenu1;
if Form1.repsave then
begin
toolbutton6.Visible:=false;
toolbutton17.Visible:=true;
end;
end;
1: begin
treeview1.PopupMenu:=popupmenu3;
toolbutton6.Visible:=false;
toolbutton17.Visible:=true;
end;
end
// case
end;
//打开文件
procedure TForm1.TreeView1DblClick(Sender: TObject);
var
node:ttreenode;
yn,un,val:string;
ty,i,j,yi,m,n : Integer;
begin
if TempNode=nil then Exit;
Closesheet;
Form1.tempname:='';
Node :=TempNode;
if node.Level =0 then
begin
Form1.tempname:=PMyRec(node.data)^.Name;
if (form1.isnew) and (form1.changed ) then
begin
if messagedlg('文件还没保存,要保存吗?',mtinformation,[mbYes, mbNo], 0)=mryes then
begin
savetemp;
end
else
begin
dtmd.ybdtst.Cancel;
dtmd.gsdtst.Cancel;
end;
end;
openrepttemplet;
form1.opened:=true;
end;
if node.Level=1 then
begin
Form1.tempname:=node.text;
if (form1.isnew) and (form1.changed ) then
begin
if messagedlg('文件还没保存,要保存吗?',mtinformation,[mbYes, mbNo], 0)=mryes then
begin
savetemp;
end
else
begin
dtmd.ybdtst.Cancel;
dtmd.gsdtst.Cancel;
end;
end;
un:=node.Text;
yn:=PMyRec(node.Parent.data)^.Name;
yi:=PMyRec(node.Parent.Data)^.id;
if not dtmd.ybdtst.active then dtmd.ybdtst.Open;
Dtmd.ybdtst.First;
if dtmd.ybdtst.Locate('temp_id',yi,[loCaseInsensitive]) then
begin
try
dtmd.ybdtstTemp_Obj.SaveToFile(apppath+'/syz.vts');
fbook1.ReadEx(apppath+'/syz.vts');
finally
deletefile(apppath+'/syz.vts');
end;
dtmd.qrydtst.Close;
dtmd.qrydtst.CommandText:='select''count''=count(rept_id) from reports where temp_id='+inttostr(yi)+'and unitname='''+un+'''';
dtmd.qrydtst.open;
i:=dtmd.qrydtst.fieldbyname('count').asinteger;
for j := 1 to i-1 do // Iterate
begin
Fbook1.InsertSheets(fbook1.numsheets+1,1);
end
// for
Fbook1.Sheet:=1;
Fbook1.SetSelection(-1,-1,1,1);
Fbook1.ClearClipboard;
Fbook1.EditCopy;
Fbook1.Setselection(-1,-1,1,1);
Fbook1.SetSelection(1,1,1,1);
for j := 2 to Fbook1.NumSheets do // Iterate
begin
Fbook1.sheet:=j;
Fbook1.SetActiveCell(1,1);
Fbook1.editpaste;
Fbook1.Setselection(-1,-1,1,1);
Fbook1.SetSelection(1,1,1,1);
end
// for
end;
for j := 1 to Fbook1.NumSheets do // Iterate
begin
Fbook1.sheet:=j;
Dtmd.qrydtst.close;
Dtmd.qrydtst.CommandText:='Select * from reptvalues,reports where reptvalues.rept_id=reports.rept_id and reports.temp_id='+inttostr(yi)+' and reports.unitname='''+un+'''';
Dtmd.qrydtst.Open;
Fbook1.SheetName[j]:=Dtmd.qrydtst.fieldbyname('sheet').asstring;
while Not Dtmd.qrydtst.Eof do
begin
m:=Dtmd.qrydtst.fieldbyname('row').asinteger;
n:=Dtmd.qrydtst.fieldbyname('col').asinteger;
val:=Dtmd.qrydtst.fieldbyname('val').asstring;
ty:=Dtmd.qrydtst.fieldbyname('type').asinteger;
if (ty=2) or (ty=-2) then Fbook1.TextRC[m,n]:=val;
if (ty=1) or (ty=-1) then Fbook1.NumberRC[m,n]:=strtofloat(val);
Dtmd.qrydtst.next;
end
// while
end
// for
for j := 1 to Fbook1.NumSheets do // Iterate
begin
Fbook1.sheet:=j;
Fbook1.EnableProtection:=True;
end
// for
end;
end;
//树形列表框的显示
procedure TForm1.ToolButton4Click(Sender: TObject);
begin
panel1.Visible :=not toolbutton4.Down
n39.Checked:=panel1.Visible;
end;
//copy 动作
procedure TForm1.copyselectExecute(Sender: TObject);
begin
fbook1.ClearClipboard
fbook1.EditCopy
end;
//cut 动作
procedure TForm1.cutExecute(Sender: TObject);
begin
fbook1.clearclipboard;
fbook1.editcut;
end;
//paste 动作
procedure TForm1.pasteexecute(sender: tobject);
begin
fbook1.editpaste;
end;
//clear 动作
procedure TForm1.clearExecute(Sender: TObject);
begin
fbook1.EditClear(F1ClearDlg)
end;
//删除
procedure TForm1.deleteExecute(Sender: TObject);
begin
if deletefrm=nil then deletefrm:=tdeletefrm.Create(application);
deletefrm.RadioGroup1.ItemIndex :=0;
deletefrm.ShowModal
if deletefrm.ModalResult =mrok then
begin
with fbook1 do
begin
case deletefrm.RadioGroup1.ItemIndex of //
0: editdelete(f1shifthorizontal);
1: editdelete(f1shiftvertical );
2: editdelete(f1shiftrows);
3: editdelete(f1shiftcols);
4: if numsheets<>1 then deletesheets(1,1);
end
// case
end
// with
end;
deletefrm.free;
deletefrm:=nil;
end;
//格式
procedure TForm1.FormatExecute(Sender: TObject);
begin
fbook1.FormatCellsDlg (2147483647)
//显示格式对话框
end;
procedure TForm1.OptionsExecute(Sender: TObject);
var
pr1:integer;
pr2:integer;
pc1:integer;
pc2:integer;
begin
if wandhfrm=nil then wandhfrm:=Twandhfrm.create(application);
form1.fbook1.GetSelection (0,pr1,pc1,pr2,pc2);
wandhfrm.label1.caption:=inttostr(pr1);
wandhfrm.label2.caption:=inttostr(pc1);
wandhfrm.label3.caption:=inttostr(pr2);
wandhfrm.label4.caption:=inttostr(pc2);
wandhfrm.showmodal;
wandhfrm.free;
wandhfrm:=nil;
end;
//插入
procedure TForm1.insertExecute(Sender: TObject);
begin
if deletefrm=nil then deletefrm:=tdeletefrm.Create(application);
with deletefrm.RadioGroup1 do
begin
Items.Clear
items.Add('Shell cells right');
items.add('Shell cells down');
items.Add ('Entire row');
items.add('Entire column');
items.Add('Worksheet');
ItemIndex :=0;
end
// with
deletefrm.RadioGroup1.Caption :='Insert';
deletefrm.Caption :='Insert';
deletefrm.ShowModal
if deletefrm.ModalResult =mrok then
begin
with fbook1 do
begin
case deletefrm.RadioGroup1.ItemIndex of //
0: editinsert(f1shifthorizontal);
1: editinsert(f1shiftvertical );
2: editinsert(f1shiftrows);
3: editinsert(f1shiftcols);
4: InsertSheets(1,1);
end
// case
end
// with
end;
deletefrm.free;
deletefrm:=nil;
end;
//替换
procedure TForm1.replaceExecute(Sender: TObject);
begin
fbook1.ReplaceDlg
end;
//查找
procedure TForm1.findExecute(Sender: TObject);
begin
fbook1.FindDlg
end;
procedure TForm1.ToolButton3Click(Sender: TObject)
//编辑框的显示情况
begin
fbook1.ShowEditBar :=not toolbutton3.Down;
n41.Checked := not toolbutton3.Down;
end;
procedure TForm1.N12Click(Sender: TObject)
//新建样表
begin
form1.saveed:=false;
closesheet;
form1.isnew:=true;
caption:=formcaption+'-新建样表';
end;
procedure TForm1.N10Click(Sender: TObject);
begin
setpassword_id;
end;
procedure TForm1.N22Click(Sender: TObject)
// 打开样表
begin
if openfrm=nil then openfrm:=topenfrm.create(nil);
openfrm.ShowModal
if openfrm.ModalResult =mrok then
begin
form1.tempname:=openfrm.Edit1.Text;
openrepttemplet;
end;
openfrm.free;
openfrm:=nil;
end;
procedure TForm1.Save1Click(Sender: TObject)
//保存
begin
//savemodulefile;
end;
procedure TForm1.ToolButton17Click(Sender: TObject);
begin
savetemp
//保存样表文件
end;
procedure TForm1.Close1Click(Sender: TObject);
begin
closesheet;
end;
procedure TForm1.TreeView1Edited(Sender: TObject
Node: TTreeNode
//修改样表文件名
var S: String);
begin
form1.tempname:=node.Text;
if s<>form1.tempname then
begin
PMyRec(node.data)^.Name :=s;
dtmd.qrydtst.Close;
dtmd.qrydtst.CommandText:='update repttemplet set temp_name='''+s+''' where temp_id='+inttostr(PMyRec(node.Data)^.id)+'''';
dtmd.qrydtst.Execute;
dtmd.ybdtst.open;
dtmd.ybdtst.ApplyUpdates(-1);
end;
treeview1.readonly:=true;
end;
procedure TForm1.N4Click(Sender: TObject)
//节点改名
begin
treeview1.ReadOnly :=false;
treeview1.selected.edittext;
end;
procedure TForm1.openfile1Click(Sender: TObject)
//打开文件
begin //用来
newtemp;
openDialog1.DefaultExt :='xls';
opendialog1.Execute;
form1.openfilename:=opendialog1.FileName;
form1.fbook1.ReadEx (form1.openfilename);
form1.FBook1.SaveWindowInfo;
try
dtmd.ybdtst.Open;
dtmd.ybdtst.Locate('temp_name',form1.tempname,[loCaseInsensitive]);
dtmd.ybdtst.edit;
form1.FBook1.Writeex(form1.apppath+'syz.vts',12);
dtmd.ybdtstTemp_Obj.LoadFromFile(form1.apppath+'syz.vts');
dtmd.ybdtst.Post;
finally
deletefile(form1.apppath+'syz.vts');
end;
form1.isnew:=true;
end;
procedure TForm1.SelectAll1Click(Sender: TObject);
begin
fbook1.SetSelection (1,1,fbook1.lastrow,fbook1.lastcol);
end;
procedure TForm1.N38Click(Sender: TObject)
//删除样表
begin
if delmodule=nil then delmodule:=tdelmodule.Create(nil);
delmodule.ShowModal
delmodule.free;
delmodule:=nil;
end;
procedure TForm1.N37Click(Sender: TObject)
//引入样表
begin
if copyintofrm=nil then copyintofrm:=tcopyintofrm.create(nil);
copyintofrm.ShowModal;
copyintofrm.free;
copyintofrm:=nil;
end;
procedure TForm1.N36Click(Sender: TObject)
//引出样表
begin
if copyoutfrm=nil then copyoutfrm:=tcopyoutfrm.Create(nil);
copyoutfrm.ShowModal
copyoutfrm.free;
copyoutfrm:=nil;
end;
procedure TForm1.ColorComboBox1Change(Sender: TObject)
//设置字体颜色
var
a:F1CellFormat;
begin
a:=form1.FBook1.getcellformat;
a.fontcolor:=colorcombobox1.ColorValue;
form1.fbook1.setcellformat(a);
end;
procedure TForm1.FBook1SelChange(Sender: TObject)
//返回当前单元的属性
var
a:F1CellFormat;
begin
a:=form1.FBook1.GetCellFormat;
colorcombobox1.ColorValue:=a.FontColor;
lmdfontcombobox1.SelectedFont :=a.FontName;
form1.LMDFontSizeComboBox1.FontSize :=a.FontSize
dfscolorbutton1.Color:=a.PatternFG;
toolbutton21.Down:=a.FontBold;
toolbutton22.down:=a.FontItalic;
toolbutton23.Down :=a.FontUnderline
toolbutton34.Down:=a.FontStrikeout;
case a.AlignHorizontal of
2: toolbutton25.Down:=true;
3: toolbutton26.Down :=true;
4: toolbutton27.down:=true;
7: toolbutton29.down:=true;
else
begin
toolbutton25.Down:=false;
toolbutton26.Down :=false;
toolbutton27.down:=false;
toolbutton29.down:=false;
end;
end;
end;
procedure TForm1.ToolButton16Click(Sender: TObject)
//排序对话框
begin
fbook1.SortDlg;
end;
procedure TForm1.LMDFontComboBox1Change(Sender: TObject)
//设置字体名称
var
a:F1CellFormat;
begin
a:=form1.FBook1.getcellformat;
a.FontName:=form1.LMDFontComboBox1.SelectedFont;
form1.fbook1.setcellformat(a);
end;
procedure TForm1.LMDFontSizeComboBox1Change(Sender: TObject)
//设置字体大小
var
a:f1cellformat;
begin
a:=form1.fbook1.getcellformat;
a.FontSize:=form1.LMDFontSizeComboBox1.FontSize
form1.FBook1.SetCellFormat(a);
end;
procedure TForm1.ToolButton21Click(Sender: TObject)
//设置字体的粗细
var
cellformat:f1cellformat;
begin
cellformat:=fbook1.GetCellFormat;
if toolbutton21.Down then cellformat.FontBold:=true
else
cellformat.FontBold :=false;
if toolbutton22.Down then cellformat.FontItalic :=true
else
cellformat.FontItalic:=false;
if toolbutton34.Down then cellformat.FontStrikeout:=true
else
cellformat.FontStrikeout:=false;
if toolbutton23.Down then cellformat.FontUnderline :=true
else
cellformat.FontUnderline:=false;
fbook1.SetCellFormat(cellformat);
end;
procedure TForm1.ToolButtonClick(Sender: TObject)
//设置单元格内容在单元中的位置
var
cellformat:f1cellformat;
begin
cellformat:=fbook1.GetCellFormat;
case TControl(Sender).tag of
0: cellformat.AlignHorizontal:=2
//左对齐
1: cellformat.AlignHorizontal:=3
//右对齐
2: cellformat.AlignHorizontal:=4
//中间对齐
3: cellformat.AlignHorizontal:=7
//居中对齐
end;
fbook1.SetCellFormat(cellformat);
end;
procedure TForm1.dfsColorButton1Exit(Sender: TObject)
//对所选的单元进行设置颜色
begin
fbook1.SetPattern(1,dfscolorbutton1.color,dfscolorbutton1.color);
end;
//'以下是修改时间的问题'
procedure TForm1.FBook1EndEdit(Sender: TObject
var EditString: WideString
//修改formula 6.0 以下版本 中的时间bug
var Cancel: Smallint);
//var
// s,s1:string;
// i:integer;
// cellformat:f1cellformat;
begin
// s1:=editstring;
// cellformat:=fbook1.GetCellFormat;
// i:=pos('-',editstring);
// if (i=0) or (i>5) then
// begin
// editstring:= s1;
// exit;
// end;
// s:=copy(editstring,1,i-1);
//
// if strtoint(s)>1999 then
// begin
// try
// begin
// cellformat.NumberFormat[fbook1.handle]:='yyyy-mm-dd';
// fbook1.SetCellFormat(cellformat);
// editstring:=datetimetostr(strtodatetime(editstring)-1);
// end;
// except
// editstring:=s1;
// end;
// end;
end;
///////////////////////////////////////////////////////
//以下为设置表格中数值格式
//////////////////////////////////////////////////////
procedure TForm1.ToolButton32Click(Sender: TObject);
var
s:string;
cellformat:f1cellformat;
begin
cellformat:=fbook1.getcellformat;
s:=cellformat.NumberFormat[fbook1.handle];
if pos('.',s)<>0 then cellformat.NumberFormat[fbook1.handle]:=s+'0'
else
cellformat.NumberFormat[fbook1.handle]:='#.0';
fbook1.SetCellFormat(cellformat);
end;
procedure TForm1.ToolButton33Click(Sender: TObject)
//加小数点
var
i:integer;
s,s2,s3,s4:string;
cellformat:f1cellformat;
begin
cellformat:=fbook1.getcellformat;
s:=cellformat.NumberFormat[fbook1.handle];
i:=length(s);
s2:=copy(s,1,pos('.',s)-1);
s3:=copy(s,pos('.',s),i-pos('.',s));
if s3<>'.' then
s4:=s2+s3
else
s4:=s2;
cellformat.NumberFormat[fbook1.handle]:=s4;
fbook1.SetCellFormat(cellformat);
end;
procedure TForm1.ToolButton38Click(Sender: TObject);
var
r1,c1,r2,c2:integer;
begin
fbook1.getselection(0,r1,c1,r2,c2);
fbook1.ObjCreate(5,r1,c1,r2,c2);
fbook1.ObjBringToFront
end;
procedure TForm1.ToolButton39Click(Sender: TObject);
var
cellformat:f1cellformat;
s,s1:string;
i,j,r1,r2,c1,c2:integer;
cellvalue:double;
begin
s1:='#,###.';
fbook1.GetSelection(0,r1,c1,r2,c2);
cellvalue:=fbook1.numberrc[r1,c1];
cellformat:=fbook1.GetCellFormat;
s:=cellformat.NumberFormat[fbook1.handle];
if pos(',',s)<>0 then
begin
if pos('.',s)<>0 then cellformat.NumberFormat[fbook1.handle]:='###'+copy(s,pos('.',s),length(s)-pos('.',s)+1)
else
cellformat.NumberFormat[fbook1.handle]:='###';
end
else
begin
if s='General'then
begin
if pos('.',floattostr(cellvalue))=0 then cellformat.NumberFormat[fbook1.handle]:='#,###'
else
begin
i:=length(floattostr(cellvalue));
for j:=1 to i-pos('.',floattostr(cellvalue)) do
begin
s1:=s1+'0';
end;
cellformat.NumberFormat[fbook1.handle]:=s1;
end;
end
else
cellformat.NumberFormat[fbook1.handle]:='#,###'+copy(s,pos('.',s),length(s)-pos('.',s)+1);
end;
fbook1.SetCellFormat(cellformat);
end;
////////////////////////////////////////////////////////////////
//以上为表格中的数值格式的设置
/////////////////////////////////////////////////////////////////
procedure TForm1.N2Click(Sender: TObject)
//打开排序对话框
begin
fbook1.SortDlg;
end;
procedure TForm1.N111DrawItem(Sender: TObject
ACanvas: TCanvas;
ARect: TRect
Selected: Boolean)
//重画toolbar 上的快捷菜单 '1/2'
var
x:integer;
begin
if selected then acanvas.Brush.Color:=clblue
else
acanvas.Brush.Color :=clwhite;
acanvas.FillRect(arect);
x:=arect.Right-arect.Left
acanvas.MoveTo(x div 2,arect.Top );
acanvas.LineTo(x div 2,arect.bottom);
acanvas.TextOut(arect.left+8,arect.top,'1/2');
acanvas.TextOut(x div 2+8,arect.top,'-1/2');
end;
procedure TForm1.N211DrawItem(Sender: TObject
ACanvas: TCanvas;
ARect: TRect
Selected: Boolean)
//重画toolbar 上的快捷菜单 '-1/2'
var
x:integer;
begin
if selected then acanvas.Brush.Color:=clblue
else
acanvas.Brush.Color :=clwhite;
acanvas.FillRect(arect);
x:=arect.Right-arect.Left
acanvas.MoveTo(x div 2,arect.Top );
acanvas.LineTo(x div 2,arect.bottom);
acanvas.TextOut(arect.left+8,arect.top+2,'1/5');
acanvas.TextOut(x div 2+8,arect.top+2,'-1/5');
acanvas.MoveTo(arect.left,arect.top);
acanvas.LineTo(arect.right,arect.top);
end;
procedure TForm1.N111MeasureItem(Sender: TObject
ACanvas: TCanvas;
var Width, Height: Integer);
begin
width:=60
//设置快捷菜单的宽度
end;
procedure TForm1.N110MeasureItem(Sender: TObject
ACanvas: TCanvas;
var Width, Height: Integer);
begin
width:=100
//设置快捷菜单的宽度
end;
procedure TForm1.N110DrawItem(Sender: TObject
ACanvas: TCanvas;
ARect: TRect
Selected: Boolean);
var //重画toolbar 上的快捷菜单 '% '
x:integer;
begin
if selected then acanvas.Brush.Color:=clblue
else
acanvas.Brush.Color :=clwhite;
acanvas.FillRect(arect);
x:=arect.Right-arect.Left
acanvas.MoveTo(x div 2,arect.Top );
acanvas.LineTo(x div 2,arect.bottom);
acanvas.TextOut(arect.left+8,arect.top,'123%');
acanvas.TextOut(x div 2+8,arect.top,'-123%');
end;
procedure TForm1.N210DrawItem(Sender: TObject
ACanvas: TCanvas;
ARect: TRect
Selected: Boolean);
var
x:integer
//重画toolbar 上的快捷菜单 '-%'
begin
if selected then acanvas.Brush.Color:=clblue
else
acanvas.Brush.Color :=clwhite;
acanvas.FillRect(arect);
x:=arect.Right-arect.Left
acanvas.MoveTo(x div 2,arect.Top );
acanvas.LineTo(x div 2,arect.bottom);
acanvas.TextOut(arect.left+8,arect.top+2,'123.40%');
acanvas.TextOut(x div 2+8,arect.top+2,'-123.40%');
acanvas.MoveTo(arect.left,arect.top);
acanvas.LineTo(arect.right,arect.top);
end;
procedure TForm1.N111Click(Sender: TObject)
//单元格内容的格式
var
cellformat:f1cellformat;
begin
cellformat:=fbook1.GetCellFormat;
cellformat.NumberFormat[fbook1.handle]:='#?/?'
//一位数分子
fbook1.SetCellFormat(cellformat);
end;
procedure TForm1.N211Click(Sender: TObject);
var
cellformat:f1cellformat;
begin
cellformat:=fbook1.GetCellFormat;
cellformat.NumberFormat[fbook1.handle]:='#?/??'
//两位数的分子
fbook1.SetCellFormat(cellformat);
end;
procedure TForm1.N110Click(Sender: TObject);
var //增加 %
cellformat:f1cellformat;
begin
cellformat:=fbook1.GetCellFormat;
cellformat.NumberFormat[fbook1.handle]:='0%';
fbook1.SetCellFormat(cellformat);
end;
procedure TForm1.N210Click(Sender: TObject);
var
cellformat:f1cellformat;
begin
cellformat:=fbook1.GetCellFormat;
cellformat.NumberFormat[fbook1.handle]:='0.00%';
fbook1.SetCellFormat(cellformat);
end;
procedure TForm1.ToolButton15Click(Sender: TObject)
//打开函数向导
var
r1,r2,c1,c2 : Integer;
hasfunction : boolean;
s : string;
dllfrm levariant;
begin
fbook1.GetSelection(0,r1,c1,r2,c2);
if fbook1.FormulaRC[r1,c1]<>'' then hasfunction:=true
else
hasfunction:=false;
dllfrm:=createoleobject('formula.selfun');
s:=dllfrm.showselfunfrm(hasfunction);
fbook1.FormulaRC[r1,c1]:=fbook1.formularc[r1,c1]+s;
//if hsxdfrm=nil then hsxdfrm:=thsxdfrm.Create(nil);
//hsxdfrm.ShowModal;
////hsxdfrm.free;
////hsxdfrm:=nil;
end;
procedure TForm1.StatusBar1MouseMove(Sender: TObject
Shift: TShiftState;
X, Y: Integer);
begin
lab.Font.Color:=clwindowtext
//状态栏上字体变为原来的色
end;
procedure TForm1.ToolButton40Click(Sender: TObject)
//在工作表中设置固定区域
var
r1,c1,r2,c2 : Integer;
begin
if toolbutton40.Down then
begin
fbook1.getselection(0,r1,c1,r2,c2);
fbook1.fixedcol:=1
//设置起始列
fbook1.fixedcols:=0
//列数
fbook1.FixedRow:=r1
//设置起始行
fbook1.FixedRows:=r2-r1+1
//行数
end
else
begin
fbook1.fixedcol:=1;
fbook1.fixedcols:=0
//固定列失效
fbook1.FixedRow:=1;
fbook1.FixedRows:=0
//固定行失效
end;
end;
procedure TForm1.N7Click(Sender: TObject)
//工具栏,toolbar ,树形列框的
begin //显示控制
n7.Checked:=not n7.Checked;
if n7.Checked then toolbar1.Visible:=true
else toolbar1.Visible:=false;
end;
procedure TForm1.N39Click(Sender: TObject)
//是否要显示树形列表框
begin
n39.Checked:=not n39.Checked;
toolbutton4.Down:=not n39.Checked;
panel1.Visible :=not toolbutton4.Down
end;
procedure TForm1.N40Click(Sender: TObject)
//设置是否要显示线条
begin
n40.Checked:=not n40.Checked;
fbook1.ShowGridLines:=n40.Checked;
end;
procedure TForm1.ToolButton41Click(Sender: TObject);
var
r1,c1,r2,c2 : Integer
//选中区域中的升序排序
begin
fbook1.GetSelection (0,r1,c1,r2,c2);
fbook1.Sort3(r1,c1,r2,c2,true,1,0,0);
end;
procedure TForm1.ToolButton42Click(Sender: TObject);
var
r1,c1,r2,c2 : Integer
//选中区域中的降序排序
begin
fbook1.GetSelection (0,r1,c1,r2,c2);
fbook1.Sort3(r1,c1,r2,c2,true,-1,0,0);
end;
procedure TForm1.FBook1Click(Sender: TObject
nRow, nCol: Integer)
//设默置单元格的提示信息
var
pr1,pc1,pr2,pc2:integer;
s1: string;
begin
fbook1.GetSelection(0,pr1,pc1,pr2,pc2);
//状态栏中显示当前光标所在的行和列
StatusBar1.Panels[0].Text:=' '+inttostr(pr1)+'行'+inttostr(pc1)+'列';
//根据单元格的不同的内容来显示不同的hint
s1:=fbook1.FormulaRC[pr1,pc1];
if s1<>'' then fbook1.Hint:='公式单元'
else fbook1.Hint:='';
//s2:=uppercase(copy(s1,1,pos('(',s1)-1));
//if s2='' then fbook1.hint:='';
//
//if s2='YCJY' then fbook1.Hint:='取科目的月初借方余额(如果余额在贷方结果为负数)|取科目的月初借方余额(如果余额在贷方结果为负数)';
//if s2='YCDY' then fbook1.hint:='取科目的月初贷方余额(如果余额在借方结果为负数)';
//if s2='YCJY0' then fbook1.hint :='取科目的月初借方余额(如果余额在贷方结果为0)';
//if s2= 'YCDY0' then fbook1.hint :='取科目的月初贷方余额(如果余额在借方结果为0)';
//if s2= 'YCJYM' then fbook1.hint :='取所属明细科目的月初借方余额之和';
//if s2= 'YCDYM' then fbook1.hint :='取所属明细科目的月初贷方余额之和';
//if s2= 'YMJY' then fbook1.hint :='取科目的月末借方余额(如果余额在贷方结果为负数)';
//if s2= 'YMDY' then fbook1.hint :='取科目的月末贷方余额(如果余额在借方结果为负数)';
//if s2= 'YMJY0' then fbook1.hint :='取科目的月末借方余额(如果余额在贷方结果为0)';
//if s2= 'YMDY0' then fbook1.hint :='取科目的月末贷方余额(如果余额在借方结果为0)';
//if s2= 'YMJYM' then fbook1.hint :='取所属明细科目的月末借方余额之和';
//if s2= 'YMDYM' then fbook1.hint :='取所属明细科目的月末贷方余额之和';
//
//if s2= 'YJF' then fbook1.hint :='取科目的本月借方发生额';
//if s2= 'YDF' then fbook1.hint :='取科目的本月贷方发生额';
//if s2= 'YJLF' then fbook1.hint :='取科目的本年借方累计额';
//if s2= 'YDLF' then fbook1.hint :='取科目的本年贷方累计额';
//if s2= 'YJIF' then fbook1.hint :='取科目的本月借方净发生额(借方发生额减贷方发生额)';
//if s2= 'YDIF' then fbook1.hint :='取科目的本月贷方净发生额(贷方发生额减借方发生额)';
//if s2= 'YJLIF' then fbook1.hint :='取科目的本年借方净累计额(借方累计额减贷方累计额)';
//if s2= 'YDLIF' then fbook1.hint :='取科目的本年贷方净累计额(贷方累计额减借方累计额)';
////===============================================================================
//// 科目期间金额函数
////===============================================================================
//if s2= 'QJJF' then fbook1.hint :='取科目某期间借方发生额';
//if s2= 'QJDF' then fbook1.hint :='取科目某期间贷方发生额';
//if s2= 'QJJIF' then fbook1.hint :='取科目某期间借方净发生额(借方发生额减贷方发生额)';
//if s2= 'QJDIF' then fbook1.hint :='取科目某期间贷方净发生额(贷方发生额减借方发生额)';
////===============================================================================
//// 科目年度金额函数
////===============================================================================
//if s2= 'NCJY' then fbook1.hint :='取科目的年初借方余额(如果余额在贷方结果为负数)';
//if s2= 'NCDY' then fbook1.hint :='取科目的年初贷方余额(如果余额在借方结果为负数)';
//if s2= 'NCJY0' then fbook1.hint :='取科目的年初借方余额(如果余额在贷方结果为0)';
//if s2= 'NCDY0' then fbook1.hint :='取科目的年初贷方余额(如果余额在借方结果为0)';
//if s2= 'NCJYM' then fbook1.hint :='取所属明细科目的年初借方余额之和';
//if s2='NCDYM' then fbook1.hint :='取所属明细科目的年初贷方余额之和';
////===============================================================================
//// 核算项月份金额函数
////===============================================================================
//if s2= 'HYCJY' then fbook1.hint :='取核算项的月初借方余额(如果余额在贷方结果为负数)';
//if s2= 'HYCDY' then fbook1.hint :='取核算项的月初贷方余额(如果余额在借方结果为负数)';
//if s2= 'HYCJY0' then fbook1.hint :='取核算项的月初借方余额(如果余额在贷方结果为0)';
//if s2= 'HYCDY0' then fbook1.hint :='取核算项的月初贷方余额(如果余额在借方结果为0)';
//if s2= 'HYCJYM' then fbook1.hint :='取所属明细核算项的月初借方余额之和';
//if s2= 'HYCDYM' then fbook1.hint :='取所属明细核算项的月初贷方余额之和';
//if s2= 'HYMJY' then fbook1.hint :='取核算项的月末借方余额(如果余额在贷方结果为负数)';
//if s2= 'HYMDY' then fbook1.hint :='取核算项的月末贷方余额(如果余额在借方结果为负数)';
//if s2= 'HYMJY0' then fbook1.hint :='取核算项的月末借方余额(如果余额在贷方结果为0)';
//if s2= 'HYMDY0' then fbook1.hint :='取核算项的月末贷方余额(如果余额在借方结果为0)';
//if s2= 'HYMJYM' then fbook1.hint :='取所属明细核算项的月末借方余额之和';
//if s2= 'HYMDYM' then fbook1.hint :='取所属明细核算项的月末贷方余额之和';
//
//if s2= 'HYJF' then fbook1.hint :='取核算项的本月借方发生额';
//if s2= 'HYDF' then fbook1.hint :='取核算项的本月贷方发生额';
//if s2= 'HYJLF' then fbook1.hint :='取核算项的本年借方累计额';
//if s2= 'HYDLF' then fbook1.hint :='取核算项的本年贷方累计额';
//if s2= 'HYJIF' then fbook1.hint :='取核算项的本月的借方净发生额(借方发生额减贷方发生额)';
//if s2= 'HYDIF' then fbook1.hint :='取核算项的本月的贷方净发生额(贷方发生额减借方发生额)';
//if s2= 'HYJLIF' then fbook1.hint :='取核算项的本年的借方净累计额(借方累计额减贷方累计额)';
//if s2= 'HYDLIF' then fbook1.hint :='取核算项的本年的贷方净累计额(贷方累计额减借方累计额)';
////===============================================================================
//// 核算项期间金额函数
////===============================================================================
//if s2= 'HQJJF' then fbook1.hint :='取核算项某期间借方发生额';
//if s2= 'HQJDF' then fbook1.hint :='取核算项某期间贷方发生额';
//if s2= 'HQJJIF' then fbook1.hint :='取核算项某期间借方净发生额(借方发生额减贷方发生额)';
//if s2= 'HQJDIF' then fbook1.hint :='取核算项某期间贷方净发生额(贷方发生额减借方发生额)';
////===============================================================================
//// 核算项年度金额函数
////===============================================================================
//if s2= 'HNCJY' then fbook1.hint :='取核算项的年初借方余额(如果余额在贷方结果为负数)';
//if s2= 'HNCDY' then fbook1.hint :='取核算项的年初贷方余额(如果余额在借方结果为负数)';
//if s2= 'HNCJY0' then fbook1.hint :='取核算项的年初借方余额(如果余额在贷方结果为0)';
//if s2= 'HNCDY0' then fbook1.hint :='取核算项的年初贷方余额(如果余额在借方结果为0)';
//if s2= 'HNCJYM' then fbook1.hint :='取所属明细核算项的年初借方余额之和';
//if s2= 'HNCDYM' then fbook1.hint :='取所属明细核算项的年初贷方余额之和';
////=========================================================================
////其它函数
////========================================================================
//if s2= 'ZBR' then fbook1.hint :='制表人';
//if s2= 'DW' then fbook1.hint :='制表单位|制表单位';
//if s2= 'ZDATE' then fbook1.hint :='制表日期';
end;
procedure TForm1.N41Click(Sender: TObject)
//显示编辑栏
begin
n41.Checked:=not n41.Checked;
if n41.Checked then fbook1.ShowEditBar:=true
else fbook1.ShowEditBar:=false;
toolbutton3.Down:=not n41.checked;
end;
procedure TForm1.N5Click(Sender: TObject)
//新建报表
begin
if rptcrtfrm=nil then rptcrtfrm:=trptcrtfrm.create(nil);
rptcrtfrm.ShowModal;
rptcrtfrm.free;
rptcrtfrm:=nil;
end;
procedure savetempformula
//保存样表公式
var
m,i,j: Integer;
s : string;
begin
if Not Dtmd.gsdtst.active then dtmd.gsdtst.Open;
Dtmd.gsdtst.first;
while dtmd.gsdtst.locate('temp_id;formulatype',vararrayof([form1.tempid,1]),[loCaseInsensitive]) do
begin
dtmd.gsdtst.delete;
dtmd.gsdtst.edit;
end
// while
for m := 1 to form1.FBook1.NumSheets do // Iterate
begin
form1.FBook1.sheet:=m;
for i := 1 to form1.FBook1.LastRow do // Iterate
begin
for j := 1 to form1.FBook1.lastcol do // Iterate
begin
if form1.FBook1.FormulaRC[i,j]<>'' then
s:=form1.FBook1.FormulaRC[i,j]
else
continue;
dtmd.gsdtst.Open;
dtmd.gsdtst.append;
dtmd.gsdtst.fieldbyname('temp_id').asinteger:=form1.tempid;
dtmd.gsdtst.FieldByName('formulatype').asinteger:=form1.status;
dtmd.gsdtst.FieldByName('sheet').asstring:=form1.FBook1.SheetName[m];
dtmd.gsdtst.FieldByName('row').asinteger:=i;
dtmd.gsdtst.FieldByName('col').asinteger:=j;
dtmd.gsdtst.FieldByName('formula').asstring:=s;
//dtmd.gsdtst.Post;
end
// for
end
// for
end
//for
end;
procedure opentempformula
//打开样表公式
var
x,y, m,i,j : Integer;
s : string;
begin
if Not dtmd.ybdtst.active then dtmd.ybdtst.Open;
Dtmd.ybdtst.first;
if dtmd.ybdtst.Locate('temp_name',form1.tempname,[loCaseInsensitive]) then
begin
try
if dtmd.ybdtstTemp_Obj.value<>null then
begin
dtmd.ybdtstTemp_Obj.SaveToFile(form1.apppath+'syz.vts');
form1.fbook1.Readex(form1.apppath+'syz.vts');
end;
finally
deletefile(form1.apppath+'syz.vts');
end;
end;
for m := 1 to form1.FBook1.NumSheets do // Iterate
begin
form1.FBook1.sheet:=m;
for x := 1 to form1.fbook1.lastrow do // Iterate
begin
for y := 1 to form1.fbook1.lastcol do // Iterate
begin
if form1.fbook1.formularc[x,y]<>'' then form1.fbook1.textrc[x,y]:='';
end
// for
end
// for
dtmd.qrydtst.close;
dtmd.qrydtst.CommandText:='select * from tempformula where temp_id='+inttostr(form1.tempid)
+' and formulatype='+inttostr(form1.status)+' and sheet='''+form1.FBook1.SheetName[m]+'''';
dtmd.qrydtst.Open
dtmd.qrydtst.First;
while not dtmd.qrydtst.Eof do
begin
i:=dtmd.qrydtst.fieldbyname('row').asinteger;
j:=dtmd.qrydtst.fieldbyname('col').asinteger;
s:=dtmd.qrydtst.FieldByName('formula').asstring;
if s<>'' then
form1.FBook1.FormulaRC[i,j]:=s;
dtmd.qrydtst.next;
end
//end while
dtmd.qrydtst.close;
end
// for
end;
procedure TForm1.N30Click(Sender: TObject)
//打开保存审核公式
var
i,j : Integer;
begin
n30.Checked:=not n30.Checked;
form1.status:=1;
if n30.Checked then
begin
n29.Enabled:=false;
n31.Enabled :=false;
for j := 0 to mainmenu1.Items.Count-1 do // Iterate
begin
if mainmenu1.Items[j].Caption='公式[&O]' then
begin
for i := 0 to mainmenu1.Items[j].Count-1 do // Iterate
begin
if copy(mainmenu1.Items[j].Items.Name,1,3)='new' then mainmenu1.Items[j].Items.Visible :=false;
end
// for
end;
end
// for
crhzgs.Visible:=false;
crshgs.Visible:=true;
opentempformula;
end
else
begin
n29.Enabled:=true;
n31.Enabled :=true;
for j := 0 to mainmenu1.Items.Count-1 do // Iterate
begin
if mainmenu1.Items[j].Caption='公式[&O]' then
begin
for i := 0 to mainmenu1.Items[j].Count-1 do // Iterate
begin
if copy(mainmenu1.Items[j].Items.Name,1,3)='new' then mainmenu1.Items[j].Items.Visible :=false;
end
// for
end;
end
// for
crhzgs.Visible:=false;
crshgs.Visible:=false;
savetempformula;
openrepttemplet;
form1.isnew:=true;
end;
end;
procedure TForm1.N31Click(Sender: TObject)
//打开保存汇总公式
var
i,j : Integer;
begin
n31.Checked:=not n31.Checked;
form1.status:=2;
if n31.Checked then
begin
n29.Enabled:=false;
n30.Enabled:=false;
for j := 0 to mainmenu1.Items.Count-1 do // Iterate
begin
if mainmenu1.Items[j].Caption='公式[&O]' then
begin
for i := 0 to mainmenu1.Items[j].Count-1 do // Iterate
begin
if copy(mainmenu1.Items[j].Items.Name,1,3)='new' then mainmenu1.Items[j].Items.Visible :=false;
end
// for
end;
end
// for
crshgs.Visible:=false;
crhzgs.Visible:=true;
opentempformula;
end
else
begin
n29.Enabled:=true;
n30.Enabled:=true;
for j := 0 to mainmenu1.Items.Count-1 do // Iterate
begin
if mainmenu1.Items[j].Caption='公式[&O]' then
begin
for i := 0 to mainmenu1.Items[j].Count-1 do // Iterate
begin
if copy(mainmenu1.Items[j].Items.Name,1,3)='new' then mainmenu1.Items[j].Items.Visible :=false;
end
// for
end;
end
// for
crshgs.Visible:=false;
crhzgs.Visible:=false;
savetempformula;
openrepttemplet;
end;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject)
//设置信息栏
begin
panel4.Visible:=false;
n50.Checked:=false;
end;
procedure TForm1.N43Click(Sender: TObject)
//打开报表
begin
rptopnfrm.ShowModal;
end;
procedure TForm1.ToolButton46Click(Sender: TObject)
//报表审核
var
m,r1,c1 : Integer;
x,y, val,s,s1 : string;
begin
listbox1.Items.Clear;
panel4.Visible:=false;
for m := 1 to form1.fbook1.NumSheets do // Iterate
begin
if form1.fbook1.SheetSelected[m] then
begin
fbook1.Sheet:=m;
r1:=fbook1.LastRow+1;
c1:=fbook1.lastcol+1;
dtmd.qrydtst.close;
dtmd.qrydtst.Commandtext:='select * from tempformula where temp_id='+inttostr(form1.tempid)+'and formulatype=1 and sheet='''+fbook1.SheetName[m]+'''';
dtmd.qrydtst.Open;
dtmd.qrydtst.First;
if dtmd.qrydtst.eof then
begin
showmessage('此表没有定义审核公式');
exit;
end;
dtmd.qrydtst.First;
while not dtmd.qrydtst.eof do
begin
try
val:=dtmd.qrydtst.fieldbyname('formula').asstring;
s:=copy(val,4,length(val)-4);
fbook1.FormulaRC[r1,c1]:=s;
s1:=copy(val,1,2);
if uppercase(s1)='GT' then
begin
if strtofloat(fbook1.TextRC[dtmd.qrydtst.FieldByName('row').asinteger,dtmd.qrydtst.FieldByName('col').asinteger])<=strtofloat(fbook1.TextRC[r1,c1]) then
listbox1.Items.Add(fbook1.SheetName[m]+'表'+inttostr(dtmd.qrydtst.FieldByName('row').asinteger)+'行'+inttostr(dtmd.qrydtst.FieldByName('col').asinteger)+'列审核没有通过');
end
else if uppercase(s1)='GE' then
begin
if strtofloat(fbook1.TextRC[dtmd.qrydtst.FieldByName('row').asinteger,dtmd.qrydtst.FieldByName('col').asinteger])<strtofloat(fbook1.TextRC[r1,c1]) then
listbox1.Items.Add(fbook1.SheetName[m]+'表'+inttostr(dtmd.qrydtst.FieldByName('row').asinteger)+'行'+inttostr(dtmd.qrydtst.FieldByName('col').asinteger)+'列审核没有通过');
end
else if uppercase(s1)='LT' then
begin
x:=fbook1.TextRC[dtmd.qrydtst.FieldByName('row').asinteger,dtmd.qrydtst.FieldByName('col').asinteger];
y:=fbook1.TextRC[r1,c1];
if strtofloat(x)>=strtofloat then
listbox1.Items.Add(fbook1.SheetName[m]+'表'+inttostr(dtmd.qrydtst.FieldByName('row').asinteger)+'行'+inttostr(dtmd.qrydtst.FieldByName('col').asinteger)+'列审核没有通过');
end
else if uppercase(s1)='LE' then
begin
if strtofloat(fbook1.TextRC[dtmd.qrydtst.FieldByName('row').asinteger,dtmd.qrydtst.FieldByName('col').asinteger])>strtofloat(fbook1.TextRC[r1,c1]) then
listbox1.Items.Add(fbook1.SheetName[m]+'表'+inttostr(dtmd.qrydtst.FieldByName('row').asinteger)+'行'+inttostr(dtmd.qrydtst.FieldByName('col').asinteger)+'列审核没有通过');
end
else if uppercase(s1)='NE' then
begin
if strtofloat(fbook1.TextRC[dtmd.qrydtst.FieldByName('row').asinteger,dtmd.qrydtst.FieldByName('col').asinteger])=strtofloat(fbook1.TextRC[r1,c1] )then
listbox1.Items.Add(fbook1.SheetName[m]+'表'+inttostr(dtmd.qrydtst.FieldByName('row').asinteger)+'行'+inttostr(dtmd.qrydtst.FieldByName('col').asinteger)+'列审核没有通过');
end;
except
listbox1.Items.Add(fbook1.SheetName[m]+'表'+inttostr(dtmd.qrydtst.FieldByName('row').asinteger)+'行'+inttostr(dtmd.qrydtst.FieldByName('col').asinteger)+'列审核没有通过');
end;
dtmd.qrydtst.Next;
form1.FBook1.TextRC[r1,c1]:='';
end
// while
end
//if
end
//for
if listbox1.Items.Count>=1 then
panel4.Visible:=true;
n50.Checked:=true;
end;
procedure TForm1.ToolButton47Click(Sender: TObject)
//选中的区域求和
var
r1,c1,r2,c2 : Integer;
s : string;
begin
fbook1.GetSelection(0,r1,c1,r2,c2);
r1:=r1-1;
c1:=c1-1;
r2:=r2-1;
c2:=c2-1;
if (c1=c2)and (r1<>r2) then
begin
fbook1.FormulaRC[r2+2,c1+1]:='sum(offset(a1,'+inttostr(r1)+','+inttostr(c1)+',1,1)ffset(a1,'+inttostr(r2)+','+inttostr(c2)+',1,1))';
fbook1.numberrc[r2+2,c1+1]:=fbook1.numberrc[r2+2,c1+1];
end;
if (r1=r2)and (c1<>c2) then
begin
fbook1.FormulaRC[r1+1,c2+2]:='sum(offset(a1,'+inttostr(r1)+','+inttostr(c1)+',1,1)ffset(a1,'+inttostr(r2)+','+inttostr(c2)+',1,1))';
fbook1.numberrc[r1+1,c2+2]:=fbook1.numberrc[r1+1,c2+2];
end;
if (c1<>c2) and (r1<>r2) then
begin
fbook1.FormulaRC[fbook1.LastRow,fbook1.lastcol]:='sum(offset(a1,'+inttostr(r1)+','+inttostr(c1)+',1,1)ffset(a1,'+inttostr(r2)+','+inttostr(c2)+',1,1))';
s:=fbook1.textrc[fbook1.lastrow,fbook1.lastcol];
fbook1.textRC[fbook1.lastrow,fbook1.lastcol]:='';
showmessage(s);
end;
end;
procedure TForm1.ToolButton45Click(Sender: TObject);
begin
if form1.isnew then
begin
if messagedlg('文件还没保存,要保存吗?',mtinformation,[mbYes, mbNo], 0)=mryes then
begin
savetemp;
end
else
begin
If Dtmd.ybdtst.Active then
begin
Dtmd.ybdtst.close;
Dtmd.ybdtst.Open;
end;
If Dtmd.bbdtst.Active then
begin
Dtmd.bbdtst.Close;
Dtmd.bbdtst.Open
end;
If Dtmd.gsdtst.Active then
begin
Dtmd.gsdtst.close;
Dtmd.gsdtst.Open;
end;
If Dtmd.vludtst.Active then
begin
Dtmd.vludtst.Close;
Dtmd.vludtst.Open;
end;
end;
end;
newtemp;
end;
procedure TForm1.ToolButton44Click(Sender: TObject)
//打印预览
begin
fbook1.FilePrintPreview
end;
procedure TForm1.ToolButton10Click(Sender: TObject)
//打印
begin
fbook1.FilePrint(false);
end;
procedure TForm1.N45Click(Sender: TObject)
//打印设置
begin
fbook1.FilePrintSetupDlg
end;
procedure TForm1.N46Click(Sender: TObject)
//打印对话框
begin
fbook1.FilePrint(true);
end;
procedure TForm1.ToolButton13Click(Sender: TObject);
begin
if wandhfrm=nil then wandhfrm:=Twandhfrm.Create(nil);
wandhfrm.ShowModal;
wandhfrm.free;
wandhfrm:=nil;
end;
procedure TForm1.N50Click(Sender: TObject);
begin
n50.Checked:=not n50.Checked;
if n50.Checked then panel4.Visible:=true
else panel4.Visible:=false;
end;
procedure TForm1.ListBox1Click(Sender: TObject)
//根据信息栏的提示来选定单元格
var
s1,s2,s3,s4 : string;
j,r1,c1,x,y,z : Integer;
begin
s1:=listbox1.Items.Strings[listbox1.ItemIndex];
x:=pos('表',s1);
y:=pos('行',s1);
z:=pos('列',s1);
s4:=copy(s1,1,x-1)
//取表名
s2:=copy(s1,x+2,y-x-2)
//取行
s3:=copy(s1,y+2,z-y-2)
//取列
for j := 1 to form1.FBook1.NumSheets do // Iterate
begin
if uppercase(form1.FBook1.SheetName[j])=uppercase(s4) then
form1.FBook1.sheet:=j;
end
// for
r1:=strtoint(s2);
c1:=strtoint(s3);
fbook1.showselections:=1;
fbook1.SetSelection(r1,c1,r1,c1);
fbook1.Focused;
fbook1.ShowActiveCell;
end;
procedure TForm1.crshgsClick(Sender: TObject)
////插入审核公式
begin
if repshfrm=nil then repshfrm:=trepshfrm.Create(nil);
repshfrm.ShowModal;
repshfrm.free;
repshfrm:=nil;
end;
procedure TForm1.crhzgsClick(Sender: TObject)
//插入汇总公式
begin
if repisthzfrm=nil then repisthzfrm:=trepisthzfrm.create(nil);
repisthzfrm.ShowModal;
repisthzfrm.free;
repisthzfrm:=nil;
end;
procedure TForm1.N25Click(Sender: TObject)
//汇总
begin
if rephzistfrm=nil then rephzistfrm:=trephzistfrm.create(nil);
rephzistfrm.ShowModal;
rephzistfrm.free;
rephzistfrm:=nil;
end;
procedure TForm1.N44Click(Sender: TObject)
//按会计期查询
begin
if repqryfrm=nil then repqryfrm:=trepqryfrm.Create(nil);
repqryfrm.ShowModal;
repqryfrm.free;
repqryfrm:=nil;
end;
procedure TForm1.N52Click(Sender: TObject)
//打印页面设置
begin
fbook1.FilePageSetupDlg
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
openrepttemplet;
end;
procedure TForm1.N23Click(Sender: TObject);
begin
if rptcrtfrm=nil then rptcrtfrm:=trptcrtfrm.Create(nil);
repsave:=false;
rptcrtfrm.ShowModal;
rptcrtfrm.free;
rptcrtfrm:=nil;
end;
procedure TForm1.N29Click(Sender: TObject)
//进入取数公式的编辑
var
i, j : Integer;
begin
n29.Checked:=not n29.Checked;
if n29.Checked then
begin
n30.Enabled:=false;
n31.Enabled:=false;
for i := 0 to O1.Count - 1 do // Iterate
begin
if Copy(O1.Items.Name, 1, 3) = 'new' then
O1.Items.Visible := True;
end
// for
{
for j := 0 to mainmenu1.Items.Count-1 do // Iterate
begin
if mainmenu1.Items[j].Caption='公式[&O]' then
begin
for i := 0 to mainmenu1.Items[j].Count-1 do // Iterate
begin
if copy(mainmenu1.Items[j].Items.Name,1,3)='new' then mainmenu1.Items[j].Items.Visible :=true;
end
// for
end;
end
// for
}
crshgs.Visible:=false;
crhzgs.Visible :=false;
//dtmd.ybdtst.Close;
//if Not Dtmd.ybdtst.active then dtmd.ybdtst.Open;
// Dtmd.ybdtst.First;
// if dtmd.ybdtst.Locate('temp_name',form1.tempname ,[loCaseInsensitive]) then
// begin
// try
// if dtmd.ybdtsttemp_obj<> nil then
// begin
// dtmd.ybdtstTemp_Obj.SaveToFile(form1.apppath+'syz.vts');
// form1.fbook1.Readex(form1.apppath+'syz.vts');
// end;
// finally
// deletefile(form1.apppath+'syz.vts');
// end
// try/finally
// end;
end
else
begin
for j := 0 to mainmenu1.Items.Count-1 do // Iterate
begin
if mainmenu1.Items[j].Caption='公式[&O]' then
begin
for i := 0 to mainmenu1.Items[j].Count-1 do // Iterate
begin
if copy(mainmenu1.Items[j].Items.Name,1,3)='new' then mainmenu1.Items[j].Items.Visible :=false;
end
// for
end;
end
// for
n30.Enabled :=true;
n31.Enabled :=true;
crshgs.visible:=false;
crhzgs.Visible :=false;
dtmd.ybdtst.Open;
form1.fbook1.SaveWindowInfo;
form1.fbook1.Writeex(form1.apppath+'syz.vts',12);
if dtmd.ybdtst.Locate('temp_name',form1.tempname,[loCaseInsensitive]) then
begin
try
dtmd.ybdtst.edit;
dtmd.ybdtstTemp_Obj.LoadFromFile(form1.apppath+'syz.vts');
dtmd.ybdtst.Post;
finally
deletefile(form1.apppath+'syz.vts');
end;
end;
end;
end;
procedure TForm1.FBook1Modified(Sender: TObject);
begin
changed:=true
//判断是否已经修改
end;
procedure TForm1.FormClose(Sender: TObject
var Action: TCloseAction);
var
areg:tregistry;
i,j : Integer;
MyRecPtr: PMyRec;
MyPfbP fbp;
begin
//savetemp;
areg:=tregistry.Create;
with areg do
begin
rootkey:=root;
for i := low(dllid) to high(dllid) do // Iterate
begin
if keyexists('Software/Tidestone Technologies/Formula One/AddIns/'+inttostr(dllid-1)) then
deletekey('Software/Tidestone Technologies/Formula One/AddIns/'+inttostr(dllid-1));
end
// for
destroy;
end
// with
for i := 0 to Treeview1.Items.Count-1 do // Iterate
begin
if treeview1.items.level=0 then
begin
MyRecPtr:=Treeview1.Items.Data;
dispose(MyRecPtr);
end;
end;
end;
procedure TForm1.N15Click(Sender: TObject);
begin
if repoutfrm=nil then repoutfrm:=trepoutfrm.Create(nil);
repoutfrm.ShowModal;
repoutfrm.free;
repoutfrm:=nil;
end;
procedure TForm1.N18Click(Sender: TObject);
begin
if repintofrm=nil then repintofrm:=trepintofrm.Create(nil);
repintofrm.ShowModal;
repintofrm.free;
repintofrm:=nil;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
treeview1.Items.addchild(treeview1.items[4],'wqwf');
end;
procedure TForm1.N33Click(Sender: TObject);
begin
form1.saveed:=false;
closesheet;
form1.isnew:=true;
caption:=formcaption+'-新建样表';
end;
procedure TForm1.N53Click(Sender: TObject);
begin
if copyoutfrm=nil then copyoutfrm:=tcopyoutfrm.Create(nil);
copyoutfrm.ShowModal
copyoutfrm.free;
copyoutfrm:=nil;
end;
procedure TForm1.N51Click(Sender: TObject);
begin
if copyintofrm=nil then copyintofrm:=tcopyintofrm.create(nil);
copyintofrm.ShowModal;
copyintofrm.free;
copyintofrm:=nil;
end;
procedure TForm1.N54Click(Sender: TObject);
begin
if delmodule=nil then delmodule:=tdelmodule.Create(nil);
delmodule.ShowModal
delmodule.free;
delmodule:=nil;
end;
procedure TForm1.TreeView1MouseUp(Sender: TObject
Button: TMouseButton;
Shift: TShiftState
X, Y: Integer);
begin
TempNode:=TreeView1.GetNodeAt(x,y);
end;
procedure TForm1.N1Click(Sender: TObject);
begin
DelReports;
TreeViewRefresh;
end;
procedure TForm1.N13Click(Sender: TObject);
var
j : Integer;
begin
for j := 1 to Fbook1.NumSheets do // Iterate
begin
if Fbook1.SheetSelected[j] then
begin
Fbook1.Sheet:=j;
Fbook1.EnableProtection:=False;
end;
end
// for
end;
procedure TForm1.N58Click(Sender: TObject);
var
s,s1,s2,s3,s4:string;
begin
if PMyRec(Treeview1.selected.data)^.islocked then s:='是'
Else
s:='否';
s:='保 护: '+s;
s1:='样表名: '+PMyRec(Treeview1.selected.data)^.Name;
s2:='编 号: '+inttostr(PMyRec(Treeview1.selected.data)^.id);
s3:='作 者: '+PMyRec(Treeview1.selected.data)^.User;
s4:='说 明: '+PMyRec(Treeview1.selected.data)^.Note;
Application.MessageBox(pchar(s1+#13+s2+#13+s3+#13+s4+#13+s+#13),
pchar(PMyRec(Treeview1.selected.data)^.Name),
Mb_ok or Mb_IconInformation);
end;
procedure TForm1.N59Click(Sender: TObject);
begin
Dtmd.GTServer1.LoginDlg;
if Dtmd.gtserver1.Connected then
begin
Dtmd.zt:=Dtmd.gtserver1.CopyId
Dtmd.yy:=inttostr(Dtmd.gtserver1.CopyYear);
Dtmd.creator:=Dtmd.gtserver1.UserId
Dtmd.unitname:=Dtmd.gtserver1.UnitName;
Dtmd.logdate:=Dtmd.gtserver1.LogDate;
dtmd.dcomcn1.Connected:=true;
dtmd.dcomcn1.AppServer.setdbforconnection(Dtmd.zt,Dtmd.yy);
dtmd.dcomcn2.Connected:=true;
dtmd.dcomcn2.AppServer.setdbforconnection(Dtmd.zt,Dtmd.yy);
end
else
exit;
end;
procedure TForm1.ToolButton6Click(Sender: TObject);
begin
if rptsvefrm=nil then rptsvefrm:=trptsvefrm.Create(nil);
repsave:=false;
rptsvefrm.ShowModal;
rptsvefrm.free;
rptsvefrm:=nil;
Treeviewrefresh;
end;
procedure TForm1.N63Click(Sender: TObject);
begin
shellexecute(application.MainForm.Handle,nil,'www.generware.com.cn',nil,nil,sw_show);
end;
procedure TForm1.WMQueryEndSession(var Msg: TMessage);
begin
if (Form1.saveed) and (Form1.repsave) then Msg.Result:=1 //不能关闭Windows
Else
begin
Msg.Result:=0;
if Form1.Saveed=false then Showmessage('请先保存样表再退出Windows系统');
if Form1.repsave=false then showmessage('请先保存报表再退出Windows系统');
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject
var CanClose: Boolean);
begin
if (Form1.saveed) and (Form1.repsave) then CanClose:=true
else
begin
CanClose:=false;
if Form1.saveed =false then
begin
if messagedlg('样表还没保存,要保存吗?',mtinformation,[mbYes, mbNo], 0)=mryes then savetemp
Else
begin
if Not Dtmd.ybdtst.active then Dtmd.ybdtst.Open;
Dtmd.ybdtst.edit;
dtmd.ybdtst.Cancel;
if Not Dtmd.gsdtst.active then Dtmd.gsdtst.Open;
Dtmd.gsdtst.edit;
dtmd.gsdtst.Cancel;
end;
end;
if Form1.repsave=false then
begin
if messagedlg('报表还没保存,要保存吗?',mtinformation,[mbYes, mbNo], 0)=mryes then
begin
if rptsvefrm=nil then rptsvefrm:=trptsvefrm.Create(nil);
repsave:=false;
rptsvefrm.ShowModal;
rptsvefrm.free;
rptsvefrm:=nil;
Treeviewrefresh;
end
else
begin
if Not Dtmd.bbdtst.active then Dtmd.bbdtst.Open;
Dtmd.bbdtst.edit;
Dtmd.bbdtst.Cancel;
if Not Dtmd.vludtst.active then Dtmd.vludtst.Open;
Dtmd.vludtst.Edit;
Dtmd.vludtst.Cancel;
end;
end;
end;
end;
end.