1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201
|
{%MainUnit win32wsstdctrls.pp}
{$IFDEF MEMOHEADER}
type
{ TWin32MemoStrings }
TWin32MemoStrings = class(TCustomMemoStrings)
private
FHandle: HWND;
FOwner: TWinControl;
function GetLineLength(Index: Integer): Integer;
function GetLineStart(Index: Integer): Integer;
protected
function GetTextStr: string; override;
function GetRealCount: integer;
function GetCount: integer; override;
function Get(Index : Integer) : string; override;
//procedure SetSorted(Val : boolean); virtual;
procedure SetUpdateState(Updating: Boolean); override;
public
constructor Create(Handle: HWND; TheOwner: TWinControl);
procedure Assign(Source: TPersistent); override;
procedure AddStrings(TheStrings: TStrings); override;
procedure Clear; override;
procedure Delete(Index : integer); override;
procedure Insert(Index : integer; const S: string); override;
procedure SetTextStr(const Value: string); override;
procedure LoadFromFile(const FileName: string); override;
procedure SaveToFile(const FileName: string); override;
//procedure Sort; virtual;
public
//property Sorted: boolean read FSorted write SetSorted;
property Owner: TWinControl read FOwner;
end;
{$ELSE} // Implementation
function TWin32MemoStrings.GetLineLength(Index: Integer): Integer;
begin
Result := Integer(SendMessageW(FHandle, EM_LINELENGTH, SendMessageW(FHandle, EM_LINEINDEX, Index, 0), 0));
end;
function TWin32MemoStrings.GetLineStart(Index: Integer): Integer;
begin
Result := Integer(SendMessageW(FHandle, EM_LINEINDEX, Index, 0));
end;
function TWin32MemoStrings.GetTextStr: string;
begin
Result := win32proc.GetControlText(FHandle);
end;
function TWin32MemoStrings.GetRealCount: integer;
begin
Result := SendMessage(FHandle, EM_GETLINECOUNT, 0, 0);
end;
function TWin32MemoStrings.GetCount: integer;
begin
Result := GetRealCount;
if Get(Result-1) = '' then Dec(Result);
end;
function TWin32MemoStrings.Get(Index: Integer): string;
var
len: Integer;
WideBuffer: WideString;
begin
len := GetLineLength(Index);
if len=0 then
begin
Result := '';
exit;
end;
Setlength(WideBuffer, len);
PWord(@WideBuffer[1])^ := len+1;
len := SendMessageW(FHandle, EM_GETLINE, Index, lparam(PWideChar(WideBuffer)));
Result := UTF16ToUTF8(WideBuffer);
end;
procedure TWin32MemoStrings.SetUpdateState(Updating: Boolean);
begin
Windows.SendMessage(FHandle, WM_SETREDRAW, WPARAM(not Updating), 0);
if not Updating then
Windows.InvalidateRect(FHandle, nil, TRUE);
end;
constructor TWin32MemoStrings.Create(Handle: HWND; TheOwner: TWinControl);
begin
inherited Create;
FHandle := Handle;
FOwner := TheOwner;
end;
procedure TWin32MemoStrings.Assign(Source: TPersistent);
var
S: TStrings absolute Source;
begin
if Source is TStrings then
begin
// to prevent Clear and then SetText we need to use our own Assign
TextLineBreakStyle := S.TextLineBreakStyle; //put this first to call CheckSpecialChars if not done yet
QuoteChar := S.QuoteChar;
Delimiter := S.Delimiter;
NameValueSeparator := S.NameValueSeparator;
Text := S.Text;
end
else
inherited Assign(Source);
end;
procedure TWin32MemoStrings.AddStrings(TheStrings: TStrings);
begin
SetTextStr(GetTextStr + TStrings(TheStrings).Text);
end;
procedure TWin32MemoStrings.Clear;
begin
SetText('');
end;
procedure TWin32MemoStrings.Delete(Index: integer);
var
LineStart,
LineEnd: Integer;
begin
LineStart := GetLineStart(Index);
LineEnd := GetLineStart(Index+1);
if LineEnd < 0 then LineEnd := LineStart+GetLineLength(Index);
SendMessageW(FHandle, EM_SETSEL, LineStart, LineEnd);
SendMessageW(FHandle, EM_REPLACESEL,0 , lparam(PWChar('')));
end;
procedure TWin32MemoStrings.Insert(Index: integer; const S: string);
var
LineStart, RealCount: Integer;
NewLine: String;
begin
RealCount := GetRealCount;
if Index < RealCount then
begin
//insert with LineEnding
LineStart := GetLineStart(Index);
NewLine := S+LineEnding;
SendMessageW(FHandle, EM_SETSEL, LineStart, LineStart);
SendMessageW(FHandle, EM_REPLACESEL, 0, lparam(PWideChar(UTF8ToUTF16(NewLine))));
end
else
begin
//append with a preceding LineEnding
LineStart := GetLineStart(Index-1)+GetLineLength(Index-1);
SendMessageW(FHandle, EM_SETSEL, LineStart, LineStart);
//check if last line is empty
if Get(RealCount - 1) <> '' then
NewLine := LineEnding+S+LineEnding
else
NewLine := S+LineEnding;
SendMessageW(FHandle, EM_REPLACESEL, 0, lparam(PWideChar(UTF8ToUTF16(NewLine))));
end;
end;
procedure TWin32MemoStrings.SetTextStr(const Value: string);
var
Msg: TLMessage;
AdjustedValue: String;
begin
AdjustedValue := AdjustLineBreaks(Value);
if (AdjustedValue <> Text) then
begin
Windows.SetWindowTextW(FHandle, PWideChar(UTF8ToUTF16(AdjustedValue)));
FillChar(Msg, SizeOf(Msg), 0);
Msg.Msg := CM_TEXTCHANGED;
DeliverMessage(Owner, Msg);
end;
end;
procedure TWin32MemoStrings.LoadFromFile(const FileName: string);
var
TheStream: TFileStreamUTF8;
begin
TheStream:=TFileStreamUtf8.Create(FileName,fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(TheStream);
finally
TheStream.Free;
end;
end;
procedure TWin32MemoStrings.SaveToFile(const FileName: string);
var
TheStream: TFileStreamUTF8;
begin
TheStream:=TFileStreamUtf8.Create(FileName,fmCreate);
try
SaveToStream(TheStream);
finally
TheStream.Free;
end;
end;
{$ENDIF}
|