1{%MainUnit gtkint.pp} 2{****************************************************************************** 3 gtklistsl.inc 4 TGtkListStringList and TGtkCListStringList 5 6 ****************************************************************************** 7 8 ***************************************************************************** 9 This file is part of the Lazarus Component Library (LCL) 10 11 See the file COPYING.modifiedLGPL.txt, included in this distribution, 12 for details about the license. 13 ***************************************************************************** 14} 15 16 17{************************************************************* 18 Default compare functions 19*************************************************************} 20 21{function DefaultCompareFunc(a, b : gpointer) : gint; cdecl; 22var AStr, BStr : PChar; 23begin 24 gtk_label_get(PGtkLabel(PGtkBin(a)^.child), @AStr); 25 gtk_label_get(PGtkLabel(PGtkBin(b)^.child), @BStr); 26 Result:= strcomp(AStr, BStr); 27end;} 28 29{function DefaultCheckCompareFunc(a, b : gpointer) : gint; cdecl; 30var AStr, BStr : PChar; 31begin 32 gtk_label_get(PPointer(PGTKBox(PGtkBin(a)^.child)^.Children^.Next^.Data)^, @AStr); 33 gtk_label_get(PPointer(PGTKBox(PGtkBin(b)^.child)^.Children^.Next^.Data)^, @BStr); 34 Result:= strcomp(AStr, BStr); 35end;} 36 37{------------------------------------------------------------------------------ 38 function gtkListItemDrawCB(Widget: PGtkWidget; area: PGDKRectangle; 39 data: gPointer) : GBoolean; cdecl; 40 41 Handler for draw events of every item in a TGtkListStringList. 42------------------------------------------------------------------------------} 43function gtkListItemDrawAfterCB(Widget: PGtkWidget; {%H-}area: PGDKRectangle; 44 data: gPointer): GBoolean; cdecl; 45var 46 Msg: TLMDrawListItem; 47 ItemIndex: integer; 48 GtkList: PGtkList; 49 AreaRect: TRect; 50 State: TOwnerDrawState; 51 LCLList: TGtkListStringList; 52begin 53 Result:=true; 54 55 //DebugLn('gtkListItemDrawCB '); 56 57 // get context 58 GtkList:=PGtkList(g_object_get_data(PGObject(Data),GtkListItemGtkListTag)); 59 if GtkList=nil then 60 RaiseGDBException('gtkListItemDrawAfterCB GtkList=nil'); 61 LCLList:=TGtkListStringList(g_object_get_data(PGObject(Data), 62 GtkListItemLCLListTag)); 63 if LCLList=nil then 64 RaiseGDBException('gtkListItemDrawAfterCB LCLList=nil'); 65 if [csDestroying,csLoading]*LCLList.Owner.ComponentState<>[] then exit; 66 67 // only owner draw lists are interested in drawing items themselves. 68 if LclList.Owner is TCustomListbox then 69 if TCustomListbox(LCLList.Owner).Style = lbStandard then 70 exit; 71 if LclList.Owner is TCustomCombobox then 72 if not TCustomCombobox(LclList.Owner).Style.IsOwnerDrawn then 73 exit; 74 75 // get itemindex and area 76 ItemIndex:=g_list_index(GtkList^.children,Data); 77 with Widget^.allocation do begin 78 AreaRect:=Bounds(x,y,width,height); 79 end; 80 81 // collect state flags 82 State:=[odBackgroundPainted]; 83 if g_list_index(GtkList^.selection,Widget)>=0 then 84 Include(State,odSelected); 85 if not GTK_WIDGET_SENSITIVE(Widget) then 86 Include(State,odInactive); 87 if GTK_WIDGET_HAS_DEFAULT(Widget) then 88 Include(State,odDefault); 89 if GTK_WIDGET_HAS_FOCUS(Widget) then 90 Include(State,odFocused); 91 92 // create message and deliver 93 FillChar(Msg{%H-},SizeOf(Msg),0); 94 Msg.Msg:=LM_DrawListItem; 95 New(Msg.DrawListItemStruct); 96 try 97 FillChar(Msg.DrawListItemStruct^,SizeOf(TDrawListItemStruct),0); 98 with Msg.DrawListItemStruct^ do begin 99 ItemID:=ItemIndex; 100 Area:=AreaRect; 101 DC:=GetDC(HWnd({%H-}PtrUInt(Widget))); 102 ItemState:=State; 103 end; 104 //DebugLn('gtkListItemDrawAfterCB ',DbgSName(LCLList.Owner),' Widget=',DbgS(Widget)); 105 Result := DeliverMessage(LCLList.Owner, Msg)=0; 106 ReleaseDC(HWnd({%H-}PtrUInt(Widget)),Msg.DrawListItemStruct^.DC); 107 finally 108 Dispose(Msg.DrawListItemStruct); 109 end; 110end; 111 112{------------------------------------------------------------------------------ 113function gtkListItemExposeEvent(Widget: PGtkWidget; 114 Event : PGdkEventExpose; data: gPointer): GBoolean; cdecl; 115 116 GTK2 helper for drawing every item in a TGtkListStringList. 117------------------------------------------------------------------------------} 118function gtkListItemExposeEvent(Widget: PGtkWidget; 119 Event : PGdkEventExpose; data: gPointer): GBoolean; cdecl; 120begin 121 Result := gtkListItemDrawAfterCB(Widget, @Event^.Area, data); 122end; 123 124{------------------------------------------------------------------------------ 125 function gtkListItemToggledCB(Widget: PGtkWidget; Data: gPointer): GBoolean; cdecl; 126 127 Called when a toggle button has change in a 128 TGtkListStringList (TCustomCheckListBox). 129------------------------------------------------------------------------------} 130function gtkListItemToggledCB(Widget: PGtkWidget; Data: gPointer): GBoolean; cdecl; 131var 132 GtkList: PGtkList; 133 LCLList: TGtkListStringList; 134 Mess: TLMessage; 135 ItemIndex: LongInt; 136begin 137 Result:=true; 138 139 //DebugLn('gtkListItemDrawCB '); 140 141 // get context 142 GtkList:=PGtkList(g_object_get_data(PGObject(Data),GtkListItemGtkListTag)); 143 if GtkList=nil then 144 RaiseGDBException('gtkListItemToggledCB GtkList=nil'); 145 LCLList:=TGtkListStringList(g_object_get_data(PGObject(Data), 146 GtkListItemLCLListTag)); 147 if LCLList=nil then 148 RaiseGDBException('gtkListItemToggledCB LCLList=nil'); 149 if [csDestroying,csLoading]*LCLList.Owner.ComponentState<>[] then exit; 150 151 // get itemindex and area 152 ItemIndex:=g_list_index(GtkList^.children,Data); 153 154 if LockOnChange({%H-}PgtkObject(LCLList.Owner.Handle),0) > 0 then Exit; 155 156 if GtkWidgetIsA(Widget,gtk_toggle_button_get_type) then begin 157 g_object_set_data(PGObject(Widget), 'Grayed', nil); 158 end; 159 160 Mess.Msg := LM_CHANGED; 161 Mess.Result := 0; 162 Mess.WParam := ItemIndex; 163 //DebugLn(['gtkListItemToggledCB ',ItemIndex]); 164 DeliverMessage(LCLList.Owner, Mess); 165end; 166 167procedure GtkListItemSelectAfterCB(Widget: PGtkWidget; data: gpointer); cdecl; 168 169 procedure RaiseGTKListNotFound; 170 var 171 s: String; 172 ChildWidget: PGtkWidget; 173 BoxWidget: PGtkBox; 174 LabelWidget: PGtkLabel; 175 LabelText: PChar; 176 begin 177 s:='gtkListItemSelectAfterCB GtkList=nil li='+dbgs(Widget); 178 ChildWidget:=PGtkBin(Widget)^.child; 179 LabelWidget:=nil; 180 if GtkWidgetIsA(ChildWidget,gtk_label_get_type) then 181 LabelWidget:=PGTKLabel(ChildWidget) 182 else if GtkWidgetIsA(ChildWidget,gtk_box_get_type) then begin 183 BoxWidget:=PGTKBox(ChildWidget); 184 if (BoxWidget^.Children<>nil) 185 and (BoxWidget^.Children^.Next<>nil) then begin 186 LabelWidget:=BoxWidget^.Children^.Next^.Data; 187 if not GtkWidgetIsA(PGtkWidget(LabelWidget),gtk_label_get_type) then 188 LabelWidget:=nil; 189 end; 190 end; 191 if LabelWidget<>nil then begin 192 LabelText:=nil; 193 gtk_label_get(LabelWidget, @LabelText); 194 s:=s+' Text="'+DbgStr(StrPas(LabelText))+'"'; 195 end; 196 RaiseGDBException(s); 197 end; 198 199var 200 GtkList: PGtkList; 201 LCLList: TGtkListStringList; 202 //ItemIndex: LongInt; 203 Mess: TLMessage; 204begin 205 {$IFDEF EventTrace} 206 Debugln('gtkListItemSelectAfterCB'); 207 {$ENDIF} 208 // get context 209 GtkList:=PGtkList(g_object_get_data(PGObject(Data),GtkListItemGtkListTag)); 210 if GtkList=nil then 211 RaiseGTKListNotFound; 212 LCLList:=TGtkListStringList(g_object_get_data(PGObject(Data), 213 GtkListItemLCLListTag)); 214 if LCLList=nil then 215 RaiseGDBException('gtkListItemSelectAfterCB LCLList=nil'); 216 if [csDestroying,csLoading]*LCLList.Owner.ComponentState<>[] then exit; 217 218 // get itemindex and area 219 //ItemIndex:=g_list_index(GtkList^.children,Data); 220 221 if LockOnChange({%H-}PGtkObject(LCLList.Owner.Handle),0) > 0 then Exit; 222 223 Mess.Msg := LM_SELCHANGE; 224 Mess.Result := 0; 225 DeliverMessage(LCLList.Owner, Mess); 226end; 227 228{*************************************************************} 229{ TGtkListStringList methods } 230{*************************************************************} 231 232{------------------------------------------------------------------------------ 233 Method: TGtkListStringList.Create 234 Params: 235 Returns: 236 237 ------------------------------------------------------------------------------} 238constructor TGtkListStringList.Create(List: PGtkList; TheOwner: TWinControl; 239 const AWithCheckBox: Boolean); 240begin 241 inherited Create; 242 if List = nil then RaiseGDBException( 243 'TGtkListStringList.Create Unspecified list widget'); 244 FGtkList:= List; 245 if TheOwner = nil then RaiseGDBException( 246 'TGtkListStringList.Create Unspecified owner'); 247 FOwner:=TheOwner; 248 FWithCheckBox := AWithCheckBox; 249 //DebugLn('TGtkListStringList.Create Self=',DbgS(Self),' List=',DbgS(List),' Owner=',DbgS(Owner)); 250 Include(FStates,glsItemCacheNeedsUpdate); 251 ConnectAllCallbacks; 252 {$IFDEF CheckGtkList} 253 ConsistencyCheck; 254 {$ENDIF} 255end; 256 257destructor TGtkListStringList.Destroy; 258begin 259 // don't destroy the widgets 260 RemoveAllCallbacks; 261 ReAllocMem(FCachedItems,0); 262 FCachedItems:=nil; 263 FCachedCount:=0; 264 FCachedCapacity:=0; 265 //DebugLn('TGtkListStringList.Destroy Self=',DbgS(Self),' List=',DbgS(FGtkList),' Owner=',DbgS(Owner)); 266 inherited Destroy; 267end; 268 269function TGtkListStringList.Add(const S: string): Integer; 270begin 271 if FSorted then begin 272 Result := GetInsertPosition(S); 273 Insert(Count,S); 274 end else begin 275 Result:=Count; 276 Insert(Result,S); 277 end; 278end; 279 280{------------------------------------------------------------------------------ 281 Method: TGtkListStringList.SetSorted 282 Params: 283 Returns: 284 285 ------------------------------------------------------------------------------} 286procedure TGtkListStringList.SetSorted(Val : boolean); 287begin 288 if Val <> FSorted then begin 289 FSorted:= Val; 290 if FSorted then Sort; 291 end; 292end; 293 294procedure TGtkListStringList.CheckForInvalidFocus; 295var 296 Window: PGtkWindow; 297begin 298 { This procedure works round a gtk problem - a deleted item may have the focus 299 according to an enclosing window, but the enclosing window does not notice 300 that the item has gone. } 301 Window := PGtkWindow(gtk_widget_get_ancestor(PGtkWidget(FGtkList), 302 gtk_window_get_type)); 303 if (Window <> nil) and (Window^.focus_widget <> nil) 304 and (gtk_widget_get_ancestor(Window^.focus_widget, gtk_list_get_type) 305 = PGtkWidget(FGtkList)) 306 then 307 Window^.focus_widget := nil; 308end; 309 310{------------------------------------------------------------------------------ 311 procedure TGtkListStringList.ConnectItemCallbacks(Index: integer); 312 313 ------------------------------------------------------------------------------} 314procedure TGtkListStringList.ConnectItemCallbacks(Index: integer); 315var 316 ListItem: PGtkListItem; 317begin 318 UpdateItemCache; 319 {$IFDEF EventTrace} 320 Debugln( 'connect ',strings[index]); 321 {$ENDIF} 322 ListItem:=FCachedItems[Index]; 323 ConnectItemCallbacks(ListItem); 324end; 325 326{------------------------------------------------------------------------------ 327 procedure TGtkListStringList.ConnectItemCallbacks(Li: PGtkListItem); 328 329 ------------------------------------------------------------------------------} 330procedure TGtkListStringList.ConnectItemCallbacks(Li: PGtkListItem); 331var 332 ChildWidget: Pointer; 333begin 334 {$IFDEF EventTrace} 335 Debugln('connect itemCallback'); 336 {$ENDIF} 337 g_object_set_data(PGObject(li),GtkListItemLCLListTag,Self); 338 g_object_set_data(PGObject(li),GtkListItemGtkListTag,FGtkList); 339 //DebugLn('TGtkListStringList.ConnectItemCallbacks Self=',DbgS(Self), 340 //' GtkList=',DbgS(FGtkList), 341 //' Owner=',DbgS(Owner),'=',Owner.ClassName, 342 //' LI=',DbgS(LI), 343 //' '); 344 //DebugLn(['TGtkListStringList.ConnectItemCallbacks ',DbgSName(Owner)]); 345 g_signal_connect_after(G_OBJECT(li), 'expose_event', 346 G_CALLBACK(@gtkListItemExposeEvent), li); 347 if FWithCheckBox then begin 348 ChildWidget := PPointer(PGTKBox(PGtkBin(Li)^.child)^.Children^.Data)^; 349 g_signal_connect_after(G_OBJECT(ChildWidget), 'toggled', 350 G_CALLBACK(@gtkListItemToggledCB), li); 351 end; 352end; 353 354{------------------------------------------------------------------------------ 355 procedure TGtkListStringList.ConnectAllCallbacks; 356 ------------------------------------------------------------------------------} 357procedure TGtkListStringList.ConnectAllCallbacks; 358var 359 i: Integer; 360begin 361 BeginUpdate; 362 UpdateItemCache; 363 i := FCachedCount - 1; 364 while i >= 0 do 365 begin 366 {$IFDEF EventTrace} 367 DebugLn('connect ',strings[i]); 368 {$ENDIF} 369 ConnectItemCallbacks(FCachedItems[i]); 370 Dec(i); 371 end; 372 EndUpdate; 373end; 374 375{------------------------------------------------------------------------------ 376 procedure TGtkListStringList.RemoveItemCallbacks(Index: integer); 377 378 ------------------------------------------------------------------------------} 379procedure TGtkListStringList.RemoveItemCallbacks(Index: integer); 380begin 381 UpdateItemCache; 382 RemoveItemCallbacks(FCachedItems[Index]); 383end; 384 385procedure TGtkListStringList.RemoveItemCallbacks(AItem: PGtkListItem); 386var 387 ChildWidget: Pointer; 388begin 389 {$IFDEF EventTrace} 390 Debugln('connect itemCallback'); 391 {$ENDIF} 392 g_object_set_data(PGObject(AItem), GtkListItemLCLListTag, nil); 393 g_object_set_data(PGObject(AItem), GtkListItemGtkListTag, nil); 394 395 g_signal_handlers_disconnect_by_func( 396 G_OBJECT(AItem), G_CALLBACK(@gtkListItemExposeEvent), AItem); 397 if FWithCheckBox 398 then begin 399 ChildWidget := PPointer(PGTKBox(PGtkBin(AItem)^.child)^.Children^.Data)^; 400 gtk_signal_disconnect_by_func( 401 PGtkObject(ChildWidget), TGTKSignalFunc(@gtkListItemToggledCB), AItem); 402 FreeWidgetInfo(ChildWidget); 403 end; 404end; 405 406{------------------------------------------------------------------------------ 407 procedure TGtkListStringList.RemoveAllCallbacks; 408 409 ------------------------------------------------------------------------------} 410procedure TGtkListStringList.RemoveAllCallbacks; 411var 412 i: integer; 413begin 414 BeginUpdate; 415 UpdateItemCache; 416 i := FCachedCount - 1; 417 while i >= 0 do 418 begin 419 RemoveItemCallbacks(FCachedItems[i]); 420 Dec(i); 421 end; 422 EndUpdate; 423end; 424 425procedure TGtkListStringList.UpdateItemCache; 426var 427 CurListItem: PGList; 428 i: integer; 429begin 430 if not (glsItemCacheNeedsUpdate in FStates) then exit; 431 432 {$IFDEF DebugLCLComponents} 433 // if items were removed => mark them as destroyed 434 for i:=0 to FCachedCount-1 do begin 435 if (FGtkList=nil) 436 or (g_list_find(FGtkList^.children,FCachedItems[i])=nil) then begin 437 if DebugGtkWidgets.IsCreated(FCachedItems[i]) then begin 438 DebugLn(['TGtkListStringList.UpdateItemCache item vanished: ',i]); 439 DebugGtkWidgets.MarkDestroyed(FCachedItems[i]); 440 end; 441 end; 442 end; 443 {$ENDIF} 444 445 if (FGtkList<>nil) and (FGtkList^.children<>nil) then 446 FCachedCount:=g_list_length(FGtkList^.children) 447 else 448 FCachedCount:=0; 449 if FCachedCount=0 then 450 FCachedCapacity:=0 451 else begin 452 FCachedCapacity:=1; 453 while FCachedCapacity<FCachedCount do 454 FCachedCapacity:=FCachedCapacity shl 1; 455 FCachedCapacity:=FCachedCapacity shl 1; 456 end; 457 ReAllocMem(FCachedItems,SizeOf(PGtkListItem)*FCachedCapacity); 458 if FGtkList<>nil then begin 459 CurListItem:=FGtkList^.children; 460 i:=0; 461 while CurListItem<>nil do begin 462 FCachedItems[i]:=PGtkListItem(CurListItem^.Data); 463 {$IFDEF DebugLCLComponents} 464 if not DebugGtkWidgets.IsCreated(PGtkListItem(CurListItem^.Data)) then 465 begin 466 DebugLn(['TGtkListStringList.UpdateItemCache unknown item ',i,' ',DbgSName(Owner)]); 467 DumpStack; 468 end; 469 {$ENDIF} 470 inc(i); 471 CurListItem:=CurListItem^.Next; 472 end; 473 end; 474 Exclude(FStates,glsItemCacheNeedsUpdate); 475end; 476 477function TGtkListStringList.CacheValid: boolean; 478begin 479 Result:=not (glsItemCacheNeedsUpdate in FStates); 480end; 481 482procedure TGtkListStringList.PutObject(Index: Integer; AnObject: TObject); 483var 484 ListItem : PGtkListItem; 485begin 486 //DebugLn('[TGtkListStringList.PutObject] Index=',Index,' Count=',Count); 487 ListItem:=GetListItem(Index); 488 if ListItem <> nil then 489 g_object_set_data(PGObject(ListItem),'LCLStringsObject',AnObject); 490end; 491 492{------------------------------------------------------------------------------ 493 Method: TGtkListStringList.Sort 494 Params: 495 Returns: 496 497 ------------------------------------------------------------------------------} 498procedure TGtkListStringList.Sort; 499var 500 sl: TStringList; 501begin 502 BeginUpdate; 503 // sort internally (sorting in the widget would be slow and unpretty ;) 504 sl:=TStringList.Create; 505 sl.Assign(Self); 506 sl.Sort; // currently this is quicksort -> 507 // Disadvantages: - worst case on sorted list 508 // - not keeping order 509 // ToDo: replace by mergesort and add customsort 510 // remember selected items 511 Assign(sl); 512 sl.Free; 513 EndUpdate; 514end; 515 516function TGtkListStringList.IsEqual(List: TStrings; 517 CompareObjects: boolean): boolean; 518var 519 i, Cnt: integer; 520 CmpList: TStringList; 521begin 522 if List=Self then begin 523 Result:=true; 524 exit; 525 end; 526 Result:=false; 527 if List=nil then exit; 528 Cnt:=Count; 529 if (Cnt<>List.Count) then exit; 530 BeginUpdate; 531 CmpList:=TStringList.Create; 532 try 533 CmpList.Assign(List); 534 CmpList.Sorted:=FSorted; 535 for i:=0 to Cnt-1 do begin 536 if (Strings[i]<>CmpList[i]) 537 or (CompareObjects and (Objects[i]<>CmpList.Objects[i])) then 538 exit; 539 end; 540 finally 541 CmpList.Free; 542 EndUpdate; 543 end; 544 Result:=true; 545end; 546 547procedure TGtkListStringList.BeginUpdate; 548begin 549 //NOTE: in TComboBox, event handling is done inside the 'changed' event 550 // of the entry widget. Here we are locking the main combo widget. 551 // Currently, there's no know bug origined from this flaw. 552 inc(FUpdateCount); 553 if (FUpdateCount=1) and (Owner<>nil) and (Owner.HandleAllocated) then 554 LockOnChange({%H-}PGtkObject(Owner.Handle),+1); 555end; 556 557procedure TGtkListStringList.EndUpdate; 558begin 559 dec(FUpdateCount); 560 if (FUpdateCount=0) then begin 561 if (Owner<>nil) and (Owner.HandleAllocated) then 562 LockOnChange({%H-}PGtkObject(Owner.Handle),-1); 563 if (glsItemCacheNeedsUpdate in FStates) then 564 UpdateItemCache; 565 end; 566end; 567 568procedure TGtkListStringList.ConsistencyCheck; 569var 570 CurListItem: PGList; 571 i: integer; 572 RealCachedCount: Integer; 573 Str1: string; 574 Str2: string; 575begin 576 if FCachedCount>FCachedCapacity then RaiseGDBException(''); 577 if (FCachedItems=nil) and (FCachedCapacity>0) then RaiseGDBException(''); 578 if (FCachedItems<>nil) and (FCachedCapacity=0) then RaiseGDBException(''); 579 580 UpdateItemCache; 581 if (FGtkList<>nil) and (FGtkList^.children<>nil) then 582 RealCachedCount:=g_list_length(FGtkList^.children) 583 else 584 RealCachedCount:=0; 585 if RealCachedCount<>FCachedCount then 586 RaiseGDBException('RealCachedCount='+IntToStr(RealCachedCount) 587 +' FCachedCount='+IntToStr(FCachedCount)); 588 if FGtkList<>nil then begin 589 CurListItem:=FGtkList^.children; 590 i:=0; 591 while CurListItem<>nil do begin 592 if FCachedItems[i]<>PGtkListItem(CurListItem^.Data) then 593 RaiseGDBException(IntToStr(i)); 594 inc(i); 595 CurListItem:=CurListItem^.Next; 596 end; 597 end; 598 599 if Sorted then begin 600 for i:=0 to FCachedCount-2 do begin 601 Str1:=Strings[i]; 602 Str2:=Strings[i+1]; 603 if (AnsiCompareText(Str1,Str2)>0) then 604 RaiseGDBException(IntToStr(i)+':'+Str1+'>'+IntToStr(i+1)+':'+Str2); 605 end; 606 end; 607end; 608 609{------------------------------------------------------------------------------ 610 Method: TGtkListStringList.Assign 611 Params: 612 Returns: 613 614 ------------------------------------------------------------------------------} 615procedure TGtkListStringList.Assign(Source : TPersistent); 616var 617 i, Cnt: integer; 618 SrcStrings: TStrings; 619begin 620 if (Source=Self) or (Source=nil) then exit; 621 if ((Source is TGtkListStringList) 622 and (TGtkListStringList(Source).FGtkList=FGtkList)) 623 then 624 RaiseGDBException('TGtkListStringList.Assign: There 2 lists with the same FGtkList'); 625 BeginUpdate; 626//DebugLn('[TGtkListStringList.Assign] A ',Source.Classname,' Self=',DbgS(Self),' Source=',DbgS(Source)); 627 try 628 if Source is TStrings then begin 629 // clearing and resetting can change other properties of the widget, 630 // => don't change if the content is already the same 631 SrcStrings:=TStrings(Source); 632 if IsEqual(SrcStrings,true) then exit; 633 Clear; 634 Cnt:=SrcStrings.Count; 635 for i:=0 to Cnt - 1 do begin 636 AddObject(SrcStrings[i],SrcStrings.Objects[i]); 637 end; 638 // ToDo: restore other settings 639 640 // Do not call inherited Assign as it does things we do not want to happen 641 end else 642 inherited Assign(Source); 643 finally 644 EndUpdate; 645 end; 646 {$IFDEF CheckGtkList} 647 ConsistencyCheck; 648 {$ENDIF} 649//DebugLn('[TGtkListStringList.Assign] END ',Source.Classname); 650end; 651 652{------------------------------------------------------------------------------ 653 Method: TGtkListStringList.Get 654 Params: 655 Returns: 656 657 ------------------------------------------------------------------------------} 658function TGtkListStringList.Get(Index : integer) : string; 659var 660 Item : PChar; 661 ALabel : PGtkLabel; 662begin 663 //DebugLn('[TGtkListStringList.Get] Index=',Index,' Count=',Count); 664 ALabel:=GetLabel(Index); 665 666 if ALabel = nil then 667 Result:= '' 668 else begin 669 Item:=nil; 670 gtk_label_get(ALabel, @Item); 671 Result:= StrPas(Item); 672 end; 673end; 674 675function TGtkListStringList.GetObject(Index: Integer): TObject; 676var 677 ListItem : PGtkListItem; 678begin 679 //DebugLn('[TGtkListStringList.GetObject] Index=',Index,' Count=',Count); 680 Result:=nil; 681 ListItem:=GetListItem(Index); 682 if ListItem<>nil then 683 Result:=TObject(g_object_get_data(PGObject(ListItem),'LCLStringsObject')); 684end; 685 686procedure TGtkListStringList.Put(Index: Integer; const S: string); 687var 688 ALabel: PGtkLabel; 689 NewText: PChar; 690 SortedIndex: Integer; 691begin 692 //DebugLn('[TGtkListStringList.Put] Index=',Index,' Count=',Count); 693 if Sorted then begin 694 SortedIndex:=GetInsertPosition(S); 695 // we move instead of insert => adjust position 696 if SortedIndex>Index then dec(SortedIndex); 697 end else 698 SortedIndex:=Index; 699 700 // change label 701 ALabel:=GetLabel(Index); 702 if ALabel = nil then 703 RaiseGDBException('TGtkListStringList.Put'); 704 if S<>'' then 705 NewText:=PChar(S) 706 else 707 NewText:=#0; 708 gtk_label_set_text(ALabel, NewText); 709 //set default font 710 711 // repair sorting 712 if Sorted and (SortedIndex<>Index) then begin 713 Move(Index,SortedIndex); 714 end; 715end; 716 717function TGtkListStringList.GetListItem(Index: integer): PGtkListItem; 718begin 719 if (Index < 0) or (Index >= Count) then 720 RaiseGDBException('TGtkListStringList.Get Out of bounds.') 721 else begin 722 UpdateItemCache; 723 Result:=FCachedItems[Index]; 724 end; 725end; 726 727function TGtkListStringList.GetLabel(Index: integer): PGtkLabel; 728var 729 ListItem: PGtkListItem; 730begin 731 ListItem:=GetListItem(Index); 732 733 if FWithCheckBox then 734 Result := PPointer(PGTKBox(PGtkBin(ListItem)^.child)^.Children^.Next^.Data)^ 735 else 736 Result := PGTKLabel(PGtkBin(ListItem)^.child); 737end; 738 739{------------------------------------------------------------------------------ 740 Method: TGtkListStringList.GetCount 741 Params: 742 Returns: 743 744 ------------------------------------------------------------------------------} 745function TGtkListStringList.GetCount: integer; 746begin 747 if (FGtkList<>nil) and (FGtkList^.children <> nil) then begin 748 UpdateItemCache; 749 Result:=FCachedCount; 750 end else begin 751 Result:= 0 752 end; 753end; 754 755{------------------------------------------------------------------------------ 756 Method: TGtkListStringList.Clear 757 Params: 758 Returns: 759 760 ------------------------------------------------------------------------------} 761procedure TGtkListStringList.Clear; 762var 763 i: integer; 764begin 765 BeginUpdate; 766 RemoveAllCallbacks; 767 for i:=0 to FCachedCount-1 do begin 768 {$IFDEF DebugLCLComponents} 769 DebugGtkWidgets.MarkDestroyed(FCachedItems[i]); 770 {$ENDIF} 771 end; 772 Include(FStates,glsItemCacheNeedsUpdate); 773 CheckForInvalidFocus; 774 if gtkListGetSelectionMode(FGtkList)=GTK_SELECTION_BROWSE then begin 775 // GTK_SELECTION_BROWSE always auto selects one child 776 // -> disable it and enable it when a selection is needed 777 gtk_list_set_selection_mode(FGtkList,GTK_SELECTION_SINGLE); 778 end; 779 gtk_list_clear_items(FGtkList, 0, Count); 780 FCachedCount:=0; 781 //Update the internal Item Index cache 782 if FOwner.HandleAllocated and (FOwner is TCustomComboBox) then 783 PInteger(GetWidgetInfo({%H-}Pointer(FOwner.Handle))^.UserData)^ := -1; 784 EndUpdate; 785 {$IFDEF CheckGtkList} 786 ConsistencyCheck; 787 {$ENDIF} 788end; 789 790{------------------------------------------------------------------------------ 791 Method: TGtkListStringList.Delete 792 Params: 793 Returns: 794 795 ------------------------------------------------------------------------------} 796procedure TGtkListStringList.Delete(Index: integer); 797begin 798 UpdateItemCache; 799 RemoveItemCallbacks(Index); 800 {$IFDEF DebugLCLComponents} 801 DebugGtkWidgets.MarkDestroyed(FCachedItems[Index]); 802 {$ENDIF} 803 // remove item from cache 804 if (Index<FCachedCount-1) then begin 805 System.Move(FCachedItems[Index+1],FCachedItems[Index], 806 SizeOf(Pointer)*(FCachedCount-1-Index)); 807 end; 808 // shrink cache (lazy) 809 dec(FCachedCount); 810 if (FCachedCount<(FCachedCapacity shr 2)) then begin 811 FCachedCapacity:=FCachedCapacity shr 1; 812 ReAllocMem(FCachedItems,SizeOf(PGtkListItem)*FCachedCapacity); 813 end; 814 // change selection mode if needed 815 if (gtkListGetSelectionMode(FGtkList)=GTK_SELECTION_BROWSE) 816 and (FGtkList^.selection<>nil) 817 and (g_list_nth_data(FGtkList^.children, Index)=FGtkList^.selection^.data) then begin 818 // item is selected and BROWSE mode is enabled 819 // -> change selection mode to prevent, that gtk auto selects another child 820 gtk_list_set_selection_mode(FGtkList,GTK_SELECTION_SINGLE); 821 end; 822 823 // remove item from gtk list 824 if Count = 0 then CheckForInvalidFocus; 825 gtk_list_clear_items(FGtkList, Index, Index + 1); 826 Include(FStates,glsItemCacheNeedsUpdate); 827 828 //Clear the combobox text and set item index to -1 829 if FOwner is TCustomComboBox then 830 TGtk2WSCustomComboBox.SetItemIndex(TCustomComboBox(FOwner), -1); 831 832 {$IFDEF CheckGtkList} 833 ConsistencyCheck; 834 {$ENDIF} 835end; 836 837{------------------------------------------------------------------------------ 838 function TGtkListStringList.IndexOf(const S: string): Integer; 839 840 Returns index of item with string. 841 ------------------------------------------------------------------------------} 842function TGtkListStringList.IndexOf(const S: string): Integer; 843var 844 l, m, r, cmp: integer; 845begin 846 if FSorted then begin 847 l:=0; 848 r:=Count-1; 849 m:=l; 850 while (l<=r) do begin 851 m:=(l+r) shr 1; 852 cmp:=AnsiCompareText(S,Strings[m]); 853 854 if cmp<0 then 855 r:=m-1 856 else if cmp>0 then 857 l:=m+1 858 else begin 859 Result:=m; 860 exit; 861 end; 862 end; 863 Result:=-1; 864 end else begin 865 Result:=inherited IndexOf(S); 866 end; 867end; 868 869{------------------------------------------------------------------------------ 870 Method: TGtkListStringList.Insert 871 Params: 872 Returns: 873 874 ------------------------------------------------------------------------------} 875procedure TGtkListStringList.Insert(Index : integer; const S : string); 876var 877 li, cb, box,aLabel: PGtkWidget; 878 item_requisition: TGtkRequisition; 879 OldCount: LongInt; 880 LCLIndex: PInteger; 881 882 procedure RaiseIndexOutOfBounds; 883 begin 884 RaiseGDBException('TGtkListStringList.Insert: Index '+IntToStr(Index) 885 +' out of bounds. Count='+IntToStr(OldCount)); 886 end; 887 888begin 889 OldCount:=Count; 890 BeginUpdate; 891 try 892 if FSorted then begin 893 Index:=GetInsertPosition(S); 894 end; 895 if (Index < 0) or (Index > OldCount) then 896 RaiseIndexOutOfBounds; 897 if Owner = nil then RaiseGDBException( 898 'TGtkListStringList.Insert Unspecified owner'); 899 900 // ToDo: 901 // - Icons 902 // - measure item 903 904 if FWithCheckBox 905 then begin 906 li := gtk_list_item_new; 907 box := gtk_hbox_new(False, 0); //^Pointer(PGTKBox(box)^.children^.Next^.Data)^ 908 gtk_container_add(PGTKContainer(li), box); 909 cb := gtk_check_button_new; 910 gtk_box_pack_start(PGTKBox(box), cb, False, False, 0); 911 912 aLabel:=gtk_label_new(PChar(S)); 913 if not TListBox(Owner).Font.IsDefault then begin 914 Gtk2WidgetSet.SetWidgetColor(aLabel, TListBox(Owner).Font.Color, clNone, 915 [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]); 916 Gtk2WidgetSet.SetWidgetFont(aLabel, TListBox(Owner).Font); 917 end; 918 gtk_box_pack_start(PGTKBox(box), aLabel, False, False, 0); 919 end 920 else begin 921 li:=gtk_list_item_new_with_label(PChar(S)); 922 aLabel:=PGtkBin(li)^.child; 923 if not TListBox(Owner).Font.IsDefault then begin 924 Gtk2WidgetSet.SetWidgetColor(aLabel, TListBox(Owner).Font.Color, clNone, 925 [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]); 926 Gtk2WidgetSet.SetWidgetFont(aLabel, TListBox(Owner).Font); 927 end; 928 end; 929 {$IFDEF DebugLCLComponents} 930 DebugGtkWidgets.MarkCreated(li,dbgsName(Owner)+' Index='+dbgs(Index)+' Count='+dbgs(Count)); 931 {$ENDIF} 932 {$IFDEF EventTrace} 933 Debugln('insertListItem',s); 934 {$ENDIF} 935 ConnectItemCallbacks(PGtkListItem(li)); 936 // grow capacity 937 UpdateItemCache; 938 if (FCachedCapacity<=OldCount) then begin 939 if FCachedCapacity=0 then FCachedCapacity:=1; 940 while (FCachedCapacity<=OldCount) do 941 FCachedCapacity:=FCachedCapacity shl 1; 942 ReAllocMem(FCachedItems,SizeOf(PGtkListItem)*FCachedCapacity); 943 end; 944 // insert item in cache 945 inc(FCachedCount); 946 if Index<OldCount then 947 System.Move(FCachedItems[Index],FCachedItems[Index+1], 948 SizeOf(PGtkListItem)*(OldCount-Index)); 949 FCachedItems[Index]:=PGtkListItem(li); 950 // insert in gtk 951 gtk_widget_show_all(li); 952 gtk_list_insert_items(FGtkList, g_list_append(nil, li), Index); 953 //if the item is inserted before the selected item the 954 //internal index cache becomes out of sync 955 if (FOwner is TCustomComboBox) and FOwner.HandleAllocated then 956 begin 957 LCLIndex := PInteger(GetWidgetInfo({%H-}Pointer(FOwner.Handle))^.UserData); 958 if Index <= LCLIndex^ then 959 Inc(LCLIndex^); 960 end; 961 // adjust gtk height 962 if (Owner is TCustomListBox) 963 and (TListBox(Owner).ItemHeight>1) then begin 964 if li^.Allocation.Width>1 then 965 item_requisition.Width:=li^.Allocation.Width 966 else 967 gtk_widget_size_request(li,@item_requisition); 968 gtk_widget_set_usize(li,Max(li^.Allocation.Width,item_requisition.Width), 969 TListBox(Owner).ItemHeight); 970 end; 971 finally 972 EndUpdate; 973 {$IFDEF CheckGtkList} 974 ConsistencyCheck; 975 {$ENDIF} 976 end; 977//DebugLn('[TGtkListStringList.Insert] END Index=',Index,' Count=',Count,' ',S,',',Count); 978end; 979 980function TGtkListStringList.GetInsertPosition(const S: string): integer; 981var 982 l: Integer; 983 Cnt: LongInt; 984 r: Integer; 985 m: LongInt; 986 cmp: LongInt; 987begin 988 Cnt:=Count; 989 if FSorted then begin 990 l:=0; 991 r:=Cnt-1; 992 m:=l; 993 while (l<=r) do begin 994 m:=(l+r) shr 1; 995 cmp:=AnsiCompareText(S,Strings[m]); 996 if cmp<0 then 997 r:=m-1 998 else if cmp>0 then 999 l:=m+1 1000 else 1001 break; 1002 end; 1003 if (m<Cnt) and (AnsiCompareText(S,Strings[m])>0) then 1004 inc(m); 1005 Result:=m; 1006 end else begin 1007 Result:=Cnt; 1008 end; 1009end; 1010 1011procedure TGtkListStringList.Move(FromIndex, ToIndex: Integer); 1012var 1013 Item: PGtkListItem; 1014begin 1015 if (FromIndex=ToIndex) then exit; 1016 1017 //debugln('TGtkListStringList.Move From=',dbgs(FromIndex),' To=',dbgs(ToIndex)); 1018 Item:=GetListItem(FromIndex); 1019 1020 // move in gtk 1021 MoveGListLink(FGtkList^.children,FromIndex,ToIndex); 1022 if (GTK_WIDGET_VISIBLE (PGtkWidget(FGtkList))) then 1023 gtk_widget_queue_resize (PGtkWidget(FGtkList)); 1024 1025 // move in cache 1026 if CacheValid then begin 1027 if FromIndex<ToIndex then begin 1028 System.Move(FCachedItems[FromIndex+1],FCachedItems[FromIndex], 1029 SizeOf(PGtkListItem)*(ToIndex-FromIndex)); 1030 end else begin 1031 System.Move(FCachedItems[ToIndex],FCachedItems[ToIndex+1], 1032 SizeOf(PGtkListItem)*(FromIndex-ToIndex)); 1033 end; 1034 FCachedItems[ToIndex]:=Item; 1035 end; 1036end; 1037 1038