paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 23:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

Implements CaretPos for TCustomEdit and TCustomMemo under win32.

Browse Source 
git-svn-id: trunk@14943 -
This commit is contained in:
sekelsenmat 2008-04-23 20:06:32 +00:00
parent a87a738d15
commit 4bae6b0476
5 changed files with 117 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lcl/include/customedit.inc
View File

@ -84,6 +84,14 @@ begin
Result := Copy(Text, SelStart + 1, SelLength)
end;
{------------------------------------------------------------------------------
Setter for CaretPos
------------------------------------------------------------------------------}
procedure TCustomEdit.SetCaretPos(const Value: TPoint);
begin
TWSCustomEditClass(WidgetSetClass).SetCaretPos(Self, Value);
end;
{------------------------------------------------------------------------------
Method: TCustomEdit.SetSelText
Params: val - new string for text-field
@ -448,5 +456,13 @@ begin
inherited DoExit;
end;
{------------------------------------------------------------------------------
Getter for CaretPos
------------------------------------------------------------------------------}
function TCustomEdit.GetCaretPos: TPoint;
begin
Result := TWSCustomEditClass(WidgetSetClass).GetCaretPos(Self);
end;
// included by stdctrls.pp

16
lcl/include/custommemo.inc
View File

@ -84,6 +84,14 @@ begin
TWSCustomMemoClass(WidgetSetClass).SetAlignment(Self, AValue);
end;
{------------------------------------------------------------------------------
Setter for CaretPos
------------------------------------------------------------------------------}
procedure TCustomMemo.SetCaretPos(const Value: TPoint);
begin
TWSCustomMemoClass(WidgetSetClass).SetCaretPos(Self, Value);
end;
{------------------------------------------------------------------------------
procedure TCustomMemo.SetVertScrollBar(const AValue: TMemoScrollBar);
------------------------------------------------------------------------------}
@ -168,6 +176,14 @@ begin
Result:= false;
end;
{------------------------------------------------------------------------------
Getter for CaretPos
------------------------------------------------------------------------------}
function TCustomMemo.GetCaretPos: TPoint;
begin
Result := TWSCustomMemoClass(WidgetSetClass).GetCaretPos(Self);
end;
{------------------------------------------------------------------------------
Method: TCustomMemo.SetLines
Params:

69
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -162,11 +162,13 @@ type
public
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class function GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; override;
class function GetSelStart(const ACustomEdit: TCustomEdit): integer; override;
class function GetSelLength(const ACustomEdit: TCustomEdit): integer; override;
class function GetMaxLength(const ACustomEdit: TCustomEdit): integer; {override;}
class function GetText(const AWinControl: TWinControl; var AText: string): boolean; override;
class procedure SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); override;
class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); override;
class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
@ -184,9 +186,13 @@ type
public
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class function GetStrings(const ACustomMemo: TCustomMemo): TStrings; override;
class procedure AppendText(const ACustomMemo: TCustomMemo; const AText: string); override;
class function GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; override;
class function GetStrings(const ACustomMemo: TCustomMemo): TStrings; override;
class procedure SetAlignment(const ACustomMemo: TCustomMemo; const AAlignment: TAlignment); override;
class procedure SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); override;
class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
@ -1030,6 +1036,16 @@ begin
Result := Params.Window;
end;
class function TWin32WSCustomEdit.GetCaretPos(const ACustomEdit: TCustomEdit): TPoint;
var
BufferX: Longword;
begin
// EM_GETSEL expects a pointer to 32-bits buffer in lParam
Windows.SendMessageW(ACustomEdit.Handle, EM_GETSEL, 0, PtrInt(@BufferX));
Result.X := BufferX;
Result.Y := 0;
end;
class function TWin32WSCustomEdit.GetSelStart(const ACustomEdit: TCustomEdit): integer;
begin
Result := EditGetSelStart(ACustomEdit.Handle);
@ -1053,6 +1069,11 @@ begin
AText := GetControlText(AWinControl.Handle);
end;
class procedure TWin32WSCustomEdit.SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint);
begin
Windows.SendMessageW(ACustomEdit.Handle, EM_SETSEL, NewPos.X, NewPos.X);
end;
class procedure TWin32WSCustomEdit.SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase);
const
EditStyles: array[TEditCharCase] of integer = (0, ES_UPPERCASE, ES_LOWERCASE);
@ -1151,6 +1172,40 @@ begin
end;
end;
{
The index of the first line is zero
The index of the caret before the first char is zero
If there is a selection, the caret is considered to be right after
the last selected char, being that "last" here means the right-most char.
}
class function TWin32WSCustomMemo.GetCaretPos(const ACustomEdit: TCustomEdit): TPoint;
var
BufferX: Longword;
begin
{ X position calculation }
{ EM_GETSET returns the char index of the caret, but this index
doesn't go back to zero in new lines, so we need to subtract
the char index from the line
EM_GETSEL expects a pointer to 32-bits buffer in lParam
}
Windows.SendMessageW(ACustomEdit.Handle, EM_GETSEL, 0, PtrInt(@BufferX));
{ EM_LINEINDEX returns the char index of a given line
wParam = -1 indicates the line of the caret
}
Result.X := BufferX - Windows.SendMessageW(ACustomEdit.Handle, EM_LINEINDEX, -1, 0);
{ Y position calculation }
{ EM_LINEFROMCHAR returns the number of the line of a given
char index.
}
Result.Y := Windows.SendMessageW(ACustomEdit.Handle, EM_LINEFROMCHAR, BufferX, 0);
end;
class procedure TWin32WSCustomMemo.SetAlignment(const ACustomMemo: TCustomMemo;
const AAlignment: TAlignment);
begin
@ -1158,6 +1213,18 @@ begin
RecreateWnd(ACustomMemo);
end;
class procedure TWin32WSCustomMemo.SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint);
var
CharIndex: Longword;
begin
{ EM_LINEINDEX returns the char index of a given line }
CharIndex := Windows.SendMessageW(ACustomEdit.Handle, EM_LINEINDEX, NewPos.Y, 0) + NewPos.X;
{ EM_SETSEL expects the character position in char index, which
doesn't go back to zero in new lines
}
Windows.SendMessageW(ACustomEdit.Handle, EM_SETSEL, CharIndex, CharIndex);
end;
class procedure TWin32WSCustomMemo.SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle);
begin
// TODO: check if can be done without recreation

5
lcl/stdctrls.pp
View File

@ -671,9 +671,11 @@ type
procedure Change; dynamic;
procedure DoEnter; override;
procedure DoExit; override;
function GetCaretPos: TPoint; virtual;
function GetSelLength: integer; virtual;
function GetSelStart: integer; virtual;
function GetSelText: string; virtual;
procedure SetCaretPos(const Value: TPoint); virtual;
procedure SetEchoMode(Val: TEchoMode); virtual;
procedure SetReadOnly(Value: Boolean); virtual;
procedure SetSelLength(Val: integer); virtual;
@ -697,6 +699,7 @@ type
procedure PasteFromClipboard; virtual;
public
property BorderStyle;
property CaretPos: TPoint read GetCaretPos write SetCaretPos;
property CharCase: TEditCharCase read FCharCase write SetCharCase default ecNormal;
property EchoMode: TEchoMode read FEchoMode write SetEchoMode default emNormal;
property MaxLength: Integer read FMaxLength write SetMaxLength default -1;
@ -752,7 +755,9 @@ type
function RealGetText: TCaption; override;
procedure RealSetText(const Value: TCaption); override;
function GetCachedText(var CachedText: TCaption): boolean; override;
function GetCaretPos: TPoint; override;
procedure SetAlignment(const AValue: TAlignment);
procedure SetCaretPos(const Value: TPoint); override;
procedure SetLines(const Value: TStrings);
procedure SetSelText(const Val: string); override;
procedure SetWantReturns(const AValue: Boolean);

12
lcl/widgetset/wsstdctrls.pp
View File

@ -129,9 +129,11 @@ type
{ TWSCustomEdit }
TWSCustomEdit = class(TWSWinControl)
class function GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; virtual;
class function GetSelStart(const ACustomEdit: TCustomEdit): integer; virtual;
class function GetSelLength(const ACustomEdit: TCustomEdit): integer; virtual;
class procedure SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); virtual;
class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); virtual;
class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); virtual;
class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); virtual;
@ -390,6 +392,11 @@ end;
{ TWSCustomEdit }
class function TWSCustomEdit.GetCaretPos(const ACustomEdit: TCustomEdit): TPoint;
begin
Result := Point(0, 0);
end;
class function TWSCustomEdit.GetSelStart(const ACustomEdit: TCustomEdit): integer;
begin
result := -1;
@ -400,6 +407,11 @@ begin
result := 0;
end;
class procedure TWSCustomEdit.SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint);
begin
end;
class procedure TWSCustomEdit.SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase);
begin
end;