⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainunit.pas

📁 面对纵多的各种各样的资料
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{**********************************
 *资料收集软件是我用于个人资料收  *
 *藏用的, 由于时间匆忙,只实现了 *
 *一些基本的功能,不过我还有一些  *
 *更好的想法有待去做,让本软件支  *
 *持网络共享资料,相信应该有一定  *
 *意义。                          *
 *作者: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 + -