jvrichedit.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvRichEd.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
Portions created by S閎astien Buysse are Copyright (C) 2001 S閎astien Buysse.
All Rights Reserved.

Contributor(s):
  Polaris Software
  S閎astien Buysse [sbuysse att buypin dott com] (original code in JvRichEdit.pas)
  Michael Beck [mbeck att bigfoot dott com] (contributor to JvRichEdit.pas)
  Roman Kovbasiouk [roko att users dott sourceforge dott net] (merging JvRichEdit.pas)
  Remko Bonte [remkobonte att myrealbox dott com] (insert image procedures, MS Text converters)
  Jacob Boerema [jgboerema att hotmail dott com] (indentation style, zoom, tab styles)

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvRichEdit.pas,v 1.69 2005/03/09 14:57:29 marquardt Exp $

unit JvRichEdit;

{$I jvcl.inc}
{$I windowsonly.inc}

{$RANGECHECKS OFF}

interface

{$HPPEMIT '#define CHARFORMAT2A Richedit::CHARFORMAT2A'}

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, ActiveX, ComObj, CommCtrl, Messages, SysUtils, Classes, Controls,
  Forms, Graphics, StdCtrls, Dialogs, RichEdit, Menus, ComCtrls, SyncObjs,
  JVCLVer, JvExStdCtrls;

type
  TRichEditVersion = 1..4;

  // Polaris
  //  TCharFormat2 = TCharFormat2A;

type
  TJvCustomRichEdit = class;

  TJvAttributeType = (atDefaultText, atSelected, atWord);
  TJvConsistentAttribute = (caBold, caColor, caFace, caItalic, caSize,
    caStrikeOut, caUnderline, caProtected, caOffset, caHidden, caLink,
    caBackColor, caDisabled, caWeight, caSubscript, caRevAuthor);
  TJvConsistentAttributes = set of TJvConsistentAttribute;
  TSubscriptStyle = (ssNone, ssSubscript, ssSuperscript);
  TUnderlineType = (utNone, utSolid, utWord, utDouble, utDotted, utDash,
    utDashDot, utDashDotDot, utWave, utThick);
  TUnderlineColor = (ucBlack, ucBlue, ucAqua, ucLime, ucFuchsia, ucRed,
    ucYellow, ucWhite, ucNavy, ucTeal, ucGreen, ucPurple, ucMaroon, ucOlive,
    ucGray, ucSilver);

  TJvTextAttributes = class(TPersistent)
  private
    FRichEdit: TJvCustomRichEdit;
    FType: TJvAttributeType;
    procedure AssignFont(Font: TFont);
    procedure GetAttributes(var Format: TCharFormat2);
    procedure SetAttributes(var Format: RichEdit.TCharFormat2);
    function GetAttribute(const Flag: Integer): Boolean;
    function GetBackColor: TColor;
    function GetCharset: TFontCharset;
    function GetColor: TColor;
    function GetConsistentAttributes: TJvConsistentAttributes;
    function GetDisabled: Boolean;
    function GetHeight: Integer;
    function GetHidden: Boolean;
    function GetLink: Boolean;
    function GetName: TFontName;
    function GetOffset: Integer;
    function GetPitch: TFontPitch;
    function GetProtected: Boolean;
    function GetRevAuthorIndex: Byte;
    function GetSize: Integer;
    function GetStyle: TFontStyles;
    function GetSubscriptStyle: TSubscriptStyle;
    function GetUnderlineColor: TUnderlineColor;
    function GetUnderlineType: TUnderlineType;
    procedure SetAttribute(const Flag: Integer; const Value: Boolean);
    procedure SetBackColor(Value: TColor);
    procedure SetCharset(Value: TFontCharset);
    procedure SetColor(Value: TColor);
    procedure SetDisabled(Value: Boolean);
    procedure SetHeight(Value: Integer);
    procedure SetHidden(Value: Boolean);
    procedure SetLink(Value: Boolean);
    procedure SetName(Value: TFontName);
    procedure SetOffset(Value: Integer);
    procedure SetPitch(Value: TFontPitch);
    procedure SetProtected(Value: Boolean);
    procedure SetRevAuthorIndex(Value: Byte);
    procedure SetSize(Value: Integer);
    procedure SetStyle(Value: TFontStyles);
    procedure SetSubscriptStyle(Value: TSubscriptStyle);
    procedure SetUnderlineColor(const Value: TUnderlineColor);
    procedure SetUnderlineType(Value: TUnderlineType);
  protected
    procedure InitFormat(var Format: RichEdit.TCharFormat2);
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create(AOwner: TJvCustomRichEdit; AttributeType: TJvAttributeType);
    procedure Assign(Source: TPersistent); override;
    property BackColor: TColor read GetBackColor write SetBackColor;
    property Charset: TFontCharset read GetCharset write SetCharset;
    property Color: TColor read GetColor write SetColor;
    property ConsistentAttributes: TJvConsistentAttributes read GetConsistentAttributes;
    property Disabled: Boolean read GetDisabled write SetDisabled;
    property Height: Integer read GetHeight write SetHeight;
    property Hidden: Boolean read GetHidden write SetHidden;
    property Link: Boolean read GetLink write SetLink;
    property Name: TFontName read GetName write SetName;
    property Offset: Integer read GetOffset write SetOffset;
    property Pitch: TFontPitch read GetPitch write SetPitch;
    property Protected: Boolean read GetProtected write SetProtected;
    property RevAuthorIndex: Byte read GetRevAuthorIndex write SetRevAuthorIndex;
    property Size: Integer read GetSize write SetSize;
    property Style: TFontStyles read GetStyle write SetStyle;
    property SubscriptStyle: TSubscriptStyle read GetSubscriptStyle write SetSubscriptStyle;
    property UnderlineColor: TUnderlineColor read GetUnderlineColor write SetUnderlineColor;
    property UnderlineType: TUnderlineType read GetUnderlineType write SetUnderlineType;
    property Bold: Boolean index CFE_BOLD read GetAttribute write SetAttribute;
    property Italic: Boolean index CFE_ITALIC read GetAttribute write SetAttribute;
    property Underline: Boolean index CFE_UNDERLINE read GetAttribute write SetAttribute;
    property StrikeOut: Boolean index CFE_STRIKEOUT read GetAttribute write SetAttribute;
  end;

  TJvNumbering = (nsNone, nsBullet, nsArabicNumbers, nsLoCaseLetter,
    nsUpCaseLetter, nsLoCaseRoman, nsUpCaseRoman);
  TJvNumberingStyle = (nsParenthesis, nsPeriod, nsEnclosed, nsSimple);
  TParaAlignment = (paLeftJustify, paRightJustify, paCenter, paJustify);
  TLineSpacingRule = (lsSingle, lsOneAndHalf, lsDouble, lsSpecifiedOrMore,
    lsSpecified, lsMultiple);
  THeadingStyle = 0..9;
  TParaTableStyle = (tsNone, tsTableRow, tsTableCellEnd, tsTableCell);

  TJvIndentationStyle = (isRichEdit, isOffice); // added by J.G. Boerema
  // TJvIndentationStyle: default is isRichEdit
  // - isRichEdit: LefIndent relative to FirstIndent
  // - isOffice: FirstIndent relative to LeftIndent (like MsWord and WordPad)
  // For example when FirstIndent=2 and LeftIndent=1 the effect is:
  // isRichEdit: first line starts at 2 and following lines at 3
  // isOffice: first line starts at 3 and following lines at 1

  //  From Msdn PARAFORMAT info:
{
   Rich Edit 2.0: For compatibility with TOM interfaces, you can use the eight
   high-order bits to store additional information about each tab stop.

   Bits 24-27 can specify one of the following values to indicate the tab alignment.
   These bits do not affect the rich edit control display for versions earlier
   than Rich Edit 3.0. [Note J.G.Boerema: This information is incorrect! At
   least, my version of Rich Edit 3 shows all tabs as ordinary tabs.]
   0    Ordinary tab
   1    Center tab
   2    Right-aligned tab
   3    Decimal tab
   4    Word bar tab (vertical bar)

   Bits 28-31 can specify one of the following values to indicate the type of tab leader.
   These bits do not affect the rich edit control display.
   0    No leader
   1    Dotted leader
   2    Dashed leader
   3    Underlined leader
   4    Thick line leader
   5    Double line leader
}

  TJvTabAlignment =
    (taOrdinary, taCenter, taRight, taDecimal, taVertical); // added by J.G. Boerema
  // Note: if taVertical then tableader should be disabled according to Word
  TJvTabLeader =
    (tlNone, tlDotted, tlDashed, tlUnderlined, tlThick, tlDouble); // added by J.G. Boerema

  TJvParaAttributes = class(TPersistent)
  private
    FRichEdit: TJvCustomRichEdit;
    FIndentationStyle: TJvIndentationStyle; // added by J.G. Boerema
    procedure GetAttributes(var Paragraph: TParaFormat2);
    function GetAlignment: TParaAlignment;
    function GetFirstIndent: Longint;
    function GetHeadingStyle: THeadingStyle;
    function GetLeftIndent: Longint;
    function GetLineSpacing: Longint;
    function GetLineSpacingRule: TLineSpacingRule;
    function GetNumbering: TJvNumbering;
    function GetNumberingStart: Integer;
    function GetNumberingStyle: TJvNumberingStyle;
    function GetNumberingTab: Word;
    function GetRightIndent: Longint;
    function GetSpaceAfter: Longint;
    function GetSpaceBefore: Longint;
    function GetTab(Index: Byte): Longint;
    function GetTabCount: Integer;
    function GetTableStyle: TParaTableStyle;
    function GetTabAlignment(Index: Byte): TJvTabAlignment;
    function GetTabLeader(Index: Byte): TJvTabLeader;
    procedure SetAlignment(Value: TParaAlignment);
    procedure SetAttributes(var Paragraph: TParaFormat2);
    procedure SetFirstIndent(Value: Longint);
    procedure SetHeadingStyle(Value: THeadingStyle);
    procedure SetLeftIndent(Value: Longint);
    procedure SetLineSpacing(Value: Longint);
    procedure SetLineSpacingRule(Value: TLineSpacingRule);
    procedure SetNumbering(Value: TJvNumbering);
    procedure SetNumberingStart(const Value: Integer);
    procedure SetNumberingStyle(Value: TJvNumberingStyle);
    procedure SetNumberingTab(Value: Word);
    procedure SetRightIndent(Value: Longint);
    procedure SetSpaceAfter(Value: Longint);
    procedure SetSpaceBefore(Value: Longint);
    procedure SetTab(Index: Byte; Value: Longint);
    procedure SetTabCount(Value: Integer);
    procedure SetTableStyle(Value: TParaTableStyle);
    procedure SetTabAlignment(Index: Byte; Value: TJvTabAlignment);
    procedure SetTabLeader(Index: Byte; Value: TJvTabLeader);
  protected
    procedure InitPara(var Paragraph: TParaFormat2);
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create(AOwner: TJvCustomRichEdit);
    procedure Assign(Source: TPersistent); override;
    property Alignment: TParaAlignment read GetAlignment write SetAlignment;
    property FirstIndent: Longint read GetFirstIndent write SetFirstIndent;
    property HeadingStyle: THeadingStyle read GetHeadingStyle write SetHeadingStyle;
    property IndentationStyle: TJvIndentationStyle read FIndentationStyle
      write FIndentationStyle; // added by J.G. Boerema
    property LeftIndent: Longint read GetLeftIndent write SetLeftIndent;
    property LineSpacing: Longint read GetLineSpacing write SetLineSpacing;
    property LineSpacingRule: TLineSpacingRule read GetLineSpacingRule write SetLineSpacingRule;
    property Numbering: TJvNumbering read GetNumbering write SetNumbering;
    property NumberingStart: Integer read GetNumberingStart write SetNumberingStart;
    property NumberingStyle: TJvNumberingStyle read GetNumberingStyle write SetNumberingStyle;
    property NumberingTab: Word read GetNumberingTab write SetNumberingTab;
    property RightIndent: Longint read GetRightIndent write SetRightIndent;
    property SpaceAfter: Longint read GetSpaceAfter write SetSpaceAfter;
    property SpaceBefore: Longint read GetSpaceBefore write SetSpaceBefore;
    property Tab[Index: Byte]: Longint read GetTab write SetTab;
    property TabCount: Integer read GetTabCount write SetTabCount;
    property TableStyle: TParaTableStyle read GetTableStyle write SetTableStyle;
    property TabAlignment[Index: Byte]: TJvTabAlignment read GetTabAlignment write SetTabAlignment;
    property TabLeader[Index: Byte]: TJvTabLeader read GetTabLeader write SetTabLeader;
  end;

  TJvConversionKind = (ckImport, ckExport);
  TJvConversionTextKind = (ctkText, ctkRTF, ctkBothPreferText, ctkBothPreferRTF);

  { (rb) Name TJvConverter is already taken, thus: }
  TJvConversion = class(TObject)
  private
    FOnProgress: TNotifyEvent;
    FParentWindow: THandle;
  protected
    FPercentDone: Integer;
    procedure DoProgress(APercentDone: Integer);
  public
    function CanHandle(const AExtension: string; const AKind: TJvConversionKind): Boolean; overload; virtual;
    function CanHandle(const AKind: TJvConversionKind): Boolean; overload; virtual;
    function Filter: string; virtual;
    function TextKind: TJvConversionTextKind; virtual;
    function IsFormatCorrect(const AFileName: string): Boolean; overload; virtual;
    function IsFormatCorrect(AStream: TStream): Boolean; overload; virtual;

    function Open(const AFileName: string; const AKind: TJvConversionKind): Boolean; overload; virtual;
    function Open(Stream: TStream; const AKind: TJvConversionKind): Boolean; overload; virtual;
    procedure Init(AParentWindow: THandle); virtual;
    procedure Done; virtual;
    function Retry: Boolean; virtual;

    function ConvertRead(Buffer: PChar; BufSize: Integer): Integer; virtual;
    function ConvertWrite(Buffer: PChar; BufSize: Integer): Integer; virtual;

    function UserCancel: Boolean; virtual;
    function Error: Boolean; virtual;
    function ErrorStr: string; virtual;

    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
    property PercentDone: Integer read FPercentDone;
    property ParentWindow: THandle read FParentWindow;
  end;

  TJvStreamConversion = class(TJvConversion)
  private
    FStream: TStream;
    FSavedPosition: Int64;
    FStreamSize: Integer;
    FFreeStream: Boolean;
    FBytesConverted: Integer;
  public
    function Open(const AFileName: string; const AKind: TJvConversionKind): Boolean; override;
    function Open(Stream: TStream; const AKind: TJvConversionKind): Boolean; override;