Fórum TRichEdit e TQRRichText x quebra de linhas #375767

unit QRPlus;

interface
uses QRCtrls, comCtrls, classes;

Type
  TQRRichTextPlus = class(TQRRichEdit)
  private
    FSelAttributes: TTextAttributes;
    FDefAttributes: TTextAttributes;
    FOnSelChange: TNotifyEvent;
    FModified: Boolean;
    procedure SetDefAttributes(Value: TTextAttributes);
    procedure SetSelAttributes(Value: TTextAttributes);

  protected
    property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange;
  public
    constructor Create(AOwner: TComponent); override;
    property DefAttributes: TTextAttributes read FDefAttributes write SetDefAttributes;
    property SelAttributes: TTextAttributes read FSelAttributes write SetSelAttributes;
  end;

implementation

{ TQRRichTextPlus }



constructor TQRRichTextPlus.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

procedure TQRRichTextPlus.SetDefAttributes(Value: TTextAttributes);
begin
  DefAttributes.Assign(Value);
end;

procedure TQRRichTextPlus.SetSelAttributes(Value: TTextAttributes);
begin
  SelAttributes.Assign(Value);
end;

end.

unit teste;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, QRPlus, StdCtrls, QuickRpt, ExtCtrls, QRCtrls;

type
  TForm1 = class(TForm)
    BtnCriar: TButton;
    QuickRep1: TQuickRep;
    DetailBand1: TQRBand;
    BtnFormatarTexto: TButton;
    QRRichText1: TQRRichText;
    procedure BtnCriarClick(Sender: TObject);
    procedure BtnFormatarTextoClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }


  end;

var
  Form1: TForm1;
   var RTP : TQRRichTextPlus;
implementation

{$R *.dfm}

procedure TForm1.BtnCriarClick(Sender: TObject);
begin
   RTP := TQRRichTextPlus.Create(Form1);
   //QuickRep1.InsertControl(obj);
   DetailBand1.InsertControl(RTP);
end;

procedure TForm1.BtnFormatarTextoClick(Sender: TObject);
begin
  RTP.SelAttributes.Style := [fsBold];
end;

end.

program dprQRPlus;

uses
  Forms,
  teste in ´teste.pas´ ,
  QRPlus in ´QRPlus.pas´;

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit QRPlus;

interface
uses QRCtrls, comCtrls, classes, RichEdit, Graphics, Windows, SysUtils;

Type

  TQRTextAttributes = class(TPersistent)
  private
    QRRichText: TQRRichText;
    FType: TAttributeType;
    procedure GetAttributes(var Format: TCharFormat);
    function GetCharset: TFontCharset;
    function GetColor: TColor;
    function GetConsistentAttributes: TConsistentAttributes;
    function GetHeight: Integer;
    function GetName: TFontName;
    function GetPitch: TFontPitch;
    function GetProtected: Boolean;
    function GetSize: Integer;
    function GetStyle: TFontStyles;
    procedure SetAttributes(var Format: TCharFormat);
    procedure SetCharset(Value: TFontCharset);
    procedure SetColor(Value: TColor);
    procedure SetHeight(Value: Integer);
    procedure SetName(Value: TFontName);
    procedure SetPitch(Value: TFontPitch);
    procedure SetProtected(Value: Boolean);
    procedure SetSize(Value: Integer);
    procedure SetStyle(Value: TFontStyles);
  protected
    procedure InitFormat(var Format: TCharFormat);
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create(AOwner: TQRRichText; AttributeType: TAttributeType);
    procedure Assign(Source: TPersistent); override;
    property Charset: TFontCharset read GetCharset write SetCharset;
    property Color: TColor read GetColor write SetColor;
    property ConsistentAttributes: TConsistentAttributes read GetConsistentAttributes;
    property Name: TFontName read GetName write SetName;
    property Pitch: TFontPitch read GetPitch write SetPitch;
    property Protected: Boolean read GetProtected write SetProtected;
    property Size: Integer read GetSize write SetSize;
    property Style: TFontStyles read GetStyle write SetStyle;
    property Height: Integer read GetHeight write SetHeight;
  end;

  TQRRichTextPlus = class(TQRRichText)
  private
    FSelAttributes: TQRTextAttributes;
    FDefAttributes: TQRTextAttributes;
    FOnSelChange: TNotifyEvent;
    FModified: Boolean;
    procedure SetDefAttributes(Value: TQRTextAttributes);
    procedure SetSelAttributes(Value: TQRTextAttributes);

  protected
    property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange;
  public
    constructor Create(AOwner: TComponent); override;
    property DefAttributes: TQRTextAttributes read FDefAttributes write SetDefAttributes;
    property SelAttributes: TQRTextAttributes read FSelAttributes write SetSelAttributes;
  end;

implementation

{ TQRRichTextPlus }



constructor TQRRichTextPlus.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSelAttributes := TQRTextAttributes.Create(self, atSelected);
  FDefAttributes := TQRTextAttributes.Create(Self, atDefaultText);
end;

procedure TQRRichTextPlus.SetDefAttributes(Value: TQRTextAttributes);
begin
  DefAttributes.Assign(Value);
end;

procedure TQRRichTextPlus.SetSelAttributes(Value: TQRTextAttributes);
begin
  SelAttributes.Assign(Value);
end;


{ TQRTextAttributes }

constructor TQRTextAttributes.Create(AOwner: TQRRichText;
  AttributeType: TAttributeType);
begin
  inherited Create;
  QRRichText := AOwner;
  FType := AttributeType;
end;

procedure TQRTextAttributes.InitFormat(var Format: TCharFormat);
begin
  FillChar(Format, SizeOf(TCharFormat), 0);
  Format.cbSize := SizeOf(TCharFormat);
end;

function TQRTextAttributes.GetConsistentAttributes: TConsistentAttributes;
var
  Format: TCharFormat;
begin
  Result := [];
  if QRRichText.HandleAllocated and (FType = atSelected) then
  begin
    InitFormat(Format);
    SendMessage(QRRichText.Handle, EM_GETCHARFORMAT,
      WPARAM(FType = atSelected), LPARAM(@Format));
    with Format do
    begin
      if (dwMask and CFM_BOLD) <> 0 then Include(Result, caBold);
      if (dwMask and CFM_COLOR) <> 0 then Include(Result, caColor);
      if (dwMask and CFM_FACE) <> 0 then Include(Result, caFace);
      if (dwMask and CFM_ITALIC) <> 0 then Include(Result, caItalic);
      if (dwMask and CFM_SIZE) <> 0 then Include(Result, caSize);
      if (dwMask and CFM_STRIKEOUT) <> 0 then Include(Result, caStrikeOut);
      if (dwMask and CFM_UNDERLINE) <> 0 then Include(Result, caUnderline);
      if (dwMask and CFM_PROTECTED) <> 0 then Include(Result, caProtected);
    end;
  end;
end;

procedure TQRTextAttributes.GetAttributes(var Format: TCharFormat);
begin
  InitFormat(Format);
  if QRRichText.HandleAllocated then
    SendMessage(QRRichText.Handle, EM_GETCHARFORMAT,
      WPARAM(FType = atSelected), LPARAM(@Format));
end;

procedure TQRTextAttributes.SetAttributes(var Format: TCharFormat);
var
  Flag: Longint;
begin
  if FType = atSelected then Flag := SCF_SELECTION
  else Flag := 0;
  if QRRichText.HandleAllocated then
    SendMessage(QRRichText.Handle, EM_SETCHARFORMAT, Flag, LPARAM(@Format))
end;

function TQRTextAttributes.GetCharset: TFontCharset;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  Result := Format.bCharset;
end;

procedure TQRTextAttributes.SetCharset(Value: TFontCharset);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_CHARSET;
    bCharSet := Value;
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetProtected: Boolean;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  with Format do
    if (dwEffects and CFE_PROTECTED) <> 0 then
      Result := True else
      Result := False;
end;

procedure TQRTextAttributes.SetProtected(Value: Boolean);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_PROTECTED;
    if Value then dwEffects := CFE_PROTECTED;
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetColor: TColor;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  with Format do
    if (dwEffects and CFE_AUTOCOLOR) <> 0 then
      Result := clWindowText else
      Result := crTextColor;
end;

procedure TQRTextAttributes.SetColor(Value: TColor);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_COLOR;
    if Value = clWindowText then
      dwEffects := CFE_AUTOCOLOR else
      crTextColor := ColorToRGB(Value);
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetName: TFontName;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  Result := Format.szFaceName;
end;

procedure TQRTextAttributes.SetName(Value: TFontName);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_FACE;
    StrPLCopy(szFaceName, Value, SizeOf(szFaceName) - 1);
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetStyle: TFontStyles;
var
  Format: TCharFormat;
begin
  Result := [];
  GetAttributes(Format);
  with Format do
  begin
    if (dwEffects and CFE_BOLD) <> 0 then Include(Result, fsBold);
    if (dwEffects and CFE_ITALIC) <> 0 then Include(Result, fsItalic);
    if (dwEffects and CFE_UNDERLINE) <> 0 then Include(Result, fsUnderline);
    if (dwEffects and CFE_STRIKEOUT) <> 0 then Include(Result, fsStrikeOut);
  end;
end;

procedure TQRTextAttributes.SetStyle(Value: TFontStyles);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT;
    if fsBold in Value then dwEffects := dwEffects or CFE_BOLD;
    if fsItalic in Value then dwEffects := dwEffects or CFE_ITALIC;
    if fsUnderline in Value then dwEffects := dwEffects or CFE_UNDERLINE;
    if fsStrikeOut in Value then dwEffects := dwEffects or CFE_STRIKEOUT;
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetSize: Integer;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  Result := Format.yHeight div 20;
end;

procedure TQRTextAttributes.SetSize(Value: Integer);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := Integer(CFM_SIZE);
    yHeight := Value * 20;
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetHeight: Integer;
begin
  Result := MulDiv(Size, QRRichText.Height, 72);
end;

procedure TQRTextAttributes.SetHeight(Value: Integer);
begin
  Size := MulDiv(Value, 72, QRRichText.Height);
end;

function TQRTextAttributes.GetPitch: TFontPitch;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  case (Format.bPitchAndFamily and $03) of
    DEFAULT_PITCH: Result := fpDefault;
    VARIABLE_PITCH: Result := fpVariable;
    FIXED_PITCH: Result := fpFixed;
  else
    Result := fpDefault;
  end;
end;

procedure TQRTextAttributes.SetPitch(Value: TFontPitch);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    case Value of
      fpVariable: Format.bPitchAndFamily := VARIABLE_PITCH;
      fpFixed: Format.bPitchAndFamily := FIXED_PITCH;
    else
      Format.bPitchAndFamily := DEFAULT_PITCH;
    end;
  end;
  SetAttributes(Format);
end;

procedure TQRTextAttributes.Assign(Source: TPersistent);
begin
  if Source is TFont then
  begin
    Color := TFont(Source).Color;
    Name := TFont(Source).Name;
    Charset := TFont(Source).Charset;
    Style := TFont(Source).Style;
    Size := TFont(Source).Size;
    Pitch := TFont(Source).Pitch;
  end
  else if Source is TQRTextAttributes then
  begin
    Color := TQRTextAttributes(Source).Color;
    Name := TQRTextAttributes(Source).Name;
    Charset := TQRTextAttributes(Source).Charset;
    Style := TQRTextAttributes(Source).Style;
    Pitch := TQRTextAttributes(Source).Pitch;
    Size := TQRTextAttributes(Source).Size;
  end
  else inherited Assign(Source);
end;

procedure TQRTextAttributes.AssignTo(Dest: TPersistent);
begin
  if Dest is TFont then
  begin
    TFont(Dest).Color := Color;
    TFont(Dest).Name := Name;
    TFont(Dest).Charset := Charset;
    TFont(Dest).Style := Style;
    TFont(Dest).Size := Size;
    TFont(Dest).Pitch := Pitch;
  end
  else if Dest is TQRTextAttributes then
  begin
    TQRTextAttributes(Dest).Color := Color;
    TQRTextAttributes(Dest).Name := Name;
    TQRTextAttributes(Dest).Charset := Charset;
    TQRTextAttributes(Dest).Style := Style;
    TQRTextAttributes(Dest).Pitch := Pitch;
  end
  else inherited AssignTo(Dest);
end;


end.

unit teste;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, QRPlus, StdCtrls, QuickRpt, ExtCtrls, QRCtrls, qrpctrls,
  ComCtrls;

type
  TForm1 = class(TForm)
    QuickRep1: TQuickRep; //adicione ao form
    DetailBand1: TQRBand; //adicione ao quickrep
    BtnCriar: TButton; //adicione ao form
    BtnFormatarTexto: TButton; //adicione ao form
    BtnPreview: TButton; //adicione ao form
    procedure BtnCriarClick(Sender: TObject);
    procedure BtnFormatarTextoClick(Sender: TObject);
    procedure BtnPreviewClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }


  end;

var
  Form1: TForm1;
   var rtp : TQRRichTextPlus;
implementation

{$R *.dfm}

procedure TForm1.BtnCriarClick(Sender: TObject);
begin
   rtp := TQRRichTextPlus.Create(Form1);
   rtp.Parent := DetailBand1;
   DetailBand1.InsertControl(rtp);
   rtp.Size.Width := 100;
end;

procedure TForm1.BtnFormatarTextoClick(Sender: TObject);
begin
  rtp.SelAttributes.Style := [fsBold];
end;

procedure TForm1.BtnPreviewClick(Sender: TObject);
begin
   QuickRep1.Preview;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, QuickRpt, QRCtrls, ExtCtrls, RichEdit;

type
  TForm1 = class(TForm)
    QuickRep1: TQuickRep;     //coloque no form
    DetailBand1: TQRBand;     //coloque no quikrep
    QRRichText1: TQRRichText; //coloque na banda

    RichEdit1: TRichEdit;  //coloque no form (pequeno 200 x 100 em um canto do form)
    BtnPreview: TButton;   //coloque no form
    BtnNegritar: TButton;  //coloque no form
    procedure BtnPreviewClick(Sender: TObject);
    procedure BtnNegritarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BtnPreviewClick(Sender: TObject);
begin
    QuickRep1.Preview;
end;

procedure TForm1.BtnNegritarClick(Sender: TObject);
var
  Format: TCharFormat;
begin
  FillChar(Format, SizeOf(Format), 0);
  Format.cbSize := SizeOf(Format);

  with Format do
  begin
    dwMask := CFM_BOLD;
    dwEffects := CFE_BOLD;
  end;

  SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Format));    //aplica a formatação com sucesso
  SendMessage(QRRichText1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Format));  //não aplica a formatação com sucesso
end;

end.

unit QRPlus;


interface

uses ComCtrls, Windows, RichEdit, QRCtrls, classes, Messages, Controls, SysUtils, Forms, Menus,
Graphics, StdCtrls, ToolWin, ImgList, ExtCtrls, ListActns, ShlObj, Consts, printers, ComStrs;

Type

  TQRParaAttributes = class;
  TQRTextAttributes = class;

  TQRRichTextPlusCustomEdit = class;
  TQRRichTextPlusCustomMemo = class;
  TQRRichTextPlusCustom = class;
  TQRRichTextPlus = class;

  TSelection = record
    StartPos, EndPos: Integer;
  end;

  TQRRichEditStrings = class(TStrings)
  private
    RichEdit: TQRRichTextPlusCustom;
    FPlainText: Boolean;
    FConverter: TConversion;
    procedure EnableChange(const Value: Boolean);
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure SetUpdateState(Updating: Boolean); override;
    procedure SetTextStr(const Value: string); override;
  public
    destructor Destroy; override;
    procedure Clear; override;
    procedure AddStrings(Strings: TStrings); override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure LoadFromFile(const FileName: string); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToFile(const FileName: string); override;
    procedure SaveToStream(Stream: TStream); override;
    property PlainText: Boolean read FPlainText write FPlainText;
  end;

  TQRMemoStrings = class(TStrings)
  private
    Memo: TQRRichTextPlusCustomMemo;
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    function GetTextStr: string; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure SetTextStr(const Value: string); override;
    procedure SetUpdateState(Updating: Boolean); override;
  public
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
  end;


  TQRParaAttributes = class(TPersistent)
  private
    QRRichTextPlus: TQRRichTextPlusCustom;
    procedure GetAttributes(var Paragraph: TParaFormat);
    function GetAlignment: TAlignment;
    function GetFirstIndent: Longint;
    function GetLeftIndent: Longint;
    function GetRightIndent: Longint;
    function GetNumbering: TNumberingStyle;
    function GetTab(Index: Byte): Longint;
    function GetTabCount: Integer;
    procedure InitPara(var Paragraph: TParaFormat);
    procedure SetAlignment(Value: TAlignment);
    procedure SetAttributes(var Paragraph: TParaFormat);
    procedure SetFirstIndent(Value: Longint);
    procedure SetLeftIndent(Value: Longint);
    procedure SetRightIndent(Value: Longint);
    procedure SetNumbering(Value: TNumberingStyle);
    procedure SetTab(Index: Byte; Value: Longint);
    procedure SetTabCount(Value: Integer);
  public
    constructor Create(AOwner: TQRRichTextPlusCustom);
    procedure Assign(Source: TPersistent); override;
    property Alignment: TAlignment read GetAlignment write SetAlignment;
    property FirstIndent: Longint read GetFirstIndent write SetFirstIndent;
    property LeftIndent: Longint read GetLeftIndent write SetLeftIndent;
    property Numbering: TNumberingStyle read GetNumbering write SetNumbering;
    property RightIndent: Longint read GetRightIndent write SetRightIndent;
    property Tab[Index: Byte]: Longint read GetTab write SetTab;
    property TabCount: Integer read GetTabCount write SetTabCount;
  end;

  TQRTextAttributes = class(TPersistent)
  private
    QRRichTextPlus: TQRRichTextPlusCustom;
    FType: TAttributeType;
    procedure GetAttributes(var Format: TCharFormat);
    function GetCharset: TFontCharset;
    function GetColor: TColor;
    function GetConsistentAttributes: TConsistentAttributes;
    function GetHeight: Integer;
    function GetName: TFontName;
    function GetPitch: TFontPitch;
    function GetProtected: Boolean;
    function GetSize: Integer;
    function GetStyle: TFontStyles;
    procedure SetAttributes(var Format: TCharFormat);
    procedure SetCharset(Value: TFontCharset);
    procedure SetColor(Value: TColor);
    procedure SetHeight(Value: Integer);
    procedure SetName(Value: TFontName);
    procedure SetPitch(Value: TFontPitch);
    procedure SetProtected(Value: Boolean);
    procedure SetSize(Value: Integer);
    procedure SetStyle(Value: TFontStyles);
  protected
    procedure InitFormat(var Format: TCharFormat);
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create(AOwner: TQRRichTextPlusCustom; AttributeType: TAttributeType);
    procedure Assign(Source: TPersistent); override;
    property Charset: TFontCharset read GetCharset write SetCharset;
    property Color: TColor read GetColor write SetColor;
    property ConsistentAttributes: TConsistentAttributes read GetConsistentAttributes;
    property Name: TFontName read GetName write SetName;
    property Pitch: TFontPitch read GetPitch write SetPitch;
    property Protected: Boolean read GetProtected write SetProtected;
    property Size: Integer read GetSize write SetSize;
    property Style: TFontStyles read GetStyle write SetStyle;
    property Height: Integer read GetHeight write SetHeight;
  end;

  TQRRichTextPlusCustomEdit = class(TQRRichText)
  private
    FMaxLength: Integer;
    FBorderStyle: TBorderStyle;
    FPasswordChar: Char;
    FReadOnly: Boolean;
    FAutoSize: Boolean;
    FAutoSelect: Boolean;
    FHideSelection: Boolean;
    FOEMConvert: Boolean;
    FCharCase: TEditCharCase;
    FCreating: Boolean;
    FModified: Boolean;
    FOnChange: TNotifyEvent;
    procedure AdjustHeight;
    function GetModified: Boolean;
    function GetCanUndo: Boolean;
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetCharCase(Value: TEditCharCase);
    procedure SetHideSelection(Value: Boolean);
    procedure SetMaxLength(Value: Integer);
    procedure SetModified(Value: Boolean);
    procedure SetOEMConvert(Value: Boolean);
    procedure SetPasswordChar(Value: Char);
    procedure SetReadOnly(Value: Boolean);
    procedure SetSelText(const Value: string);
    procedure UpdateHeight;
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMContextMenu(var Message: TWMContextMenu);
      message WM_CONTEXTMENU;
  protected
    procedure Change; dynamic;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure DoSetMaxLength(Value: Integer); virtual;
    function GetSelLength: Integer; virtual;
    function GetSelStart: Integer; virtual;
    function GetSelText: string; virtual;
    procedure SetAutoSize(Value: Boolean); override;
    procedure SetSelLength(Value: Integer); virtual;
    procedure SetSelStart(Value: Integer); virtual;
    property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
    property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
    property MaxLength: Integer read FMaxLength write SetMaxLength default 0;
    property OEMConvert: Boolean read FOEMConvert write SetOEMConvert default False;
    property PasswordChar: Char read FPasswordChar write SetPasswordChar default #0;
    property ParentColor default False;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Clear; virtual;
    procedure ClearSelection;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure DefaultHandler(var Message); override;
    procedure PasteFromClipboard;
    procedure Undo;
    procedure ClearUndo;
    function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
    procedure SelectAll;
    procedure SetSelTextBuf(Buffer: PChar);
    property CanUndo: Boolean read GetCanUndo;
    property Modified: Boolean read GetModified write SetModified;
    property SelLength: Integer read GetSelLength write SetSelLength;
    property SelStart: Integer read GetSelStart write SetSelStart;
    property SelText: string read GetSelText write SetSelText;
    property Text;
  published
    property TabStop default True;
  end;

  TQRRichTextPlusCustomMemo = class(TQRRichTextPlusCustomEdit)
  private
    FLines: TStrings;
    FAlignment: TAlignment;
    FScrollBars: TScrollStyle;
    FWordWrap: Boolean;
    FWantReturns: Boolean;
    FWantTabs: Boolean;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
  protected
    function GetCaretPos: TPoint; virtual;
    procedure SetCaretPos(const Value: TPoint); virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure SetAlignment(Value: TAlignment);
    procedure SetLines(Value: TStrings);
    procedure SetScrollBars(Value: TScrollStyle);
    procedure SetWordWrap(Value: Boolean);
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssNone;
    property WantReturns: Boolean read FWantReturns write FWantReturns default True;
    property WantTabs: Boolean read FWantTabs write FWantTabs default False;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetControlsAlignment: TAlignment; override;
    property CaretPos: TPoint read GetCaretPos write SetCaretPos;
    property Lines: TStrings read FLines write SetLines;
  end;

  TQRRichTextPlusCustom = class(TQRRichTextPlusCustomMemo)
  private
    FHideScrollBars: Boolean;
    FSelAttributes: TQRTextAttributes;
    FDefAttributes: TQRTextAttributes;
    FParagraph: TQRParaAttributes;
    FOldParaAlignment: TAlignment;
    FScreenLogPixels: Integer;
    FRichEditStrings: TStrings;
    FMemStream: TMemoryStream;
    FOnSelChange: TNotifyEvent;
    FHideSelection: Boolean;
    FModified: Boolean;
    FDefaultConverter: TConversionClass;
    FOnResizeRequest: TRichEditResizeEvent;
    FOnProtectChange: TRichEditProtectChange;
    FOnSaveClipboard: TRichEditSaveClipboard;
    FPageRect: TRect;
    procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    function GetPlainText: Boolean;
    function ProtectChange(StartPos, EndPos: Integer): Boolean;
    function SaveClipboard(NumObj, NumChars: Integer): Boolean;
    procedure SetHideScrollBars(Value: Boolean);
    procedure SetHideSelection(Value: Boolean);
    procedure SetPlainText(Value: Boolean);
    procedure SetRichEditStrings(Value: TStrings);
    procedure SetDefAttributes(Value: TQRTextAttributes);
    procedure SetSelAttributes(Value: TQRTextAttributes);
    procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    procedure RequestSize(const Rect: TRect); virtual;
    procedure SelectionChange; dynamic;
    procedure DoSetMaxLength(Value: Integer); override;
    function GetCaretPos: TPoint; override;
    procedure SetCaretPos(const Value: TPoint); override;    
    function GetSelLength: Integer; override;
    function GetSelStart: Integer; override;
    function GetSelText: string; override;
    procedure SetSelLength(Value: Integer); override;
    procedure SetSelStart(Value: Integer); override;
    property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
    property HideScrollBars: Boolean read FHideScrollBars
      write SetHideScrollBars default True;
    property Lines: TStrings read FRichEditStrings write SetRichEditStrings;
    property OnSaveClipboard: TRichEditSaveClipboard read FOnSaveClipboard
      write FOnSaveClipboard;
    property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange;
    property OnProtectChange: TRichEditProtectChange read FOnProtectChange
      write FOnProtectChange;
    property OnResizeRequest: TRichEditResizeEvent read FOnResizeRequest
      write FOnResizeRequest;
    property PlainText: Boolean read GetPlainText write SetPlainText default False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear; override;
    function FindText(const SearchStr: string;
      StartPos, Length: Integer; Options: TSearchTypes): Integer;
    function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer; override;
    procedure Print(const Caption: string); virtual;
    class procedure RegisterConversionFormat(const AExtension: string;
      AConversionClass: TConversionClass);
    property DefaultConverter: TConversionClass
      read FDefaultConverter write FDefaultConverter;
    property DefAttributes: TQRTextAttributes read FDefAttributes write SetDefAttributes;
    property SelAttributes: TQRTextAttributes read FSelAttributes write SetSelAttributes;
    property PageRect: TRect read FPageRect write FPageRect;
    property Paragraph: TQRParaAttributes read FParagraph;
  end;
  
  TQRRichTextPlus = class(TQRRichTextPlusCustom)
  end;

const
  ReadError = $0001;
  WriteError = $0002;
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
  RTFConversionFormat: TConversionFormat = (
    ConversionClass: TConversion;
    Extension: ´rtf´;
    Next: nil);
  TextConversionFormat: TConversionFormat = (
    ConversionClass: TConversion;
    Extension: ´txt´;
    Next: @RTFConversionFormat);

var
  ConversionFormatList: PConversionFormat = @TextConversionFormat;
  FRichEditModule: THandle;

  implementation


destructor TQRRichEditStrings.Destroy;
begin
  FConverter.Free;
  inherited Destroy;
end;

procedure TQRRichEditStrings.AddStrings(Strings: TStrings);
var
  SelChange: TNotifyEvent;
begin
  SelChange := RichEdit.OnSelectionChange;
  RichEdit.OnSelectionChange := nil;
  try
    inherited AddStrings(Strings);
  finally
    RichEdit.OnSelectionChange := SelChange;
  end;
end;

function TQRRichEditStrings.GetCount: Integer;
begin
  Result := SendMessage(RichEdit.Handle, EM_GETLINECOUNT, 0, 0);
  if SendMessage(RichEdit.Handle, EM_LINELENGTH, SendMessage(RichEdit.Handle,
    EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
end;

function TQRRichEditStrings.Get(Index: Integer): string;
var
  Text: array[0..4095] of Char;
  L: Integer;
begin
  Word((@Text)^) := SizeOf(Text);
  L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));
  if (Text[L - 2] = 13) and (Text[L - 1] = 10) then Dec(L, 2);
  SetString(Result, Text, L);
end;

procedure TQRRichEditStrings.Put(Index: Integer; const S: string);
var
  Selection: TCharRange;
begin
  if Index >= 0 then
  begin
    Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
    if Selection.cpMin <> -1 then
    begin
      Selection.cpMax := Selection.cpMin +
        SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.cpMin, 0);
      SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
      SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
    end;
  end;
end;

procedure TQRRichEditStrings.Insert(Index: Integer; const S: string);
var
  L: Integer;
  Selection: TCharRange;
  Fmt: PChar;
  Str: string;
begin
  if Index >= 0 then
  begin
    Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
    if Selection.cpMin >= 0 then Fmt := ´¬s´#1310
    else begin
      Selection.cpMin :=
        SendMessage(RichEdit.Handle, EM_LINEINDEX, Index - 1, 0);
      if Selection.cpMin < 0 then Exit;
      L := SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.cpMin, 0);
      if L = 0 then Exit;
      Inc(Selection.cpMin, L);
      Fmt := #1310´¬s´;
    end;
    Selection.cpMax := Selection.cpMin;
    SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
    Str := Format(Fmt, [S]);
    SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, LongInt(PChar(Str)));
    if RichEdit.SelStart <> (Selection.cpMax + Length(Str)) then
      raise EOutOfResources.Create(sRichEditInsertError);
  end;
end;

procedure TQRRichEditStrings.Delete(Index: Integer);
const
  Empty: PChar = ´´;
var
  Selection: TCharRange;
begin
  if Index < 0 then Exit;
  Selection.cpMin := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index, 0);
  if Selection.cpMin <> -1 then
  begin
    Selection.cpMax := SendMessage(RichEdit.Handle, EM_LINEINDEX, Index + 1, 0);
    if Selection.cpMax = -1 then
      Selection.cpMax := Selection.cpMin +
        SendMessage(RichEdit.Handle, EM_LINELENGTH, Selection.cpMin, 0);
    SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
    SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(Empty));
  end;
end;

procedure TQRRichEditStrings.Clear;
begin
  RichEdit.Clear;
end;

procedure TQRRichEditStrings.SetUpdateState(Updating: Boolean);
begin
  if RichEdit.Showing then
    SendMessage(RichEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  if not Updating then begin
    RichEdit.Refresh;
    RichEdit.Perform(CM_TEXTCHANGED, 0, 0);
  end;
end;

procedure TQRRichEditStrings.EnableChange(const Value: Boolean);
var
  EventMask: Longint;
begin
  with RichEdit do
  begin
    if Value then
      EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) or ENM_CHANGE
    else
      EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0) and not ENM_CHANGE;
    SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask);
  end;
end;

procedure TQRRichEditStrings.SetTextStr(const Value: string);
begin
  EnableChange(False);
  try
    inherited SetTextStr(Value);
  finally
    EnableChange(True);
  end;
end;

function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler;
asm
        PUSH    ESI
        PUSH    EDI
        MOV     EDI,EAX
        MOV     ESI,EDX
        MOV     EDX,EAX
        CLD
@@1:    LODSB
@@2:    OR      AL,AL
        JE      @@4
        CMP     AL,0AH
        JE      @@3
        STOSB
        CMP     AL,0DH
        JNE     @@1
        MOV     AL,0AH
        STOSB
        LODSB
        CMP     AL,0AH
        JE      @@1
        JMP     @@2
@@3:    MOV     EAX,0A0DH
        STOSW
        JMP     @@1
@@4:    STOSB
        LEA     EAX,[EDI-1]
        SUB     EAX,EDX
        POP     EDI
        POP     ESI
end;

function StreamSave(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): Longint; stdcall;
var
  StreamInfo: PRichEditStreamInfo;
begin
  Result := NoError;
  StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  try
    pcb := 0;
    if StreamInfo^.Converter <> nil then
      pcb := StreamInfo^.Converter.ConvertWriteStream(StreamInfo^.Stream, PChar(pbBuff), cb);
  except
    Result := WriteError;
  end;
end;

function StreamLoad(dwCookie: Longint; pbBuff: PByte;
  cb: Longint; var pcb: Longint): Longint; stdcall;
var
  Buffer, pBuff: PChar;
  StreamInfo: PRichEditStreamInfo;
begin
  Result := NoError;
  StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  Buffer := StrAlloc(cb + 1);
  try
    cb := cb div 2;
    pcb := 0;
    pBuff := Buffer + cb;
    try
      if StreamInfo^.Converter <> nil then
        pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, pBuff, cb);
      if pcb > 0 then
      begin
        pBuff[pcb] := 0;
        if pBuff[pcb - 1] = 13 then pBuff[pcb - 1] := 0;
        pcb := AdjustLineBreaks(Buffer, pBuff);
        Move(Buffer^, pbBuff^, pcb);
      end;
    except
      Result := ReadError;
    end;
  finally
    StrDispose(Buffer);
  end;
end;

procedure TQRRichEditStrings.LoadFromStream(Stream: TStream);
var
  EditStream: TEditStream;
  Position: Longint;
  TextType: Longint;
  StreamInfo: TRichEditStreamInfo;
  Converter: TConversion;
begin
  StreamInfo.Stream := Stream;
  if FConverter <> nil then Converter := FConverter
  else Converter := RichEdit.DefaultConverter.Create;
  StreamInfo.Converter := Converter;
  try
    with EditStream do
    begin
      dwCookie := LongInt(Pointer(@StreamInfo));
      pfnCallBack := @StreamLoad;
      dwError := 0;
    end;
    Position := Stream.Position;
    if PlainText then TextType := SF_TEXT
    else TextType := SF_RTF;
    SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
    if (TextType = SF_RTF) and (EditStream.dwError <> 0) then
    begin
      Stream.Position := Position;
      if PlainText then TextType := SF_RTF
      else TextType := SF_TEXT;
      SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
      if EditStream.dwError <> 0 then
        raise EOutOfResources.Create(sRichEditLoadFail);
    end;
  finally
    if FConverter = nil then Converter.Free;
  end;
end;

procedure TQRRichEditStrings.SaveToStream(Stream: TStream);
var
  EditStream: TEditStream;
  TextType: Longint;
  StreamInfo: TRichEditStreamInfo;
  Converter: TConversion;
begin
  if FConverter <> nil then Converter := FConverter
  else Converter := RichEdit.DefaultConverter.Create;
  StreamInfo.Stream := Stream;
  StreamInfo.Converter := Converter;
  try
    with EditStream do
    begin
      dwCookie := LongInt(Pointer(@StreamInfo));
      pfnCallBack := @StreamSave;
      dwError := 0;
    end;
    if PlainText then TextType := SF_TEXT
    else TextType := SF_RTF;
    SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, Longint(@EditStream));
    if EditStream.dwError <> 0 then
      raise EOutOfResources.Create(sRichEditSaveFail);
  finally
    if FConverter = nil then Converter.Free;
  end;
end;

procedure TQRRichEditStrings.LoadFromFile(const FileName: string);
var
  Ext: string;
  Convert: PConversionFormat;
begin
  Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
  System.Delete(Ext, 1, 1);
  Convert := ConversionFormatList;
  while Convert <> nil do
    with Convert^ do
      if Extension <> Ext then Convert := Next
      else Break;
  if Convert = nil then
    Convert := @TextConversionFormat;
  if FConverter = nil then FConverter := Convert^.ConversionClass.Create;
  try
    inherited LoadFromFile(FileName);
  except
    FConverter.Free;
    FConverter := nil;
    raise;
  end;
  RichEdit.DoSetMaxLength($7FFFFFF0);
end;

procedure TQRRichEditStrings.SaveToFile(const FileName: string);
var
  Ext: string;
  Convert: PConversionFormat;
begin
  Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
  System.Delete(Ext, 1, 1);
  Convert := ConversionFormatList;
  while Convert <> nil do
    with Convert^ do
      if Extension <> Ext then Convert := Next
      else Break;
  if Convert = nil then
    Convert := @TextConversionFormat;
  if FConverter = nil then FConverter := Convert^.ConversionClass.Create;
  try
    inherited SaveToFile(FileName);
  except
    FConverter.Free;
    FConverter := nil;
    raise;
  end;
end;


{ TQRMemoStrings }

function TQRMemoStrings.GetCount: Integer;
begin
  Result := 0;
  if Memo.HandleAllocated or (Memo.WindowText <> nil) then
  begin
    Result := SendMessage(Memo.Handle, EM_GETLINECOUNT, 0, 0);
    if SendMessage(Memo.Handle, EM_LINELENGTH, SendMessage(Memo.Handle,
      EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
  end;
end;

function TQRMemoStrings.Get(Index: Integer): string;
var
  Text: array[0..4095] of Char;
begin
  Word((@Text)^) := SizeOf(Text);
  SetString(Result, Text, SendMessage(Memo.Handle, EM_GETLINE, Index,
    Longint(@Text)));
end;

procedure TQRMemoStrings.Put(Index: Integer; const S: string);
var
  SelStart: Integer;
begin
  SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  if SelStart >= 0 then
  begin
    SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelStart +
      SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0));
    SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
  end;
end;

procedure TQRMemoStrings.Insert(Index: Integer; const S: string);
var
  SelStart, LineLen: Integer;
  Line: string;
begin
  if Index >= 0 then
  begin
    SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
    if SelStart >= 0 then Line := S + #1310 else
    begin
      SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index - 1, 0);
      if SelStart < 0 then Exit;
      LineLen := SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
      if LineLen = 0 then Exit;
      Inc(SelStart, LineLen);
      Line := 1310 + s;
    end;
    SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelStart);
    SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(PChar(Line)));
  end;
end;

procedure TQRMemoStrings.Delete(Index: Integer);
const
  Empty: PChar = ´´;
var
  SelStart, SelEnd: Integer;
begin
  SelStart := SendMessage(Memo.Handle, EM_LINEINDEX, Index, 0);
  if SelStart >= 0 then
  begin
    SelEnd := SendMessage(Memo.Handle, EM_LINEINDEX, Index + 1, 0);
    if SelEnd < 0 then SelEnd := SelStart +
      SendMessage(Memo.Handle, EM_LINELENGTH, SelStart, 0);
    SendMessage(Memo.Handle, EM_SETSEL, SelStart, SelEnd);
    SendMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(Empty));
  end;
end;

procedure TQRMemoStrings.Clear;
begin
  Memo.Clear;
end;

procedure TQRMemoStrings.SetUpdateState(Updating: Boolean);
begin
  if Memo.HandleAllocated then
  begin
    SendMessage(Memo.Handle, WM_SETREDRAW, Ord(not Updating), 0);
    if not Updating then
    begin   // WM_SETREDRAW causes visibility side effects in memo controls
      Memo.Perform(CM_SHOWINGCHANGED,0,0); // This reasserts the visibility we want
      Memo.Refresh;
    end;
  end;
end;

function TQRMemoStrings.GetTextStr: string;
begin
  Result := Memo.Text;
end;

procedure TQRMemoStrings.SetTextStr(const Value: string);
var
  NewText: string;
begin
  NewText := SysUtils.AdjustLineBreaks(Value);
  if (Length(NewText) <> Memo.GetTextLen) or (NewText <> Memo.Text) then
  begin
    if SendMessage(Memo.Handle, WM_SETTEXT, 0, Longint(NewText)) = 0 then
      raise EInvalidOperation.Create(SInvalidMemoSize);
    Memo.Perform(CM_TEXTCHANGED, 0, 0);
  end;
end;


{ TQRParaAttributes }

constructor TQRParaAttributes.Create(AOwner: TQRRichTextPlusCustom);
begin
  inherited Create;
  QRRichTextPlus := AOwner;
end;

procedure TQRParaAttributes.InitPara(var Paragraph: TParaFormat);
begin
  FillChar(Paragraph, SizeOf(TParaFormat), 0);
  Paragraph.cbSize := SizeOf(TParaFormat);
end;

procedure TQRParaAttributes.GetAttributes(var Paragraph: TParaFormat);
begin
  InitPara(Paragraph);
  if QRRichTextPlus.HandleAllocated then
    SendMessage(QRRichTextPlus.Handle, EM_GETPARAFORMAT, 0, LPARAM(@Paragraph));
end;

procedure TQRParaAttributes.SetAttributes(var Paragraph: TParaFormat);
begin
  QRRichTextPlus.HandleNeeded; { we REALLY need the handle for BiDi }
  if QRRichTextPlus.HandleAllocated then
  begin
    if QRRichTextPlus.UseRightToLeftAlignment then
      if Paragraph.wAlignment = PFA_LEFT then
        Paragraph.wAlignment := PFA_RIGHT
      else if Paragraph.wAlignment = PFA_RIGHT then
        Paragraph.wAlignment := PFA_LEFT;
    SendMessage(QRRichTextPlus.Handle, EM_SETPARAFORMAT, 0, LPARAM(@Paragraph));
  end;
end;

function TQRParaAttributes.GetAlignment: TAlignment;
var
  Paragraph: TParaFormat;
begin
  GetAttributes(Paragraph);
  Result := TAlignment(Paragraph.wAlignment - 1);
end;

procedure TQRParaAttributes.SetAlignment(Value: TAlignment);
var
  Paragraph: TParaFormat;
begin
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_ALIGNMENT;
    wAlignment := Ord(Value) + 1;
  end;
  SetAttributes(Paragraph);
end;

function TQRParaAttributes.GetNumbering: TNumberingStyle;
var
  Paragraph: TParaFormat;
begin
  GetAttributes(Paragraph);
  Result := TNumberingStyle(Paragraph.wNumbering);
end;

procedure TQRParaAttributes.SetNumbering(Value: TNumberingStyle);
var
  Paragraph: TParaFormat;
begin
  case Value of
    nsBullet: if LeftIndent < 10 then LeftIndent := 10;
    nsNone: LeftIndent := 0;
  end;
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_NUMBERING;
    wNumbering := Ord(Value);
  end;
  SetAttributes(Paragraph);
end;

function TQRParaAttributes.GetFirstIndent: Longint;
var
  Paragraph: TParaFormat;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.dxStartIndent div 20
end;

procedure TQRParaAttributes.SetFirstIndent(Value: Longint);
var
  Paragraph: TParaFormat;
begin
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_STARTINDENT;
    dxStartIndent := Value * 20;
  end;
  SetAttributes(Paragraph);
end;

function TQRParaAttributes.GetLeftIndent: Longint;
var
  Paragraph: TParaFormat;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.dxOffset div 20;
end;

procedure TQRParaAttributes.SetLeftIndent(Value: Longint);
var
  Paragraph: TParaFormat;
begin
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_OFFSET;
    dxOffset := Value * 20;
  end;
  SetAttributes(Paragraph);
end;

function TQRParaAttributes.GetRightIndent: Longint;
var
  Paragraph: TParaFormat;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.dxRightIndent div 20;
end;

procedure TQRParaAttributes.SetRightIndent(Value: Longint);
var
  Paragraph: TParaFormat;
begin
  InitPara(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_RIGHTINDENT;
    dxRightIndent := Value * 20;
  end;
  SetAttributes(Paragraph);
end;

function TQRParaAttributes.GetTab(Index: Byte): Longint;
var
  Paragraph: TParaFormat;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.rgxTabs[Index] div 20;
end;

procedure TQRParaAttributes.SetTab(Index: Byte; Value: Longint);
var
  Paragraph: TParaFormat;
begin
  GetAttributes(Paragraph);
  with Paragraph do
  begin
    rgxTabs[Index] := Value * 20;
    dwMask := PFM_TABSTOPS;
    if cTabCount < Index then cTabCount := Index;
    SetAttributes(Paragraph);
  end;
end;

function TQRParaAttributes.GetTabCount: Integer;
var
  Paragraph: TParaFormat;
begin
  GetAttributes(Paragraph);
  Result := Paragraph.cTabCount;
end;

procedure TQRParaAttributes.SetTabCount(Value: Integer);
var
  Paragraph: TParaFormat;
begin
  GetAttributes(Paragraph);
  with Paragraph do
  begin
    dwMask := PFM_TABSTOPS;
    cTabCount := Value;
    SetAttributes(Paragraph);
  end;
end;

procedure TQRParaAttributes.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TQRParaAttributes then
  begin
    Alignment := TQRParaAttributes(Source).Alignment;
    FirstIndent := TQRParaAttributes(Source).FirstIndent;
    LeftIndent := TQRParaAttributes(Source).LeftIndent;
    RightIndent := TQRParaAttributes(Source).RightIndent;
    Numbering := TQRParaAttributes(Source).Numbering;
    for I := 0 to MAX_TAB_STOPS - 1 do
      Tab[I] := TQRParaAttributes(Source).Tab[I];
  end
  else inherited Assign(Source);
end;

{ TQRTextAttributes }

constructor TQRTextAttributes.Create(AOwner: TQRRichTextPlusCustom;
  AttributeType: TAttributeType);
begin
  inherited Create;
  QRRichTextPlus := AOwner;
  FType := AttributeType;
end;

procedure TQRTextAttributes.InitFormat(var Format: TCharFormat);
begin
  FillChar(Format, SizeOf(TCharFormat), 0);
  Format.cbSize := SizeOf(TCharFormat);
end;

function TQRTextAttributes.GetConsistentAttributes: TConsistentAttributes;
var
  Format: TCharFormat;
begin
  Result := [];
  if QRRichTextPlus.HandleAllocated and (FType = atSelected) then
  begin
    InitFormat(Format);
    SendMessage(QRRichTextPlus.Handle, EM_GETCHARFORMAT,
      WPARAM(FType = atSelected), LPARAM(@Format));
    with Format do
    begin
      if (dwMask and CFM_BOLD) <> 0 then Include(Result, caBold);
      if (dwMask and CFM_COLOR) <> 0 then Include(Result, caColor);
      if (dwMask and CFM_FACE) <> 0 then Include(Result, caFace);
      if (dwMask and CFM_ITALIC) <> 0 then Include(Result, caItalic);
      if (dwMask and CFM_SIZE) <> 0 then Include(Result, caSize);
      if (dwMask and CFM_STRIKEOUT) <> 0 then Include(Result, caStrikeOut);
      if (dwMask and CFM_UNDERLINE) <> 0 then Include(Result, caUnderline);
      if (dwMask and CFM_PROTECTED) <> 0 then Include(Result, caProtected);
    end;
  end;
end;

procedure TQRTextAttributes.GetAttributes(var Format: TCharFormat);
begin
  InitFormat(Format);
  if QRRichTextPlus.HandleAllocated then
    SendMessage(QRRichTextPlus.Handle, EM_GETCHARFORMAT,
      WPARAM(FType = atSelected), LPARAM(@Format));
end;

procedure TQRTextAttributes.SetAttributes(var Format: TCharFormat);
var
  Flag: Longint;
begin
  if FType = atSelected then Flag := SCF_SELECTION
  else Flag := 0;
  if QRRichTextPlus.HandleAllocated then
    SendMessage(QRRichTextPlus.Handle, EM_SETCHARFORMAT, Flag, LPARAM(@Format))
end;

function TQRTextAttributes.GetCharset: TFontCharset;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  Result := Format.bCharset;
end;

procedure TQRTextAttributes.SetCharset(Value: TFontCharset);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_CHARSET;
    bCharSet := Value;
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetProtected: Boolean;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  with Format do
    if (dwEffects and CFE_PROTECTED) <> 0 then
      Result := True else
      Result := False;
end;

procedure TQRTextAttributes.SetProtected(Value: Boolean);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_PROTECTED;
    if Value then dwEffects := CFE_PROTECTED;
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetColor: TColor;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  with Format do
    if (dwEffects and CFE_AUTOCOLOR) <> 0 then
      Result := clWindowText else
      Result := crTextColor;
end;

procedure TQRTextAttributes.SetColor(Value: TColor);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_COLOR;
    if Value = clWindowText then
      dwEffects := CFE_AUTOCOLOR else
      crTextColor := ColorToRGB(Value);
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetName: TFontName;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  Result := Format.szFaceName;
end;

procedure TQRTextAttributes.SetName(Value: TFontName);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_FACE;
    StrPLCopy(szFaceName, Value, SizeOf(szFaceName) - 1);
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetStyle: TFontStyles;
var
  Format: TCharFormat;
begin
  Result := [];
  GetAttributes(Format);
  with Format do
  begin
    if (dwEffects and CFE_BOLD) <> 0 then Include(Result, fsBold);
    if (dwEffects and CFE_ITALIC) <> 0 then Include(Result, fsItalic);
    if (dwEffects and CFE_UNDERLINE) <> 0 then Include(Result, fsUnderline);
    if (dwEffects and CFE_STRIKEOUT) <> 0 then Include(Result, fsStrikeOut);
  end;
end;

procedure TQRTextAttributes.SetStyle(Value: TFontStyles);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT;
    if fsBold in Value then dwEffects := dwEffects or CFE_BOLD;
    if fsItalic in Value then dwEffects := dwEffects or CFE_ITALIC;
    if fsUnderline in Value then dwEffects := dwEffects or CFE_UNDERLINE;
    if fsStrikeOut in Value then dwEffects := dwEffects or CFE_STRIKEOUT;
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetSize: Integer;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  Result := Format.yHeight div 20;
end;

procedure TQRTextAttributes.SetSize(Value: Integer);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    dwMask := Integer(CFM_SIZE);
    yHeight := Value * 20;
  end;
  SetAttributes(Format);
end;

function TQRTextAttributes.GetHeight: Integer;
begin
  Result := MulDiv(Size, QRRichTextPlus.Height, 72);
end;

procedure TQRTextAttributes.SetHeight(Value: Integer);
begin
  Size := MulDiv(Value, 72, QRRichTextPlus.Height);
end;

function TQRTextAttributes.GetPitch: TFontPitch;
var
  Format: TCharFormat;
begin
  GetAttributes(Format);
  case (Format.bPitchAndFamily and $03) of
    DEFAULT_PITCH: Result := fpDefault;
    VARIABLE_PITCH: Result := fpVariable;
    FIXED_PITCH: Result := fpFixed;
  else
    Result := fpDefault;
  end;
end;

procedure TQRTextAttributes.SetPitch(Value: TFontPitch);
var
  Format: TCharFormat;
begin
  InitFormat(Format);
  with Format do
  begin
    case Value of
      fpVariable: Format.bPitchAndFamily := VARIABLE_PITCH;
      fpFixed: Format.bPitchAndFamily := FIXED_PITCH;
    else
      Format.bPitchAndFamily := DEFAULT_PITCH;
    end;
  end;
  SetAttributes(Format);
end;

procedure TQRTextAttributes.Assign(Source: TPersistent);
begin
  if Source is TFont then
  begin
    Color := TFont(Source).Color;
    Name := TFont(Source).Name;
    Charset := TFont(Source).Charset;
    Style := TFont(Source).Style;
    Size := TFont(Source).Size;
    Pitch := TFont(Source).Pitch;
  end
  else if Source is TQRTextAttributes then
  begin
    Color := TQRTextAttributes(Source).Color;
    Name := TQRTextAttributes(Source).Name;
    Charset := TQRTextAttributes(Source).Charset;
    Style := TQRTextAttributes(Source).Style;
    Pitch := TQRTextAttributes(Source).Pitch;
    Size := TQRTextAttributes(Source).Size;
  end
  else inherited Assign(Source);
end;

procedure TQRTextAttributes.AssignTo(Dest: TPersistent);
begin
  if Dest is TFont then
  begin
    TFont(Dest).Color := Color;
    TFont(Dest).Name := Name;
    TFont(Dest).Charset := Charset;
    TFont(Dest).Style := Style;
    TFont(Dest).Size := Size;
    TFont(Dest).Pitch := Pitch;
  end
  else if Dest is TQRTextAttributes then
  begin
    TQRTextAttributes(Dest).Color := Color;
    TQRTextAttributes(Dest).Name := Name;
    TQRTextAttributes(Dest).Charset := Charset;
    TQRTextAttributes(Dest).Style := Style;
    TQRTextAttributes(Dest).Pitch := Pitch;
  end
  else inherited AssignTo(Dest);
end;

{ TQRRichTextPlusCustomEdit }

constructor TQRRichTextPlusCustomEdit.Create(AOwner: TComponent);
const
  EditStyle = [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight];
begin
  inherited Create(AOwner);
  if NewStyleControls then
    ControlStyle := EditStyle else
    ControlStyle := EditStyle + [csFramed];
  Width := 121;
  Height := 25;
  TabStop := True;
  ParentColor := False;
  FBorderStyle := bsSingle;
  FAutoSize := True;
  FAutoSelect := True;
  FHideSelection := True;
  AdjustHeight;
end;

procedure TQRRichTextPlusCustomEdit.DoSetMaxLength(Value: Integer);
begin
  SendMessage(Handle, EM_LIMITTEXT, Value, 0)
end;

procedure TQRRichTextPlusCustomEdit.SetAutoSize(Value: Boolean);
begin
  if FAutoSize <> Value then
  begin
    FAutoSize := Value;
    UpdateHeight;
  end;
end;

procedure TQRRichTextPlusCustomEdit.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    UpdateHeight;
    RecreateWnd;
  end;
end;

procedure TQRRichTextPlusCustomEdit.SetCharCase(Value: TEditCharCase);
begin
  if FCharCase <> Value then
  begin
    FCharCase := Value;
    RecreateWnd;
  end;
end;

procedure TQRRichTextPlusCustomEdit.SetHideSelection(Value: Boolean);
begin
  if FHideSelection <> Value then
  begin
    FHideSelection := Value;
    RecreateWnd;
  end;
end;

procedure TQRRichTextPlusCustomEdit.SetMaxLength(Value: Integer);
begin
  if FMaxLength <> Value then
  begin
    FMaxLength := Value;
    if HandleAllocated then DoSetMaxLength(Value);
  end;
end;

procedure TQRRichTextPlusCustomEdit.SetOEMConvert(Value: Boolean);
begin
  if FOEMConvert <> Value then
  begin
    FOEMConvert := Value;
    RecreateWnd;
  end;
end;

function TQRRichTextPlusCustomEdit.GetModified: Boolean;
begin
  Result := FModified;
  if HandleAllocated then Result := SendMessage(Handle, EM_GETMODIFY, 0, 0) <> 0;
end;

function TQRRichTextPlusCustomEdit.GetCanUndo: Boolean;
begin
  Result := False;
  if HandleAllocated then Result := SendMessage(Handle, EM_CANUNDO, 0, 0) <> 0;
end;

procedure TQRRichTextPlusCustomEdit.SetModified(Value: Boolean);
begin
  if HandleAllocated then
    SendMessage(Handle, EM_SETMODIFY, Byte(Value), 0) else
    FModified := Value;
end;

procedure TQRRichTextPlusCustomEdit.SetPasswordChar(Value: Char);
begin
  if FPasswordChar <> Value then
  begin
    FPasswordChar := Value;
    if HandleAllocated then
    begin
      SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
      SetTextBuf(PChar(Text));
    end;
  end;
end;

procedure TQRRichTextPlusCustomEdit.SetReadOnly(Value: Boolean);
begin
  if FReadOnly <> Value then
  begin
    FReadOnly := Value;
    if HandleAllocated then
      SendMessage(Handle, EM_SETREADONLY, Ord(Value), 0);
  end;
end;

function TQRRichTextPlusCustomEdit.GetSelStart: Integer;
begin
  SendMessage(Handle, EM_GETSEL, Longint(@Result), 0);
end;

procedure TQRRichTextPlusCustomEdit.SetSelStart(Value: Integer);
begin
  SendMessage(Handle, EM_SETSEL, Value, Value);
end;

function TQRRichTextPlusCustomEdit.GetSelLength: Integer;
var
  Selection: TSelection;
begin
  SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  Result := Selection.EndPos - Selection.StartPos;
end;

procedure TQRRichTextPlusCustomEdit.SetSelLength(Value: Integer);
var
  Selection: TSelection;
begin
  SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  Selection.EndPos := Selection.StartPos + Value;
  SendMessage(Handle, EM_SETSEL, Selection.StartPos, Selection.EndPos);
  SendMessage(Handle, EM_SCROLLCARET, 0,0);
end;

procedure TQRRichTextPlusCustomEdit.Clear;
begin
  SetWindowText(Handle, ´´);
end;

procedure TQRRichTextPlusCustomEdit.ClearSelection;
begin
  SendMessage(Handle, WM_CLEAR, 0, 0);
end;

procedure TQRRichTextPlusCustomEdit.CopyToClipboard;
begin
  SendMessage(Handle, WM_COPY, 0, 0);
end;

procedure TQRRichTextPlusCustomEdit.CutToClipboard;
begin
  SendMessage(Handle, WM_CUT, 0, 0);
end;

procedure TQRRichTextPlusCustomEdit.PasteFromClipboard;
begin
  SendMessage(Handle, WM_PASTE, 0, 0);
end;

procedure TQRRichTextPlusCustomEdit.Undo;
begin
  SendMessage(Handle, WM_UNDO, 0, 0);
end;

procedure TQRRichTextPlusCustomEdit.ClearUndo;
begin
  SendMessage(Handle, EM_EMPTYUNDOBUFFER, 0, 0);
end;

procedure TQRRichTextPlusCustomEdit.SelectAll;
begin
  SendMessage(Handle, EM_SETSEL, 0, -1);
end;

function TQRRichTextPlusCustomEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
var
  P: PChar;
  StartPos: Integer;
begin
  StartPos := GetSelStart;
  Result := GetSelLength;
  P := StrAlloc(GetTextLen + 1);
  try
    GetTextBuf(P, StrBufSize(P));
    if Result >= BufSize then Result := BufSize - 1;
    StrLCopy(Buffer, P + StartPos, Result);
  finally
    StrDispose(P);
  end;
end;

procedure TQRRichTextPlusCustomEdit.SetSelTextBuf(Buffer: PChar);
begin
  SendMessage(Handle, EM_REPLACESEL, 0, LongInt(Buffer));
end;

function TQRRichTextPlusCustomEdit.GetSelText: string;
var
  P: PChar;
  SelStart, Len: Integer;
begin
  SelStart := GetSelStart;
  Len := GetSelLength;
  SetString(Result, PChar(nil), Len);
  if Len <> 0 then
  begin
    P := StrAlloc(GetTextLen + 1);
    try
      GetTextBuf(P, StrBufSize(P));
      Move(P[SelStart], Pointer(Result)^, Len);
    finally
      StrDispose(P);
    end;
  end;
end;

procedure TQRRichTextPlusCustomEdit.SetSelText(const Value: String);
begin
  SendMessage(Handle, EM_REPLACESEL, 0, Longint(PChar(Value)));
end;

procedure TQRRichTextPlusCustomEdit.CreateParams(var Params: TCreateParams);
const
  Passwords: array[Boolean] of DWORD = (0, ES_PASSWORD);
  ReadOnlys: array[Boolean] of DWORD = (0, ES_READONLY);
  CharCases: array[TEditCharCase] of DWORD = (0, ES_UPPERCASE, ES_LOWERCASE);
  HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
  OEMConverts: array[Boolean] of DWORD = (0, ES_OEMCONVERT);
begin
  inherited CreateParams(Params);
  CreateSubClass(Params, ´EDIT´);
  with Params do
  begin
    Style := Style or (ES_AUTOHSCROLL or ES_AUTOVSCROLL) or
      BorderStyles[FBorderStyle] or Passwords[FPasswordChar <> 0] or
      ReadOnlys[FReadOnly] or CharCases[FCharCase] or
      HideSelections[FHideSelection] or OEMConverts[FOEMConvert];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

procedure TQRRichTextPlusCustomEdit.CreateWindowHandle(const Params: TCreateParams);
var
  P: TCreateParams;
begin
  if SysLocale.FarEast and (Win32Platform <> VER_PLATFORM_WIN32_NT) and
    ((Params.Style and ES_READONLY) <> 0) then
  begin
    // Work around Far East Win95 API/IME bug.
    P := Params;
    P.Style := P.Style and (not ES_READONLY);
    inherited CreateWindowHandle(P);
    if WindowHandle <> 0 then
      SendMessage(WindowHandle, EM_SETREADONLY, Ord(True), 0);
  end
  else
    inherited CreateWindowHandle(Params);
end;

procedure TQRRichTextPlusCustomEdit.CreateWnd;
begin
  FCreating := True;
  try
    inherited CreateWnd;
  finally
    FCreating := False;
  end;
  DoSetMaxLength(FMaxLength);
  Modified := FModified;
  if FPasswordChar <> #0 then
    SendMessage(Handle, EM_SETPASSWORDCHAR, Ord(FPasswordChar), 0);
  UpdateHeight;
end;

procedure TQRRichTextPlusCustomEdit.DestroyWnd;
begin
  FModified := Modified;
  inherited DestroyWnd;
end;

procedure TQRRichTextPlusCustomEdit.UpdateHeight;
begin
  if FAutoSize and (BorderStyle = bsSingle) then
  begin
    ControlStyle := ControlStyle + [csFixedHeight];
    AdjustHeight;
  end else
    ControlStyle := ControlStyle - [csFixedHeight];
end;

procedure TQRRichTextPlusCustomEdit.AdjustHeight;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  if NewStyleControls then
  begin
    if Ctl3D then I := 8 else I := 6;
    I := GetSystemMetrics(SM_CYBORDER) * I;
  end else
  begin
    I := SysMetrics.tmHeight;
    if I > Metrics.tmHeight then I := Metrics.tmHeight;
    I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
  end;
  Height := Metrics.tmHeight + I;
end;

procedure TQRRichTextPlusCustomEdit.Change;
begin
  inherited Changed;
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TQRRichTextPlusCustomEdit.DefaultHandler(var Message);
begin
  case TMessage(Message).Msg of
    WM_SETFOCUS:
      if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
        not IsWindow(TWMSetFocus(Message).FocusedWnd) then
        TWMSetFocus(Message).FocusedWnd := 0;
  end;
  inherited;
end;

procedure TQRRichTextPlusCustomEdit.WMSetFont(var Message: TWMSetFont);
begin
  inherited;
  if NewStyleControls and
    (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then
    SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
end;

procedure TQRRichTextPlusCustomEdit.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then
  begin
    UpdateHeight;
    RecreateWnd;
  end;
  inherited;
end;

procedure TQRRichTextPlusCustomEdit.CMFontChanged(var Message: TMessage);
begin
  inherited;
  if (csFixedHeight in ControlStyle) and not ((csDesigning in
    ComponentState) and (csLoading in ComponentState)) then AdjustHeight;
end;

procedure TQRRichTextPlusCustomEdit.CNCommand(var Message: TWMCommand);
begin
  if (Message.NotifyCode = EN_CHANGE) and not FCreating then Change;
end;

procedure TQRRichTextPlusCustomEdit.CMEnter(var Message: TCMGotFocus);
begin
  if FAutoSelect and not (csLButtonDown in ControlState) and
    (GetWindowLong(Handle, GWL_STYLE) and ES_MULTILINE = 0) then SelectAll;
  inherited;
end;

procedure TQRRichTextPlusCustomEdit.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if not HandleAllocated or (GetWindowLong(Handle, GWL_STYLE) and
    ES_MULTILINE <> 0) then Change;
end;

procedure TQRRichTextPlusCustomEdit.WMContextMenu(var Message: TWMContextMenu);
begin
  SetFocus;
  inherited;
end;


{ TQRRichTextPlusCustomMemo }

constructor TQRRichTextPlusCustomMemo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 185;
  Height := 89;
  AutoSize := False;
  FWordWrap := True;
  FWantReturns := True;
  FLines := TQRMemoStrings.Create;
  TQRMemoStrings(FLines).Memo := Self;
  ParentBackground := False;
end;

destructor TQRRichTextPlusCustomMemo.Destroy;
begin
  FLines.Free;
  inherited Destroy;
end;

procedure TQRRichTextPlusCustomMemo.CreateParams(var Params: TCreateParams);
const
  Alignments: array[Boolean, TAlignment] of DWORD =
    ((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER));
  ScrollBar: array[TScrollStyle] of DWORD = (0, WS_HSCROLL, WS_VSCROLL,
    WS_HSCROLL or WS_VSCROLL);
  WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style and not WordWraps[FWordWrap] or ES_MULTILINE or
      Alignments[UseRightToLeftAlignment, FAlignment] or ScrollBar[FScrollBars];
  end;
end;

procedure TQRRichTextPlusCustomMemo.CreateWindowHandle(const Params: TCreateParams);
begin
  with Params do
  begin
    if SysLocale.FarEast and (Win32Platform <> VER_PLATFORM_WIN32_NT) and
      ((Style and ES_READONLY) <> 0) then
    begin
      // Work around Far East Win95 API/IME bug.
      WindowHandle := CreateWindowEx(ExStyle, WinClassName, ´´,
        Style and (not ES_READONLY),
        X, Y, Width, Height, WndParent, 0, HInstance, Param);
      if WindowHandle <> 0 then
        SendMessage(WindowHandle, EM_SETREADONLY, Ord(True), 0);
    end
    else
      WindowHandle := CreateWindowEx(ExStyle, WinClassName, ´´, Style,
        X, Y, Width, Height, WndParent, 0, HInstance, Param);
    SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
  end;
end;

function TQRRichTextPlusCustomMemo.GetCaretPos: TPoint;
begin
  Result.X := LongRec(SendMessage(Handle, EM_GETSEL, 0, 0)).Hi;
  Result.Y := SendMessage(Handle, EM_LINEFROMCHAR, Result.X, 0);
  Result.X := Result.X - SendMessage(Handle, EM_LINEINDEX, -1, 0);
end;

procedure TQRRichTextPlusCustomMemo.SetCaretPos(const Value: TPoint);
var
  CharIdx: Integer;
begin
  CharIdx := SendMessage(Handle, EM_LINEINDEX, Value.y, 0) + Value.x;
  SendMessage(Handle, EM_SETSEL, CharIdx, CharIdx);
end;

function TQRRichTextPlusCustomMemo.GetControlsAlignment: TAlignment;
begin
  Result := FAlignment;
end;

procedure TQRRichTextPlusCustomMemo.Loaded;
begin
  inherited Loaded;
  Modified := False;
end;

procedure TQRRichTextPlusCustomMemo.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    RecreateWnd;
  end;
end;

procedure TQRRichTextPlusCustomMemo.SetLines(Value: TStrings);
begin
  FLines.Assign(Value);
end;

procedure TQRRichTextPlusCustomMemo.SetScrollBars(Value: TScrollStyle);
begin
  if FScrollBars <> Value then
  begin
    FScrollBars := Value;
    RecreateWnd;
  end;
end;

procedure TQRRichTextPlusCustomMemo.SetWordWrap(Value: Boolean);
begin
  if Value <> FWordWrap then
  begin
    FWordWrap := Value;
    RecreateWnd;
  end;
end;

procedure TQRRichTextPlusCustomMemo.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  if FWantTabs then Message.Result := Message.Result or DLGC_WANTTAB
  else Message.Result := Message.Result and not DLGC_WANTTAB;
  if not FWantReturns then
    Message.Result := Message.Result and not DLGC_WANTALLKEYS;
end;

procedure TQRRichTextPlusCustomMemo.WMNCDestroy(var Message: TWMNCDestroy);
begin
  inherited;
end;

procedure TQRRichTextPlusCustomMemo.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key = Char(VK_RETURN)) and not FWantReturns then Key := #0;
end;


{ TQRRichTextPlusCustom }

constructor TQRRichTextPlusCustom.Create(AOwner: TComponent);
var
  DC: HDC;
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csNeedsBorderPaint];
  FSelAttributes := TQRTextAttributes.Create(Self, atSelected);
  FDefAttributes := TQRTextAttributes.Create(Self, atDefaultText);
  FParagraph := TQRParaAttributes.Create(Self);
  FRichEditStrings := TQRRichEditStrings.Create;
  TQRRichEditStrings(FRichEditStrings).RichEdit := Self;
  TabStop := True;
  Width := 185;
  Height := 89;
  AutoSize := False;
  DoubleBuffered := False;
  FHideSelection := True;
  HideScrollBars := True;
  DC := GetDC(0);
  FScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
  DefaultConverter := TConversion;
  ReleaseDC(0, DC);
  FOldParaAlignment := Alignment;
  Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
end;

destructor TQRRichTextPlusCustom.Destroy;
begin
  FSelAttributes.Free;
  FDefAttributes.Free;
  FParagraph.Free;
  FRichEditStrings.Free;
  FMemStream.Free;
  inherited Destroy;
end;

procedure TQRRichTextPlusCustom.Clear;
begin
  inherited Clear;
  Modified := False;
end;

procedure TQRRichTextPlusCustom.CreateParams(var Params: TCreateParams);
const
  RichEditModuleName = ´RICHED32.DLL´;
  HideScrollBars: array[Boolean] of DWORD = (ES_DISABLENOSCROLL, 0);
  HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
begin
  if FRichEditModule = 0 then
  begin
    FRichEditModule := LoadLibrary(RichEditModuleName);
    if FRichEditModule <= HINSTANCE_ERROR then FRichEditModule := 0;
  end;
  inherited CreateParams(Params);
  CreateSubClass(Params, ´RICHEDIT´);
  with Params do
  begin
    Style := Style or HideScrollBars[FHideScrollBars] or
      HideSelections[HideSelection];
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;

procedure TQRRichTextPlusCustom.CreateWnd;
var
  Plain, DesignMode, WasModified: Boolean;
begin
  WasModified := inherited Modified;
  inherited CreateWnd;
  if (SysLocale.FarEast) and not (SysLocale.PriLangID = LANG_JAPANESE) then
    Font.Charset := GetDefFontCharSet;
  SendMessage(Handle, EM_SETEVENTMASK, 0,
    ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or
    ENM_PROTECTED);
  SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color));
  if FMemStream <> nil then
  begin
    Plain := PlainText;
    FMemStream.ReadBuffer(DesignMode, sizeof(DesignMode));
    PlainText := DesignMode;
    try
      Lines.LoadFromStream(FMemStream);
      FMemStream.Free;
      FMemStream := nil;
    finally
      PlainText := Plain;
    end;
  end;
  Modified := WasModified;
end;

procedure TQRRichTextPlusCustom.DestroyWnd;
var
  Plain, DesignMode: Boolean;
begin
  FModified := Modified;
  FMemStream := TMemoryStream.Create;
  Plain := PlainText;
  DesignMode := (csDesigning in ComponentState);
  PlainText := DesignMode;
  FMemStream.WriteBuffer(DesignMode, sizeof(DesignMode));
  try
    Lines.SaveToStream(FMemStream);
    FMemStream.Position := 0;
  finally
    PlainText := Plain;
  end;
  inherited DestroyWnd;
end;

procedure TQRRichTextPlusCustom.WMNCDestroy(var Message: TWMNCDestroy);
begin
  inherited;
end;

procedure TQRRichTextPlusCustom.WMSetFont(var Message: TWMSetFont);
begin
  FDefAttributes.Assign(Font);
end;

procedure TQRRichTextPlusCustom.WMRButtonUp(var Message: TWMRButtonUp);
begin
  // RichEd20 does not pass the WM_RBUTTONUP message to defwndproc,
  // so we get no WM_CONTEXTMENU message.  Simulate message here.
  if Win32MajorVersion < 5 then
    Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
      ClientToScreen(SmallPointToPoint(Message.Pos)))));
  inherited;
end;

procedure TQRRichTextPlusCustom.CMFontChanged(var Message: TMessage);
begin
  FDefAttributes.Assign(Font);
end;

procedure TQRRichTextPlusCustom.DoSetMaxLength(Value: Integer);
begin
  SendMessage(Handle, EM_EXLIMITTEXT, 0, Value);
end;

function TQRRichTextPlusCustom.GetCaretPos;
var
  CharRange: TCharRange;
begin
  SendMessage(Handle, EM_EXGETSEL, 0, LongInt(@CharRange));
  Result.X := CharRange.cpMax;
  Result.Y := SendMessage(Handle, EM_EXLINEFROMCHAR, 0, Result.X);
  Result.X := Result.X - SendMessage(Handle, EM_LINEINDEX, -1, 0);
end;

procedure TQRRichTextPlusCustom.SetCaretPos(const Value: TPoint);
var
  CharRange: TCharRange;
begin
  CharRange.cpMin := SendMessage(Handle, EM_LINEINDEX, Value.y, 0) + Value.x;
  CharRange.cpMax := CharRange.cpMin;
  SendMessage(Handle, EM_EXSETSEL, 0, Longint(@CharRange));
end;

function TQRRichTextPlusCustom.GetSelLength: Integer;
var
  CharRange: TCharRange;
begin
  SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
  Result := CharRange.cpMax - CharRange.cpMin;
end;

function TQRRichTextPlusCustom.GetSelStart: Integer;
var
  CharRange: TCharRange;
begin
  SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
  Result := CharRange.cpMin;
end;

function TQRRichTextPlusCustom.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
var
  S: string;
begin
  S := GetSelText;
  Result := Length(S);
  if BufSize <= Length(S) then Result := BufSize - 1;
  StrPLCopy(Buffer, S, Result);
end;

function TQRRichTextPlusCustom.GetSelText: string;
var
  Length: Integer;
begin
  SetLength(Result, GetSelLength + 1);
  Length := SendMessage(Handle, EM_GETSELTEXT, 0, Longint(PChar(Result)));
  SetLength(Result, Length);
end;

procedure TQRRichTextPlusCustom.CMBiDiModeChanged(var Message: TMessage);
var
  AParagraph: TParaFormat;
begin
  HandleNeeded; { we REALLY need the handle for BiDi }
  inherited;
  Paragraph.GetAttributes(AParagraph);
  AParagraph.dwMask := PFM_ALIGNMENT;
  AParagraph.wAlignment := Ord(Alignment) + 1;
  Paragraph.SetAttributes(AParagraph);
end;

procedure TQRRichTextPlusCustom.SetHideScrollBars(Value: Boolean);
begin
  if HideScrollBars <> Value then
  begin
    FHideScrollBars := value;
    RecreateWnd;
  end;
end;

procedure TQRRichTextPlusCustom.SetHideSelection(Value: Boolean);
begin
  if HideSelection <> Value then
  begin
    FHideSelection := Value;
    SendMessage(Handle, EM_HIDESELECTION, Ord(HideSelection), LongInt(True));
  end;
end;

procedure TQRRichTextPlusCustom.SetSelAttributes(Value: TQRTextAttributes);
begin
  SelAttributes.Assign(Value);
end;

procedure TQRRichTextPlusCustom.SetSelLength(Value: Integer);
var
  CharRange: TCharRange;
begin
  SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
  CharRange.cpMax := CharRange.cpMin + Value;
  SendMessage(Handle, EM_EXSETSEL, 0, Longint(@CharRange));
  SendMessage(Handle, EM_SCROLLCARET, 0, 0);
end;

procedure TQRRichTextPlusCustom.SetDefAttributes(Value: TQRTextAttributes);
begin
  DefAttributes.Assign(Value);
end;

function TQRRichTextPlusCustom.GetPlainText: Boolean;
begin
  Result := TQRRichEditStrings(Lines).PlainText;
end;

procedure TQRRichTextPlusCustom.SetPlainText(Value: Boolean);
begin
  TQRRichEditStrings(Lines).PlainText := Value;
end;

procedure TQRRichTextPlusCustom.CMColorChanged(var Message: TMessage);
begin
  inherited;
//  SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color))
end;

procedure TQRRichTextPlusCustom.SetRichEditStrings(Value: TStrings);
begin
  FRichEditStrings.Assign(Value);
end;

procedure TQRRichTextPlusCustom.SetSelStart(Value: Integer);
var
  CharRange: TCharRange;
begin
  CharRange.cpMin := Value;
  CharRange.cpMax := Value;
  SendMessage(Handle, EM_EXSETSEL, 0, Longint(@CharRange));
end;

procedure TQRRichTextPlusCustom.Print(const Caption: string);
var
  Range: TFormatRange;
  LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  SaveRect: TRect;
begin
  FillChar(Range, SizeOf(TFormatRange), 0);
  with Printer, Range do
  begin
    Title := Caption;
    BeginDoc;
    hdc := Handle;
    hdcTarget := hdc;
    LogX := GetDeviceCaps(Handle, LOGPIXELSX);
    LogY := GetDeviceCaps(Handle, LOGPIXELSY);
    if IsRectEmpty(PageRect) then
    begin
      rc.right := PageWidth * 1440 div LogX;
      rc.bottom := PageHeight * 1440 div LogY;
    end
    else begin
      rc.left := PageRect.Left * 1440 div LogX;
      rc.top := PageRect.Top * 1440 div LogY;
      rc.right := PageRect.Right * 1440 div LogX;
      rc.bottom := PageRect.Bottom * 1440 div LogY;
    end;
    rcPage := rc;
    SaveRect := rc;
    LastChar := 0;
    MaxLen := GetTextLen;
    chrg.cpMax := -1;
    // ensure printer DC is in text map mode
    OldMap := SetMapMode(hdc, MM_TEXT);
    SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);    // flush buffer
    try
      repeat
        rc := SaveRect;
        chrg.cpMin := LastChar;
        LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
        if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
      until (LastChar >= MaxLen) or (LastChar = -1);
      EndDoc;
    finally
      SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);  // flush buffer
      SetMapMode(hdc, OldMap);       // restore previous map mode
    end;
  end;
end;

var
  Painting: Boolean = False;

procedure TQRRichTextPlusCustom.WMPaint(var Message: TWMPaint);
var
  R, R1: TRect;
begin
  if GetUpdateRect(Handle, R, True) then
  begin
    with ClientRect do R1 := Rect(Right - 3, Top, Right, Bottom);
    if IntersectRect(R, R, R1) then InvalidateRect(Handle, @R1, True);
  end;
  if Painting then
    Invalidate
  else begin
    Painting := True;
    try
      inherited;
    finally
      Painting := False;
    end;
  end;
end;

procedure TQRRichTextPlusCustom.WMSetCursor(var Message: TWMSetCursor);
var
  P: TPoint;
begin
  inherited;
  if Message.Result = 0 then
  begin
    Message.Result := 1;
    GetCursorPos(P);
    with PointToSmallPoint(P) do
      case Perform(WM_NCHITTEST, 0, MakeLong(X, Y)) of
        HTVSCROLL,
        HTHSCROLL:
          Windows.SetCursor(Screen.Cursors[crArrow]);
        HTCLIENT:
          Windows.SetCursor(Screen.Cursors[crIBeam]);
      end;
  end;
end;

procedure TQRRichTextPlusCustom.CNNotify(var Message: TWMNotify);
begin
  with Message do
    case NMHdr^.code of
      EN_SELCHANGE: SelectionChange;
      EN_REQUESTRESIZE: RequestSize(PReqSize(NMHdr)^.rc);
      EN_SAVECLIPBOARD:
        with PENSaveClipboard(NMHdr)^ do
          if not SaveClipboard(cObjectCount, cch) then Result := 1;
      EN_PROTECTED:
        with PENProtected(NMHdr)^.chrg do
          if not ProtectChange(cpMin, cpMax) then Result := 1;
    end;
end;

function TQRRichTextPlusCustom.SaveClipboard(NumObj, NumChars: Integer): Boolean;
begin
  Result := True;
  if Assigned(OnSaveClipboard) then OnSaveClipboard(Self, NumObj, NumChars, Result);
end;

function TQRRichTextPlusCustom.ProtectChange(StartPos, EndPos: Integer): Boolean;
begin
  Result := False;
  if Assigned(OnProtectChange) then OnProtectChange(Self, StartPos, EndPos, Result);
end;

procedure TQRRichTextPlusCustom.SelectionChange;
begin
  if Assigned(OnSelectionChange) then OnSelectionChange(Self);
end;

procedure TQRRichTextPlusCustom.RequestSize(const Rect: TRect);
begin
  if Assigned(OnResizeRequest) then OnResizeRequest(Self, Rect);
end;

function TQRRichTextPlusCustom.FindText(const SearchStr: string;
  StartPos, Length: Integer; Options: TSearchTypes): Integer;
var
  Find: TFindText;
  Flags: Integer;
begin
  with Find.chrg do
  begin
    cpMin := StartPos;
    cpMax := cpMin + Length;
  end;
  Flags := 0;
  if stWholeWord in Options then Flags := Flags or FT_WHOLEWORD;
  if stMatchCase in Options then Flags := Flags or FT_MATCHCASE;
  Find.lpstrText := PChar(SearchStr);
  Result := SendMessage(Handle, EM_FINDTEXT, Flags, LongInt(@Find));
end;

procedure AppendConversionFormat(const Ext: string; AClass: TConversionClass);
var
  NewRec: PConversionFormat;
begin
  New(NewRec);
  with NewRec^ do
  begin
    Extension := AnsiLowerCaseFileName(Ext);
    ConversionClass := AClass;
    Next := ConversionFormatList;
  end;
  ConversionFormatList := NewRec;
end;

class procedure TQRRichTextPlusCustom.RegisterConversionFormat(const AExtension: string;
  AConversionClass: TConversionClass);
begin
  AppendConversionFormat(AExtension, AConversionClass);
end;

end.