📄 mainfun.~pa
字号:
//---------------------------------------------------------------------------
//(R)CopyRight KivenSoft International ,inc 1999
//单元名称:主窗口附属单元
//程序名称:电子书库
//作 者:李会文
//开始时间:1997.07.01
//最后修改:1999.07.15
//备注:此单元定义了主窗口一些实用函数段
//---------------------------------------------------------------------------
unit MainFun;
interface
function SaveItem:boolean; //储存当前节点的变动内容
function SaveIndex:boolean; //储存变动后的索引内容
function SaveSrm:boolean; //保存主窗口中的数据库
function CloseSrm:boolean; //关闭数据库
function CloseSrmQuery:boolean; //是否保存对数据库的改动
function OpenSrm(Fn:string):boolean; //打开数据库文件在主窗口中并装入索引
function BrowseFolder:string; //目录浏览,返回被选择的目录,空为无选择
function GetLastPathName(var Pn:string):string;//提取最后的路径名
procedure SetOpenSrmWithApp(Value:boolean);//在注册表文件中设置SRM文件关联或取消
procedure ImportDir(var Dir,Mask:string); //引入目录下文件
function FormatTreeNodeString(Value:string):string;
//格式化树形视图节点字符串防止无效字符
implementation
uses
Classes, SysUtils, Controls, Windows, Registry, Forms, ComCtrls, CommCtrl,
Messages, FileCtrl, ShlObj, MainUnit, SrmConst, SrmUnit, InputPw, RegUnit;
//储存当前节点的变动内容--------------------------------------
function SaveItem:boolean;
var
Ms:TMemoryStream;
pInt:^integer;
begin
Result:=true;
if Srm=nil then Exit;
with SrmForm do
begin
if TreeView.Selected<>nil then //要保存的节点为空时退出
if (Srm.ItemHeadChanged) or (TreeView.Selected.Data=pointer(-1)) then
//标题属性有改变或是新增节点时
with Srm.DataHead do
begin
ContextAuthorEdit.GetTextBuf(Author,16);
ContextPasswordEdit.GetTextBuf(Password,12);
ContextIndexEdit.GetTextBuf(SearchKey,52);
pInt:=@DataType;
pInt^:=TreeView.Selected.ImageIndex;
end;
if (SrmForm.RichEdit.Modified) or
(SrmForm.TreeView.Selected.Data=pointer(-1)) then
//内容有改变或是新增节点时
begin
with Srm.DataHead do
if (RichEdit.GetTextLen<>0) then Num:=1 else Num:=0;
TreeView.Selected.Data:=pointer(Srm.AddItemHead);
Srm.IndexChanged:=true; //索引改变
if RichEdit.GetTextLen<>0 then
begin
Ms:=TMemoryStream.Create;
Ms.SetSize(RichEdit.GetTextLen+1);
RichEdit.GetTextBuf(Ms.Memory,Ms.Size);
Srm.AddItemData(Ms);
Ms.Free;
end;
end;
if (Srm.ItemHeadChanged) and (not Srm.ItemDataChanged) and
(not RichEdit.Modified) then //已有节点属性改变但内容不变时
begin
Srm.EditItemHead(integer(TreeView.Selected.Data));
end;
RichEdit.Modified:=false; //置相应的标志复位
Srm.ItemHeadChanged:=false;
Srm.ItemDataChanged:=false;
end;
end;
//储存变动后的索引内容-----------------------------------
function SaveIndex:boolean;
var
Msh,Msd:TMemoryStream;
i,n:integer;
p:PTreeData;
AList:TStringList;
ANode:TTreeNode;
begin
Result:=true;
if Srm=nil then Exit;
if not Srm.IndexChanged then Exit; //索引没改变时
Msh:=TMemoryStream.Create;
Msd:=TMemoryStream.Create;
AList:=TStringList.Create;
Msd.SetSize(sizeof(TTreeData)*SrmForm.TreeView.Items.Count);
p:=Msd.Memory;
n:=SrmForm.TreeView.Items.Count -1;
ANode:=SrmForm.TreeView.Items.GetFirstNode;
with ANode do
begin
for i:=0 to n do //添加相应级别的TAB字符
begin
AList.Add(StringOfChar(#9,Level)+Text);
p^.Pos:=integer(Data);
p^.DataType:=ImageIndex;
ANode:=GetNext;
p:=pointer(integer(p)+sizeof(TTreeData));
end;
end;
AList.SaveToStream(Msh);
AList.Free;
Srm.SaveIndex(Msh,Msd);
Srm.IndexChanged:=false;
Msh.Free;
Msd.Free;
end;
//保存主窗口中的数据库-------------------------------------
function SaveSrm:boolean;
begin
Result:=true;
if Srm=nil then Exit;
SaveItem;
SaveIndex;
if Srm.DbChanged then //如果数据库属性有变动
begin
with Srm.FileHead,SrmForm do
begin
DbAuthorEdit.GetTextBuf(Author,16);
DbPasswordEdit.GetTextBuf(Password,12);
Srm.SaveSrmFile;
Srm.IndexChanged:=false;
Srm.DbChanged:=false;
end;
end;
end;
//关闭数据库-------------------------------------------
function CloseSrm:boolean;
begin
Result:=true;
if Srm<>nil then
begin
SaveSrm;
Srm.Free;
Srm:=nil;
end;
SrmForm.SearchListBox.Items.Clear;//*清空查找栏
with SrmForm.TreeView do //清空树形视图
begin
SendMessage(Handle,TVM_SELECTITEM,TVGN_CARET,LPARAM(0));
SendMessage(Handle,WM_SETREDRAW,0,0);
//禁止重绘
SendMessage(Handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));
//删除所有节点
SendMessage(Handle,WM_SETREDRAW,-1,0);
//允许重绘
Selected:=nil;
end;
with SrmForm do //编辑框和其它的清空
begin
RichEdit.Text:='';
DbAuthorEdit.Text:='';
DbPasswordEdit.Text:='';
DbBuildDateEdit.Text:='';
DbEditDateEdit.Text:='';
ContextAuthorEdit.Text:='';
ContextPasswordEdit.Text:='';
ContextPubDateEdit.Text:='';
ContextIndexEdit.Text:='';
ContextTypeRadioGroup.ItemIndex:=-1;
end;
end;
//是否保存对数据库的改动------------------------------------------
function CloseSrmQuery:boolean;
begin
Result:=true;
if Srm=nil then Exit; //没有打开的数据文件
if not AppIni.DelRecordQuery then exit; //不提示即保存
if (SrmForm.RichEdit.Modified or Srm.ItemDataChanged or Srm.ItemHeadChanged or
Srm.IndexChanged or Srm.DbChanged) then
begin
case MessageBox(SrmForm.Handle,csSaveQuery,csAppName,MB_YESNOCANCEL or
MB_ICONQUESTION) of
IDYES:Result:=true;
IDNO:
begin
Result:=true;
SrmForm.RichEdit.Modified:=false;
Srm.ItemHeadChanged:=false;
Srm.ItemDataChanged:=false;
Srm.IndexChanged:=false;
Srm.DbChanged:=false;
end;
IDCANCEL:Result:=false;
end;
end;
end;
//打开数据库文件在主窗口中并装入索引--------------------------
function OpenSrm(Fn:string):boolean;
var
Ps,UserPs:string;
Msh,Msd:TMemoryStream;
i,j,n:integer;
p:PTreeData;
AList: TStringList;
ALevel,AOldLevel:integer;
AParentNode:TTreeNode;
StrBuf:PChar;
begin
Result:=true;
Application.ProcessMessages; //恢复原窗口
Srm:=TSrmObject.Create(Fn,fmOpenReadWrite);
if Srm.FileHead.Password[0]<>#0 then //密码保护
begin
InPwForm:=TInPwForm.Create(SrmForm);
with InPwForm do
begin
Caption:=csAppName;
InputLabel.Caption:=csPasswordTitle;
if ShowModal=mrCancel then
begin
Srm.Free;
Srm:=nil;
Free;
Result:=false;
Exit;
end;
Ps:=Edit.Text;
UserPs:=string(Srm.FileHead.Password);
if Ps<>UserPs then
begin
if ModalResult<>mrCancel then
Application.MessageBox(csAppName,csPasswordError,MB_OK);
Srm.Free;
Srm:=nil;
Result:=false;
Free;
Exit;
end;
Free;
end;
end;
Screen.Cursor:=crHourGlass;
Msh:=TMemoryStream.Create;
Msd:=TMemoryStream.Create;
Srm.LoadIndex(Msh,Msd); //装入索引
AList := TStringList.Create;
SrmForm.TreeView.Items.BeginUpdate;
AList.LoadFromStream(Msh); //装入到字符串列表中
SendMessage(SrmForm.TreeView.Handle, TVM_DELETEITEM, 0, Longint(TVI_ROOT));
AOldLevel := 0;
AParentNode := nil;
n:=AList.Count-1;
p:=Msd.Memory;
for i:=0 to n do //根据TAB的多少得到相应级别
begin
StrBuf:=PChar(AList.Strings[i]);
ALevel:=0;
while StrBuf^=#9 do //得该项所在层数
begin
Inc(StrBuf);
Inc(ALevel);
end;
if (ALevel<AOldLevel) or (AParentNode<>nil) then
begin //返回该项的上级节点
for j:=AOldLevel downto ALevel do
begin
AParentNode:=AParentNode.Parent;
end;
end;
AParentNode:=SrmForm.TreeView.Items.AddChildObject(AParentNode,StrBuf,
pointer(p.Pos));
AParentNode.ImageIndex:=p.DataType; //得该节点类型
AOldLevel:=ALevel;
p:=pointer(integer(p)+sizeof(TTreeData));
end;
SrmForm.TreeView.Items.EndUpdate;
AList.Free;
Msd.Free;
Msh.Free;
with Srm.FileHead,SrmForm do //显示文件属性
begin
DbAuthorEdit.Text:=String(Author);
DbPasswordEdit.Text:=String(Password);
DbBuildDateEdit.Text:=DateToStr(BuildDate);
DbEditDateEdit.Text:=DateToStr(EditDate);
end;
SrmForm.TreeView.Selected:=nil; //置当前选择项为空
with Srm do
begin
DbChanged:=false; //数据库变动标志复原
IndexChanged:=false; //索引变动标志复原
ItemHeadChanged:=false;
ItemDataChanged:=false;
end;
Screen.Cursor:=crDefault;
end;
//目录浏览,返回被选择的目录,空为无选择---------------------------
function BrowseFolder:string;
var
Info:TBrowseInfo;
Dir:array[0..260] of char;
ItemId:PItemIDList;
begin
with Info do
begin
hwndOwner:=SrmForm.Handle;
pidlRoot:=nil;
pszDisplayName:=nil;
lpszTitle:=csBrowseFolderInfo;
ulFlags:=0;
lpfn:=nil;
lParam:=0;
iImage:=0;
end;
ItemId:=SHBrowseForFolder(Info);
if ItemId<>nil then
begin
SHGetPathFromIDList(ItemId,@Dir);
Result:=string(Dir);
end;
end;
//提取最后的路径名----------------------------------------------
function GetLastPathName(var Pn:string):string;
var
Size:integer;
begin
Result:=Pn;
if Result[Length(Result)]='\' then Delete(Result,Length(Result),1);
repeat
Size:=Pos('\',Result);
if Size>0 then Delete(Result,1,Size);
until Size=0;
end;
//在注册表文件中设置SRM文件关联或取消-----------------------------
procedure SetOpenSrmWithApp(Value:boolean);
var
s:string;
begin
with TRegistry.Create do
begin
RootKey:=HKEY_CLASSES_ROOT;
s:=csSrmFileType;
if Value then //建立相应的键值
begin
OpenKey(s,true); //s:='\.srm'
Delete(s,1,2);
WriteString('',s); //:s='srm'
Insert('\',s,1);
OpenKey(s,true); //s:='\srm';
WriteString('',csSrmFileDescribe);
OpenKey(csSrmCommand,true);
WriteString('','"'+Application.ExeName+'" %1');
end
else //删除相应的键值
begin
DeleteKey(s);
Delete(s,2,1);
DeleteKey(s); //s:='\srm'
end;
Free;
end;
end;
//从目录中引入--------------------------------------------------------------
procedure ImportDir(var Dir,Mask:string);
var
SRec: TSearchRec;
ANode,OldNode:TTreeNode;
Path,Fn:string;
retval,oldlen:integer;
SubFlag,ItemFlag:boolean;
begin
Path:=Dir; //搜索路径
oldlen := Length(Dir);
retval := FindFirst( Dir+Mask,faAnyFile,SRec);
ItemFlag:=true;
SubFlag:=true;
OldNode:=SrmForm.TreeView.Selected;
ANode:=nil;
While retval=0 Do
Begin
If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then //是文件
begin
Fn:=SRec.Name;
Delete(Fn,Length(Fn)-3,4);
if ItemFlag then
begin
ItemFlag:=false;
ANode:=SrmForm.TreeView.Items.AddChildObjectFirst
(SrmForm.TreeView.Selected,Fn,pointer(-1));
end
else
ANode:=SrmForm.TreeView.Items.AddObjectFirst
(SrmForm.TreeView.Selected,Fn,pointer(-1));
ANode.ImageIndex:=2; //初始化添加数据
with Srm.DataHead do
begin
DataType:=2;
Author[0]:=#0;
Password[0]:=#0;
end;
SrmForm.TreeView.Selected:=ANode;
SrmForm.RichEdit.Lines.LoadFromFile(Dir+SRec.Name);
end;
retval := FindNext(SRec);
End;
SysUtils.FindClose(SRec);
if not ItemFlag then SrmForm.TreeView.Selected:=ANode.Parent;
retval:=FindFirst(path+'*.*',faDirectory,SRec); //目录搜索
While retval=0 Do
Begin
If (SRec.Attr and faDirectory)<>0 Then //是目录
If (SRec.Name <> '.') and (SRec.Name <> '..') Then
Begin
Path:=Path+SRec.Name+'\';
if SubFlag then
begin
SubFlag:=false;
ANode:=SrmForm.TreeView.Items.AddChildObjectFirst
(SrmForm.TreeView.Selected,GetLastPathName(Path),
pointer(-1));
end
else
ANode:=SrmForm.TreeView.Items.AddObjectFirst
(SrmForm.TreeView.Selected,GetLastPathName(Path),
pointer(-1));
ANode.ImageIndex:=1;
with Srm.DataHead do
begin
DataType:=1;
Author[0]:=#0;
Password[0]:=#0;
end;
SrmForm.TreeView.Selected:=ANode;
SrmForm.RichEdit.Modified:=true;
ImportDir(path,mask);
Delete(path,oldlen+1,260);
End;
retval := FindNext(SRec);
End;
SysUtils.FindClose(SRec);
SrmForm.TreeView.Selected:=OldNode;
end;
//格式化树形视图节点字符串防止无效字符-----------------------------------
function FormatTreeNodeString(Value:string):string;
var
Ap,At:pchar;
begin
Value:=TrimLeft(Value);
Value:=TrimRight(Value);
Ap:=pchar(Value);
// while Ap^ in [#1..#32] do inc(Ap); //去掉开头小于等于空格的字符
At:=Ap;
while At^<>#0 do
begin
if At^ in [#1..#31] then At^:=#32; //将小于空格的无效字符替换成空格
inc(At);
end;
Result:=string(Ap);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -