echmmain.pas

帮助编写程序

 CurrLink:=''; 

 while InputIdx<=InputLen do 
 begin 
  NextToken:=GetNextToken(s0,InputIdx); 

  // 去除<style ...> -- </style>之间的内容 
  if lowercase(copy(NextToken,1,6))='<style' then 
  begin 
   while lowercase(NextToken)<>'</style>' do 
   begin 
    inc(InputIdx,length(NextToken)); 
    NextToken:=GetNextToken(s0,InputIdx); 
   end; 
   inc(InputIdx,length(NextToken)); 
   NextToken:=GetNextToken(s0,InputIdx); 
  end; 

  // 去除<Script ...> -- </Script>之间的内容 
  if lowercase(copy(NextToken,1,7))='<script' then 
  begin 
   inc(InputIdx,length(NextToken)); 
   inQuot:=false; 
   i:=InputIdx-1; 
   while I<InputLen do 
   begin 
    inc(i); 
    if s0[i]='"' then 
    begin 
     inQuot:=not inQuot; 
     continue; 
    end; 
    if not inQuot then 
     // 去除<script>段里的<!-- ... -->注释段, 99.8.2 
     if copy(s0,i,4)='<!--' then 
     begin 
      HelpIdx:=pos('-->',copy(s0,i+4,MaxInt)); 
      if HelpIdx>0 then 
      begin 
       inc(i,4+HelpIdx+2); 
      end 
      else 
      begin 
       i:=InputLen; 
       break; 
      end; 
     end; 
     if lowercase(copy(s0,i,9))='</script>' then 
     begin 
      break; 
     end; 
   end; 
   InputIdx:=i; 
  end; 

  NextToken:=GetNextToken(s0,InputIdx);
  inc(InputIdx,length(NextToken));
  result:=result+ConvertHTMLToken(NextToken,inPre);
 end; 
end; 


function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

function TEchmForm.GetEditor: TRichEdit;
var I:integer;
    FFrame:TFrame;
begin
  if PCT.ActivePage = nil then Result := nil
  else begin
   for I:=0 to self.ComponentCount-1 do
    if self.Components[I].Name= 'EchmChildForm'+IntToStr(PCT.ActivePage.PageIndex) then
      FFrame:= TFrame(self.Components[I]);

   with FFrame do
   for I:=0 to ComponentCount-1 do
    if Components[I].InheritsFrom(TRichEdit) then
      Result :=  TRichEdit(Components[I]);
  end;
end;

function TEchmForm.GetEditorCol: Integer;
begin
  with ActiveEditor do
    Result := SelStart - SendMessage(Handle, EM_LINEINDEX, EditorRow, 0);
end;

function TEchmForm.GetEditorRow: Integer;
begin
  with ActiveEditor do
    Result := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0);
end;

function TEchmForm.GetFileName: string;
var I:integer;
begin
  if PCT.ActivePage = nil then Result := ''
  else Result :=  PCT.ActivePage.Caption;
end;

procedure TEchmForm.SetFileName(Value: string);
begin
  if PCT.ActivePage <> nil then
    PCT.ActivePage.Caption := Value;
end;

procedure TEchmForm.FindOne(Sender: TObject);
var
  StartPos, FindLength, FoundAt: Integer;
  Flags: TSearchTypes;
  P: TPoint;
  CaretR, R, IntersectR: TRect;
begin
  with ActiveEditor, TFindDialog(Sender) do
  begin
    if frDown in Options then
    begin
      if SelLength = 0 then StartPos := SelStart
      else StartPos := SelStart + SelLength;
      FindLength := Length(Text) - StartPos;
    end
    else
    begin
      StartPos := SelStart;
      FindLength := -StartPos;
    end;
    Flags := [];
    if frMatchCase in Options then Include(Flags, stMatchCase);
    if frWholeWord in Options then Include(Flags, stWholeWord);
    Screen.Cursor := crHourglass;
    FoundAt := ActiveEditor.FindText(FindText, StartPos, FindLength, Flags);
    if not (frReplaceAll in Options) then Screen.Cursor := crDefault;
    if FoundAt > -1 then
      if frReplaceAll in Options then
      begin
        SelStart := FoundAt;
        SelLength := Length(FindText);
      end
      else
      begin
        SetFocus;
        SelStart := FoundAt;
        SelLength := Length(FindText);

        GetCaretPos(P);
        P := ClientToScreen(P);
        CaretR := Rect(P.X, P.Y, P.X + 2, P.Y + 20);
        GetWindowRect(Handle, R);
        if IntersectRect(IntersectR, CaretR, R) then
          if P.Y < Screen.Height div 2 then
            Top := P.Y + 40
          else
            Top := P.Y - (R.Bottom - R.Top + 20);
      end
    else
      if not (frReplaceAll in Options) then
        Application.MessageBox(sRichEditTextNotFound,
          sRichEditFoundResultCaption, MB_ICONINFORMATION);
  end;
end;

procedure TEchmForm.ReplaceOne(Sender: TObject);
var
  ReplacedCount, OldSelStart, PrevSelStart: Integer;
  S: string;
begin
  with ActiveEditor, TReplaceDialog(Sender) do
  begin
    ReplacedCount := 0;
    OldSelStart := SelStart;
    if frReplaceAll in Options then
      Screen.Cursor := crHourglass;
    repeat
      if (SelLength > 0) and ((SelText = FindText) or
        (not (frMatchCase in Options) and
         (AnsiUpperCase(SelText) = AnsiUpperCase(FindText)))) then
      begin
        SelText := ReplaceText;
        Inc(ReplacedCount);
      end;
      PrevSelStart := SelStart;
      FindOne(Sender);
    until not (frReplaceAll in Options) or (SelStart = PrevSelStart);
    if frReplaceAll in Options then
    begin
      Screen.Cursor := crDefault;
      if ReplacedCount = 0 then S := sRichEditTextNotFound
      else
      begin
        SelStart := OldSelStart;
        S := Format(sRichEditReplaceAllResult, [ReplacedCount]);
      end;
      Application.MessageBox(PChar(S), sRichEditFoundResultCaption,
        MB_ICONINFORMATION);
    end;
  end;
end;

function TEchmForm.GetWebDesign: THTMLEdit;       //webDesign
var I:integer;
    FFrame:TFrame;
begin
  if PCT.ActivePage = nil then Result := nil
  else begin
   for I:=0 to self.ComponentCount-1 do
    if self.Components[I].Name= 'EchmChildForm'+IntToStr(PCT.ActivePage.PageIndex) then
      FFrame:= TFrame(self.Components[I]);

   with FFrame do
   for I:=0 to ComponentCount-1 do
    if Components[I].InheritsFrom(THTMLEdit) then
      Result :=  THTMLEdit(Components[I]);
  end;
end;


procedure TEchmForm.EditorChange(Sender: TObject);
begin
  if ActiveEditor = nil then Exit;

  ActiveEditor.OnSelectionChange(ActiveEditor);
  SetModified(ActiveEditor.Modified);
  dxStatusBar.Panels[3].Text :=IsActiveEdit;
  dxStatusBar.Panels[1].Text := PCT.ActivePage.Caption;
  TdxStatusBarTextPanelStyle(dxStatusBar.Panels[1].PanelStyle).ImageIndex := 0;
  TdxStatusBarTextPanelStyle(dxStatusBar.Panels[0].PanelStyle).ImageIndex := 2;
  dxBarButtonUndo.Enabled := SendMessage(ActiveEditor.Handle, EM_CANUNDO, 0, 0) <> 0;
end;

procedure TEchmForm.EditorSelectionChange(Sender: TObject);
begin
  with ActiveEditor, SelAttributes do
  begin
    FUpdating := True;
    dxBarComboFontSize.OnChange := nil;
    dxBarComboFontName.OnChange := nil;
    dxBarComboFontColor.OnChange := nil;
    try
       dxStatusBar.Panels[0].Text := Format('Line: %3d   Col: %3d', [1 + EditorRow, 1 + EditorCol]);

       dxBarButtonCopy.Enabled := SelLength > 0;
       dxBarButtonCut.Enabled := dxBarButtonCopy.Enabled;
       dxBarButtonPaste.Enabled := SendMessage(ActiveEditor.Handle, EM_CANPASTE, 0, 0) <> 0;
       dxBarButtonClear.Enabled := dxBarButtonCopy.Enabled;

       dxBarComboFontSize.Text := IntToStr(Size);
       dxBarComboFontName.Text := Name;
       dxBarComboFontColor.Color := Color;

       dxBarButtonBold.Down := fsBold in Style;
       dxBarButtonItalic.Down := fsItalic in Style;
       dxBarButtonUnderline.Down := fsUnderline in Style;

       dxBarButtonBullets.Down := Boolean(Paragraph.Numbering);
       case Ord(Paragraph.Alignment) of
         0: dxBarButtonAlignLeft.Down := True;
         1: dxBarButtonAlignRight.Down := True;
         2: dxBarButtonCenter.Down := True;
       end;
       dxBarButtonProtected.Down := Protected;
    finally
      FUpdating := False;
      dxBarComboFontSize.OnChange := dxBarComboFontSizeChange;
      dxBarComboFontName.OnChange := dxBarComboFontNameChange;
      dxBarComboFontColor.OnChange := dxBarComboFontColorChange;
    end;
  end;
end;

function TEchmForm.SaveFile(ASaveAs: Boolean): Boolean;
begin
  if ASaveAs or (FileName = '') then
  begin
    SaveDialog.FileName := FileName;
    Result := SaveDialog.Execute;
    if not Result then Exit;
    FileName := SaveDialog.FileName;
  end;
  ActiveEditor.Lines.SaveToFile(FileName);
  dxStatusBar.Panels[1].Text := PCT.ActivePage.Caption;
  SetModified(False);
  Result := True;
end;

procedure TEchmForm.SetModified(Value: Boolean);
begin
  ActiveEditor.Modified := Value;
  if Value then
  begin
    dxStatusBar.Panels[2].Text := 'Modified';
    TdxStatusBarTextPanelStyle(dxStatusBar.Panels[2].PanelStyle).ImageIndex := 1;
  end
  else
  begin
    dxStatusBar.Panels[2].Text := '';
    TdxStatusBarTextPanelStyle(dxStatusBar.Panels[2].PanelStyle).ImageIndex := 4;
  end;
  dxBarButtonSave.Enabled := Value;
end;

procedure TEchmForm.ShowItems(AShow: Boolean);
var
  AVisible: TdxBarItemVisible;
begin
  BarManager.LockUpdate := True;
  try
    if not AShow then
    begin
      dxStatusBar.Panels[0].Text := '';
      dxStatusBar.Panels[1].Text := '';
      dxStatusBar.Panels[2].Text := '';
    end;
    BarManager.Groups[0].Enabled := AShow;

    if AShow then AVisible := ivAlways
    else AVisible := ivInCustomizing;

    dxBarSubItemEdit.Visible := AVisible;
    dxBarSubItemFormat.Visible := AVisible;
  finally
    BarManager.LockUpdate := False;
  end;

  TdxStatusBarTextPanelStyle(dxStatusBar.Panels[0].PanelStyle).ImageIndex := 5;
  TdxStatusBarTextPanelStyle(dxStatusBar.Panels[1].PanelStyle).ImageIndex := 3;
  TdxStatusBarTextPanelStyle(dxStatusBar.Panels[2].PanelStyle).ImageIndex := 4;
end;

procedure TEchmForm.FormCreate(Sender: TObject);
const
  Filter = 'Rich Text Files (*.RTF)|*.RTF';
begin
  OpenDialog.Filter := Filter;
  SaveDialog.Filter := Filter;
  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  SaveDialog.InitialDir := OpenDialog.InitialDir;
  ShowItems(True);
end;

procedure TEchmForm.dxBarButtonNewClick(Sender: TObject);
var
  FFrame:TFrame;I:integer;
begin
  if FFrame <> nil then FFrame:=nil;
  with TcxTabSheet.Create(Self) do
  begin
   PageControl:=PCT;
   PCT.ActivePageIndex:= PageIndex;
   FFrame := TEchmChildForm.Create(self);
   with FFrame do begin
    Name:='EchmChildForm'+IntToStr(PageIndex);
    Parent := PCT.ActivePage;
    Align:=alClient;
    Visible := true;
    Font.Name := '宋体';
    Font.Size := 9;
    
    for I:=0 to ComponentCount-1 do
    begin
     if Components[I].InheritsFrom(TcxPageControl) then
       TcxPageControl(Components[I]).OnChange :=  cxPageControlChange;
     if Components[I].InheritsFrom(TRichEdit) then
     begin
      Caption := 'Document' + IntToStr(PCT.PageCount);
      TRichEdit(Components[I]).OnChange := EditorChange;
      TRichEdit(Components[I]).OnSelectionChange := EditorSelectionChange;
      dxBarListWindows.Items.AddObject(Caption, Self);
      TRichEdit(Components[I]).Modified;
      IsActiveEdit :='Editor';

     //  if PCT.PageCount = 1 then ShowItems(True);
         
        TRichEdit(Components[I]).Text :='<Html>'+#10  //产生网页代码模板：
        +'<Headl><Title></Title><Headl>'+#10
        +'<Body>'+#10+#10
        +'</Body>'+#10
        +'</Html>';
     end;
    end;
    
   end;

  end;
 // TEchmChildForm.Create(Application); 
end;

procedure TEchmForm.dxBarButtonOpenClick(Sender: TObject);
const
  Filter = 'HTML Documents(*.HTM,*.HTML)|*.HTM;*.HTML|*.RTF|*.RTF|*.*|*.*';
var
  FFrame:TFrame; I:integer;
begin
  if FFrame <> nil then FFrame:=nil;

  OpenDialog.Filter := Filter;
  OpenDialog.FileName := '';
  if OpenDialog.Execute then
  begin
   with TcxTabSheet.Create(Self) do
   begin
    PageControl:=PCT;
    PCT.ActivePageIndex:= PageIndex;
    FFrame := TEchmChildForm.Create(self);
    with FFrame do begin
     Name:='EchmChildForm'+IntToStr(PageIndex);
     Parent := PCT.ActivePage;
     Align:=alClient;
     Visible := true;
     Font.Name := '宋体';
     Font.Size := 9; 

     if (ExtractFileExt(OpenDialog.FileName)='.htm') or
        (ExtractFileExt(OpenDialog.FileName)='.html') then
     begin
      FDocPathName := '';
      try
       for I:=0 to ComponentCount-1 do
       begin
        if Components[I].InheritsFrom(THTMLEdit) then
        begin
         THTMLEdit(Components[I]).Open(OpenDialog.FileName);
         FDocPathName := OpenDialog.FileName;
        end;
        if Components[I].InheritsFrom(TcxPageControl) then
        begin
           TcxPageControl(Components[I]).ActivePageIndex:=0;
           TcxPageControl(Components[I]).OnChange :=  cxPageControlChange;
        end;
       end;
       Caption :=  FDocPathName;
       IsActiveEdit :='webDesign';
       except
        ShowMessage('打开文档失败');
       end;
     end else
     begin
       for I:=0 to ComponentCount-1 do
       begin
        if Components[I].InheritsFrom(TRichEdit) then
        begin
           TRichEdit(Components[I]).Lines.LoadFromFile(OpenDialog.FileName);
           TRichEdit(Components[I]).OnChange := EditorChange;
           TRichEdit(Components[I]).OnSelectionChange := EditorSelectionChange;
        end;
        if Components[I].InheritsFrom(TcxPageControl) then
        begin
           TcxPageControl(Components[I]).ActivePageIndex:=1;
           TcxPageControl(Components[I]).OnChange :=  cxPageControlChange;
        end;
       end;
      IsActiveEdit :='Editor';
      SetModified(False);
     end;

    end;
   end;
    dxBarMRUFiles.RemoveItem(OpenDialog.FileName, nil);
    dxBarListWindows.Items.AddObject(OpenDialog.FileName, Self);
  end;
end;

procedure TEchmForm.dxBarButtonSaveClick(Sender: TObject);