mainfrm.pas

一个可以把源代码以语法高亮的形式转换成HTML格式或RTF格式。

      //inS := TMemoryStream.Create;
      outS := TMemoryStream.Create ;
      try
        ///inS.Write(FmtStr[1],Length(FmtStr));
        //Ins.LoadFromFile('F:\Stud\myDelphiCode\SourceTo v1.1 (源代码转换工具)\SourceTo\Source\cnPack_Test.htm');
        ///inS.Position  :=0;
        //SetLength(s,inS.Size);
        //inS.Read(s[1],inS.Size);
        ConvertHTMLToClipBoardHtml(FmtStr,outS);  // 源码转剪贴板格式
        outS.Position :=0;
        if chkClipboardTextOrFmtText.Checked then   // 文本是否是 HTML 格式
          CopyHTMLToClipBoard(PChar(outS.Memory),outS.Size ,
            PChar(FmtStr),length(FmtStr))      // HTML格式(utf-8)与文本格式源码都放到剪贴板
        else
          CopyHTMLToClipBoard(PChar(outS.Memory),outS.Size ,
            PChar(TextStr),length(TextStr))    // HTML格式(utf-8)与原文本格式都放到剪贴板              
        //outs.Position :=0;
        //outs.SaveToFile('f:\test.htm.txt');
      finally
        //inS.Free;
        outS.Free;
      end;
    end
    else
      if chkClipboardTextOrFmtText.Checked then  
        Clipboard.AsText := FmtStr
      else
        Clipboard.AsText := TextStr;  

  end;
end;

procedure TFrmMain.AddToMemo(const s: string);
begin
  if chkIsClearMemo.Checked then
    Memo.Text := s
  else
    Memo.Lines.Add(s);
end;
         
//---------------------In Form Control Event--------------------------------

procedure TFrmMain.acSelTextToMemoExecute(Sender: TObject);
var
  Acc :AccidenceBlock.TAccidence;
  s : string;
begin
  s := '';
  try
    case GetCurFilterIndexActivePageOfName of
    1: // RichEdit1
      s := RichEdit.SelText;
  //1: // WebBrower
       // s := WebBrower.
    3: // Memo1
      s := Memo.SelText ;
    end;
  except
    s :='';
  end;
  if s = '' then exit;

  Acc := CreateAccidence;
  try
    Acc.Source.Text := s;
    Acc.Conversion(True);
    AddToMemo (Acc.Target.Text);
    AddToClipBoard(Acc.Target.Text,s);
  finally
    Acc.Free;
  end;

  //pcMain.TabIndex :=2;
  tsMemo.Show;
  lblMemo.Caption := fNoSave;
end;

procedure TFrmMain.acGetHighLishtHeadExecute(Sender: TObject);
var
  Acc :TAccidence;
  s : string;
begin
  Acc := CreateAccidence;
  try      
    s := Acc.GetConvHead;
    AddToMemo(s);
    AddToClipBoard(s,s);
  finally
    Acc.Free;
  end;
end;

procedure TFrmMain.acGetHighLishtEndExecute(Sender: TObject);
var
  Acc :TAccidence;
  s : string;
begin
  Acc := CreateAccidence;
  try
    s := Acc.GetConvEnd;
    AddToMemo (s);
    AddToClipBoard(s,s);
  finally
    Acc.Free;
  end;
end;

procedure TFrmMain.acClipboardToWebExecute(Sender: TObject);
var
//  L :TStringList;
  s :string;
  sTmp :WideString;
  uFormat :UINT;
  hData :Cardinal;
  i,Size :integer;
  P :PChar; 
begin
  // StringToWebBrowser(..);
  // CommonUtils.StringToWebBrowser(WebBrower,ClipBoard.AsText);
{  L := TStringList.Create;
  L.LoadFromFile('E:\Documents and Settings\tssi\桌面\aaa.htm');
  s := L.Text ;
  L.Free;  }
  //
  s := '';
  if OpenClipboard(0) then
  begin
    try
      uFormat := RegisterClipboardFormat('HTML Format');
      if IsClipboardFormatAvailable(uFormat) then
      begin
        hData := GetClipboardData(uFormat);
        P :=PChar(GlobalLock(hData));
        try     
          i :=Pos('EndHTML:',StrPas(P));
          i := StrToInt(Copy(StrPas(P),i+8,9));
          s := Copy(StrPas(P),1,i);
          Size := Length(s);     
          SetLength(sTmp,Size);
          Size :=Utf8ToUnicode(PWideChar(sTmp),Size +1,PChar(s),Size);
          if Size>0 then 
            SetLength(sTmp,Size)
          else
            SetLength(sTmp,0);  
          i := Pos('<html',LowerCase(sTmp));   // 开始位置 HTMLStartPos
          s := Copy(sTmp,i,Size - i);
        finally
          GlobalUnlock(hData); 
        end;      
      end;      
    finally
      CloseClipboard;
    end;
  end;  
  if s ='' then 
  begin
    s := ClipBoard.AsText;
    ShowDlg(pubGet(137));
  end;  
  WriteWebBrowser(WebBrowser,{s} s);
  //StringToWebBrowser(WebBrowser,{s} ClipBoard.AsText);
  //pcMain.TabIndex := 1;
  tsShowHtml.Show;
  lblWebBrowser.Caption := fNoSave;
end;

procedure TFrmMain.acClipboardToREExecute(Sender: TObject);
var
  Str :TStrings;
  SM :TMemoryStream;
begin
  if ClipBoard.AsText <> '' then
  begin
    RichEdit.Clear;
    Str := TStringList.Create;
    Str.Text := ClipBoard.AsText ;
    SM := TMemoryStream.Create;
    try
      Str.SaveToStream(SM);
      SM.Position :=0;
      RichEdit.Lines.LoadFromStream(SM);
    finally
      SM.Free;
      Str.Free;
    end;
  end;
  //pcMain.TabIndex := 0;
  tsRichEdit.Show;
  lblRichEditFileName.Caption := fNoSave;  
end;

procedure TFrmMain.acWebToHtmlExecute(Sender: TObject);
var
  Dir,ToDir,AccName,Exts :string;
  Cnt ,i:Integer;
begin
  i := MessageBox(0,PChar(pubGet(136)),PChar(pubGet(4)),MB_YesNoCancel);
  if i = id_Cancel then Exit;
  //if i = id_Yes then 
  //  AddToMemo(GetWebSourceText(nil,'E:\Test2\CnWizMultiLang.html'))
  //else
  AddToMemo(GetWebSource(WebBrowser,i=id_Yes));
  //pcMain.TabIndex := 2;
  tsMemo.Show;
  lblMemo.Caption := fNoSave; 
{  Dir := 'C:\Program Files\Borland\Delphi7\Projects\CnWizards';
  ToDir := 'E:\Test\';
  AccName := 'Delphi';
  Exts := '.pas';
  ConvertFilesToDir(Dir,Exts,ToDir,AccName,TConvType(0),Cnt);
  ShowMessage('转换的文件数量：'+ IntToStr(Cnt));   }
end;

procedure TFrmMain.btnSettingClick(Sender: TObject);
begin
{  Clipboard.Open;
  EmptyClipboard;
  Clipboard.Close;}
  FormShowModal(TFrmSetting);
  UpdateAcciListName;
end;

procedure TFrmMain.acClipboardToHightLightToMemoExecute(Sender: TObject);
var
  Acc :TAccidence;
begin
  if Clipboard.AsText <>'' then
  begin
    Acc := CreateAccidence;
    try
      Acc.Source.Text := Clipboard.AsText;
      Acc.Conversion(True);
      AddToMemo (Acc.Target.Text);
      AddToClipBoard(Acc.Target.Text,Acc.Source.Text);
    finally
      Acc.Free;
    end;
  end;
  //pcMain.TabIndex := 2;
  tsMemo.Show;
  lblMemo.Caption := fNoSave;
end;

procedure TFrmMain.acFileOpenExecute(Sender: TObject);
var
  i :integer;
  sFileName :string;
begin
  i := GetCurFilterIndexActivePageOfName ;
  if i=-1 then Exit; // 不看到时不能操作
  if DMCommon.ExecOpenFile(pubGet('DialogFilter'),i,sFileName) then
  begin
    case GetCurFilterIndexActivePageOfName of
    1:
      begin
        RichEdit.Lines.LoadFromFile(sFileName);
        lblRichEditFileName.Caption := sFileName ;
      end;
    2:
      begin
        WebBrowser.Navigate(sFileName);
        lblWebBrowser.Caption := sFileName ;
      end;
    3:
      begin
        Memo.Lines.LoadFromFile(sFileName);
        lblMemo.Caption := sFileName ;
      end;
    end;
  end;
end;

procedure TFrmMain.acFileSaveASExecute(Sender: TObject);
var
  i :integer;
  s ,sFileName :string;
begin
  i := GetCurFilterIndexActivePageOfName;
  if i=-1 then Exit;
  if DMCommon.ExecSaveFile(pubGet('DialogFilter'),i,sFileName) then
  begin
    s := LowerCase(ExtractFileExt(sFileName));
    if (i =1) and (s <>'.rtf') then
      s := sFileName + '.rtf'
    else if (i =2) and (s<>'.htm') and (s<>'.html') then
      s := sFileName + '.htm'
    else
      s := sFileName;
    CurSaveFile(s);
  end;
end;

procedure TFrmMain.acFileSaveExecute(Sender: TObject);
begin
  case GetCurFilterIndexActivePageOfName of
  1:
    if lblRichEditFileName.Caption =fNoSave then
      acFileSaveASExecute(Sender)
    else
      CurSaveFile(lblRichEditFileName.Caption);
  2:
    if lblWebBrowser.Caption = fNoSave then
      acFileSaveASExecute(Sender)
    else
      CurSaveFile(lblWebBrowser.Caption);
  3:
    if lblMemo.Caption = fNoSave then
      acFileSaveASExecute(Sender)
    else
      CurSaveFile(lblMemo.Caption);
  end;    
end;

procedure TFrmMain.acSelTextToMemoUpdate(Sender: TObject);
begin
  acSelTextToMemo.Enabled :=
    ((GetCurFilterIndexActivePageOfName =1) and (RichEdit.SelLength >0)) or
    ((GetCurFilterIndexActivePageOfName =3) and (Memo.SelLength >0));
end;

procedure TFrmMain.ClipboardHasData(Sender: TObject);
begin
  if Sender is TAction then
  try
    TAction(Sender).Enabled := IsClipboardFormatAvailable(CF_TEXT) or
       IsClipboardFormatAvailable(RegisterClipboardFormat('HTML Format'));
    //Clipboard.AsText <>''; //ToDo: 有时会不能访问，who?
    //OutputDebugString(PChar('ClipboardHasData:'+ BoolToStr(TAction(Sender).Enabled,True)));
  except
    TAction(Sender).Enabled := False;
  end;
end;

procedure TFrmMain.pmSetSelectFontClick(Sender: TObject);
begin
  if RichEdit.SelLength >0 then
    ModifyFont(RichEdit);
end;

procedure TFrmMain.getClipboardFormats;
var
  uFormat  : Cardinal;
  hData : THandle ;
  P : PChar;
  arrFormatName :array [0..79] of char;
  Name : string;
  IsHtmlFmt :Boolean;
begin
  if CountClipboardFormats =0 then Exit;
  if Not OpenClipboard(Handle) then Exit;
  try
    if chkIsClearMemo.Checked then cbItem.Clear;
    if chkIsClearMemo.Checked then Memo.Clear;
    uFormat := EnumClipboardFormats(0);
    while uFormat>0 do
    begin
      if Not IntToIdent(uFormat,Name,PriorityClipboardFormat) then  // 自定义格式 值，名称对 MapEntry
      //  PriorityClipboardFormat :array[1..27] of TIdentMapEntry =(
      //  (Value: CF_TEXT;            Name:'CF_TEXT'),
      //  (Value: CF_BITMAP;          Name:'CF_BITMAP'),
      //   ...... 27项, CF_TEXT 等等 参考 windows单元
      begin
        if GetClipboardFormatName(uFormat,arrFormatName,SizeOf(arrFormatName))=0 then
          arrFormatName :='(unknown)'#0;
        Name := StrPas(arrFormatName);
      end;
      IsHtmlFmt := Name='HTML Format';
      
      Name :=Format('%6.d : %s', [uFormat,Name]);
      cbItem.Items.Add(Name);

      hData := GetClipboardData(uFormat);
      P := PChar(GlobalLock(hData));
      try
      {  if IsHtmlFmt then
        begin
          with TStringList.Create do
          try          
            Text :=StrPas(P);
            SaveToFile('E:\Documents and Settings\tssi\桌面\aaa.txt'); 
          finally
            Free;
          end;  
        end;   }
        Memo.Lines.Add(Name + ' :--------------start---------------------');
        Memo.Lines.Add(StrPas(P));   // 取数据到 #0