lazarus-ccr/components/richmemo/richmemoutils.pas

{
 richmemoutils.pas

 Author: Dmitry 'skalogryz' Boyarintsev

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}
unit RichMemoUtils;

interface

{$mode objfpc}{$h+}

uses
  Types, SysUtils, Classes, Graphics, LazFileUtils, LazUTF8, RichMemo;

const
  NoResize : TSize = ( cx: 0; cy : 0 );

var
  { Disclaimer: the function would insert an image file into RichMemo
    (if implemented by the widgetset) But in a very inefficient way.
    The image would be read again and the memory would be re-allocated for
    the image every time. So please, don't use it for smileys in
    your chat instant messaging.  A better API (with data caching) is considered.
    (That's why this method is not part of TCustomRichMemo class)

    APos - position in the text
    AImgSize - size to be inserted (in POINTS, not pixels!).
        if both width and height are 0, the image would not be resized at all.
    }
  InsertImageFromFile : function (const ARichMemo: TCustomRichMemo; APos: Integer;
     const FileNameUTF8: string;
     const AImgSize: TSize
  ): Boolean = nil;

function InsertImageFromFileNoResize (const ARichMemo: TCustomRichMemo; APos: Integer;
     const FileNameUTF8: string): Boolean;

procedure LoadRTFFile(const ARichMemo: TCustomRichMemo; const FileNameUTF8: string);

procedure SaveRTFFile(const ARichMemo: TCustomRichMemo; const FileNameUTF8: string);

procedure InsertStyledText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; AStyle: TFontStyles;
  InsPos : Integer = -1 );
procedure InsertColorStyledText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; AColor: TColor; AStyle: TFontStyles;
  InsPos : Integer = -1 );
procedure InsertFontText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; const prms: TFontParams;
  InsPos : Integer = -1 );

implementation

procedure InsertFontText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; const prms: TFontParams;
  InsPos : Integer = -1 );
var
  len : Integer;
begin
  if InsPos<0 then InsPos:=UTF8Length(ARichMemo.Text);
  len:=ARichMemo.InDelText(TextUTF8, InsPos, 0);
  ARichMemo.SetTextAttributes(InsPos, len, prms);
end;

procedure InsertColorStyledText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; AColor: TColor; AStyle: TFontStyles;
  InsPos : Integer = -1 );
var
  sel: Integer;
  ft : TFontParams;
begin
  if InsPos<0 then InsPos:=UTF8Length(ARichMemo.Text);
  ARichMemo.GetTextAttributes(InsPos, ft);
  ft.Style:=AStyle;
  ft.Color:=AColor;
  InsertFontText(ARichMemo, TextUTF8, ft, InsPos);
end;

procedure InsertStyledText(const ARichMemo: TCustomRichMemo; const TextUTF8: String; AStyle: TFontStyles;
  InsPos : Integer );
var
  sel: Integer;
  ft : TFontParams;
begin
  if InsPos<0 then InsPos:=UTF8Length(ARichMemo.Text);
  ARichMemo.GetTextAttributes(InsPos, ft);
  ft.Style:=AStyle;
  InsertFontText(ARichMemo, TextUTF8, ft, InsPos);
end;

function InsertImageFileDummy(const ARichMemo: TCustomRichMemo; APos: Integer;
     const FileNameUTF8: string;
     const AImgSize: TSize): Boolean;
begin
  Result:=false;
end;

function InsertImageFromFileNoResize (const ARichMemo: TCustomRichMemo; APos: Integer;
     const FileNameUTF8: string): Boolean;
begin
  Result:=InsertImageFromFile(ARichMemo, APos, FileNameUTF8, NoResize);
end;

{$IFDEF USELCLUtf8}
procedure LoadRTFFile(const ARichMemo: TCustomRichMemo; const FileNameUTF8: string);
var
  fs : THandleStream;
  h  : THandle;
begin
  if not Assigned(ARichMemo) then Exit;
  h:= FileOpenUTF8(FileNameUTF8, fmShareDenyNone or fmOpenRead);
  fs := THandleStream.Create( h );
  try
    ARichMemo.LoadRichText(fs);
  finally
    fs.Free;
  end;
  FileClose(h);
end;
{$ENDIF}

procedure LoadRTFFile(const ARichMemo: TCustomRichMemo; const FileNameUTF8: string);
var
  fs : TFileStream;
begin
  if not Assigned(ARichMemo) then Exit;
  fs:= TFileStream.Create( UTF8Decode(FileNameUTF8), fmShareDenyNone or fmOpenRead);
  try
    ARichMemo.LoadRichText(fs);
  finally
    fs.Free;
  end;
end;

procedure SaveRTFFile(const ARichMemo: TCustomRichMemo; const FileNameUTF8: string);
var
  fs : TFileStream;
begin
  if not Assigned(ARichMemo) then Exit;
  fs:= TFileStream.Create( UTF8Decode(FileNameUTF8), fmCreate);
  try
    ARichMemo.SaveRichText(fs);
  finally
    fs.Free;
  end;
end;


initialization
  if not Assigned(InsertImageFromFile)  then
    InsertImageFromFile := @InsertImageFileDummy;

end.