mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-20 11:59:08 +02:00
LCL Carbon: improved Memo Lines handling and fixed bug #0011834: TMemo in carbon
git-svn-id: trunk@16228 -
This commit is contained in:
tombo
parent
42a0de4eba
commit
39a3313e3f
@ -170,6 +170,7 @@ type
|
||||
function GetFrame(Index: Integer): ControlRef; override;
|
||||
procedure CreateWidget(const AParams: TCreateParams); override;
|
||||
procedure DestroyWidget; override;
|
||||
procedure GetLineOffset(AIndex: Integer; out AStart, AEnd: TXNOffset);
|
||||
public
|
||||
procedure TextDidChange; override;
|
||||
function FilterKeyPress(SysKey: Boolean; const Char: TUTF8Char): Boolean; override;
|
||||
@ -182,6 +183,11 @@ type
|
||||
procedure SetPasswordChar(AChar: Char); override;
|
||||
procedure SetReadOnly(AReadOnly: Boolean); override;
|
||||
procedure SetWordWrap(AWordWrap: Boolean); virtual;
|
||||
public
|
||||
function GetLineCount: Integer;
|
||||
function GetLine(AIndex: Integer): String;
|
||||
procedure DeleteLine(AIndex: Integer);
|
||||
procedure InsertLine(AIndex: Integer; const S: String);
|
||||
public
|
||||
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
|
||||
end;
|
||||
@ -1385,6 +1391,72 @@ begin
|
||||
DisposeControl(FScrollView);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemo.GetLineOffset
|
||||
Returns: Offset of specified line
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemo.GetLineOffset(AIndex: Integer; out AStart, AEnd: TXNOffset);
|
||||
const
|
||||
SName = 'GetLineOffset';
|
||||
var
|
||||
O: TXNObject;
|
||||
W, H: Fixed;
|
||||
P: HIPoint;
|
||||
Line, TextStart, TextEnd: TXNOffset;
|
||||
LineTop, LineBottom: Single;
|
||||
begin
|
||||
AStart := 0;
|
||||
AEnd := 0;
|
||||
if AIndex >= GetLineCount then
|
||||
begin
|
||||
AStart := kTXNEndOffset;
|
||||
AEnd := kTXNEndOffset;
|
||||
Exit;
|
||||
end;
|
||||
O := HITextViewGetTXNObject(ControlRef(Widget));
|
||||
if TXNDataSize(O) = 0 then Exit;
|
||||
|
||||
if OSError(TXNGetLineMetrics(O, AIndex, W, H), Self, SName, 'TXNGetLineMetrics') then Exit;
|
||||
if OSError(TXNOffsetToHIPoint(O, 0, P), Self, SName, 'TXNOffsetToHIPoint') then Exit;
|
||||
LineTop := P.y + AIndex * (H / $10000);
|
||||
LineBottom := LineTop + H / $10000;
|
||||
|
||||
// find line offset with bisection
|
||||
TextStart := 0;
|
||||
TextEnd := TXNDataSize(O) div 2;
|
||||
repeat
|
||||
Line := (TextStart + TextEnd) div 2;
|
||||
if OSError(TXNOffsetToHIPoint(O, Line, P), Self, SName, 'TXNOffsetToHIPoint') then Exit;
|
||||
if P.y < LineTop then
|
||||
TextStart := Line + 1
|
||||
else
|
||||
TextEnd := Line;
|
||||
|
||||
if (P.y >= LineTop) and (P.y < LineBottom) then Break;
|
||||
until TextEnd < TextStart;
|
||||
|
||||
LineTop := P.y;
|
||||
|
||||
// find line start offset
|
||||
AStart := Line;
|
||||
while AStart > 0 do
|
||||
begin
|
||||
if OSError(TXNOffsetToHIPoint(O, AStart - 1, P), Self, SName, 'TXNOffsetToHIPoint') then Exit;
|
||||
if P.y <> LineTop then Break;
|
||||
Dec(AStart);
|
||||
end;
|
||||
|
||||
// find line end offset
|
||||
AEnd := Line;
|
||||
TextEnd := TXNDataSize(O) div 2;
|
||||
while AEnd < TextEnd do
|
||||
begin
|
||||
if OSError(TXNOffsetToHIPoint(O, AEnd + 1, P), Self, SName, 'TXNOffsetToHIPoint') then Exit;
|
||||
if P.y <> LineTop then Break;
|
||||
Inc(AEnd);
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemo.TextDidChange
|
||||
|
||||
@ -1392,7 +1464,6 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemo.TextDidChange;
|
||||
var
|
||||
MemoStrings: TCarbonMemoStrings;
|
||||
Msg: TLMessage;
|
||||
begin
|
||||
// limit the text according to MaxLength
|
||||
@ -1400,10 +1471,6 @@ begin
|
||||
|
||||
AdaptCharCase;
|
||||
|
||||
// update memo strings
|
||||
MemoStrings := (LCLObject as TCustomMemo).Lines as TCarbonMemoStrings;
|
||||
if MemoStrings <> nil then MemoStrings.ExternalChanged;
|
||||
|
||||
FillChar(Msg, SizeOf(Msg), 0);
|
||||
Msg.Msg := CM_TEXTCHANGED;
|
||||
DeliverMessage(LCLObject, Msg);
|
||||
@ -1566,6 +1633,98 @@ begin
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemo.GetLineCount
|
||||
Returns: Memo line count
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonMemo.GetLineCount: Integer;
|
||||
var
|
||||
C: ItemCount;
|
||||
S: Integer;
|
||||
O: TXNObject;
|
||||
begin
|
||||
Result := 0;
|
||||
O := HITextViewGetTXNObject(ControlRef(Widget));
|
||||
if not OSError(TXNGetLineCount(O, C),
|
||||
Self, 'GetLineCount', 'TXNGetLineCount') then
|
||||
begin
|
||||
Result := C;
|
||||
S := TXNDataSize(O);
|
||||
if S = 0 then Dec(Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemo.GetLine
|
||||
Returns: Memo line text
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonMemo.GetLine(AIndex: Integer): String;
|
||||
var
|
||||
AStart, AEnd: TXNOffset;
|
||||
Data: Handle;
|
||||
W: WideString;
|
||||
begin
|
||||
Result := '';
|
||||
|
||||
GetLineOffset(AIndex, AStart, AEnd);
|
||||
if OSError(TXNGetData(HITextViewGetTXNObject(ControlRef(Widget)), AStart, AEnd, Data), Self, 'GetLine', 'TXNGetData') then Exit;
|
||||
|
||||
W := PWideChar(Data^);
|
||||
|
||||
Result := UTF16ToUTF8(Copy(W, 0, GetHandleSize(Data) div 2));
|
||||
// remove CRLF
|
||||
if (Result <> '') and (Result[Length(Result)] in [#10, #13]) then
|
||||
Delete(Result, Length(Result), 1);
|
||||
if (Result <> '') and (Result[Length(Result)] in [#10, #13]) then
|
||||
Delete(Result, Length(Result), 1);
|
||||
|
||||
DisposeHandle(Data);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemo.DeleteLine
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemo.DeleteLine(AIndex: Integer);
|
||||
var
|
||||
AStart, AEnd: TXNOffset;
|
||||
begin
|
||||
GetLineOffset(AIndex, AStart, AEnd);
|
||||
if (AIndex > 0) and (AIndex = GetLineCount - 1) then Dec(AStart);
|
||||
|
||||
OSError(TXNSetData(HITextViewGetTXNObject(ControlRef(Widget)), kTXNUnicodeTextData, nil, 0, AStart, AEnd),
|
||||
Self, 'DeleteLine', 'TXNSetData');
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemo.InsertLine
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemo.InsertLine(AIndex: Integer; const S: String);
|
||||
var
|
||||
AStart, AEnd: TXNOffset;
|
||||
W: WideString;
|
||||
begin
|
||||
if AIndex < 0 then AIndex := 0;
|
||||
W := UTF8ToUTF16(S);
|
||||
|
||||
if GetLineCount = 0 then
|
||||
AStart := 0
|
||||
else
|
||||
if AIndex < GetLineCount then
|
||||
begin
|
||||
GetLineOffset(AIndex, AStart, AEnd);
|
||||
W := W + #10;
|
||||
end
|
||||
else
|
||||
begin
|
||||
GetLineOffset(GetLineCount - 1, AStart, AEnd);
|
||||
W := #10 + W;
|
||||
AStart := AEnd;
|
||||
end;
|
||||
|
||||
OSError(TXNSetData(HITextViewGetTXNObject(ControlRef(Widget)), kTXNUnicodeTextData, @W[1], Length(W) * 2, AStart, AStart),
|
||||
Self, 'InsertLine', 'TXNSetData');
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemo.FilterKeyPress
|
||||
|
||||
|
||||
@ -76,25 +76,17 @@ type
|
||||
|
||||
TCarbonMemoStrings = class(TStrings)
|
||||
private
|
||||
FStringList: TStringList; // internal string list
|
||||
FOwner: TCarbonMemo; // Carbon memo control owning strings
|
||||
FExternalChanged: Boolean;// Carbon strings object has changed
|
||||
procedure InternalUpdate;
|
||||
procedure ExternalUpdate;
|
||||
protected
|
||||
function GetTextStr: string; override;
|
||||
procedure SetTextStr(const Value: string); override;
|
||||
function GetCount: Integer; override;
|
||||
function Get(Index: Integer): string; override;
|
||||
public
|
||||
constructor Create(AOwner: TCarbonMemo);
|
||||
destructor Destroy; override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure Clear; override;
|
||||
procedure Delete(Index: Integer); override;
|
||||
procedure Insert(Index: Integer; const S: string); override;
|
||||
procedure SetText(TheText: PChar); override;
|
||||
|
||||
procedure ExternalChanged; dynamic;
|
||||
public
|
||||
property Owner: TCarbonMemo read FOwner;
|
||||
end;
|
||||
@ -309,42 +301,21 @@ end;
|
||||
|
||||
{ TCarbonMemoStrings }
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemoStrings.InternalUpdate
|
||||
|
||||
Updates the internal strings from Carbon interface
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemoStrings.InternalUpdate;
|
||||
var
|
||||
S: String;
|
||||
begin
|
||||
S := '';
|
||||
//DebugLn('TCarbonMemoStrings.InternalUpdate');
|
||||
if FOwner.GetText(S) then
|
||||
FStringList.Text := S;
|
||||
|
||||
FExternalChanged := False;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemoStrings.ExternalUpdate
|
||||
|
||||
Updates the strings in Carbon interface from internal
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemoStrings.ExternalUpdate;
|
||||
begin
|
||||
//DebugLn('TCarbonMemoStrings.ExternalUpdate Text: ' + FStringList.Text);
|
||||
FOwner.SetText(FStringList.Text);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemoStrings.GetTextStr
|
||||
Returns: Text of Carbon strings
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonMemoStrings.GetTextStr: string;
|
||||
begin
|
||||
if FExternalChanged then InternalUpdate;
|
||||
Result := FStringList.Text;
|
||||
FOwner.GetText(Result);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemoStrings.SetTextStr
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemoStrings.SetTextStr(const Value: string);
|
||||
begin
|
||||
FOwner.SetText(Value);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -353,8 +324,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonMemoStrings.GetCount: Integer;
|
||||
begin
|
||||
if FExternalChanged then InternalUpdate;
|
||||
Result := FStringList.Count;
|
||||
Result := FOwner.GetLineCount;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -364,8 +334,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function TCarbonMemoStrings.Get(Index: Integer): string;
|
||||
begin
|
||||
if FExternalChanged then InternalUpdate;
|
||||
Result := FStringList[Index];
|
||||
Result := FOwner.GetLine(Index);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -377,38 +346,6 @@ end;
|
||||
constructor TCarbonMemoStrings.Create(AOwner: TCarbonMemo);
|
||||
begin
|
||||
FOwner := AOwner;
|
||||
FStringList := TStringList.Create;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemoStrings.Destroy
|
||||
|
||||
Releases strings from Carbon memo strings
|
||||
------------------------------------------------------------------------------}
|
||||
destructor TCarbonMemoStrings.Destroy;
|
||||
begin
|
||||
FStringList.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemoStrings.Assign
|
||||
Params: Source - Object to assing
|
||||
|
||||
Assings strings object
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemoStrings.Assign(Source: TPersistent);
|
||||
begin
|
||||
if (Source = Self) or (Source = nil) then Exit;
|
||||
if Source is TStrings then
|
||||
begin
|
||||
FStringList.Clear;
|
||||
FStringList.Text := TStrings(Source).Text;
|
||||
ExternalUpdate;
|
||||
end
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -418,8 +355,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemoStrings.Clear;
|
||||
begin
|
||||
FStringList.Clear;
|
||||
ExternalUpdate;
|
||||
SetTextStr('');
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -430,8 +366,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemoStrings.Delete(Index: Integer);
|
||||
begin
|
||||
FStringList.Delete(Index);
|
||||
ExternalUpdate;
|
||||
FOwner.DeleteLine(Index);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -443,30 +378,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemoStrings.Insert(Index: Integer; const S: string);
|
||||
begin
|
||||
FStringList.Insert(Index, S);
|
||||
ExternalUpdate;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemoStrings.SetText
|
||||
Params: TheText - Text to set
|
||||
|
||||
Sets the text of strings
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemoStrings.SetText(TheText: PChar);
|
||||
begin
|
||||
FStringList.Text := TheText;
|
||||
ExternalUpdate;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCarbonMemoStrings.ExternalChanged
|
||||
|
||||
Notifies that strings object in Carbon interface has changed
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCarbonMemoStrings.ExternalChanged;
|
||||
begin
|
||||
FExternalChanged := True;
|
||||
FOwner.InsertLine(Index, S);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user