umain.pas

网页文档资料整理程序,便于日后用chm软件合并整理,优化了很多格式

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ExtCtrls, StdCtrls, ComCtrls, jpeg, Menus, StrUtils;

type
  TfrmMain = class(TForm)
    Panel2: TPanel;
    Image1: TImage;
    Panel3: TPanel;
    rShow: TRichEdit;
    sBar: TStatusBar;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    CheckBox1: TCheckBox;
    Button4: TButton;
    procedure Image1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button4Click(Sender: TObject);
  private
    Handle:integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses uModule;

{$R *.dfm}

procedure TfrmMain.Image1Click(Sender: TObject);
begin
  sBar.SimpleText := '程序设计:Easten, 联系邮箱:[e-mail]';
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  rShow.SetFocus;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  dModule.O1.Click;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
begin
  dModule.S1.Click;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
var
  i,iCount:integer;
  sTemp:string;
begin
  Button2.Enabled := False;
  rShow.SetFocus;
  sBar.SimpleText := '第一步[10%]: 正在删除小空格,请稍候.....';
  sTemp := rShow.Text;
  iCount := rShow.Lines.Count;
  for i:=0 to iCount do  //此算法太落后,可考虑用线程
  begin
    sTemp := rShow.Lines[i];
    if Pos(' ',sTemp)=1 then
    begin
      Application.ProcessMessages;
      rShow.Lines[i] := Trim(sTemp);  //第一个为空格则剪切
    end;
  end;
  sBar.SimpleText := '第二步[45%]: 正在删除大空格,请稍候.....';
  for i:=0 to 4 do
    if rShow.Lines[0]='' then rShow.Lines.Delete(0);
  sTemp := rShow.Text;
  sTemp := StringReplace(sTemp, '　　 ','', [rfReplaceAll]);
  sTemp := StringReplace(sTemp, '　','', [rfReplaceAll]); //除去大空格
  sBar.SimpleText := '第三步[80%]: 正在调整段落位置,请稍候.....';
  sTemp := StringReplace(sTemp, '  ',' ', [rfReplaceAll]); //除去连续三小空格
  sTemp := StringReplace(sTemp, '--','', [rfReplaceAll]);  //除去--
  sTemp := StringReplace(sTemp, '—','', [rfReplaceAll]);  //除去--
  sTemp := StringReplace(sTemp, chr(13)+chr(10)+chr(13)+chr(10)+chr(13)+chr(10),
           chr(13)+chr(10)+chr(13)+chr(10), [rfReplaceAll]);  //替换三个连续回车为二个
  sTemp := StringReplace(sTemp, chr(13)+chr(10)+chr(13)+chr(10)+chr(13)+chr(10),
           chr(13)+chr(10)+chr(13)+chr(10), [rfReplaceAll]);  //替换三个连续回车为二个
  sTemp := StringReplace(sTemp, ' '+chr(13)+chr(10),
           chr(13)+chr(10), [rfReplaceAll]);   //替换空格+回车为回车
  sBar.SimpleText := '第四步[95%]: 正在添加段前空格,请稍候.....';
  sTemp := StringReplace(sTemp, chr(13)+chr(10),
           chr(13)+chr(10)+'　　', [rfReplaceAll]);
  rShow.Text := sTemp;
  rShow.Lines.Insert(1,chr(13)+chr(10));  //标题后空两段
  Button2.Enabled := True;
  sBar.SimpleText := '祝贺你,文档处理成功!';
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  sAllFile:string;
begin
  if DirectoryExists('Disposal')=False then
    CreateDir('Disposal');   //存放文件的目录
  sAllFile := ExtractFileDir(Application.ExeName)+'\Disposal\';
  //保证文件夹不被删除
  if FileExists(sAllFile+'Keep.ini') then
    Handle := FileOpen(sAllFile+'Keep.ini',fmOpenRead) //存在则打开
  else
    Handle := FileCreate(sAllFile+'Keep.ini'); //不存在则创建
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  sAllFile:string;
begin
  sAllFile := ExtractFileDir(Application.ExeName)+'\Disposal\';
  if FileExists(sAllFile+'Keep.ini') then
  begin
    FileClose(Handle);
    DeleteFile(sAllFile+'Keep.ini');
  end;
end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin
  dModule.P1.Click;
end;

end.