mainfrm.pas

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

// Ctrl + O + O

{*
  UnitName    : MainFrm;
  Author      : liqj;
  Create date : 2006-07-12
  
 *}

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ImgList, StdActns, ActnList, ExtCtrls, StdCtrls,
  ComCtrls, OleCtrls, SHDocVw, ToolWin ,ActiveX ,AccidenceBlock ,MSHTML,
  Buttons,DB,ADODB , BaseFrm;

type
  TFrmMain = class(TFrmBase)
    ToolBar1: TToolBar;
    pcMain: TPageControl;
    tsShowHtml: TTabSheet;
    WebBrowser: TWebBrowser;
    tsRichEdit: TTabSheet;
    RichEdit: TRichEdit;
    tsMemo: TTabSheet;
    MainMenu1: TMainMenu;
    mmFile: TMenuItem;
    Open1: TMenuItem;
    SaveAs1: TMenuItem;
    SaveAs2: TMenuItem;
    N2: TMenuItem;
    Exit1: TMenuItem;
    mmEdit: TMenuItem;
    Undo1: TMenuItem;
    Delete1: TMenuItem;
    N1: TMenuItem;
    Copy1: TMenuItem;
    Cut1: TMenuItem;
    Paste1: TMenuItem;
    SelectAll1: TMenuItem;
    ActionList1: TActionList;
    FileExit: TFileExit;
    EditCut: TEditCut;
    EditCopy: TEditCopy;
    EditPaste: TEditPaste;
    EditSelectAll: TEditSelectAll;
    EditUndo: TEditUndo;
    EditDelete: TEditDelete;
    PopupMenu: TPopupMenu;
    acSelTextToMemo: TAction;
    Copy2: TMenuItem;
    Cut2: TMenuItem;
    Delete2: TMenuItem;
    SelectAll2: TMenuItem;
    N3: TMenuItem;
    pmConvHighLight: TMenuItem;
    Paste2: TMenuItem;
    acClipboardToWeb: TAction;
    Memo: TMemo;
    acClipboardToRE: TAction;
    pmacClipboardToWeb: TMenuItem;
    pmClipboardToRE: TMenuItem;
    acClipboardToHightLightToMemo: TAction;
    pmClipboardToMemo: TMenuItem;
    pmpmClipboardTo: TMenuItem;
    acGetHighLishtHead: TAction;
    acGetHighLishtEnd: TAction;
    pmGetHighLishtHead: TMenuItem;
    pmGetHighLishtEnd: TMenuItem;
    chkIsAddClip: TCheckBox;
    cbAcciType: TComboBox;
    cbConvType: TComboBox;
    acWebToHtml: TAction;
    pmWebToHtml_Memo: TMenuItem;
    btnSetting: TToolButton;
    pmHighLisht: TMenuItem;
    N5: TMenuItem;
    acFileOpen: TAction;
    acFileSave: TAction;
    acFileSaveAS: TAction;
    chkIsClearMemo: TCheckBox;
    pnlMain: TPanel;
    spSelTextToMemo: TSpeedButton;
    spClipboardToHightLightToMemo: TSpeedButton;
    spClipboardToRE: TSpeedButton;
    spClipboardToWeb: TSpeedButton;
    spWebToHtml_Memo: TSpeedButton;
    tbtnEditSelectAll: TToolButton;
    tbtnFileOpen: TToolButton;
    tbtnFileSave: TToolButton;
    lblRichEditFileName: TLabel;
    lblWebBrowser: TLabel;
    lblMemo: TLabel;
    pmSetSelectFont: TMenuItem;
    cbItem: TComboBox;
    mmTest: TMenuItem;
    mmgetClipboardFormats: TMenuItem;
    TabSheet1: TTabSheet;
    edtSrc: TEdit;
    edtDes: TEdit;
    btnTran: TButton;
    lblSrcDir: TLabel;
    lblDesDir: TLabel;
    edtExt: TEdit;
    lblFileExt: TLabel;
    lblMsg: TLabel;
    ToolButton1: TToolButton;
    pnlAccSet: TPanel;
    edtSrcFile: TEdit;
    lblSrcFile: TLabel;
    lblDesFile: TLabel;
    edtDesFile: TEdit;
    spSelectFile: TSpeedButton;
    spSaveFile: TSpeedButton;
    btnTranFile: TButton;
    chkTranView: TCheckBox;
    N4: TMenuItem;
    pmAbout: TMenuItem;
    chkHTMLFormat: TCheckBox;
    chkClipboardTextOrFmtText: TCheckBox;
    ProgressBar: TProgressBar;
    lblCurSrc: TLabel;
    lblCurDes: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure acSelTextToMemoExecute(Sender: TObject);

    procedure acGetHighLishtHeadExecute(Sender: TObject);
    procedure acGetHighLishtEndExecute(Sender: TObject);
    procedure acClipboardToWebExecute(Sender: TObject);
    procedure acClipboardToREExecute(Sender: TObject);
    procedure acWebToHtmlExecute(Sender: TObject);
    procedure btnSettingClick(Sender: TObject);
    procedure acClipboardToHightLightToMemoExecute(Sender: TObject);
    procedure acFileSaveASExecute(Sender: TObject);
    procedure acFileSaveExecute(Sender: TObject);
    procedure acFileOpenExecute(Sender: TObject);
    procedure acSelTextToMemoUpdate(Sender: TObject);
    procedure ClipboardHasData(Sender: TObject);
    procedure pmSetSelectFontClick(Sender: TObject);
    procedure mmgetClipboardFormatsClick(Sender: TObject);
    procedure cbItemDblClick(Sender: TObject);
    procedure RichEditKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnTranClick(Sender: TObject);
    procedure spSelectFileClick(Sender: TObject);
    procedure spSaveFileClick(Sender: TObject);
    procedure btnTranFileClick(Sender: TObject);
    procedure pmAboutClick(Sender: TObject);
    procedure pnlAccSetClick(Sender: TObject);
    procedure UpdateFileOpenAndSave(Sender: TObject);
    procedure lblMsgClick(Sender: TObject);
  private
    { Private declarations }
//    CurFileName :array [0..2] of string;
//    FFilter :string;
      fMoreFileProessCount :Integer;
      fNoSave :string;
      fTranMoreFileMsg :string;
      fCurSrcFile,fCurDesFile :string;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure getLangRes;override;             // 资源加载
    procedure StartIni;                        // 程序入口
    
    procedure UpdateAcciListName;              // 更新词法列表名称
    function CreateAccidence :TAccidence;
    procedure AddToMemo(const s:string);
    procedure AddToClipBoard(const FmtStr,TextStr:string);
    procedure CreateNewMenuFormPop;            // 加右键部份到主菜单
    function CurSaveFile(const FileName:string):Boolean; // 修改rtf格式字体
    procedure ModifyFont(ARichEdit :TRichEdit);

    function GetCurFilterIndexActivePageOfName:integer;  // 按活动页得到过滤的索引
    procedure getClipboardFormats;

    procedure TimerEvent(Sender: TObject);
  end;

var
  FrmMain: TFrmMain;
  
implementation

uses Clipbrd, CommonUtils, SettingFrm, Config, CommonDM ,Math, AboutFrm;

{$R *.dfm}

//const NO_SAVE ='No Save';

//----------------------------Main Form Event-------------------------------

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  StartIni;      
end;

constructor TFrmMain.Create(AOwner: TComponent);
begin   
  LoadResources; // 按配置文件决定加载语言文件。 --再处理
  inherited;     // 加载语言
end;

//--------------------------Costom Event------------------------------------
procedure TFrmMain.getLangRes;
begin
  inherited;
  fNoSave := pubGet(126) ;      // 由于使用频繁，使用成员变量
  Application.Title := pubGet(90);
  Self.Caption := pubGet(100);
  tsRichEdit.Caption := pubGet(101);
  tsShowHtml.Caption := pubGet(102);
  tsMemo.Caption := pubGet(103);
  chkIsAddClip.Caption := pubGet(104);
  chkIsClearMemo.Caption := pubGet(105);
  acSelTextToMemo.Caption := pubGet(106);
  acClipboardToHightLightToMemo.Caption := pubGet(107);
  acClipboardToRE.Caption := pubGet(108);
  acClipboardToWeb.Caption := pubGet(109);
  acWebToHtml.Caption := pubGet(110);
  acGetHighLishtHead.Caption := pubGet(111);
  acGetHighLishtEnd.Caption := pubGet(112);  
  pmSetSelectFont.Caption := pubGet(113);
  mmgetClipboardFormats.Caption := pubGet(114);
  pmHighLisht.Caption := pubGet(115);
  pmpmClipboardTo.Caption := pubGet(116);
  mmTest.Caption := pubGet(117);

  TabSheet1.Caption := pubGet(117);

  btnSetting.Caption := pubGet(118);
  btnTran.Caption := pubGet(119);
  lblSrcDir.Caption := pubGet(120);
  lblFileExt.Caption := pubGet(121);
  lblDesDir.Caption := pubGet(122);
  pnlAccSet.Caption := pubGet(123);
  lblSrcFile.Caption := pubGet(127);
  lblDesFile.Caption := pubGet(128);
  btnTranFile.Caption := pubGet(129);
  chkTranView.Caption := pubGet(130);

  pmAbout.Caption := pubGet(215);

  chkHTMLFormat.Caption := pubGet(132);
  chkClipboardTextOrFmtText.Caption := pubGet(133);
  
  // File Menu
  mmFile.Caption := pubGet(10); 
  acFileOpen.Caption := pubGet(11);
  acFileSave.Caption := pubGet(12);
  acFileSaveAs.Caption := pubGet(13);
  FileExit.Caption := pubGet(14);
  // Edit Menu
  mmEdit.Caption := pubGet(20);
  EditCopy.Caption := pubGet(21);
  EditCut.Caption := pubGet(22);
  EditPaste.Caption := pubGet(23);
  EditDelete.Caption := pubGet(24);
  EditUndo.Caption := pubGet(25);
  EditSelectAll.Caption := pubGet(26);
end;

procedure TFrmMain.StartIni;
begin
  
  RichEdit.Align := alClient;
  WebBrowser.Align := alClient;
  Memo.Align := alClient;
  RichEdit.Clear;
  Memo.Clear;     
  lblRichEditFileName.Caption := fNoSave;
  lblWebBrowser.Caption := fNoSave;
  lblMemo.Caption := fNoSave;
 
  UpdateAcciListName;
  CreateNewMenuFormPop;
  
end;


function TFrmMain.GetCurFilterIndexActivePageOfName: integer;
var
  s :string;
begin
  Result :=-1;
  s := LowerCase(pcMain.ActivePage.Name);
  if s ='tsrichedit' then
    Result := 1
  else if s = 'tsshowhtml' then
    Result := 2
  else if s = 'tsmemo' then
    Result := 3;
end;

function TFrmMain.CreateAccidence: TAccidence;
begin
  if cbConvType.ItemIndex=-1 then  cbConvType.ItemIndex :=0;
  if cbAcciType.ItemIndex =-1 then cbAcciType.ItemIndex :=0;
  Result := TAccidence.Create(cbAcciType.Text,TConvType(cbConvType.ItemIndex));
end;

procedure TFrmMain.UpdateAcciListName;
begin
  cbAcciType.Clear; 
  cbAccitype.Items.Text := gAppConfig.GetAccidenceFilesName ;  
  if cbAcciType.Items.Count >0 then  cbAcciType.ItemIndex := 0;
end;

procedure TFrmMain.CreateNewMenuFormPop;
var
  i ,j :integer;
  Item,Item2 :TMenuItem;
begin
  for i:=6 to PopupMenu.Items.Count -1 do
  begin
    Item := TMenuItem.Create(self);
    Item.Action := PopupMenu.Items[i].Action ;
    Item.Caption := PopupMenu.Items[i].Caption ;
    Item.OnClick := PopupMenu.Items[i].OnClick;
    for j:=0 to PopupMenu.Items[i].Count -1 do
    begin
      Item2 := TMenuItem.Create(self);
      Item2.Action := PopupMenu.Items[i].Items[j].Action ;
      Item2.Caption := PopupMenu.Items[i].Items[j].Caption ;
      Item2.OnClick := PopupMenu.Items[i].Items[j].OnClick;
      Item2.OnClick := PopupMenu.Items[i].Items[j].OnClick;

      Item.Add(Item2);
    end;
    MainMenu1.Items[2].Add(Item); // 2 = MainMenu1.Items.Find('PopMenu').MenuIndex ;
  end;
end;

function TFrmMain.CurSaveFile(const FileName: string): Boolean;
begin
  Result := False;
  case GetCurFilterIndexActivePageOfName of
  1:
    begin
      RichEdit.Lines.SaveToFile(FileName);
      lblRichEditFileName.Caption := FileName ;
    end;
  2:
    with TStringList.Create do
    try
      Text := GetWebSource(WebBrowser);
      SaveToFile(FileName);
    finally
      Free
    end;
  3:
    begin
      Memo.Lines.SaveToFile(FileName);
      lblMemo.Caption := FileName ;
    end;
   -1:
    Exit; 
  end;
  Result := True;
end;


procedure TFrmMain.ModifyFont(ARichEdit: TRichEdit);
begin
  with TFontDialog.Create(nil) do
  try
    Font.Assign(ARichEdit.SelAttributes);
    if Execute then
      ARichEdit.SelAttributes.Assign(Font);
  finally
    Free;
  end;
end;

procedure TFrmMain.AddToClipBoard(const FmtStr,TextStr: string);
var   // inS ,
  outS :TMemoryStream;
begin
  if FmtStr='' then Exit;
  if chkIsAddClip.Checked then
  begin
    if chkHTMLFormat.Checked and (cbConvType.ItemIndex =0) then // HTML
    begin