📄 main.pas

📁 chm制作工具
💻 PAS
字号:
{∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑
◎→
◎→                      Tresss Studio
◎→  Project: UPCHM
◎→  Start Date:2005/12/08
◎→  Change Date:2006/1/16
◎→  System: Delphi6+WinXP
◎→  Author: Tresss
◎→  E-Mail: Tresss@sohu.com
◎→  Character: Main File,interface
◎→  Tips:此文件为界面处理单元;
◎→       ExSet为主要功能实现单元;
◎→       ExFile为编译时输出文件单元;
◎→
◎→
∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑∑}

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ImgList, Buttons, ComCtrls, OleCtrls, SHDocVw,
  StdCtrls;

type
  TFrmMain = class(TForm)
    PnlTop: TPanel;
    BtnAddFolder: TSpeedButton;
    PnlLeft: TPanel;
    Spl1: TSplitter;
    PnlMain: TPanel;
    Trv1: TTreeView;
    Web1: TWebBrowser;
    ImgL1: TImageList;
    BtnAddFile: TSpeedButton;
    Od1: TOpenDialog;
    BtnComplite: TSpeedButton;
    Pnllbottom: TPanel;
    Btnlup: TSpeedButton;
    BtnlDown: TSpeedButton;
    BtnlLeft: TSpeedButton;
    BtnlRight: TSpeedButton;
    BtnlDel: TSpeedButton;
    BtnlEdit: TSpeedButton;
    BtnSet: TSpeedButton;
    PnlChmSetting: TPanel;
    ShpSet1: TShape;
    ShpSet2: TShape;
    ShpSet3: TShape;
    ImgCsTitle: TImage;
    BtnChmSOk: TSpeedButton;
    LblChmsTitle: TLabel;
    PnlChmSIn: TPanel;
    Bevel1: TBevel;
    SpMov: TShape;
    PnlUseSet: TPanel;
    ShpUs1: TShape;
    ShpUs2: TShape;
    ShpUs3: TShape;
    ImgUsTitle: TImage;
    BtnuseSOk: TSpeedButton;
    LblUseSetTitle: TLabel;
    BlMov: TBevel;
    SpMov1: TShape;
    PnlUsm: TPanel;
    BtnUseSet: TSpeedButton;
    PnlAbout: TPanel;
    ShpAbout1: TShape;
    ShpAbout2: TShape;
    ShpAbout3: TShape;
    ImgAboutTitle: TImage;
    LblAboutTitle: TLabel;
    BtnAbout: TSpeedButton;
    PnlCo: TPanel;
    EdtCsTitle: TEdit;
    PnlCsm: TPanel;
    LblCsTitle: TLabel;
    LblCsIndex: TLabel;
    CboCsIndex: TComboBox;
    LblCsmPath: TLabel;
    EdtCsPath: TEdit;
    BtnCsPath: TSpeedButton;
    Sd1: TSaveDialog;
    GobCsPos: TGroupBox;
    LblCsPosLeft: TLabel;
    LblCsPosTop: TLabel;
    EdtCspLeft: TEdit;
    EdtCspTop: TEdit;
    LblCspWidth: TLabel;
    LblCspHeight: TLabel;
    EdtCspHeight: TEdit;
    EdtCspWidth: TEdit;
    ImgAboutIcon: TImage;
    LblAbooutTitt1: TLabel;
    LblAboutTit2: TLabel;
    LblAboutTit1: TLabel;
    LblAboutVersion: TLabel;
    LblAbouter1: TLabel;
    LblAbouter2: TLabel;
    LblAbouter3: TLabel;
    LblAbouter4: TLabel;
    LblAboutqq2: TLabel;
    LblAboutqq1: TLabel;
    LblAboutCy: TLabel;
    LblAboutmail: TLabel;
    LblAbouUrl: TLabel;
    ChbCsNone: TCheckBox;
    PnlCompile: TPanel;
    ShpCom1: TShape;
    ShpCom2: TShape;
    ShpCom3: TShape;
    Image1: TImage;
    LblComTitle: TLabel;
    BtnCurCompile: TSpeedButton;
    BtnCompileClose: TSpeedButton;
    GbComDe: TGroupBox;
    BtnComDeFile: TSpeedButton;
    BtnComDeDir: TSpeedButton;
    EdtComDestChm: TEdit;
    EdtComDestDir: TEdit;
    BtnComDeCompile: TSpeedButton;
    ChbUsCnulldir: TCheckBox;
    EdtUsExt: TEdit;
    LblUsExt: TLabel;
    GBUsImport: TGroupBox;
    procedure BtnAddFolderClick(Sender: TObject);
    procedure Trv1Change(Sender: TObject; Node: TTreeNode);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure BtnAddFileClick(Sender: TObject);
    procedure BtnCompliteClick(Sender: TObject);
    procedure BtnlupClick(Sender: TObject);
    procedure BtnlDownClick(Sender: TObject);
    procedure BtnlLeftClick(Sender: TObject);
    procedure BtnlRightClick(Sender: TObject);
    procedure BtnlDelClick(Sender: TObject);
    procedure BtnlEditClick(Sender: TObject);
    procedure Trv1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Trv1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure BtnSetClick(Sender: TObject);
    procedure BtnChmSOkClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure SpMovMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpMovMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpMovMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpMov1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SpMov1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpMov1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BtnUseSetClick(Sender: TObject);
    procedure BtnuseSOkClick(Sender: TObject);
    procedure BtnAboutClick(Sender: TObject);
    procedure PnlAboutClick(Sender: TObject);
    procedure BtnCsPathClick(Sender: TObject);
    procedure BtnCurCompileClick(Sender: TObject);
    procedure BtnCompileCloseClick(Sender: TObject);
    procedure BtnComDeFileClick(Sender: TObject);
    procedure BtnComDeDirClick(Sender: TObject);
    procedure BtnComDeCompileClick(Sender: TObject);
  private
    BsMov:Boolean;        //BsMov用于自定义滚动条的拖动;
    Bsy:Integer;              //Bsy用于滚动条拖动前,记录鼠标偏移;

  public
    StrPath:TStringList;
    CurDir:String;
    IntPath:Array of Integer;
    LenDir:Integer;
  end;

var
  FrmMain: TFrmMain;

implementation
Uses exFile,EnSet;

{$R *.dfm}
{$R res.res}



procedure TFrmMain.Trv1Change(Sender: TObject; Node: TTreeNode);
Var
  Intind:Integer;
  Str:String;
begin
  If Node.Count=0 Then
  Begin
    IntInd:=PInteger(Node.Data)^;
    Str:=StrPath.Strings[IntInd];
    Web1.Navigate(CurDir+Str);
  ENd;
end;

procedure TFrmMain.BtnAddFolderClick(Sender: TObject);
begin
  CurDir:=SelectDir;
  If CurDir='' Then Exit;
  if not DirectoryExists(CurDir) then
  begin
    Application.MessageBox('所选路径不存在','UPCHM提示',  MB_OK +MB_ICONERROR);
  end
  Else
  Begin
    Trv1.Items.Clear;
    StrPath.Clear;
    LenDir:=Length(CurDir);
    If CurDir[LenDir]<>'\' Then CurDir:=CurDir+'\';
    LenDir:=LenDir+3;
    Caption:=CurDir;
    DirList(CurDir,Trv1,Nil);
    If EdtCSPath.Text='' Then EdtCSPath.Text:=CurDir+'UPCHM.chm';
    If ChbUscnulldir.Checked Then DeleteNull;   //删除空目录;
    If (StrPath.Count>0) And (CboCSIndex.Text='') Then
      CboCSIndex.Text:=StrPath.Strings[0];        //设置默认首页;
  End;
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  StrPath.Free;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  Web1.Navigate('http://www.tresss.com/pubsoft/upchm039');
  StrPath:=TStringList.Create;
end;

procedure TFrmMain.BtnAddFileClick(Sender: TObject);
Var
  node:TTreenode;
begin
  Od1.Filter:='Html网页文件|*.html;*.htm|Txt文件文件|*.txt|所有文件|*.*';
  If Od1.Execute Then
  Begin
    node:=Trv1.Items.AddChild(Nil,ChangeFileExt(extractfilename(Od1.FileName),''));
    node.ImageIndex:=10;
    Node.SelectedIndex:=11;
    StrPath.Add(Od1.FileName);
    If EdtCsPath.Text='' Then EdtCsPath.Text:=extractfilepath(Od1.FileName);
    If (StrPath.Count>0) And (CboCSIndex.Text='') Then
      CboCSIndex.Text:=StrPath.Strings[0];        //设置默认首页;
  End;
end;

procedure TFrmMain.BtnCompliteClick(Sender: TObject);
Var
  Intc:Integer;
begin
  Intc:=Trv1.Items.Count;
  If Intc>0 Then
    BtnCurCompile.Enabled:=True
  Else
    BtnCurCompile.Enabled:=False;
  PnlCompile.Top:=FrmMain.ClientHeight div 2-140;
  PnlCompile.Left:=FrmMain.ClientWidth Div 2-208;
  PnlCompile.Show;
  DisMainPnl;
end;

procedure TFrmMain.BtnlupClick(Sender: TObject);
Var
  Nodec,Nodel:TTreeNode;
begin
  Nodec:=Trv1.Selected;
  If (Nodec=Nil) or (Nodec.Index=0) Then Exit;
  Nodel:=Nodec.GetPrevSibling;
  Nodec.MoveTo(Nodel,NaInsert);
end;

procedure TFrmMain.BtnlDownClick(Sender: TObject);
Var
  Nodec,Nodel:TTreeNode;
begin
  Nodec:=Trv1.Selected;
  If Nodec=Nil Then Exit;
  Nodel:=Nodec.getNextSibling;
  If Nodel=Nil Then Exit;
  Nodel.MoveTo(Nodec,NaInsert);
  Nodec.Selected;
end;

procedure TFrmMain.BtnlLeftClick(Sender: TObject);
Var
  Nodec,Nodel:TTreeNode;
begin
  Nodec:=Trv1.Selected;
  If Nodec=Nil Then Exit;
  Nodel:=Nodec.Parent;
  If Nodel=Nil Then Exit;
  Nodec:=Nodel.getNextSibling;
  If Nodec=Nil Then
  Begin
    Nodec:=Trv1.Selected;
    Nodec.MoveTo(Nodel,NaInsert);
  End
  Else
  Begin
    Nodel:=Trv1.Selected;
    Nodel.MoveTo(Nodec,NaInsert);
  End;
end;

procedure TFrmMain.BtnlRightClick(Sender: TObject);
Var
  Nodec,Nodel:TTreeNode;
begin
  Nodec:=Trv1.Selected;
  If Nodec=Nil Then Exit;
  Nodel:=Nodec.getPrevSibling;
  If (Nodel=Nil) or (Nodel.Count=0) Then Exit;
  Nodec.MoveTo(Nodel,NaAddChild);
end;

procedure TFrmMain.BtnlDelClick(Sender: TObject);
Var
  Node:TTreeNode;
begin
  Node:=Trv1.Selected;
  If Node=Nil Then Exit;
  If Node.Count=0 Then
  Begin     //节点不为目录,则直接删除;
    StrPath.Strings[PInteger(Node.Data)^]:='';
  End
  Else      //节点为目录,则用递归删除;
    RemoveTNode(Node);
  Node.Delete;
end;

procedure TFrmMain.BtnlEditClick(Sender: TObject);
Var
  Node:TTreeNode;
begin
  Node:=Trv1.Selected;
  If Node<>Nil Then Node.EditText;
end;

procedure TFrmMain.Trv1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  If Sender=Source Then Accept:=True;
end;

procedure TFrmMain.Trv1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  With TTreeView(Sender) Do
  Begin
    If (Sender<> Source) or (DropTarget=Nil) or (DropTarget=Selected) Then Exit;
    If DropTarget.Count=0 Then
      Selected.MoveTo(DropTarget,NaInsert)
    Else
      Selected.MoveTo(DropTarget,NaAddChildFirst);
  End;
end;

procedure TFrmMain.BtnSetClick(Sender: TObject);
begin
  PnlChmSetting.Top:=FrmMain.ClientHeight div 2-140;
  PnlChmSetting.Left:=FrmMain.ClientWidth Div 2-208;
  DisMainPnl;
  PnlChmSetting.Show;
  SetBfIndex;           //选取最前的五个路径备用;
end;

procedure TFrmMain.BtnChmSOkClick(Sender: TObject);
begin
  EnMainPnl;
  PnlChmSetting.Hide;
end;

procedure TFrmMain.FormResize(Sender: TObject);
begin
  If PnlChmSetting.Visible Then
  Begin
    PnlChmSetting.Top:=FrmMain.ClientHeight div 2-140;
    PnlChmSetting.Left:=FrmMain.ClientWidth Div 2-208;
  End
  Else If PnlUseSet.Visible Then
  Begin
    PnlUseSet.Top:=FrmMain.ClientHeight div 2-140;
    PnlUseSet.Left:=FrmMain.ClientWidth Div 2-208;
  End
  Else If PnlAbout.Visible Then
  Begin
    PnlAbout.Top:=FrmMain.ClientHeight div 2-140;
    PnlAbout.Left:=FrmMain.ClientWidth Div 2-208;
  End;
end;

procedure TFrmMain.SpMovMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  BsMov:=True;
  Bsy:=Y;
end;

procedure TFrmMain.SpMovMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  BsMov:=False;
end;

procedure TFrmMain.SpMovMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
Var
  Tsy:Integer;
begin
  If BsMov Then
  Begin
    Tsy:=SpMov.Top+Y-Bsy;
    If Tsy<48 Then Tsy:=48;
    If Tsy>208 Then Tsy:=208;
    SpMov.Top:=Tsy;

    PnlCsm.Top:=48-SpMov.Top;
  End;
end;

procedure TFrmMain.SpMov1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  BsMov:=True;
  Bsy:=Y;
end;

procedure TFrmMain.SpMov1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
Var
  Tsy:Integer;
begin
  If BsMov Then
  Begin
    Tsy:=SpMov1.Top+Y-Bsy;
    If Tsy<48 Then Tsy:=48;
    If Tsy>208 Then Tsy:=208;
    SpMov1.Top:=Tsy;
  End;
end;

procedure TFrmMain.SpMov1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  BsMov:=False;
end;

procedure TFrmMain.BtnUseSetClick(Sender: TObject);
begin
  PnlUseSet.Top:=FrmMain.ClientHeight div 2-140;
  PnlUseSet.Left:=FrmMain.ClientWidth Div 2-208;
  DisMainPnl;
  PnlUseSet.Show;
end;

procedure TFrmMain.BtnuseSOkClick(Sender: TObject);
begin
  EnMainPnl;
  PnlUseSet.Hide;
end;

procedure TFrmMain.BtnAboutClick(Sender: TObject);
begin
  PnlAbout.Top:=FrmMain.ClientHeight div 2-140;
  PnlAbout.Left:=FrmMain.ClientWidth Div 2-208;
  DisMainPnl;
  PnlAbout.Show;
end;

procedure TFrmMain.PnlAboutClick(Sender: TObject);
begin
  EnMainPnl;
  PnlAbout.Hide;
end;

procedure TFrmMain.BtnCsPathClick(Sender: TObject);
begin
  If Sd1.Execute Then
    EdtCsPath.Text:=Sd1.FileName;
end;

procedure TFrmMain.BtnCurCompileClick(Sender: TObject);
Begin
  CompileCHM;
end;

procedure TFrmMain.BtnCompileCloseClick(Sender: TObject);
begin
  EnMainPnl;
  PnlCompile.Hide;
end;

procedure TFrmMain.BtnComDeFileClick(Sender: TObject);
begin
  Od1.Filter:='CHM文件|*.chm';
  If Od1.Execute Then
    EdtComDestChm.Text:=Od1.FileName;
end;

procedure TFrmMain.BtnComDeDirClick(Sender: TObject);
Var
  StrPath:String;
begin
  StrPath:=SelectDir;
  If StrPath<>'' Then
    EdtComDestDir.Text:=StrPath;
end;

procedure TFrmMain.BtnComDeCompileClick(Sender: TObject);
begin
  DeCompileCHM;
end;

end.
💿 文件大小 574 K
👤 上传用户 ydyzd_2008
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#chm #制作工具
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -