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