pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

started RichMemo package

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@820 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
skalogryz
2009-06-04 19:38:39 +00:00
parent 7baab9820c
commit 3eb6fb7a4f
10 changed files with 793 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

175
components/richmemo/richmemo.pas Normal file
View File

@ -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.

26
components/richmemo/richmemofactory.pas Normal file
View File

@ -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.

80
components/richmemo/richmemopackage.lpk Normal file
View File

@ -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>

19
components/richmemo/richmemopackage.lrs Normal file
View File

@ -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
]);

21
components/richmemo/richmemopackage.pas Normal file
View File

@ -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.

23
components/richmemo/richmemoregister.pas Normal file
View File

@ -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.

23
components/richmemo/richmemotypes.pas Normal file
View File

@ -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.

173
components/richmemo/win32/win32richmemo.pas Normal file
View File

@ -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.

200
components/richmemo/win32/win32richmemoproc.pas Normal file
View File

@ -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.

53
components/richmemo/wsrichmemo.pas Normal file
View File

@ -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.