tbxd_u1.pas

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

procedure TWPTBXForm.TBXLink1Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open',
    'http://www.wpcubed.com/products/wptools5/', nil, nil, SW_SHOW);
end;

procedure TWPTBXForm.WPRichText1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var mergefield: TWPTextObj;
begin
  // CodeInsideOf only checks for one type of field. This is useful for
  // merge fields because they could contain hyperlinks. If we would search
  // for 'any kind' of field - we would find the most inner first
  mergefield := WPRichText1.CodeInsideOf(x, y, wpobjMergeField);
  if mergefield <> nil then
  begin
    StatusBar1.Panels[1].Text := 'Field: ' + mergefield.Name;
    // Using this code you can read out the actual CONTENTS of the field
    //  + '-->' + Copy(mergefield.EmbeddedText,1,30) + '...';
  end else StatusBar1.Panels[1].Text := '';
end;

// Give some info about this paragraph

procedure TWPTBXForm.ShowParPrpClick(Sender: TObject);
var x, y, w, h, x1, y1, w1, h1: Integer; s: string;
begin
   // Get Rect of first line
  WPRichText1.GetTextScreenRect(
    WPRichText1.ActiveParagraph,
    0,
    x, y, w, h);
   // Get Rect of last Line
  WPRichText1.GetTextScreenRect(
    WPRichText1.ActiveParagraph,
    MaxInt,
    x1, y1, w1, h1);
   // Paint the rectangle
  WPRichText1.Canvas.Brush.Style := bsClear;
  WPRichText1.Canvas.Pen.Color := clRed;
  WPRichText1.Canvas.Pen.Width := 0;
  WPRichText1.Canvas.Rectangle(x, y, x1 + w1, y1 + h1);

  s := WPRichText1.ActiveParagraph.AGetWPSS(true, true, true) +
    #13 + #10 + 'Style=' + WPRichText1.ActiveParagraph.ABaseStyleString;
   // Show the WPCSS - which contains all the properties for this paragraph
  ShowMessage(s);
  WPRichText1.Invalidate;
end;

// Give some info about this text

procedure TWPTBXForm.TBXItem12Click(Sender: TObject);
var s, w: WideString;
  i, d: Integer;
begin
  s := '';
  d := WPRichText1.TextCursor.DropMarker;
  for i := 1 to 10 do
  begin
    w := WPRichText1.CPWideChar;
    if w = #9 then w := 'TAB'
    else if w = #10 then w := 'NL'
    else if w = #13 then w := #13 + 'CR';
    s := s + w + '=' + IntToStr(Integer(WPRichText1.CPWideChar)) + ', ';
    if not WPRichText1.CPMoveNext then Break;
  end;
  WPRichText1.TextCursor.GotoMarker(true, d);
  ShowMessage(s);
  WPRichText1.SetFocus;
end;

procedure TWPTBXForm.WPRichText1TextObjectClick(Sender: TWPCustomRtfEdit;
  pobj: TWPTextObj; obj: TWPObject; var ignore: Boolean);
begin
  if (pobj.ObjType = wpobjReference) and (pobj.CParam >= 0) then
    WPRichText1.PageNumber := pobj.CParam
  else
    if pobj.ObjType <> wpobjImage then
    begin
      ShowMessage('Embedded code object:' + #13 + #10 +
        WPTextObjTypeNames[pobj.ObjType] + #13 + #10 +
        pobj.AGetWPSS);
      ignore := TRUE;
    end;
end;

procedure TWPTBXForm.WPRichText1TextObjectDblClick(
  Sender: TWPCustomRtfEdit; pobj: TWPTextObj; obj: TWPObject;
  var ignore: Boolean);
begin
  if pobj.ObjType = wpobjImage then
  begin
    if pobj.ObjRef <> nil then pobj.ObjRef.Edit;
    ignore := TRUE;
  end;
end;

procedure TWPTBXForm.WPRichText1ChangeCursorPos(Sender: TObject);
begin
  if ThumbWindow.Visible then
  begin
    WPPreview1.PageNumber := WPRichText1.PageNumber;
    WPPreview1.Memo.SelectedPage := WPRichText1.PageNumber;
  end;
  StatusBar1.Panels[0].Text := 'Page ' + IntToStr(WPRichText1.CPPage + 1)
    + ' Line ' + IntToStr(WPRichText1.CPLineNr + 1);


end;

procedure TWPTBXForm.TBXItem13Click(Sender: TObject);
var
  par: TParagraph;
  empty: Boolean;
  i: Integer;
begin
  ShowMessage('This Procedure deletes paragraphs which are empty except for mailmerge markers');
  par := WPRichText1.FirstPar;
  while par <> nil do
  begin
    if (par.Cell = nil) and par.HasObjects(false, [wpobjMergeField]) then
    begin
      empty := TRUE;
      for i := 0 to par.CharCount do
        if (par.CharItem[i] > #32) or
          ((par.ObjectRef[i] <> nil) and
          (par.ObjectRef[i].ObjType <> wpobjMergeField)) then
          empty := FALSE;
    end else empty := FALSE;

    if empty then par := par.DeleteParagraph
    else par := par.next;
  end;
  WPRichText1.ReformatAll;
end;

procedure TWPTBXForm.TBXItem28Click(Sender: TObject);
var msg: string;
begin
  msg :=
    'This demo was compiled with WPTools ' +
    WPToolsVersion
{$IFDEF WPPREMIUM} + ' PREMIUM'{$ENDIF}
  + #13 + #10 +
    'Copyright(C) 2004 by WPCubed GmbH' + #13 + #10 +
    'mailto: [e-mail]' + #13 + #10 + #13 +
    'Info about "TBX": http://www.g32.org';

{$IFDEF WITHSPLASH}
  with TWPSplashForm.Create(Self) do
  begin
    InfoLabel.Font.Size := 7;
    InfoLabel.Caption := msg;
    ShowModal;
  end;
{$ELSE}
  ShowMessage(msg);
{$ENDIF}
end;

procedure TWPTBXForm.WPPreview1Click(Sender: TWPCustomRtfEdit; PageNo, X,
  Y: Integer; var Ignore: Boolean);
begin
  if WPPreview1.MousePage >= 0 then
    WPRichText1.PageNumber := WPPreview1.MousePage;
  WPPreview1.Memo.SelectedPage := WPRichText1.PageNumber;
end;

procedure TWPTBXForm.TBXItem5Click(Sender: TObject);
begin
  Close;
end;

procedure TWPTBXForm.StyleComboDrawItem(Sender: TTBXCustomList;
  ACanvas: TCanvas; ARect: TRect; AIndex, AHoverIndex: Integer;
  var DrawDefault: Boolean);
begin
  // ACanvas.Brush.Color := clWindow;
  // ACanvas.FillRect(ARect);
  WPRichText1.ParStylePaint(
    StyleCombo.Strings[AIndex],
    ACanvas,
    ARect
    );
  DrawDefault := FALSE;
end;

procedure TWPTBXForm.WPRichText1OpenDialog(Sender: TObject;
  DiaType: TWPCustomRtfEditDialog; var ResultValue: Boolean);
begin
  WPStyleOpenDialog(Self, Sender, DiaType, ResultValue);
end;

procedure TWPTBXForm.TBXItem3Click(Sender: TObject);
begin
  WPStyleDlg1.Execute;
end;

procedure TWPTBXForm.WPRichText1DelayedUpdate(Sender: TObject;
  var WPUPD_Code: Integer; Param: Integer);
begin
  if WPUPD_Code = WPUPD_AFTER_REORDERPAGES then
    WPPreview1.Refresh;
end;

procedure TWPTBXForm.TBXItem43Click(Sender: TObject);
begin
  WPRichText1.PrintDialog;
end;

procedure TWPTBXForm.TBXItem31Click(Sender: TObject);
begin
  WPRichText1.CreateTableOfContents('', '_Toc',
    [wptocUseParIsOutline, wptocCreateOutlineBookmarks, wptocCreateHyperlinks], nil, '');
end;

procedure TWPTBXForm.TBXItem78Click(Sender: TObject);
var i: Integer;
begin
  WPRichText1.ActiveParagraph.ASet(WPAT_ParIsOutline, 1);
  if WPRichText1.FieldExists(WPTOC_FIELDNAME) then
  begin
    i := WPRichText1.TextCursor.DropMarker;
    WPRichText1.CreateTableOfContents('', '_Toc',
      [wptocUseParIsOutline, wptocCreateOutlineBookmarks, wptocCreateHyperlinks], nil, '');
    WPRichText1.TextCursor.GotoMarker(i);
  end;
end;

procedure TWPTBXForm.TBXItem77Click(Sender: TObject);
var i: Integer;
begin
  WPRichText1.ActiveParagraph.ADel(WPAT_ParIsOutline);
  if WPRichText1.FieldExists(WPTOC_FIELDNAME) then
  begin
    i := WPRichText1.TextCursor.DropMarker;
    WPRichText1.CreateTableOfContents('', '_Toc',
      [wptocUseParIsOutline, wptocCreateOutlineBookmarks, wptocCreateHyperlinks], nil, '');
    WPRichText1.TextCursor.GotoMarker(i);
  end;
end;

procedure TWPTBXForm.WPRichText1HyperLinkEvent(Sender: TObject; text,
  url: string; IgnoredNumber: Integer);
begin
  FVisitedHyperlinks.Add(url);
  if Pos('www', url) > 0 then
    ShellExecute(Handle, 'open', PChar(url), '', '', WM_SHOWWINDOW)
  else WPRichText1.BookmarkMoveTo(url);
end;

procedure TWPTBXForm.CharModeClick(Sender: TObject);
begin
  if WPRichText1.SelectedObject <> nil then
    case (Sender as TComponent).Tag of
      1: WPRichText1.SelectedObject.PositionMode := wpotChar;
      2:
        begin
          WPRichText1.SelectedObject.Wrap := wpwrAutomatic;
          WPRichText1.SelectedObject.PositionMode := wpotPar;
        end;
      3:
        begin
          WPRichText1.SelectedObject.Wrap := wpwrBoth;
          WPRichText1.SelectedObject.PositionMode := wpotPar;
        end;
      4:
        begin
          WPRichText1.SelectedObject.Wrap := wpwrNone;
          WPRichText1.SelectedObject.PositionMode := wpotPage;
        end;
      5:
        begin
          WPRichText1.SelectedObject.Wrap := wpwrBoth;
          WPRichText1.SelectedObject.PositionMode := wpotPage;
        end;
    end;
end;

procedure TWPTBXForm.WPRichText1ChangeSelection(Sender: TObject);
begin
  GrSubMenu.Enabled := WPRichText1.SelectedObject <> nil;
end;

procedure TWPTBXForm.TBXItem15Click(Sender: TObject);
begin
  WPPreviewDlg1.Show;
end;

procedure TWPTBXForm.WPRichText1PaintWatermark(Sender: TObject;
  RTFEngine: TWPRTFEnginePaint; toCanvas: TCanvas; PageRect: TRect;
  PaintPageNr, RTFPageNr: Integer; WaterMarkRef: TObject; XRes,
  YRes: Integer; CurrentZoom: Single; PaintMode: TWPPaintModes);
  // ~~~~~~~~~~~~~~~~~~~~~ Convert CM values into pixel ~~~~~~~~~~~~~
  function XP(cm: Double): Integer;
  begin
    Result := MulDiv(WPCentimeterToTwips(cm), Xres, 1440);
  end;
  function YP(cm: Double): Integer;
  begin
    Result := MulDiv(WPCentimeterToTwips(cm), Yres, 1440);
  end;
  // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var x, y: Integer;
  bit, bit1, bit2: TJPEGImage;
  Mult: Single;
  s: string;
begin

 { //DEBUGINFO: Print info about that page and section
  if RTFPageNr>0 then
  begin
     if WPRIchText1.DisplayedText.Pages[RTFPageNr-1].StartPar<>nil
     then s := Copy(WPRIchText1.DisplayedText.Pages[RTFPageNr-1].StartPar.GetText,1,20)
     else s := '';

     toCanvas.TextOut(
         PageRect.Left, PageRect.Top,
         IntToStr(
           WPRIchText1.DisplayedText.Pages[RTFPageNr-1].SectionID
           )  +s
       );
  end; }


  if not BackImg.Checked then exit; // SWITH

  if wppInPaintDesktop in PaintMode then // ONLY ON SCREEN!!!
  begin
    Mult := XRes / Screen.PixelsPerInch;
    x := PageRect.Left;
    bit1 := Image1.Picture.Graphic as TJPEGImage;
    bit2 := Image2.Picture.Graphic as TJPEGImage;
    bit := bit1;

    if bit = nil then exit;

    if Abs(Mult - 1) < 0.01 then
      while x < PageRect.Right do
      begin
        y := PageRect.Top;
        while y < PageRect.Bottom do
        begin
          toCanvas.Draw(x, y, bit);
          inc(y, bit.Height);
        end;
        inc(x, bit.Width);
        bit := bit2;
      end else
      while x < PageRect.Right do
      begin
        y := PageRect.Top;
        while y < PageRect.Bottom do
        begin
          toCanvas.StretchDraw(Rect(x, y, Round(x + bit.Width * mult), Round(y + bit.Height * mult)), bit);
          inc(y, Round(bit.Height * mult));
        end;
        inc(x, Round(bit.Width * mult));
        bit := bit2;
      end
  end;
end;

procedure TWPTBXForm.BackImgClick(Sender: TObject);
begin
  BackImg.Checked := not BackImg.Checked;
  WPRichText1.RePaint;
end;


// Only in Professional Edition

procedure TWPTBXForm.TBXItem36Click(Sender: TObject);
{$IFNDEF WPPREMIUM}
begin
  ShowMessage('Textboxes are supported in optional Premium Edition only.');
end;
{$ELSE}
var obj: TWPORTFTextBox;
begin
  obj := TWPORTFTextBox.Create(WPRichText1);
  obj.WidthTW := 3000;
  obj.HeightTW := 3000;
  obj.ObjName := 'TEXTBOX' + IntToStr(GetTickCount);
  obj.AsString := '<b>Textboxes</b> are available in WPTools <span style="color:red"><i>Premium</i></span> <u>only</u>!';
  WPRichText1.TextObjects.InsertMovableImage(obj);
end;
{$ENDIF}

var fnr: Integer;

procedure TWPTBXForm.Button3Click(Sender: TObject);
begin
end;

// attached with: WPRichText1.Memo.OnSpellCheckWord := DoSpellCheckWord;

procedure TWPTBXForm.DoSpellCheckWord(Sender: TObject;
  var word: WideString;
  var resultvalue: TSpellCheckResult;
  var hyphen_pos: TSpellCheckHyphen;
  par: TParagraph;
  posinpar: Integer
  );
begin
  if Word <> 'misspelled' then
  begin
    resultvalue := [];
  end
  else
  begin
    resultvalue := [spMisSpelled];
  end;
end;

procedure TWPTBXForm.TBXItem50Click(Sender: TObject);
begin
  WPRichText1.MergeText;
  WPRichText1.DelayedReformat;
end;

procedure TWPTBXForm.WPRichText1MailMergeGetText(Sender: TObject;
  const inspname: string; Contents: TWPMMInsertTextContents);
var s: string;
  img: TWPObject;
begin
  if inspname = 'LOGO' then
  begin
    img := TWPOImage.Create(WPRichText1);
    img.Picture.Assign(Image1.Picture);
    img.WidthTW := img.ContentsWidth;
    img.HeightTW := img.ContentsHeight;
    Contents.obj := img;
  end else
  begin
    s := IntToStr(Random(10000000));
    Contents.WideStringValue := '漩