📄 uprocsbp.pas
字号:
{
'┌───────────────────────────────────┐
'│**********************************************************************│
'│*** 文件名称：uProcSBP *│
'│*** 功能描述：处理上报盘 *│
'│*** 编写人员：孙会强 *│
'│*** 编写日期：2001-06-06 *│
'│*** 修改人员： *│
'│*** 修改日期： *│
'│**********************************************************************│
'└───────────────────────────────────┘
}
unit uProcSBP;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ImgList, ComCtrls, ExtCtrls,Commctrl;
const
Version='VHH1.01' ;
FFileName='Report.out';
FFileNameTemp='ReportTemp.out';
//文件头信息
type
TFileHead=Record
VerInfo:string[7];//版本信息
TreCount:integer; //树型结构的大小
ProName:string[30];//工程名称
BUnitName:string[40];//投标单位名称
ValueCount:integer; //参数值文件的大小
end;
TTreeNodeInfo=record
Ralat:integer ;
//关系0_ 1..1
// 1_ 1..n
// 2 选择 是/否
PicIndex:integer; //图片索引
StrNodeName:string[30]; //节点名称
StrValue:string[255]; //值
end;
PTreeInfo=^TTreeNodeinfo ;
procedure RefreshState(var LState,LCap:TStringList;Tr:TTreeView);
//更新树型节点的状态
procedure InfoWriteToFile(FName:String;TreeView1:TTreeView;Label1:TLabel;FUnitName:string);
//将信息写入文件中
procedure InfoLoadFormFile(FName:string;TreeView1:TTreeView;Label1:TLabel;var FUnitName:string);
//将信息从文件中读出
procedure CommitData(FPriNode: TTreeNode;COmBoBox1:TComBoBox;ListView1:TListView);
//将数据提交
function WriteListContent(ListView1:TListView):string;
//主要是将ListView1的内容组成字符串，便于存储
procedure readListContent(Str:String;ListView1:TListView);
//从字符串重读出ListView的内容
procedure ProcAddValue(ListView1:TListView;ComBoBox1:TComboBox);
//处理listview得值得累加
function FuGetFilePath:string;
//得到当前应用程序的路径
function GetNodeState(node: TTreeNode):integer;
//得到TreeView的checkBox状态
procedure SetNodeState(node: TTreeNode; Flag: integer);
//设置TreeView的checkBox状态
function SetUnitPro(FName,UName,PName:string):boolean;
//再制作上报包盘时将基本信息写入
implementation
//-----------------自定义函数（过程）开始------------------------//
procedure RefreshState(var LState,LCap:TStringList;Tr:TTreeView);
{功能描述： 更新树型节点状态
输入 ： lState:保存树型节点的状态
LCap 保存树型节点的标题
Tr: 树星空件
输出 ：
描述 ：
}
var
CurNode,CurNode2:TTreeNode;
i:integer;
begin
//首先根据所保存的状态，更新当前状态
for i:=0 to Tr.Items.Count-1 do
begin
case StrToInt(LState.Strings[i]) of
0:
SetNodeState(Tr.Items[i],0);
1:
SetNodeState(Tr.Items[i],1)
end;
end;
for i:=0 to Tr.Items.Count-1 do
begin
CurNode:=Tr.Items[i];
if CurNode.Level=0 then
SetNodeState(CurNode,1) ;
if CurNode.Level=1 then
SetNodeState(CurNode,1);
if CurNode.Level=2 then
begin
if GetNodeState(CurNode)=0 then
begin
CurNode2:=CurNode.Parent;
SetNodeState(CurNode2,0) ;
CurNOde2:=CurNode2.Parent;
SetNodeState(CurNode2,0)
end;
end;
end;
//保存更新
for i:=0 to Tr.Items.Count-1 do
begin
LState.Strings[i]:=IntToStr(GetNodeState(Tr.Items[i]));
end;
end;
function SetUnitPro(FName,UName,PName:string):boolean;
{功能描述： 在职制作上报盘的时候，写入单位名称，和项目名称
输入 ： FName,UName,PName
文件名称，单位名称，工程名称
输出 ： 是否操作成功
描述 ：
}
var
OldStream,NewStream:TMemoryStream;
FFileHead:TFileHead;
begin
OldStream:=TMemoryStream.Create;
NewStream:=TMemoryStream.Create;
result:=true;
try
OldStream.LoadFromFile(FName);
OldStream.Read(FFileHead,SizeOf(FFileHead));
FFileHead.ProName:=PName;
FFileHead.BUnitName:=UName;
if FFileHead.VerInfo<>Version then
begin
Result:=False;
end
else
begin
NewStream.Write(FFileHead,SizeOf(FFileHead));
NewStream.CopyFrom(OldStream,(OldStream.Size-SizeOf(FFileHead)));
NewStream.SaveToFile(FName);
end;
finally
OldStream.Free;
NewStream.Free;
end;
end;
procedure InfoLoadFormFile(FName: string;TreeView1:TTreeView;Label1:TLabel;var FUnitName:string);
{功能描述：将信息从文件中读出
输入 ： Fname:要读入的文件名
输出 ：
描述 ：
}
var
FTreStream:TMemoryStream; //树节点流
FFileStream:TMemoryStream; //保存的文件流
FHead:TFileHEad; //文件头
FValue:TTreeNodeInfo; //文件纪录结构
PFValue:PTreeInfo; // 文件纪录结构
i:integer;
begin
FTreStream:=TMemoryStream.Create;
FFileStream:=TMemoryStream.Create;
FFileStream.LoadFromFile(FName);
FFileStream.Read(FHead,Sizeof(TFileHead));
//判断版本号：如果错误，则文件格式不正确
if FHead.VerInfo<>Version then
begin
ShowMessage('错误的文件格式');
FTreStream.Free;
FFileStream.Free;
Exit;
end;
TreeView1.Items.Clear;
Label1.Caption:=FHead.ProName;
FUnitName:=FHead.BUnitName;
//将节点的Caption读入
FTreStream.CopyFrom(FFileStream,FHead.TreCount);
FTreStream.SaveToFile('M.k');
TreeView1.LoadFromStream(FTreStream);
TreeView1.LoadFromFile('M.k');
//给树各个节点负值（Data）
for i:=0 to TreeView1.Items.Count-1 do
begin
FFileStream.Read(FValue,SizeOf(TTreeNodeInfo));
TreeView1.Items[i].ImageIndex:=FValue.PicIndex;
TreeView1.Items[i].StateIndex:=FValue.PicIndex;
TreeView1.Items[i].SelectedIndex:=FValue.PicIndex;
SetNodeState(TreeView1.Items[i],0) ;
GetMem(PFValue,SizeOf(TTreeNodeInfo));
PFValue^.Ralat:=FValue.Ralat;
PFValue^.PicIndex:=FValue.PicIndex;
PFValue^.StrNodeName:=FValue.StrNodeName;
PFValue^.StrValue:=FValue.StrValue;
TreeView1.Items[i].Data:=PFValue;
end; //for
FTreStream.Free;
FFileStream.Free;
end;
procedure InfoWriteToFile(FName: String;TreeView1:TTreeView;Label1:TLabel;FUnitName:string);
{功能：将信息写入文件中
参数说明：Fname:要写入的文件名
TreeView1:
}
var
FTreStream:TMemoryStream; //TreeView节点的Caption流
FFileStream:TMemoryStream; //文件流
FHead:TFileHEad; //文件头
FValue:TTreeNodeInfo; //节点Data
i:integer;
begin
FTreStream:=TMemoryStream.Create;
FFileStream:=TMemoryStream.Create;
//讲TreeView的各个节点的节点caption写入流
TreeView1.SaveToStream(FTreStream);
//读去文件头信息
FHead.TreCount:=FTreStream.Size;
FHead.ValueCount:=100;
FHead.VerInfo:=Version;
FHead.BUnitName:=FUnitName;
FHead.ProName:=Trim(Label1.caption);
//写入文件头信息
FFileStream.Write(FHead,SizeOf(TFileHEad));
FTreStream.Position:=0;
//将TreeView的节点信息写入
FFileStream.CopyFrom(FTreStream,FTreStream.Size);
//将值写入文件
for i:=0 to TreeView1.Items.Count-1 do
begin
FValue.PicIndex:=TreeView1.Items[i].ImageIndex;
FValue.StrNodeName:=TreeView1.Items[i].Text;
if TreeView1.Items[i].Data<>nil then
begin
FValue.StrValue:=PTreeInfo(TreeView1.Items[i].Data)^.StrValue;
FValue.Ralat:=PTreeInfo(TreeView1.Items[i].Data)^.Ralat;
end
else
begin
FValue.StrValue:='';
FValue.Ralat:=-1;
end;
FFileStream.Write(FValue,SizeOf(TTreeNodeInfo));
end; //for
//写入文件
FFileStream.SaveToFile(FName);
FTreStream.Free;
FFileStream.Free;
end;
function WriteListContent(ListView1:TListView): string;
{功能描述：将ListView的内容写入字符串
输入 ：无
输出 ：字符
备注 ：将listview的内容用@进行隔开，
}
var
i:integer;
str:string;
begin
str:='';
for i:=0 to ListView1.Items.Count-1 do
begin
str:=Str+'@'+Trim(ListView1.Items[i].Caption)+'@'+Trim(ListView1.Items[i].SubItems.Strings[0])+'@'+Trim(ListView1.Items[i].SubItems.Strings[1]);
end;
result:=Str;
end;
procedure readListContent(Str: String;ListView1:TListView);
var
DStr:string;
L,m,k,Ie:integer;
FL:TListItem;
begin
m:=0;
Fl:=nil;
while Pos('@',Str)<>0 do
begin
L:=Length(Str);
Str:=Copy(str,2,L);
Ie:=Pos('@',Str);
DStr:=Copy(Str,1,Ie-1);
k:=m mod ListView1.Columns.Count;
case k of
0:
begin
FL:=ListView1.Items.Add;
FL.Caption:=DStr;
end;
1:
begin
Fl.SubItems.Add(Dstr);
end;
2:
begin
Fl.SubItems.Add(Dstr);
end;
end;
Str:=Copy(Str,Ie,L) ;
m:=m+1;
end;
if M>0 then
FL.SubItems.Strings[1]:=Str;
end;
procedure ProcAddValue(ListView1:TListView;ComBoBox1:TComboBox);
var
FValue:Double;
i:integer;
begin
FValue:=0;
For i:=0 to ListView1.Items.Count-1 do
begin
FValue:=FValue+StrToFloat(ListView1.Items[i].SubItems.Strings[0]);
end;
ComBoBox1.Text:=FloatToStr(FValue);
end;
function FuGetFilePath: string;
{功能描述：得到当前的应用程序所在目录
参数 ：无
返回值 ：当前路径
}
var
Str,s:string;
i:integer;
begin
Str:=Application.ExeName;
//去掉文件名
for i:=Length(Trim(Application.ExeName)) downto 0 do
begin
S:=Copy(Str,i,1);
if S='\' then
break
else
Str:=Copy(Str,0,i-1);
end;
Result:=Str;
end;
function GetNodeState(node: TTreeNode): integer;
{
功能 ：得到节点NOde的checkbox状态
参数描述：Node：当前节点
返回值 ：如果选中则为1，否则为0
}
var
tvi: TTVItem;
i:integer;
begin
FillChar(tvi, SizeOf(tvi), 0);
tvi.hItem := node.ItemID;
tvi.Mask := TVIF_STATE or TVIF_HANDLE;
tvi.StateMask := TVIS_STATEIMAGEMASK;
//得到当前的状态
TreeView_GetItem(node.Handle, tvi);
i:=(tvi.state shr 12 -1);
result:=i;
end;
procedure SetNodeState(node: TTreeNode; Flag: integer);
{
功能 ：设置节点NOde的checkbox状态
参数描述：Node：当前节点
如果选中则为1，否则为0
返回值 ：无
}
var tvi: TTVItem;
begin
FillChar(tvi, SizeOf(tvi), 0);
tvi.hItem := node.ItemID;
tvi.Mask := TVIF_STATE or TVIF_HANDLE;
tvi.StateMask := TVIS_STATEIMAGEMASK;
//将状态+1左移12
tvi.state:=(Flag+1) shl 12;
//设置状态
TreeView_SetItem(node.Handle, tvi);
end;
procedure CommitData(FPriNode: TTreeNode;COmBoBox1:TComBoBox;ListView1:TListView);
var
FTreInfo:TTreeNodeinfo;
begin
if FPriNode<>nil then
begin
FPriNode.SelectedIndex:=FPriNode.ImageIndex;
SetNodeState(FPriNode,1);
if FPriNode.Data<>nil then
begin
FTreinfo:=PTreeInfo(FPriNode.Data)^;
Case FTreInfo.Ralat of
0:
begin
PTreeInfo(FPriNode.Data)^.StrValue:=ComboBox1.Text;
end;
1:
begin
PTreeInfo(FPriNode.Data)^.StrValue:=WriteListContent(ListView1);
ProcAddValue(ListView1,ComboBox1);
end;
2:
begin
PTreeInfo(FPriNode.Data)^.StrValue:=ComboBox1.Text;
end;
end;//case
end;//if
end//if
end;
//-----------------自定义函数（过程）结束------------------------//
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -