From 3eb6fb7a4f606ea5fde5b429f6e561469a87d3a7 Mon Sep 17 00:00:00 2001 From: skalogryz Date: Thu, 4 Jun 2009 19:38:39 +0000 Subject: [PATCH] started RichMemo package git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@820 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/richmemo/richmemo.pas | 175 +++++++++++++++ components/richmemo/richmemofactory.pas | 26 +++ components/richmemo/richmemopackage.lpk | 80 +++++++ components/richmemo/richmemopackage.lrs | 19 ++ components/richmemo/richmemopackage.pas | 21 ++ components/richmemo/richmemoregister.pas | 23 ++ components/richmemo/richmemotypes.pas | 23 ++ components/richmemo/win32/win32richmemo.pas | 173 +++++++++++++++ .../richmemo/win32/win32richmemoproc.pas | 200 ++++++++++++++++++ components/richmemo/wsrichmemo.pas | 53 +++++ 10 files changed, 793 insertions(+) create mode 100644 components/richmemo/richmemo.pas create mode 100644 components/richmemo/richmemofactory.pas create mode 100644 components/richmemo/richmemopackage.lpk create mode 100644 components/richmemo/richmemopackage.lrs create mode 100644 components/richmemo/richmemopackage.pas create mode 100644 components/richmemo/richmemoregister.pas create mode 100644 components/richmemo/richmemotypes.pas create mode 100644 components/richmemo/win32/win32richmemo.pas create mode 100644 components/richmemo/win32/win32richmemoproc.pas create mode 100644 components/richmemo/wsrichmemo.pas diff --git a/components/richmemo/richmemo.pas b/components/richmemo/richmemo.pas new file mode 100644 index 000000000..9f48e2704 --- /dev/null +++ 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. + diff --git a/components/richmemo/richmemofactory.pas b/components/richmemo/richmemofactory.pas new file mode 100644 index 000000000..b23d8f761 --- /dev/null +++ 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. + diff --git a/components/richmemo/richmemopackage.lpk b/components/richmemo/richmemopackage.lpk new file mode 100644 index 000000000..f2d9e0552 --- /dev/null +++ b/components/richmemo/richmemopackage.lpk @@ -0,0 +1,80 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/richmemo/richmemopackage.lrs b/components/richmemo/richmemopackage.lrs new file mode 100644 index 000000000..d2bc6893e --- /dev/null +++ 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 +]); diff --git a/components/richmemo/richmemopackage.pas b/components/richmemo/richmemopackage.pas new file mode 100644 index 000000000..06c65b2af --- /dev/null +++ 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. diff --git a/components/richmemo/richmemoregister.pas b/components/richmemo/richmemoregister.pas new file mode 100644 index 000000000..ece525955 --- /dev/null +++ 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. + diff --git a/components/richmemo/richmemotypes.pas b/components/richmemo/richmemotypes.pas new file mode 100644 index 000000000..fc71646c0 --- /dev/null +++ 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. + diff --git a/components/richmemo/win32/win32richmemo.pas b/components/richmemo/win32/win32richmemo.pas new file mode 100644 index 000000000..c0a164b49 --- /dev/null +++ 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. + diff --git a/components/richmemo/win32/win32richmemoproc.pas b/components/richmemo/win32/win32richmemoproc.pas new file mode 100644 index 000000000..cb945ebfe --- /dev/null +++ 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. + diff --git a/components/richmemo/wsrichmemo.pas b/components/richmemo/wsrichmemo.pas new file mode 100644 index 000000000..6921c18d6 --- /dev/null +++ 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. +