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