wpsyntaxu.pas

wptools5 pro 完整源代码 Msword界面的文本编辑器源代码

unit WPSyntaxU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WPRTEDefs, WPRTEPaint, WPCTRMemo, WPCTRRich, ExtCtrls,
  SynEditHighlighter, WPSyntaxInterface, WPGutter, ComCtrls,
  Menus, ClipBrd, WPSplash, Buttons, ShellAPI;

type
  TWPSyntaxHigh = class(TForm)
    Panel1: TPanel;
    WPRichText1: TWPRichText;
    HighlighterName: TComboBox;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    WPGutter1: TWPGutter;
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Load1: TMenuItem;
    Save1: TMenuItem;
    N1: TMenuItem;
    Close1: TMenuItem;
    Edit1: TMenuItem;
    SelectAll1: TMenuItem;
    Find1: TMenuItem;
    Replace1: TMenuItem;
    N2: TMenuItem;
    CopyasRTF1: TMenuItem;
    CopyasHTML1: TMenuItem;
    Info1: TMenuItem;
    AboutWPTools1: TMenuItem;
    Copy1: TMenuItem;
    ZoomButton: TSpeedButton;
    Thumbnails: TSpeedButton;
    NormalZoom: TSpeedButton;
    N3: TMenuItem;
    Print1: TMenuItem;
    Visithomepage1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure HighlighterNameChange(Sender: TObject);
    procedure WPRichText1BeforeInitializePar(Sender: TObject;
      RTFEngine: TWPRTFEngineBasis; RTFDataBlock: TWPRTFDataBlock;
      par: TParagraph);
    procedure WPRichText1NewRTFDataBlock(Sender: TObject;
      RTFDataBlock: TWPRTFDataBlock);
    procedure WPRichText1ChangeCursorPos(Sender: TObject);
    procedure WPRichText1Change(Sender: TObject);
    procedure WPRichText1PaintWatermark(Sender: TObject;
      RTFEngine: TWPRTFEnginePaint; toCanvas: TCanvas; PageRect: TRect;
      PaintPageNr, RTFPageNr: Integer; WaterMarkRef: TObject; XRes,
      YRes: Integer; CurrentZoom: Single; PaintMode: TWPPaintModes);
    procedure Load1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure SelectAll1Click(Sender: TObject);
    procedure Find1Click(Sender: TObject);
    procedure Replace1Click(Sender: TObject);
    procedure CopyasRTF1Click(Sender: TObject);
    procedure CopyasHTML1Click(Sender: TObject);
    procedure AboutWPTools1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure NormalZoomClick(Sender: TObject);
    procedure Print1Click(Sender: TObject);
    procedure Visithomepage1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    WPSynEditHighlight1 : TWPSynEditHighlight;
  end;

var
  WPSyntaxHigh: TWPSyntaxHigh;

implementation

uses SynHighlighterJava, SynHighlighterPAS,
     SynHighlighterXML, SynHighlighterCPP,
     SynHighlighterSQL, SynHighlighterVB,
     SynHighlighterVBScript;

{$R *.dfm}

procedure TWPSyntaxHigh.FormCreate(Sender: TObject);
var i : Integer;
begin
  WPSynEditHighlight1 := TWPSynEditHighlight.Create(Self);
  for i:=0 to GetPlaceableHighlighters.Count-1 do
    HighlighterName.Items.Add( GetPlaceableHighlighters.Items[i].GetLanguageName );
   // Default Attribute
   WPRichText1.Memo.RTFData.ANSITextAttr.SetFontName('Courier New');
   WPRichText1.Memo.RTFData.ANSITextAttr.SetFontSize(10);
end;

procedure TWPSyntaxHigh.FormDestroy(Sender: TObject);
begin
  WPSynEditHighlight1.Free;
end;

procedure TWPSyntaxHigh.HighlighterNameChange(Sender: TObject);
begin
  if WPSynEditHighlight1.SelectLanguage( HighlighterName.Text ) then
  begin
      WPSynEditHighlight1.Execute(WPRichText1.FirstPar);
      WPSynEditHighlight1.Enabled := FALSE;
      WPRichText1.ReformatAll(true, true);
      WPSynEditHighlight1.Enabled := TRUE;
  end;
  WPRichText1.SetFocus;
end;

procedure TWPSyntaxHigh.WPRichText1BeforeInitializePar(Sender: TObject;
  RTFEngine: TWPRTFEngineBasis; RTFDataBlock: TWPRTFDataBlock;
  par: TParagraph);
begin
  if WPSynEditHighlight1.HL<>nil then
      WPSynEditHighlight1.Execute(par,par.NextPar,RTFEngine);
end;

procedure TWPSyntaxHigh.WPRichText1NewRTFDataBlock(Sender: TObject;
  RTFDataBlock: TWPRTFDataBlock);
begin
  WPRichText1.Header.SetPageWH(-1,-1,360,360,360,360);
end;

procedure TWPSyntaxHigh.WPRichText1ChangeCursorPos(Sender: TObject);
begin
   StatusBar1.Panels[0].Text := #32 + IntToStr(WPRichText1.CPLineNr+1) +': ' + IntToStr(WPRichText1.CPColNr+1);
   StatusBar1.Panels[1].Text := ' Page ' + IntToStr(WPRichText1.CPPage+1);
end;

procedure TWPSyntaxHigh.WPRichText1Change(Sender: TObject);
begin
   if Copy(StatusBar1.Panels[2].Text,1,1)<>'*' then
       StatusBar1.Panels[2].Text := '*' + StatusBar1.Panels[2].Text;
end;   
            
procedure TWPSyntaxHigh.WPRichText1PaintWatermark(Sender: TObject;
  RTFEngine: TWPRTFEnginePaint; toCanvas: TCanvas; PageRect: TRect;
  PaintPageNr, RTFPageNr: Integer; WaterMarkRef: TObject; XRes,
  YRes: Integer; CurrentZoom: Single; PaintMode: TWPPaintModes);
var w : Integer;
begin
   toCanvas.Pen.Style := psSolid;
   toCanvas.Pen.Width := 0;
   toCanvas.Pen.Color := clBtnFace;
   w := MulDiv(RTFEngine.RTFData.Header.PageWidth
               -RTFEngine.RTFData.Header.RightMargin, XRes, 1440);
   toCanvas.MoveTo(PageRect.Left+w,PageRect.Top);
   toCanvas.LineTo(PageRect.Left+w,PageRect.Bottom);
end;

procedure TWPSyntaxHigh.Load1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
     WPRichText1.LoadFromFile(OpenDialog1.FileName, true, 'ANSI');
     // We do this in one loop, not for each paragraph!
     HighlighterNameChange(nil);
     WPRichText1.SetFocus;
     StatusBar1.Panels[2].Text := OpenDialog1.FileName;
     WPRichText1.ReadPrinterProperties;
  end;
end;

procedure TWPSyntaxHigh.Save1Click(Sender: TObject);
begin
  WPRichText1.Save;
end;

procedure TWPSyntaxHigh.Close1Click(Sender: TObject);
begin
   Close;
end;

procedure TWPSyntaxHigh.SelectAll1Click(Sender: TObject);
begin
  WPRichText1.SelectAll;
end;

procedure TWPSyntaxHigh.Find1Click(Sender: TObject);
begin
  WPRichText1.FindDialog;
end;

procedure TWPSyntaxHigh.Replace1Click(Sender: TObject);
begin
  WPRichText1.ReplaceDialog;
end;

procedure TWPSyntaxHigh.CopyasRTF1Click(Sender: TObject);
begin
  Clipboard.AsText := WPRichText1.AsANSIString('RTF',
    WPRichText1.IsSelected );
end;

procedure TWPSyntaxHigh.CopyasHTML1Click(Sender: TObject);
begin
  Clipboard.AsText := WPRichText1.AsANSIString('HTML-onlybody,',
    WPRichText1.IsSelected );
end;

procedure TWPSyntaxHigh.AboutWPTools1Click(Sender: TObject);
begin
  with TWPSplashForm.Create(Self) do
     ShowModal;
end;

procedure TWPSyntaxHigh.Copy1Click(Sender: TObject);
begin
  WPRichText1.CopyToClipboard(not WPRichText1.IsSelected);
end;

procedure TWPSyntaxHigh.NormalZoomClick(Sender: TObject);
begin
    if Thumbnails.Down then
         WPRichText1.LayoutMode := wpThumbNailView
    else
    begin
      WPRichText1.LayoutMode := wplayNormal;
      if ZoomButton.Down then
         WPRichText1.AutoZoom := wpAutoZoomWidth
      else
      begin
         WPRichText1.AutoZoom := wpAutoZoomOff;
         NormalZoom.Down := TRUE;
      end;
    end;
end;

procedure TWPSyntaxHigh.Print1Click(Sender: TObject);
begin
   WPRichText1.PrintDialog('');
end;

procedure TWPSyntaxHigh.Visithomepage1Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open', 'http://www.wpcubed.com/?SyntaxHigh=1','', '', SW_SHOWNORMAL );
end;

end.