1{%MainUnit gtk2wsstdctrls.pp} 2{$IFDEF MEMOHEADER} 3 4type 5 6 { TGtk2MemoStrings } 7 8 TGtk2MemoStrings = class(TStrings) 9 private 10 FGtkText : PGtkTextView; 11 FGtkBuf: PGtkTextBuffer; 12 FTimerMove: guint; 13 FTimerSel: guint; 14 FOwner: TWinControl; 15 FQueueCursorMove: Integer; 16 FQueueSelLength: Integer; 17 protected 18 function GetTextStr: string; override; 19 function GetCount: integer; override; 20 function Get(Index : Integer) : string; override; 21 //procedure PutObject(Index: Integer; AObject: TObject); override; 22 //function GetObject(Index: Integer): TObject; override; 23 //procedure SetSorted(Val : boolean); virtual; 24 public 25 constructor Create(TextView : PGtkTextView; TheOwner: TWinControl); 26 destructor Destroy; override; 27 procedure Assign(Source : TPersistent); override; 28 procedure AddStrings(TheStrings: TStrings); override; 29 procedure Clear; override; 30 procedure Delete(Index : integer); override; 31 procedure Insert(Index : integer; const S: string); override; 32 procedure SetTextStr(const Value: string); override; 33 procedure LoadFromFile(const FileName: string); override; 34 procedure SaveToFile(const FileName: string); override; 35 //procedure Sort; virtual; 36 procedure QueueCursorMove(APosition: Integer); 37 procedure QueueSelectLength(ALength: Integer); 38 public 39 //property Sorted: boolean read FSorted write SetSorted; 40 property Owner: TWinControl read FOwner; 41 property QueueCursorMovePos: Integer read FQueueCursorMove; 42 property QueueSelLength: Integer read FQueueSelLength; 43 end; 44{$ELSE} 45{ 46 47Implementation 48 49} 50 51function UpdateMemoCursorCB(AStrings: TGtk2MemoStrings): gboolean; cdecl; 52var 53 TextMark: PGtkTextMark; 54 CursorIter: TGtkTextIter; 55begin 56 Result := gtk_false; // stop this timer 57 58 AStrings.FTimerMove:=0; // to know if this timer is active when destroyed 59 60 if AStrings.FQueueCursorMove = -2 then 61 begin 62 // always scroll so the cursor is visible 63 TextMark := gtk_text_buffer_get_insert(AStrings.FGtkBuf); 64 gtk_text_buffer_get_iter_at_mark(AStrings.FGtkBuf, @CursorIter, TextMark); 65 end 66 else begin 67 // SelStart was used and we should move to that location 68 gtk_text_buffer_get_iter_at_offset(AStrings.FGtkBuf, @CursorIter, AStrings.FQueueCursorMove); 69 gtk_text_buffer_place_cursor(AStrings.FGtkBuf, @CursorIter); // needed to move the cursor 70 TextMark := gtk_text_buffer_get_insert(AStrings.FGtkBuf); 71 end; 72 gtk_text_view_scroll_to_mark(AStrings.FGtkText, TextMark, 0, True, 0, 1); 73 74 AStrings.FQueueCursorMove := -1; 75end; 76 77function UpdateMemoSelLengthCB(AStrings: TGtk2MemoStrings): gboolean; cdecl; 78var 79 TextMark: PGtkTextMark; 80 StartIter, 81 EndIter: TGtkTextIter; 82 Offset: Integer; 83begin 84 Result := gtk_false; // stop this timer ; 85 86 AStrings.FTimerSel:=0; // so we don't try to remove it if it's not used. 87 88 TextMark := gtk_text_buffer_get_insert(AStrings.FGtkBuf); 89 gtk_text_buffer_get_iter_at_mark(AStrings.FGtkBuf, @StartIter, TextMark); 90 91 Offset := gtk_text_iter_get_offset(@StartIter); 92 93 gtk_text_buffer_get_iter_at_offset(AStrings.FGtkBuf, @EndIter, Offset+AStrings.FQueueSelLength); 94 95 gtk_text_buffer_select_range(AStrings.FGtkBuf, @StartIter, @EndIter); 96 97 AStrings.FQueueSelLength := -1; 98end; 99 100function TGtk2MemoStrings.GetTextStr: string; 101var 102 StartIter, EndIter: TGtkTextIter; 103 AText: PgChar; 104begin 105 Result := ''; 106 gtk_text_buffer_get_start_iter(FGtkBuf, @StartIter); 107 gtk_text_buffer_get_end_iter(FGtkBuf, @EndIter); 108 109 AText := gtk_text_iter_get_text(@StartIter, @EndIter); 110 Result := StrPas(AText); 111 if AText <> nil then 112 g_free(AText); 113end; 114 115function TGtk2MemoStrings.GetCount: integer; 116begin 117 Result := gtk_text_buffer_get_line_count(FGtkBuf); 118 if Get(Result-1) = '' then Dec(Result); 119end; 120 121function TGtk2MemoStrings.Get(Index: Integer): string; 122var 123 StartIter, EndIter: TGtkTextIter; 124 AText: PgChar; 125begin 126 gtk_text_buffer_get_iter_at_line(FGtkBuf, @StartIter, Index); 127 if Index = gtk_text_buffer_get_line_count(FGtkBuf) then 128 gtk_text_buffer_get_end_iter(FGtkBuf, @EndIter) 129 else begin 130 gtk_text_buffer_get_iter_at_line(FGtkBuf, @EndIter, Index); 131 gtk_text_iter_forward_to_line_end(@EndIter); 132 end; 133 // if a row is blank gtk_text_iter_forward_to_line_end will goto the row ahead 134 // this is not desired. so if it jumped ahead a row then the row we want is blank 135 if gtk_text_iter_get_line(@StartIter) = gtk_text_iter_get_line(@EndIter) then 136 begin 137 AText := gtk_text_iter_get_text(@StartIter, @EndIter); 138 Result := StrPas(AText); 139 g_free(AText); 140 end 141 else 142 Result := ''; 143end; 144 145constructor TGtk2MemoStrings.Create(TextView: PGtkTextView; 146 TheOwner: TWinControl); 147begin 148 inherited Create; 149 if TextView = nil then 150 RaiseGDBException('TGtk2MemoStrings.Create Unspecified Text widget'); 151 FGtkText:= TextView; 152 FGtkBuf := gtk_text_view_get_buffer(FGtkText); 153 if TheOwner = nil then 154 RaiseGDBException('TGtk2MemoStrings.Create Unspecified owner'); 155 FOwner:=TheOwner; 156 FQueueCursorMove := -1; 157 FQueueSelLength := -1; 158 FTimerMove := 0; 159 FTimerSel := 0; 160end; 161 162destructor TGtk2MemoStrings.Destroy; 163begin 164 if FTimerSel <> 0 then 165 gtk_timeout_remove(FTimerSel); 166 if FTimerMove <> 0 then 167 gtk_timeout_remove(FTimerMove); 168 // don't destroy the widgets 169 inherited Destroy; 170end; 171 172procedure TGtk2MemoStrings.Assign(Source: TPersistent); 173var 174 S: TStrings absolute Source; 175begin 176 if Source is TStrings then 177 begin 178 // to prevent Clear and then SetText we need to use our own Assign 179 QuoteChar := S.QuoteChar; 180 Delimiter := S.Delimiter; 181 NameValueSeparator := S.NameValueSeparator; 182 TextLineBreakStyle := S.TextLineBreakStyle; 183 Text := S.Text; 184 end 185 else 186 inherited Assign(Source); 187end; 188 189procedure TGtk2MemoStrings.AddStrings(TheStrings: TStrings); 190begin 191 SetTextStr(GetTextStr + TStrings(TheStrings).Text); 192end; 193 194procedure TGtk2MemoStrings.Clear; 195begin 196 SetText(''); 197end; 198 199procedure TGtk2MemoStrings.Delete(Index: integer); 200var 201StartIter, 202EndIter: TGtkTextIter; 203begin 204 gtk_text_buffer_get_iter_at_line(FGtkBuf, @StartIter, Index); 205 if Index = Count-1 then 206 gtk_text_buffer_get_end_iter(FGtkBuf, @EndIter) 207 else 208 gtk_text_buffer_get_iter_at_line(FGtkBuf, @EndIter, Index+1); 209 gtk_text_buffer_delete(FGtkBuf, @StartIter, @EndIter); 210end; 211 212procedure TGtk2MemoStrings.Insert(Index: integer; const S: string); 213var 214 StartIter, 215 CursorIter: TGtkTextIter; 216 NewLine: String; 217 TextMark: PGtkTextMark; 218begin 219 if Index < gtk_text_buffer_get_line_count(FGtkBuf) then begin 220 //insert with LineEnding 221 NewLine := S+LineEnding; 222 gtk_text_buffer_get_iter_at_line(FGtkBuf, @StartIter, Index); 223 end 224 else begin 225 //append with a preceding LineEnding 226 gtk_text_buffer_get_end_iter(FGtkBuf, @StartIter); 227 if gtk_text_buffer_get_line_count(FGtkBuf) = Count then 228 NewLine := LineEnding+S+LineEnding 229 else 230 NewLine := S+LineEnding; 231 end; 232 233 if FQueueCursorMove = -1 then 234 begin 235 TextMark := gtk_text_buffer_get_insert(FGtkBuf); 236 gtk_text_buffer_get_iter_at_mark(FGtkBuf, @CursorIter, TextMark); 237 if gtk_text_iter_equal(@StartIter, @CursorIter) then 238 QueueCursorMove(-2); 239 end; 240 241 // and finally insert the new text 242 gtk_text_buffer_insert(FGtkBuf, @StartIter, PChar(NewLine) ,-1); 243end; 244 245procedure TGtk2MemoStrings.SetTextStr(const Value: string); 246var 247 aText: string; 248begin 249 aText := Text; 250 // don't queue cursor movement if both old and new text are emtpy 251 if (aText<>'') or (Value<>'') then 252 begin 253 QueueCursorMove(0); 254 QueueSelectLength(0); 255 end; 256 if (Value <> '') and (aText <> '') then 257 LockOnChange({%H-}PGtkObject(Owner.Handle), 1); 258 gtk_text_buffer_set_text(FGtkBuf, PChar(Value), -1); 259end; 260 261procedure TGtk2MemoStrings.LoadFromFile(const FileName: string); 262var 263 TheStream: TFileStream; 264begin 265 TheStream:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite); 266 try 267 LoadFromStream(TheStream); 268 finally 269 TheStream.Free; 270 end; 271end; 272 273procedure TGtk2MemoStrings.SaveToFile(const FileName: string); 274var 275 TheStream: TFileStream; 276begin 277 TheStream:=TFileStream.Create(FileName,fmCreate); 278 try 279 SaveToStream(TheStream); 280 finally 281 TheStream.Free; 282 end; 283end; 284 285procedure TGtk2MemoStrings.QueueCursorMove(APosition: Integer); 286begin 287 // needed because there is a callback that updates the GtkBuffer 288 // internally so that it actually knows where the cursor is 289 if FQueueCursorMove = -1 then 290 FTimerMove := gtk_timeout_add(0,TGSourceFunc(@UpdateMemoCursorCB), Pointer(Self)); 291 FQueueCursorMove := APosition; 292end; 293 294procedure TGtk2MemoStrings.QueueSelectLength(ALength: Integer); 295begin 296 // needed because there is a callback that updates the GtkBuffer 297 // internally so that it actually knows where the cursor is 298 if FQueueSelLength = -1 then 299 FTimerSel := gtk_timeout_add(0,TGSourceFunc(@UpdateMemoSelLengthCB), Pointer(Self)); 300 FQueueSelLength := ALength; 301end; 302 303{$ENDIF} 304