started RichMemo package

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@820 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2009-06-04 19:38:39 +00:00
parent 7baab9820c
commit 3eb6fb7a4f
10 changed files with 793 additions and 0 deletions
--- a/components/richmemo/richmemo.pas
+++ b/components/richmemo/richmemo.pas
@ -0,0 +1,175 @@
+unit RichMemo; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Graphics, StdCtrls, 
+  RichMemoTypes, WSRichMemo; 
+
+type
+  { TCustomRichMemo }
+
+  TCustomRichMemo = class(TCustomMemo)
+  private
+    fHideSelection  : Boolean;
+  protected
+    class procedure WSRegisterClass; override;
+    procedure CreateWnd; override;    
+    procedure UpdateRichMemo; virtual;
+    procedure SetHideSelection(AValue: Boolean);
+  public
+    procedure SetTextAttributes(TextStart, TextLen: Integer; AFont: TFont); 
+    procedure SetTextAttributes(TextStart, TextLen: Integer; SetMask: TTextStyleMask; const TextParams: TFontParams); virtual; 
+    function GetTextAttributes(TextStart: Integer; var TextParams: TFontParams): Boolean; virtual;
+    property HideSelection : Boolean read fHideSelection write SetHideSelection;
+  end;
+  
+  TRichMemo = class(TCustomRichMemo)
+  published
+    property Align;
+    property Alignment;
+    property Anchors;
+    property BidiMode;
+    property BorderSpacing;
+    property BorderStyle;
+    property Color;
+    property Constraints;
+    property DragCursor;
+    property DragKind;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property HideSelection;
+    property Lines;
+    property MaxLength;
+    property OnChange;
+    property OnClick;
+    property OnContextPopup;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEditingDone;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnKeyDown;
+    property OnKeyPress;
+    property OnKeyUp;
+    property OnMouseDown;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnStartDrag;
+    property OnUTF8KeyPress;
+    property ParentBidiMode;
+    property ParentColor;
+    property ParentFont;
+    property PopupMenu;
+    property ParentShowHint;
+    property ReadOnly;
+    property ScrollBars;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Visible;
+    property WantReturns;
+    property WantTabs;
+    property WordWrap;
+  end;
+  
+const
+  TextStyleAll : TTextStyleMask = [tsm_Color, tsm_Name, tsm_Size, tsm_Styles];
+  
+function GetFontParams(styles: TFontStyles): TFontParams; overload;
+function GetFontParams(color: TColor; styles: TFontStyles): TFontParams; overload;
+function GetFontParams(const Name: String; color: TColor; styles: TFontStyles): TFontParams; overload;
+function GetFontParams(const Name: String; Size: Integer; color: TColor; styles: TFontStyles): TFontParams; overload;
+  
+implementation
+
+function GetFontParams(styles: TFontStyles): TFontParams; overload;
+begin 
+  Result := GetFontParams('', 0, 0, styles);
+end;
+
+function GetFontParams(color: TColor; styles: TFontStyles): TFontParams; overload;
+begin
+  Result := GetFontParams('', 0, color, styles);
+end;
+
+function GetFontParams(const Name: String; color: TColor; styles: TFontStyles): TFontParams; overload;
+begin
+  Result := GetFontParams(Name, 0, color, styles);
+end;
+
+function GetFontParams(const Name: String; Size: Integer; color: TColor; styles: TFontStyles): TFontParams; overload;
+begin
+  Result.Name := Name;
+  Result.Size := Size;
+  Result.Color := color;
+  Result.Style := styles;
+end;
+
+{ TCustomRichMemo }
+
+procedure TCustomRichMemo.SetHideSelection(AValue: Boolean);
+begin
+  if HandleAllocated then 
+    TWSCustomRichMemoClass(WidgetSetClass).SetHideSelection(Self, AValue);
+  fHideSelection := AValue;   
+end;
+
+class procedure TCustomRichMemo.WSRegisterClass;  
+begin
+  inherited;
+  WSRegisterCustomRichMemo;
+end;
+
+procedure TCustomRichMemo.CreateWnd;  
+begin
+  inherited CreateWnd;  
+  UpdateRichMemo;
+end;
+
+procedure TCustomRichMemo.UpdateRichMemo; 
+begin
+  if not HandleAllocated then Exit;
+  TWSCustomRichMemoClass(WidgetSetClass).SetHideSelection(Self, fHideSelection);
+end;
+
+procedure TCustomRichMemo.SetTextAttributes(TextStart, TextLen: Integer;  
+  AFont: TFont); 
+var
+  params  : TFontParams;
+begin
+  params.Name := AFont.Name;
+  params.Color := AFont.Color;
+  params.Size := AFont.Size;
+  params.Style := AFont.Style;
+  SetTextAttributes(TextStart, TextLen, TextStyleAll, params);
+end;
+
+procedure TCustomRichMemo.SetTextAttributes(TextStart, TextLen: Integer;  
+  SetMask: TTextStyleMask; const TextParams: TFontParams); 
+begin
+  if HandleAllocated then  
+    TWSCustomRichMemoClass(WidgetSetClass).SetTextAttributes(Self, TextStart, TextLen, SetMask, TextParams);
+end;
+
+function TCustomRichMemo.GetTextAttributes(TextStart: Integer; var TextParams: TFontParams): Boolean; 
+begin
+  if HandleAllocated then  
+    Result := TWSCustomRichMemoClass(WidgetSetClass).GetTextAttributes(Self, TextStart, TextParams)
+  else
+    Result := false;
+end;
+
+
+end.
+
--- a/components/richmemo/richmemofactory.pas
+++ b/components/richmemo/richmemofactory.pas
@ -0,0 +1,26 @@
+unit RichMemoFactory; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+
+uses
+  WSLCLClasses,
+  RichMemo,  
+  {$ifdef LCLWin32}Win32RichMemo{$endif}
+  ;
+
+function RegisterCustomRichMemo: Boolean;
+  
+implementation
+
+function RegisterCustomRichMemo: Boolean; alias : 'WSRegisterCustomRichMemo';
+begin
+  {$ifdef LCLWin32}RegisterWSComponent(TCustomRichMemo, TWin32WSCustomRichMemo);{$endif}
+  Result := False;
+end;
+
+
+end.
+
--- a/components/richmemo/richmemopackage.lpk
+++ b/components/richmemo/richmemopackage.lpk
@ -0,0 +1,80 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="3">
+    <PathDelim Value="\"/>
+    <Name Value="richmemopackage"/>
+    <Author Value="Dmitry 'skalogryz' Boyarintsev"/>
+    <CompilerOptions>
+      <Version Value="8"/>
+      <PathDelim Value="\"/>
+      <SearchPaths>
+        <OtherUnitFiles Value="win32\"/>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Description Value="RichMemo control. Implements cross-platfrom RichEdit control.
+"/>
+    <License Value="LGPL"/>
+    <Version Minor="8"/>
+    <Files Count="8">
+      <Item1>
+        <Filename Value="richmemo.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="RichMemo"/>
+      </Item1>
+      <Item2>
+        <Filename Value="wsrichmemo.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="WSRichMemo"/>
+      </Item2>
+      <Item3>
+        <Filename Value="win32\win32richmemo.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="Win32RichMemo"/>
+      </Item3>
+      <Item4>
+        <Filename Value="win32\win32richmemoproc.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="Win32RichMemoProc"/>
+      </Item4>
+      <Item5>
+        <Filename Value="richmemofactory.pas"/>
+        <UnitName Value="RichMemoFactory"/>
+      </Item5>
+      <Item6>
+        <Filename Value="richmemotypes.pas"/>
+        <AddToUsesPkgSection Value="False"/>
+        <UnitName Value="RichMemoTypes"/>
+      </Item6>
+      <Item7>
+        <Filename Value="richmemoregister.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="richmemoregister"/>
+      </Item7>
+      <Item8>
+        <Filename Value="richmemopackage.lrs"/>
+        <Type Value="LRS"/>
+      </Item8>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="2">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item2>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)\"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>
--- a/components/richmemo/richmemopackage.lrs
+++ b/components/richmemo/richmemopackage.lrs
@ -0,0 +1,19 @@
+LazarusResources.Add('trichmemo','PNG',[
+  #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+  +#0#1'WIDATx'#218'c'#252#255#255'?'#3'-'#1'#'#3#141#1#138#5's'#231'.'#164#138
+  +'w'#146#146#226#24'qZp'#245#242#17#138#12#175#175#175'e'#224#19#144#197'oAW'
+  +#255','#172#154#153#137#176#224#215#219'{'#12'l'#194'J'#248'-'#232#197'a'#1
+  +'2'#248#139#195'r'#162'-'#248#253#235'7X'#204#190#4#17'd'#7'{l'#192'4+'#27'+'
+  +#3#11'3'''#3#211'!'#134''#140#239#24'~'#254#253'N'#186#5#191'~'#253#4#139
+  +'9'#148#28#131#203#31#232#177#2#211'll'#236#148#251#224#215#175#31#12#29'k'
+  +#30'3'#236'8'#241#4'h'#176'%'#208#162#227#12#30#22'2'#12#21'!'#178'@'#11'8('
+  +#183#224#231#207#31#12#142#165#199#193#226#251#187'-Q'#216#236#236#28#224' B'
+  +#6''#128#193'D'#162#5#223#129#134#158#128#26'j'#129#194'fg'#231#196#233#131
+  +'O'#31#30#19'N'#166' '#11#154#150#221#6#7#15':'#0#5'S]'#148'*N'#31#16'm'#129
+  +'U'#222'~'#176#216#190'.s'#184#188'S'#217'I0}l'#146'#V'#31#128#196#190#146'j'
+  +#193#222'NS'#184#188's'#249'i'#184#5#216'|@'#146#5#223#191''#193#153#201'89'
+  +'y'#168#231#3'l'#128'b'#31#16'S'#22#253#197'a9'#209#22#176#163#185#144#16#248
+  +#9'ME'#20#249#128#24'@3'#11#254#253#251#204#192#196#196';'#8'|'#16#18#228'Hq'
+  +#149#137#211#2'Z'#180'0hn'#1#0'u'#140'&'#227#242'}.'#165#0#0#0#0'IEND'#174'B'
+  +'`'#130
+]);
--- a/components/richmemo/richmemopackage.pas
+++ b/components/richmemo/richmemopackage.pas
@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit richmemopackage; 
+
+interface
+
+uses
+  RichMemoFactory, richmemoregister, LazarusPackageIntf;
+
+implementation
+
+procedure Register; 
+begin
+  RegisterUnit('richmemoregister', @richmemoregister.Register); 
+end; 
+
+initialization
+  RegisterPackage('richmemopackage', @Register); 
+end.
--- a/components/richmemo/richmemoregister.pas
+++ b/components/richmemo/richmemoregister.pas
@ -0,0 +1,23 @@
+unit richmemoregister; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, RichMemo, LResources; 
+  
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('Common Controls', [TRichMemo]);
+end;
+
+initialization
+  {$i richmemopackage.lrs}
+
+end.
+
--- a/components/richmemo/richmemotypes.pas
+++ b/components/richmemo/richmemotypes.pas
@ -0,0 +1,23 @@
+unit RichMemoTypes; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Graphics;
+
+type
+  TTextStyleMask = set of (tsm_Color, tsm_Name, tsm_Size, tsm_Styles);
+  
+  TFontParams = record
+    Name    : String;
+    Size    : Integer;
+    Color   : TColor;
+    Style   : TFontStyles;  
+  end;
+
+implementation
+
+end.
+
--- a/components/richmemo/win32/win32richmemo.pas
+++ b/components/richmemo/win32/win32richmemo.pas
@ -0,0 +1,173 @@
+unit Win32RichMemo;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  // Win32 headers  
+  Windows, 
+  // RTL headers
+  Classes, SysUtils, 
+  // LCL headers
+  LCLType, LCLIntf, LCLProc, WSLCLClasses,
+  Controls, StdCtrls,
+  // Win32WidgetSet 
+  Win32WSControls, Win32Int, 
+  // RichMemo headers
+  RichMemoTypes, WSRichMemo, Win32RichMemoProc;
+
+type  
+
+  { TWin32WSCustomRichMemo }
+
+  TWin32WSCustomRichMemo = class(TWSCustomRichMemo)
+  published
+    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
+    class function GetTextAttributes(const AWinControl: TWinControl; TextStart: Integer; 
+      var Params: TFontParams): Boolean; override;
+    class procedure SetTextAttributes(const AWinControl: TWinControl; TextStart, TextLen: Integer; 
+      Mask: TTextStyleMask; const Params: TFontParams); override;
+    class procedure SetHideSelection(const AWinControl: TWinControl; AHideSelection: Boolean); override;      
+  end;
+  
+implementation
+
+const
+  AlignmentToEditFlags: array[TAlignment] of DWord =
+  (
+{ taLeftJustify  } ES_LEFT,
+{ taRightJustify } ES_RIGHT,
+{ taCenter       } ES_CENTER
+  );
+
+  
+procedure LockRedraw(AHandle: Integer);
+begin
+  SendMessage(AHandle, WM_SETREDRAW, 0, 0);
+end;
+
+procedure UnlockRedraw(AHandle: Integer; Invalidate: Boolean = true);
+begin
+  SendMessage(AHandle, WM_SETREDRAW, 1, 0);
+  if Invalidate then InvalidateRect(AHandle, nil, false);
+end;  
+
+function RichEditProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
+   LParam: Windows.LParam): LResult; stdcall;
+begin 
+  if Msg = WM_PAINT then
+    //todo: LCL WM_PAINT handling prevents richedit from drawing correctly
+    Result := CallDefaultWindowProc(Window, Msg, WParam, LParam)
+  else
+    Result := WindowProc(Window, Msg, WParam, LParam);
+end;  
+
+{ TWin32WSCustomRichMemo }
+
+class function TWin32WSCustomRichMemo.CreateHandle(const AWinControl: TWinControl;  
+  const AParams: TCreateParams): HWND;  
+var
+  Params      : TCreateWindowExParams;
+  RichClass   : AnsiString;
+  ACustomMemo : TCustomMemo;
+begin
+  InitRichEdit;
+  RichClass := GetRichEditClass;
+  if RichClass = '' then begin
+    Result := 0;
+    Exit;
+  end;
+
+  // general initialization of Params
+  PrepareCreateWindow(AWinControl, Params);
+  Params.SubClassWndProc := @RichEditProc;
+
+  // customization of Params
+  ACustomMemo := TCustomMemo(AWinControl);
+  with Params do
+  begin
+    Flags := Flags or ES_AUTOVSCROLL or ES_MULTILINE or ES_WANTRETURN;
+    
+    if ACustomMemo.ReadOnly then
+      Flags := Flags or ES_READONLY;
+    Flags := Flags or AlignmentToEditFlags[ACustomMemo.Alignment];
+    case ACustomMemo.ScrollBars of
+      ssHorizontal, ssAutoHorizontal:
+        Flags := Flags or WS_HSCROLL;
+      ssVertical, ssAutoVertical:
+        Flags := Flags or WS_VSCROLL;
+      ssBoth, ssAutoBoth:
+        Flags := Flags or WS_HSCROLL or WS_VSCROLL;
+    end;
+    if ACustomMemo.WordWrap then
+      Flags := Flags and not WS_HSCROLL
+    else
+      Flags := Flags or ES_AUTOHSCROLL;
+    if ACustomMemo.BorderStyle=bsSingle then
+      FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
+    pClassName := @RichClass[1];
+    WindowTitle := StrCaption;
+  end;
+  // create window
+  FinishCreateWindow(AWinControl, Params, false);
+  // memo is not a transparent control -> no need for parentpainting
+  Params.WindowInfo^.needParentPaint := false;
+  Result := Params.Window;
+end;
+
+class procedure TWin32WSCustomRichMemo.SetTextAttributes(const AWinControl: TWinControl; 
+  TextStart, TextLen: Integer; Mask: TTextStyleMask; const Params: TFontParams);  
+var
+  OrigStart : Integer;
+  OrigLen   : Integer;
+  NeedLock  : Boolean;  
+begin
+  if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit;
+  
+  RichEditManager.GetSelection(AWinControl.Handle, OrigStart, OrigLen);
+  
+  NeedLock := (OrigStart <> TextStart) or (OrigLen <> TextLen);
+  if NeedLock then begin
+    LockRedraw(AWinControl.Handle);
+    RichEditManager.SetSelection(AWinControl.Handle, TextStart, TextLen);
+    RichEditManager.SetSelectedTextStyle(AWinControl.Handle, Mask, Params );
+    RichEditManager.SetSelection(AWinControl.Handle, OrigStart, OrigLen);
+    UnlockRedraw(AWinControl.Handle);
+  end else 
+    RichEditManager.SetSelectedTextStyle(AWinControl.Handle, Mask, Params);
+end;
+
+class function TWin32WSCustomRichMemo.GetTextAttributes(
+  const AWinControl: TWinControl; TextStart: Integer; var Params: TFontParams
+  ): Boolean;  
+var
+  OrigStart : Integer;
+  OrigLen   : Integer;
+  NeedLock  : Boolean;  
+begin
+  if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit;
+  
+  RichEditManager.GetSelection(AWinControl.Handle, OrigStart, OrigLen);
+  
+  NeedLock := (OrigStart <> TextStart);
+  if NeedLock then begin
+    LockRedraw(AWinControl.Handle);
+    RichEditManager.SetSelection(AWinControl.Handle, TextStart, 1);
+    Result := RichEditManager.GetSelectedTextStyle(AWinControl.Handle, Params );
+    RichEditManager.SetSelection(AWinControl.Handle, OrigStart, OrigLen);
+    UnlockRedraw(AWinControl.Handle);
+  end else 
+    Result := RichEditManager.GetSelectedTextStyle(AWinControl.Handle, Params);
+end;
+
+
+class procedure TWin32WSCustomRichMemo.SetHideSelection(
+  const AWinControl: TWinControl; AHideSelection: Boolean);  
+begin
+  if not Assigned(RichEditManager) or not Assigned(AWinControl) then Exit;
+  RichEditManager.SetHideSelection(AWinControl.Handle, AHideSelection);
+end;
+
+end.
+
--- a/components/richmemo/win32/win32richmemoproc.pas
+++ b/components/richmemo/win32/win32richmemoproc.pas
@ -0,0 +1,200 @@
+unit Win32RichMemoProc; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  // windows units
+  Windows,richedit,
+  // RTL units  
+  Classes, SysUtils, 
+  // LCL units
+  Graphics,
+  // RichMemo unit
+  RichMemoTypes, 
+  // Win32 widgetset units  
+  win32proc; 
+  
+type
+  { TRichEditManager }
+
+  TRichEditManager = class(TObject)
+  public
+    class function SetSelectedTextStyle(RichEditWnd: Handle; 
+      SetMask: TTextStyleMask; Params: TFontParams): Boolean; virtual;
+    class function GetSelectedTextStyle(RichEditWnd: Handle; var Params: TFontParams): Boolean; virtual;
+    class procedure GetSelection(RichEditWnd: Handle; var TextStart, TextLen: Integer); virtual;      
+    class procedure SetSelection(RichEditWnd: Handle; TextStart, TextLen: Integer); virtual;      
+    class procedure SetHideSelection(RichEditWnd: Handle; AValue: Boolean); virtual;
+  end;
+  TRichManagerClass = class of TRichEditManager;
+                     
+var
+  RichEditManager : TRichManagerClass = TRichEditManager;
+
+function InitRichEdit: Boolean;
+function GetRichEditClass: AnsiString;
+procedure CopyStringToCharArray(const s: String; var Chrs: array of Char; ChrsSize: integer);
+function FontStylesToEffects(Styles: TFontStyles): LongWord;
+function EffectsToFontStyles(Effects: LongWord): TFontStyles;
+
+implementation
+
+const
+  GlobalRichClass : AnsiString = '';
+  
+const  
+  TwipsInFontSize = 20; // see MSDN for CHARFORMAT Structure CFM_SIZE
+  
+function GetRichEditClass: AnsiString;
+begin
+  Result := GlobalRichClass;
+end;  
+  
+function InitRichEdit: Boolean;
+begin
+  if GlobalRichClass = '' then begin
+    if LoadLibrary('RICHED20.DLL') <> 0 then begin
+      if UnicodeEnabledOS then GlobalRichClass := 'RichEdit20W'
+      else GlobalRichClass := 'RichEdit20A'
+    end else if LoadLibrary('RICHED32.DLL') <> 0 then
+      GlobalRichClass := 'RichEdit';
+      
+    if not Assigned(RichEditManager) then 
+      RichEditManager := TRichEditManager;
+      
+    Result := GlobalRichClass <> '';
+  end;
+end;
+
+procedure CopyStringToCharArray(const s: String; var Chrs: array of Char; ChrsSize: integer);
+begin
+  if length(s) < ChrsSize then ChrsSize := length(s);
+  if length(s) > 0 then Move(s[1], Chrs[0], ChrsSize);
+end;
+
+function FontStylesToEffects(Styles: TFontStyles): LongWord;
+begin
+  Result := 0;
+  if fsBold in Styles then Result := Result or CFE_BOLD;
+  if fsItalic in Styles then Result := Result or CFE_ITALIC;
+  if fsStrikeOut in Styles then Result := Result or CFE_STRIKEOUT;
+  if fsUnderline in Styles then Result := Result or CFE_UNDERLINE;
+end;
+
+function EffectsToFontStyles(Effects: LongWord): TFontStyles;
+begin
+  Result := [];
+  if Effects and CFE_BOLD > 0 then Include(Result, fsBold);
+  if Effects and CFE_ITALIC > 0 then Include(Result, fsItalic);
+  if Effects and CFE_STRIKEOUT > 0 then Include(Result, fsStrikeOut);
+  if Effects and CFE_UNDERLINE > 0 then Include(Result, fsUnderline);
+end;
+
+         
+procedure CharFormatToFontParams(const fmt: TCHARFORMAT; var Params: TFontParams);
+begin
+  Params.Name := fmt.szFaceName;
+  Params.Size := fmt.cbSize;
+  Params.Color := fmt.crTextColor;
+  Params.Style := EffectsToFontStyles(fmt.dwEffects);
+end;
+
+{ TRichEditManager }
+
+class function TRichEditManager.SetSelectedTextStyle(RichEditWnd: Handle; 
+  SetMask: TTextStyleMask; Params: TFontParams): Boolean;
+var
+  w : WPARAM;
+  fmt : TCHARFORMAT;
+  
+begin
+  if RichEditWnd = 0 then begin
+    Result := false;
+    Exit;
+  end;
+  
+  w := SCF_SELECTION;    
+    
+  FillChar(fmt, sizeof(fmt), 0);
+  fmt.cbSize := sizeof(fmt);
+  
+  if tsm_Color in SetMask then begin
+    fmt.dwMask := fmt.dwMask or CFM_COLOR;
+    fmt.crTextColor := Params.Color;
+  end;
+  
+  if tsm_Name in SetMask then begin
+    fmt.dwMask := fmt.dwMask or CFM_FACE ;
+    // keep last char for Null-termination
+    CopyStringToCharArray(Params.Name, fmt.szFaceName, LF_FACESIZE-1); 
+  end;
+  
+  if tsm_Size in SetMask then begin
+    fmt.dwMask := fmt.dwMask or CFM_SIZE;
+    fmt.yHeight := Params.Size * TwipsInFontSize;
+  end;
+  
+  if tsm_Styles in SetMask then begin
+    fmt.dwMask := fmt.dwMask or CFM_EFFECTS;
+    fmt.dwEffects := FontStylesToEffects(Params.Style);
+  end;
+  
+  Result := SendMessage(RichEditWnd, EM_SETCHARFORMAT, w, PtrInt(@fmt))>0;
+end;
+
+class function TRichEditManager.GetSelectedTextStyle(RichEditWnd: Handle;  
+  var Params: TFontParams): Boolean; 
+var
+  w     : WPARAM;
+  fmt   : TCHARFORMAT;
+  mask  : LongWord;
+  
+begin
+  Result := false;
+  if RichEditWnd = 0 then Exit;
+  
+  w := SCF_SELECTION;    
+    
+  FillChar(fmt, sizeof(fmt), 0);
+  fmt.cbSize := sizeof(fmt);
+  fmt.dwMask := CFM_COLOR or CFM_FACE or CFM_SIZE or CFM_EFFECTS;
+  
+  mask := SendMessage(RichEditWnd, EM_GETCHARFORMAT, w, PtrInt(@fmt));
+  if mask = 0 then Exit;
+  
+  CharFormatToFontParams(fmt, Params);
+  Result := true;  
+end;
+
+class procedure TRichEditManager.GetSelection(RichEditWnd: Handle; var TextStart, TextLen: Integer); 
+var
+  Range  : TCHARRANGE;
+begin
+  Range.cpMax := 0;
+  Range.cpMin := 0;
+  SendMessage(RichEditWnd, EM_EXGETSEL, 0, PtrInt(@Range));
+  TextStart := Range.cpMin;
+  TextLen := Range.cpMax-Range.cpMin;
+end;
+
+class procedure TRichEditManager.SetSelection(RichEditWnd: Handle; TextStart, TextLen: Integer); 
+var
+  Range  : TCHARRANGE;
+begin
+  Range.cpMin := TextStart;
+  Range.cpMax := TextStart + TextLen;
+  SendMessage(RichEditWnd, EM_EXSETSEL, 0, PtrInt(@Range));
+end;
+
+class procedure TRichEditManager.SetHideSelection(RichEditWnd: Handle; AValue: Boolean); 
+begin
+  if AValue then
+    SendMessage(RichEditWnd, EM_SETOPTIONS, ECOOP_AND, not ECO_NOHIDESEL)
+  else
+    SendMessage(RichEditWnd, EM_SETOPTIONS, ECOOP_OR, ECO_NOHIDESEL);
+end;
+
+end.                                            
+
--- a/components/richmemo/wsrichmemo.pas
+++ b/components/richmemo/wsrichmemo.pas
@ -0,0 +1,53 @@
+unit WSRichMemo; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, 
+
+  Graphics, Controls, 
+  
+  RichMemoTypes, 
+  
+  WSStdCtrls; 
+  
+type
+  { TWSCustomRichMemo }
+
+  TWSCustomRichMemo = class(TWSCustomMemo)
+  published
+    class function GetTextAttributes(const AWinControl: TWinControl; TextStart: Integer; 
+      var Params: TFontParams): Boolean; virtual;
+    class procedure SetTextAttributes(const AWinControl: TWinControl; TextStart, TextLen: Integer; 
+      Mask: TTextStyleMask; const Params: TFontParams); virtual;
+    class procedure SetHideSelection(const AWinControl: TWinControl; AHideSelection: Boolean); virtual;
+  end;
+  TWSCustomRichMemoClass = class of TWSCustomRichMemo;
+  
+function WSRegisterCustomRichMemo: Boolean; external name 'WSRegisterCustomRichMemo';
+
+implementation
+
+{ TWSCustomRichMemo }
+
+class function TWSCustomRichMemo.GetTextAttributes(const AWinControl: TWinControl; 
+  TextStart: Integer; var Params: TFontParams): Boolean; 
+begin
+  Result := false;
+end;
+
+class procedure TWSCustomRichMemo.SetTextAttributes(const AWinControl: TWinControl; 
+  TextStart, TextLen: Integer;  
+  Mask: TTextStyleMask; const Params: TFontParams); 
+begin
+end;
+
+class procedure TWSCustomRichMemo.SetHideSelection(const AWinControl: TWinControl; AHideSelection: Boolean); 
+begin
+
+end;
+
+end.
+