echmmain.pas

帮助编写程序

unit EchmMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, dxBar, StdCtrls, dxBarExtItems, cxControls,  DB,
  ImgList, ActnList, cxLookAndFeels, dxStatusBar, cxGraphics, StdActns, Variants,
  uHtmlEdit, OleServer, OleCtrls, HTMLObjectList, OleCtnrs,
  cxPC, Menus, SHDocVw;

type
  TEchmForm = class(TForm)
    BarManager: TdxBarManager;

    dxBarButtonNew: TdxBarLargeButton;
    dxBarButtonOpen: TdxBarLargeButton;
    dxBarButtonClose: TdxBarLargeButton;
    dxBarButtonSave: TdxBarLargeButton;
    dxBarButtonSaveAs: TdxBarLargeButton;
    dxBarButtonPrint: TdxBarLargeButton;
    dxBarButtonExit: TdxBarLargeButton;
    dxBarButtonUndo: TdxBarLargeButton;
    dxBarButtonCut: TdxBarLargeButton;
    dxBarButtonCopy: TdxBarLargeButton;
    dxBarButtonPaste: TdxBarLargeButton;
    dxBarButtonClear: TdxBarLargeButton;
    dxBarButtonSelectAll: TdxBarLargeButton;
    dxBarButtonFind: TdxBarLargeButton;
    dxBarButtonReplace: TdxBarLargeButton;
    dxBarComboFontSize: TdxBarCombo;
    dxBarButtonBold: TdxBarLargeButton;
    dxBarButtonItalic: TdxBarLargeButton;
    dxBarButtonUnderline: TdxBarLargeButton;
    dxBarButtonBullets: TdxBarLargeButton;
    dxBarButtonProtected: TdxBarLargeButton;
    dxBarButtonAlignLeft: TdxBarLargeButton;
    dxBarButtonCenter: TdxBarLargeButton;
    dxBarButtonAlignRight: TdxBarLargeButton;
    dxBarButtonFont: TdxBarLargeButton;

    dxBarButtonNewWindow: TdxBarLargeButton;
    dxBarListWindows: TdxBarListItem;

    dxBarSubItemFile: TdxBarSubItem;
    dxBarSubItemEdit: TdxBarSubItem;
    dxBarSubItemFormat: TdxBarSubItem;
    dxBarSubItemWindow: TdxBarSubItem;
    dxBarSubItemHelp: TdxBarSubItem;

    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    PrintDialog: TPrintDialog;
    FontDialog: TFontDialog;
    dxBarPopupMenu: TdxBarPopupMenu;
    dxBarButtonEnhancedStyle: TdxBarLargeButton;
    dxBarMRUFiles: TdxBarMRUListItem;
    dxBarButtonStdStyle: TdxBarLargeButton;
    dxBarButtonFlatStyle: TdxBarLargeButton;
    dxBarDockControl1: TdxBarDockControl;
    dxBarComboFontColor: TdxBarColorCombo;
    dxBarGroup1: TdxBarGroup;
    dxBarButtonXPStyle: TdxBarLargeButton;
    alMain: TActionList;
    actHelp: TAction;
    actAbout: TAction;
    actShowDemoDescription: TAction;
    dxBarButton1: TdxBarLargeButton;
    dxBarButtonOffice11Style: TdxBarLargeButton;
    Images: TImageList;
    dxBarComboFontName: TdxBarFontNameCombo;
    ilHotImages: TImageList;
    ilDisabledImages: TImageList;
    dxBarLargeButton2: TdxBarLargeButton;
    ilStatusBarImages: TImageList;
    dxStatusBar: TdxStatusBar;
    dxBarButtonBitmap: TdxBarButton;
    dxBarSubItemInsert: TdxBarSubItem;
    dxBarButtonChmCompiler: TdxBarButton;
    dxBarButtonchmProperty: TdxBarButton;
    dxBarButtonchmRun: TdxBarButton;
    dxBarSubItemCHM: TdxBarSubItem;
    dxBarButtonTable: TdxBarButton;
    dxBarButtonInsertRow: TdxBarButton;
    dxBarButtonInsertColumn: TdxBarButton;
    dxBarButtonDeleteRows: TdxBarButton;
    dxBarButtonDeleteColumns: TdxBarButton;
    dxBarButtonInsertCell: TdxBarButton;
    dxBarButtonDeleteCells: TdxBarButton;
    dxBarButtonMergeCells: TdxBarButton;
    dxBarButtonSplitCells: TdxBarButton;
    dxBarButtonInsertTable: TdxBarButton;
    dxBarButtonDrawTable: TdxBarButton;
    dxBarSubItemTable: TdxBarSubItem;
    dxBarButtonInsertAnchor: TdxBarButton;
    dxBarButtonInsertHTML: TdxBarButton;
    dxBarButtonInsertScript: TdxBarButton;
    dxBarButtonLineBreakNormal: TdxBarButton;
    dxBarButtonLBClearLMargin: TdxBarButton;
    dxBarButtonLBClearRMargin: TdxBarButton;
    dxBarButtonLBClearLRMargin: TdxBarButton;
    dxBarButtonInsertHLine: TdxBarButton;
    dxBarButtonInsertSymbol: TdxBarButton;
    dxBarButtonInsertLayer: TdxBarButton;
    dxBarButtontInsertButton: TdxBarButton;
    dxBarButtonInsertTextBox: TdxBarButton;
    dxBarButtonInsertCheckBox: TdxBarButton;
    dxBarButtonInsertTextArea: TdxBarButton;
    dxBarButtonInserRadioButton: TdxBarButton;
    dxBarButtonInsertComboBox: TdxBarButton;
    dxBarButtonInsertImage: TdxBarButton;
    dxBarButtonInsertPasswordBox: TdxBarButton;
    dxBarButtonInsertFileSelectBox: TdxBarButton;
    dxBarButtonInsertResetButton: TdxBarButton;
    dxBarButtonInsertSubmitButton: TdxBarButton;
    dxBarButtonInsertListBox: TdxBarButton;
    dxBarSubItem1: TdxBarSubItem;
    dxBarSubItem2: TdxBarSubItem;
    dxBarSubItem3: TdxBarSubItem;
    dxBarButtonNumberList: TdxBarButton;
    dxBarButtonOutdent: TdxBarButton;
    dxBarButtonIndent: TdxBarButton;
    dxBarButtonPageProperty: TdxBarButton;
    dxBarButtonRedo: TdxBarButton;
    dxBarComboStyle: TdxBarCombo;
    PCT: TcxPageControl;
    dxBarButton2: TdxBarButton;
    dxBarLargeButton1: TdxBarLargeButton;
    dxBarLargeButton3: TdxBarLargeButton;
    dxBarButtonStrikeThrough: TdxBarLargeButton;

    procedure FormCreate(Sender: TObject);

    procedure dxBarButtonNewClick(Sender: TObject);
    procedure dxBarButtonOpenClick(Sender: TObject);
    procedure dxBarButtonSaveClick(Sender: TObject);
    procedure dxBarButtonSaveAsClick(Sender: TObject);
    procedure dxBarButtonPrintClick(Sender: TObject);
    procedure dxBarButtonExitClick(Sender: TObject);

    procedure dxBarButtonUndoClick(Sender: TObject);
    procedure dxBarButtonCutClick(Sender: TObject);
    procedure dxBarButtonCopyClick(Sender: TObject);
    procedure dxBarButtonPasteClick(Sender: TObject);
    procedure dxBarButtonClearClick(Sender: TObject);
    procedure dxBarButtonSelectAllClick(Sender: TObject);
    procedure dxBarButtonFindClick(Sender: TObject);
    procedure dxBarButtonReplaceClick(Sender: TObject);

    procedure dxBarComboFontNameChange(Sender: TObject);
    procedure dxBarComboFontSizeChange(Sender: TObject);
    procedure dxBarButtonBoldClick(Sender: TObject);
    procedure dxBarButtonItalicClick(Sender: TObject);
    procedure dxBarButtonUnderlineClick(Sender: TObject);
    procedure dxBarComboFontColorChange(Sender: TObject);
    procedure dxBarButtonBulletsClick(Sender: TObject);
    procedure dxBarButtonAlignClick(Sender: TObject);
    procedure dxBarButtonProtectedClick(Sender: TObject);
    procedure dxBarButtonFontClick(Sender: TObject);
    procedure dxBarListWindowsGetData(Sender: TObject);
    procedure dxBarListWindowsClick(Sender: TObject);
    procedure dxBarButtonOnWebClick(Sender: TObject);
    procedure dxBarButtonEnhancedStyleClick(Sender: TObject);
    procedure dxBarMRUFilesClick(Sender: TObject);
    procedure dxBarButtonStdStyleClick(Sender: TObject);
    procedure dxBarButtonFlatStyleClick(Sender: TObject);
    procedure dxBarButtonXPStyleClick(Sender: TObject);
    procedure actAboutExecute(Sender: TObject);
    procedure dxBarButtonOffice11StyleClick(Sender: TObject);
    procedure dxBarLargeButton2Click(Sender: TObject);
    procedure dxBarButtonBitmapClick(Sender: TObject);
    procedure dxBarButtonChmCompilerClick(Sender: TObject);
    procedure dxBarButtonchmPropertyClick(Sender: TObject);
    procedure dxBarButtonTableClick(Sender: TObject);
    procedure actFilePrintExecute(Sender: TObject);
    procedure dxBarButtonHTMLObjectClick(Sender: TObject);
    procedure dxBarButtonInsertImageClick(Sender: TObject);
    procedure dxBarComboStyleChange(Sender: TObject);
    procedure PCTCanClose(Sender: TObject; var ACanClose: Boolean);
    procedure dxBarButtonOutdentClick(Sender: TObject);
    procedure dxBarButtonIndentClick(Sender: TObject);
    procedure dxBarButtonRedoClick(Sender: TObject);
    procedure dxBarLargeButton1Click(Sender: TObject);
    procedure dxBarLargeButton3Click(Sender: TObject);
    procedure dxBarButtonStrikeThroughClick(Sender: TObject);
    procedure dxBarButtonInsertHLineClick(Sender: TObject);
    procedure dxBarButtonPagePropertyClick(Sender: TObject);
    procedure dxBarButtonInsertAnchorClick(Sender: TObject);
    procedure dxBarButtonInsertTableClick(Sender: TObject);
    procedure FormShow(Sender: TObject);

  private
    FUpdating: Boolean;
    FDocPathName: OleVariant;

    function GetEditor: TRichEdit;
    function GetEditorCol: Integer;
    function GetEditorRow: Integer;
    function GetFileName: string;
    procedure SetFileName(Value: string);
    procedure FindOne(Sender: TObject);
    procedure ReplaceOne(Sender: TObject);

    function GetWebDesign: THTMLEdit;

    function SaveDocument(SaveMode: Boolean; SaveQuery: Boolean = False): Boolean;
    function GetBlockFmtNamesParam: TStrings;
    procedure UpdateState;
    procedure DHTMLEditDisplayChanged(Sender: TObject);
    procedure cxPageControlChange(Sender: TObject);
  public
    IsActiveEdit: string;
    FUser :Boolean;
    FIsMHT :Boolean;
    FDesign :Boolean;  //调用方式 
    {bin //+运行状态设计单元文件的处理}
    FDataSource:TDataSource;
    FDataField: string;
    FPasField: string;
    FKeyField: string;
    FFrmName:string;
    FUnitName:string;
    procedure HtmLoadForm(SourceTable:TDataSource; KeyField,DfmField,UnitField:string;FrmName,UnitName:string);
    procedure HtmSaveToTable(Form:TForm;SourceTable:TDataSource; KeyField,DfmField,UnitField:string;FrmName,UnitName:string); //窗体保存到数据库

    {bin //+Run}
    procedure EditorChange(Sender: TObject);
    procedure EditorSelectionChange(Sender: TObject);
    function SaveFile(ASaveAs: Boolean): Boolean;
    procedure SetModified(Value: Boolean);
    procedure ShowItems(AShow: Boolean);

    property ActiveEditor: TRichEdit read GetEditor;
    property EditorCol: Integer read GetEditorCol;
    property EditorRow: Integer read GetEditorRow;
    property FileName: string read GetFileName write SetFileName;

    property ActiveWebDesign: THTMLEdit read GetWebDesign;
  end;

var
  EchmForm: TEchmForm;

implementation

{$R *.DFM}
{$R windowsxp.res}

uses
  RichEdit, ShellAPI, EchmAbout, EchmPubfunc, ChmCompiler,
  uChmProperty, WebBrowserEdit, TableProperty , AppComm,
  EchmChild;

const
  sRichEditFoundResultCaption = 'Information';
  sRichEditTextNotFound = 'The search text is not found.';
  sRichEditReplaceAllResult = 'Replaced %d occurances.';

function HtmlToTxt(const HTMLText:string;MarkLinks:boolean):string;  //Html转Txt
const 
 CR=#13#10; 
var 
 NextToken,s0:string; 
 i:integer; 
 HelpIdx:integer; 
 inQuot:boolean;    // 去除<script>段之用 
 InputLen:integer; 
 InputIdx:integer;   // 指向输入字符的下一个待处理字符 
 inPre:boolean;     // 表示是否在<pre>...</pre>段内 
 CurrLink:string; 

 function MakeStr(C: Char; N: Integer): string; 
 begin 
  if N < 1 then Result := '' 
  else begin 
 {$IFNDEF WIN32} 
   if N > 255 then N := 255; 
 {$ENDIF WIN32} 
   SetLength(Result, N); 
   FillChar(Result[1], Length(Result), C); 
  end; 
 end; 

 function NPos(const C: string; S: string; N: Integer): Integer; 
 var 
  I, P, K: Integer; 
 begin 
  Result := 0; 
  K := 0; 
  for I := 1 to N do begin 
   P := Pos(C, S); 
   Inc(K, P); 
   if (I = N) and (P > 0) then begin 
    Result := K; 
    Exit; 
   end; 
   if P > 0 then Delete(S, 1, P) 
   else Exit; 
  end; 
 end; 

 function ReplaceStr(const S, Srch, Replace: string): string; 
 var 
  I: Integer; 
  Source: string; 
 begin 
  Source := S; 
  Result := ''; 
  repeat 
   I := Pos(Srch, Source); 
   if I > 0 then begin 
    Result := Result + Copy(Source, 1, I - 1) + Replace; 
    Source := Copy(Source, I + Length(Srch), MaxInt); 
   end 
   else Result := Result + Source; 
  until I <= 0; 
 end; 

 function UnixToDos(const s:string):string; 
 begin 
  result:=AdjustLineBreaks(s); 
 end; 

 // 取得下一段字符串 
 function GetNextToken(const s:string; const StartIdx:integer):string; 
 var 
  i:integer; 
 begin 
  if StartIdx>length(s) then 
  begin 
   result:=''; 
   exit; 
  end; 
  result:=s[StartIdx]; 
  if result='&' then 
  begin 
   for i:=StartIdx+1 to length(s) do 
   begin 
    if s[i] in ['&',' ',#13,'<'] then break; 
    result:=result+s[i]; 
    if s[i]=';' then break; 
   end; 
  end 
  else if result='<' then 
  begin 
   for i:=StartIdx+1 to length(s) do 
   begin 
    result:=result+s[i]; 
    if s[i]='>' then break; 
   end; 
  end 
  else 
  begin 
   for i:=StartIdx+1 to length(s) do 
    if s[i] in ['&','<'] then break 
    else result:=result+s[i]; 
  end; 
 end; 

 // 输入：<a href="http://anjo.delphibbs.com"> 
 // 输出：http://anjo.delphibbs.com 
 function GetLink(s:string):string; 
 var 
  LPos,RPos,LQuot,RQuot:integer; 
 begin 
   result:=''; 

  // 去掉'....<' 
  LPos:=pos('<',s); 
  if LPos=0 then exit; 
  delete(s,1,LPos); 
  s:=Trim(s); 

  // 去掉'>....' 
  RPos:=pos('>',s); 
  if RPos=0 then exit; 
  delete(s,RPos,MaxInt); 

  if uppercase(copy(s,1,2))='A ' then 
  begin 
   LPos:=pos('HREF',uppercase(s)); 
   if LPos=0 then exit; 

   LQuot:=NPos('"',s,1); 
   RQuot:=NPos('"',s,2); 

   if (LQuot<LPos) or (RQuot>RPos) then exit; 

   // 开头带'#'的超链接，视为无效 
   if s[LQuot+1]='#' then exit; 

   // 开头带'javascript:'的超链接，也视为无效 
   // 如：<div align=right><a href="javascript:window.close()"><IMG SRC="button_close.gif"></a></div> 
   if copy(s,LQuot+1,11)='javascript:' then exit; 

   result:=copy(s,LQuot+1,RQuot-LQuot-1); 
  end; 
 end; 

 // 把所有&xxx的转义；所有<xxx>取消；其它照样返回 
 function ConvertHTMLToken(const s:string;var inPre:boolean):string; 
 var 
  s0,s0_2,s0_3,s0_4:string; 
 begin 
  if s='' then 
  begin 
   result:=''; 
   exit; 
  end; 
  if s[1]='&' then 
  begin 
   s0:=lowerCase(s); 
   result:=''; 
   if s0='&nbsp;' then result:=' ' 
   else if s0='&quot;' then result:='"' 
   else if s0='&gt;' then result:='>' 
   else if s0='&lt;' then result:='<' 
   else if s0='&middot;' then result:='·' 
   else if s0='&trade;' then result:=' TM ' 
   else if s0='&copy;' then result:='(c)' 
   else if s0='&reg;' then result:='(R)' 
   else if s0='&amp' then result:='&'; 
  end 
  else if s[1]='<' then 
  begin 
   s0:=lowerCase(s); 
   s0_2:=copy(s0,1,2); 
   s0_3:=copy(s0,1,3); 
   s0_4:=copy(s0,1,4); 

   result:=''; 
   // 将所有<hr>替换成为'------' 
   if s0='<br>' then result:=CR 
   else if s0_4='<pre' then  // <pre 一定要在 <p 之前判断！ 
      begin inPre:=true;result:=CR; end 
   else if s0_2='<p' then result:=CR+CR 
   else if s0_3='<hr' then result:=CR+MakeStr('-',40)+CR 
   else if s0_3='<ol' then result:=CR 
   else if s0_3='<ul' then result:=CR 
   else if s0_3='<li' then result:='·' 
   else if s0_4='</li' then result:=CR 
   else if s0_4='</tr' then result:=CR 
   else if s0='</td>' then result:=#9 
   else if s0='<title>' then result:='《' 
   else if s0='</title>' then result:='》'+CR+CR 
   else if s0='</pre>' then inPre:=false 
   else if copy(s0,1,6)='<table' then result:=CR 
   else if MarkLinks and (s0[2]='a') then 
      begin 
       CurrLink:=GetLink(s); 
       if CurrLink<>'' then result:='['; 
      end 
   else if MarkLinks and (s0='</a>') then 
       if CurrLink<>'' then result:=format(' %s ]',[CurrLink]); 
  end 
  else if inPre then 
   result:=s 
  else // 不在<pre>..</pre>内，则删除所有CR 
   result:=ReplaceStr(s,CR,''); 
 end; 

begin 
 s0:=UnixToDos(HTMLText); 
 result:=''; 
 InputLen:=length(s0); 
 InputIdx:=1; 
 inPre:=false;