📄 mainunit.pas
字号:
{**********************************
*资料收集软件是我用于个人资料收 *
*藏用的, 由于时间匆忙,只实现了 *
*一些基本的功能,不过我还有一些 *
*更好的想法有待去做,让本软件支 *
*持网络共享资料,相信应该有一定 *
*意义。 *
*作者:jackiekuang *
*时间:2004.1.5 *
*Email:jacky_kch@etang.com *
*HomePage:http://homeofkch.bak.cn*}
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons, ComCtrls, OleCtrls, SHDocVw,
ToolWin, DB, ADODB, ImgList, MSHTML, ActiveX, ComObj, ShellAPI;
const
WM_IconMessage = WM_USER + 100;
type
TMainFrm = class(TForm)
StatusBar1: TStatusBar;
pnl_Body: TPanel;
pnl_Left: TPanel;
Panel3: TPanel;
tv_Main: TTreeView;
Splitter1: TSplitter;
ADOQuery1: TADOQuery;
ADOConnection1: TADOConnection;
sbtn_AddClass: TSpeedButton;
sbtn_AddFile: TSpeedButton;
ImageList1: TImageList;
pnl_Top: TPanel;
Shape1: TShape;
sbtn_Delete: TSpeedButton;
sbtn_AddRootDir: TSpeedButton;
Label1: TLabel;
OpenDialog1: TOpenDialog;
pnl_Right: TPanel;
Panel1: TPanel;
Shape2: TShape;
Label2: TLabel;
sbtn_Open: TSpeedButton;
sbtn_Save: TSpeedButton;
edt_FileName: TEdit;
PageControl1: TPageControl;
ts_BrowserMode: TTabSheet;
wb_Content: TWebBrowser;
ts_EditMode: TTabSheet;
redt_Content: TRichEdit;
sbtn_About: TSpeedButton;
Panel2: TPanel;
sbtn_Bold: TSpeedButton;
sbtn_Italic: TSpeedButton;
sbtn_Underline: TSpeedButton;
sbtn_Cut: TSpeedButton;
sbtn_Copy: TSpeedButton;
sbtn_Paste: TSpeedButton;
shape_Slipt: TShape;
Shape3: TShape;
sbtn_SelAll: TSpeedButton;
sbtn_InsertTime: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure tv_MainChange(Sender: TObject; Node: TTreeNode);
function GetAutoNO: Integer; //得到自动编号
procedure CustomDlg(AStr:String);
procedure sbtn_AddRootDirClick(Sender: TObject);
procedure sbtn_AddClassClick(Sender: TObject);
procedure sbtn_AddFileClick(Sender: TObject);
procedure sbtn_OpenClick(Sender: TObject);
procedure sbtn_SaveClick(Sender: TObject);
procedure redt_ContentChange(Sender: TObject);
procedure sbtn_DeleteClick(Sender: TObject);
procedure sbtn_AboutClick(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure sbtn_BoldClick(Sender: TObject);
procedure sbtn_CutClick(Sender: TObject);
procedure sbtn_SelAllClick(Sender: TObject);
procedure sbtn_InsertTimeClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
procedure LoadTreeView;
function GetNodeFromId(ANodeId:Integer):TTreeNode;
function ShowInputFrm(IsPass:Boolean;var AResult:String):Boolean;
procedure LoadFileData(ANode:TTreeNode);
procedure SaveFileData(ANode:TTreeNode);
procedure DisplayTxtToWB(AStr:String);
procedure DisplayWelToWB;
function IsDocNode(ANode:TTreeNode):Boolean;
function GetWeekday(ADateTime:TDateTime):String;
procedure ProductWebPage(const WebBrowser:TWebBrowser; const Html: string);
procedure AdjustForm; //适应屏幕分辨率的改变
procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
procedure LoadSysTray; //加载系统托盘图标
procedure DelSysTray;
procedure OnIconNotify(var Message: TMessage); message WM_IconMessage;
{ Private declarations }
public
{ Public declarations }
end;
var
MainFrm: TMainFrm;
const
ITEM_KIND_DIR='目录';
ITEM_KIND_WEBFILE='网页文件';
ITEM_KIND_TXTFILE='文本文件';
Save_TAG=1; //保存模式
MODIFY_TAG=2; //修改模式
ScreenWidth: LongInt = 1024; //设计时屏幕分辨率:1024x768
ScreenHeight: LongInt = 768;
implementation
uses InputUnit, AboutUnit;
{$R *.dfm}
procedure TMainFrm.FormCreate(Sender: TObject);
var
s_MainPageFile:String;
s_DBFile:String;
begin
LoadSysTray;
//AdjustForm;
//加载主页
s_MainPageFile:=ExtractFileDir(ParamStr(0))+'\Data\index.htm';
if FileExists(s_MainPageFile) then
begin
wb_Content.Navigate(s_MainPageFile);
end
else
begin
wb_Content.Navigate('about:blank');
end;
//连接数据库
s_DBFile:=ExtractFileDir(ParamStr(0))+'\Data\UserData.mdb';
if FileExists(s_DBFile) then
begin
ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;'
+'Data Source='+s_DBFile+';'
+'Jet OLEDB:Database Password=;';
ADOQuery1.Connection:=ADOConnection1;
ADOQuery1.Close;
end
else
begin
MessageBox(handle,PChar('系统数据库加载失败,程序终止运行.'),PChar('PDCollection提示你'),MB_OK);
Application.Terminate;
end;
LoadTreeView;
end;
procedure TMainFrm.tv_MainChange(Sender: TObject; Node: TTreeNode);
begin
if (Node.ImageIndex=3) or (Node.ImageIndex=2) then //节点对应的是文件
begin
redt_Content.ReadOnly:=False;
sbtn_AddClass.Enabled:=False;
sbtn_AddFile.Enabled:=False;
LoadFileData(Node);
DisplayTxtToWB(redt_Content.Text);
sbtn_Save.Enabled:=True;
sbtn_Open.Enabled:=True;
end
else if (Node.ImageIndex=1) or (Node.ImageIndex=0) then
begin
redt_Content.ReadOnly:=True;
sbtn_AddClass.Enabled:=True;
sbtn_AddFile.Enabled:=True;
sbtn_Save.Enabled:=False;
sbtn_Open.Enabled:=False;
DisplayWelToWB;
redt_Content.Clear;
end;
//sbtn_Save.Tag:=MODIFY_TAG;
end;
function TMainFrm.GetAutoNO: Integer;
begin
Result:=0;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('Insert Into TreeDir(NodeCaption)');
ADOQuery1.SQL.Add('Values("'+'@PDC专用测试字段@'+'")');
ADOQuery1.ExecSQL;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('Select Id From TreeDir');
ADOQuery1.SQL.Add('Where NodeCaption="'+'@PDC专用测试字段@'+'"');
ADOQuery1.Open;
if ADOQuery1.RecordCount >0 then
Result:=ADOQuery1.FieldByName('Id').AsInteger;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('Delete From TreeDir');
ADOQuery1.SQL.Add('Where NodeCaption="'+'@PDC专用测试字段@'+'"');
ADOQuery1.ExecSQL;
ADOQuery1.Close;
end;
procedure TMainFrm.CustomDlg(AStr: String);
begin
MessageBox(handle,PChar(AStr),PChar('PDC提示你'),MB_OK+MB_ICONINFORMATION);
end;
procedure TMainFrm.sbtn_AddRootDirClick(Sender: TObject);
var
ParentNode:TTreeNode;
NewNode:TTreeNode;
p_NodeId:PInteger;
s_NodeCaption:String;
begin
if not ShowInputFrm(False,s_NodeCaption) then Exit;
ParentNode:=nil;
p_NodeId:=PInteger(GetAutoNO);
NewNode:=tv_Main.Items.AddChildObject(ParentNode,s_NodeCaption,p_NodeId);
NewNode.Text:=s_NodeCaption;
NewNode.ImageIndex:=0;
NewNode.SelectedIndex:=1;
//保存
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('insert into TreeDir(ParentId,NodeCaption,ItemLevel,ItemKind,ItemIndex) ');
ADOQuery1.SQL.Add('Values(:ParentId,:NodeCaption,:ItemLevel,:ItemKind,:ItemIndex)');
ADOQuery1.Parameters.ParamByName('ParentId').Value:=IntToStr(0);
ADOQuery1.Parameters.ParamByName('NodeCaption').Value:=s_NodeCaption;
ADOQuery1.Parameters.ParamByName('ItemLevel').Value:=IntToStr(0);
ADOQuery1.Parameters.ParamByName('ItemKind').Value:=ITEM_KIND_DIR;
ADOQuery1.Parameters.ParamByName('ItemIndex').Value:=tv_Main.Items[tv_Main.Items.Count-1].Index+1;;
ADOQuery1.ExecSQL;
ADOQuery1.Close;
end;
procedure TMainFrm.LoadTreeView;
var
ParentNode:TTreeNode;
NodeId:Integer;
P_NodeID:PInteger;
s_NodeCaption,s_NodeKide:String;
NewNode:TTreeNode;
begin
//加载level=0的节点
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('Select * From TreeDir');
ADOQuery1.SQL.Add('Where ItemLevel=0');
ADOQuery1.SQL.Add('Order by ItemIndex');
ADOQuery1.Open;
if ADOQuery1.RecordCount<=0 then Exit;
ParentNode:=nil;
While Not ADOQuery1.Eof Do
begin
New(P_NodeId);
P_NodeId^:= ADOQuery1.FieldByName('Id').AsInteger;
s_NodeCaption:= ADOQuery1.FieldByName('NodeCaption').AsString;
s_NodeKide:= ADOQuery1.FieldByName('ItemKind').AsString;
NewNode:=tv_Main.Items.AddChildObject(ParentNode,s_NodeCaption,P_NodeID);
if s_NodeKide=ITEM_KIND_DIR then
begin
NewNode.ImageIndex :=0;
NewNode.SelectedIndex:=1;
end
else if s_NodeKide=ITEM_KIND_WEBFILE then
begin
NewNode.ImageIndex :=2;
NewNode.SelectedIndex:=2;
end
else if s_NodeKide=ITEM_KIND_TXTFILE then
begin
NewNode.ImageIndex :=3;
NewNode.SelectedIndex:=3;
end;
ADOQuery1.Next;
end;
//加载剩余的项
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('Select * From TreeDir');
ADOQuery1.SQL.Add('Where ItemLevel>0');
ADOQuery1.SQL.Add('Order by ItemLevel,ItemIndex');
ADOQuery1.Open;
if ADOQuery1.RecordCount<=0 then Exit;
ParentNode:=nil;
While Not ADOQuery1.Eof Do
begin
NodeId:= ADOQuery1.FieldByName('ParentId').AsInteger;
ParentNode:=GetNodeFromId(NodeId);
if Not Assigned(ParentNode) then
begin
CustomDlg('加载目录树失败.');
Exit;
end;
New(P_NodeID);
P_NodeId^:= ADOQuery1.FieldByName('Id').AsInteger;
s_NodeCaption:= ADOQuery1.FieldByName('NodeCaption').AsString;
s_NodeKide:= ADOQuery1.FieldByName('ItemKind').AsString;
NewNode:=tv_Main.Items.AddChildObject(ParentNode,s_NodeCaption,P_NodeID);
if s_NodeKide=ITEM_KIND_DIR then
begin
NewNode.ImageIndex :=0;
NewNode.SelectedIndex:=1;
end
else if s_NodeKide=ITEM_KIND_WEBFILE then
begin
NewNode.ImageIndex :=2;
NewNode.SelectedIndex:=2;
end
else if s_NodeKide=ITEM_KIND_TXTFILE then
begin
NewNode.ImageIndex :=3;
NewNode.SelectedIndex:=3;
end;
ADOQuery1.Next;
end;
ADOQuery1.Close;
end;
function TMainFrm.GetNodeFromId(ANodeId: Integer): TTreeNode;
var
i:Integer;
begin
Result:=nil;
for i:=0 to tv_Main.Items.Count-1 do
begin
if PInteger(tv_Main.Items[i].Data)^=ANodeId then
begin
Result:= tv_Main.Items[i];
Break;
end;
end;
end;
procedure TMainFrm.sbtn_AddClassClick(Sender: TObject);
var
ParentNode:TTreeNode;
NewNode:TTreeNode;
p_NodeId:PInteger;
ParentNodeID:Integer;
s_NodeCaption:String;
begin
if tv_Main.Selected=nil then
begin
CustomDlg('请选择一个节点.');
Exit;
end;
if not ShowInputFrm(False,s_NodeCaption) then Exit;
ParentNode:=tv_Main.Selected;
ParentNodeID:=PInteger(ParentNode.Data)^;
New(p_NodeId);
p_NodeId^:=GetAutoNO+1;
NewNode:=tv_Main.Items.AddChildObject(ParentNode,s_NodeCaption,p_NodeId);
NewNode.Text:=s_NodeCaption;
NewNode.ImageIndex:=0;
NewNode.SelectedIndex:=1;
//保存数据
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('insert into TreeDir(ParentId,NodeCaption,ItemLevel,ItemKind,ItemIndex) ');
ADOQuery1.SQL.Add('Values(:ParentId,:NodeCaption,:ItemLevel,:ItemKind,:ItemIndex)');
ADOQuery1.Parameters.ParamByName('ParentId').Value:=IntToStr(ParentNodeID);
ADOQuery1.Parameters.ParamByName('NodeCaption').Value:=s_NodeCaption;
ADOQuery1.Parameters.ParamByName('ItemLevel').Value:=IntToStr(ParentNode.Level+1);
ADOQuery1.Parameters.ParamByName('ItemKind').Value:=ITEM_KIND_DIR;
ADOQuery1.Parameters.ParamByName('ItemIndex').Value:=tv_Main.Items[tv_Main.Items.Count-1].Index+1;;
ADOQuery1.ExecSQL;
ADOQuery1.Close;
end;
function TMainFrm.ShowInputFrm(IsPass: Boolean;var AResult:String):Boolean;
begin
InputFrm.edt_InputText.Text:='';
if IsPass then //密码输入框
begin
InputFrm.edt_InputText.PasswordChar:='*';
end
else
begin
InputFrm.edt_InputText.PasswordChar:=#0;
end;
if InputFrm.ShowModal=mrOk then
begin
AResult:=InputFrm.edt_InputText.Text;
Result:=True;
end
else
Result:=False;
end;
procedure TMainFrm.sbtn_AddFileClick(Sender: TObject);
var
ParentNode:TTreeNode;
NewNode:TTreeNode;
p_NodeId:PInteger;
ParentNodeID:Integer;
s_NodeCaption:String;
begin
if tv_Main.Selected=nil then
begin
CustomDlg('请选择一个节点.');
Exit;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -