mirror of
https://github.com/keymanapp/keyman.git
synced 2026-10-21 13:27:53 +00:00
25ea6a74dc
RichEdit allows text selection one character past end-of-string, so we need to cater for that as well in passing text ranges to the character grid. Fixes: #12454
135 lines
3.9 KiB
ObjectPascal
135 lines
3.9 KiB
ObjectPascal
(*
|
|
Name: KeymanDeveloperDebuggerMemo
|
|
Copyright: Copyright (C) 2003-2017 SIL International.
|
|
Documentation:
|
|
Description:
|
|
Create Date: 8 Jun 2012
|
|
|
|
Modified Date: 8 Jun 2012
|
|
Authors: mcdurdin
|
|
Related Files:
|
|
Dependencies:
|
|
|
|
Bugs:
|
|
Todo:
|
|
Notes:
|
|
History: 08 Jun 2012 - mcdurdin - I3323 - V9.0 - Extract debug-related code TPlus-Memo into subclass
|
|
*)
|
|
unit KeymanDeveloperDebuggerMemo; // I3323
|
|
|
|
interface
|
|
|
|
uses
|
|
System.Classes,
|
|
Winapi.Messages,
|
|
Winapi.Windows,
|
|
Vcl.Controls,
|
|
Vcl.ComCtrls,
|
|
Vcl.StdCtrls;
|
|
|
|
type
|
|
TKeymanDeveloperDebuggerMessageEvent = procedure(Sender: TObject; var Message: TMessage; var Handled: Boolean) of object;
|
|
|
|
TMemoSelection = record
|
|
Start, Finish: Integer;
|
|
Anchor: Integer;
|
|
end;
|
|
|
|
TKeymanDeveloperDebuggerMemo = class(TRichEdit)
|
|
private
|
|
FOnMessage: TKeymanDeveloperDebuggerMessageEvent;
|
|
FAllowUnicodeInput: Boolean;
|
|
FIsDebugging: Boolean;
|
|
procedure SetAllowUnicode(const Value: Boolean);
|
|
function GetSelection: TMemoSelection;
|
|
procedure SetSelection(const Value: TMemoSelection);
|
|
procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
|
|
protected
|
|
procedure CreateHandle; override;
|
|
procedure WndProc(var Message: TMessage); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property AllowUnicode: Boolean read FAllowUnicodeInput write SetAllowUnicode default True;
|
|
property OnMessage: TKeymanDeveloperDebuggerMessageEvent read FOnMessage write FOnMessage;
|
|
property Selection: TMemoSelection read GetSelection write SetSelection;
|
|
property IsDebugging: Boolean read FIsDebugging write FIsDebugging;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
{ TKeymanDeveloperDebuggerMemo }
|
|
|
|
procedure TKeymanDeveloperDebuggerMemo.CNKeyDown(var Message: TWMKeyDown);
|
|
begin
|
|
// Shortcuts for actions are handled with CN_KEYDOWN before we get WM_KEYDOWN,
|
|
// so if we are debugging we want to filter those out so that the debugger
|
|
// gets access to them instead of us. Note that this means that editor
|
|
// shortcuts such as Ctrl+A (select all) will not be processed in the normal
|
|
// way, so the host of this control needs to look after that.
|
|
if IsDebugging
|
|
then Exit
|
|
else inherited;
|
|
end;
|
|
|
|
constructor TKeymanDeveloperDebuggerMemo.Create(AOwner: TComponent);
|
|
begin
|
|
FAllowUnicodeInput := True;
|
|
inherited Create(AOwner);
|
|
PlainText := True;
|
|
end;
|
|
|
|
procedure TKeymanDeveloperDebuggerMemo.CreateHandle;
|
|
begin
|
|
inherited;
|
|
if FAllowUnicodeInput
|
|
then SetWindowLongW(Handle, GWL_WNDPROC, GetWindowLong(Handle, GWL_WNDPROC))
|
|
else SetWindowLongA(Handle, GWL_WNDPROC, GetWindowLong(Handle, GWL_WNDPROC));
|
|
end;
|
|
|
|
function TKeymanDeveloperDebuggerMemo.GetSelection: TMemoSelection;
|
|
begin
|
|
// EM_GETSEL doesn't tell us the anchor position, but we can figure
|
|
// it out with this kludge. I am not aware of side effects from this
|
|
// at this time.
|
|
SendMessage(Handle, EM_GETSEL, NativeUInt(@Result.Start), NativeUInt(@Result.Finish));
|
|
SendMessage(Handle, EM_SETSEL, -1, 0);
|
|
SendMessage(Handle, EM_GETSEL, NativeUInt(@Result.Anchor), 0);
|
|
SetSelection(Result);
|
|
end;
|
|
|
|
procedure TKeymanDeveloperDebuggerMemo.SetAllowUnicode(const Value: Boolean);
|
|
begin
|
|
if Value <> fAllowUnicodeInput then
|
|
begin
|
|
fAllowUnicodeInput := Value;
|
|
if HandleAllocated then RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TKeymanDeveloperDebuggerMemo.SetSelection(
|
|
const Value: TMemoSelection);
|
|
begin
|
|
if Value.Anchor = Value.Start
|
|
then SendMessage(Handle, EM_SETSEL, Value.Finish, Value.Start)
|
|
else SendMessage(Handle, EM_SETSEL, Value.Start, Value.Finish);
|
|
end;
|
|
|
|
procedure TKeymanDeveloperDebuggerMemo.WndProc(var Message: TMessage);
|
|
var
|
|
b: Boolean;
|
|
begin
|
|
b := False;
|
|
if Assigned(FOnMessage) then
|
|
FOnMessage(Self, Message, b);
|
|
if not b then inherited WndProc(Message);
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Keyman', [TKeymanDeveloperDebuggerMemo]);
|
|
end;
|
|
|
|
end.
|