diff --git a/lcl/checklst.pas b/lcl/checklst.pas index a56aef9201..2075bdf1ef 100644 --- a/lcl/checklst.pas +++ b/lcl/checklst.pas @@ -138,7 +138,6 @@ begin FItemDataOffset := inherited GetCachedDataSize; end; - procedure TCustomCheckListBox.DoChange(var Msg); begin clickChecked; diff --git a/lcl/include/trackbar.inc b/lcl/include/trackbar.inc index 9ba780f42d..17b697ce53 100644 --- a/lcl/include/trackbar.inc +++ b/lcl/include/trackbar.inc @@ -45,12 +45,7 @@ - range checking for min/max could raise an exception - use RecreateWnd when the orientation changes! - Bugs: - - - When changing orientation after the Trackbar has been constructed - the GTK version will CRASH } -{ASSERTIONS ON} {------------------------------------------------------------------------------ Method: TCustomTrackBar.Create Params: AOwner: the owner of the class @@ -75,7 +70,7 @@ begin FTickMarks:=tmBottomRight; FTickStyle:=tsAuto; TabStop := true; - SetInitialBounds(0,0,100,20); + SetInitialBounds(0,0,100,25); end; {------------------------------------------------------------------------------ @@ -133,7 +128,7 @@ end; Method: TCustomTrackBar.SetParams Params: APosition : new position AMin : new minimum - AMax : new maximum + AMax : new maximum Returns: Nothing Set new parameters for the trackbar. diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index c1719aa69b..796e8d3c88 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/lcl/interfaces/gtk/gtkobject.inc @@ -3632,6 +3632,7 @@ begin LM_DESTROY : begin + //DebugLn(['TGtkWidgetSet.SetCallback ',DbgSName(ALCLObject)]); ConnectSenderSignal(gObject, 'destroy', @gtkdestroyCB); end; diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index e82b2ca684..62159e7ce8 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/lcl/interfaces/gtk/gtkproc.inc @@ -4640,7 +4640,7 @@ end; Returns: Nothing Connects a gtk signal handler. - This is wrappers to get around gtk casting + This is a wrapper to get around gtk casting -------------------------------------------------------------------------------} procedure SignalConnect(const AWidget: PGTKWidget; const ASignal: PChar; const AProc: Pointer; const AInfo: PWidgetInfo); @@ -4657,7 +4657,7 @@ end; Returns: Nothing Connects a gtk signal after handler. - This is wrappers to get around gtk casting + This is a wrapper to get around gtk casting -------------------------------------------------------------------------------} procedure SignalConnectAfter(const AWidget:PGTKWidget; const ASignal: PChar; const AProc: Pointer; const AInfo: PWidgetInfo); @@ -4775,8 +4775,7 @@ begin and (not (csfDesignOnly in ASFlags)) then begin OldDesignMask := GetDesignSignalMask(PGtkWidget(AnObject)); - NewDesignMask := - OldDesignMask and not DesignSignalMasks[DesignSignalType]; + NewDesignMask :=OldDesignMask and not DesignSignalMasks[DesignSignalType]; if OldDesignMask <> NewDesignMask then SetDesignSignalMask(PGtkWidget(AnObject),NewDesignMask); end; diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index deac5f4408..a1ff61d655 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/lcl/interfaces/gtk/gtkproc.pp @@ -619,7 +619,7 @@ function GetDesignOnlySignalFlag(Widget: PGtkWidget; // new signal procs, these will obsolete the old ones // new signalshandlers are attached locally in the new WSxxx classes // they also have PWidgetInfo as data (and not the TControl) -// singnals are now also handled dedicated and locally, so no case statements +// signals are now also handled dedicated and locally, so no case statements // anymore in signal handlers procedure SignalConnect(const AWidget: PGTKWidget; const ASignal: PChar; const AProc: Pointer; const AInfo: PWidgetInfo); diff --git a/lcl/interfaces/gtk/gtkwscomctrls.pp b/lcl/interfaces/gtk/gtkwscomctrls.pp index 3d753a3460..97a8a668d3 100644 --- a/lcl/interfaces/gtk/gtkwscomctrls.pp +++ b/lcl/interfaces/gtk/gtkwscomctrls.pp @@ -337,17 +337,17 @@ end; class procedure TGtkWSTrackBar.ApplyChanges(const ATrackBar: TCustomTrackBar); var wHandle: HWND; - Widget: PGtkWidget; + Adjustment: PGtkAdjustment; begin with ATrackBar do begin wHandle := Handle; - Widget := GTK_WIDGET(gtk_range_get_adjustment (GTK_RANGE(Pointer(wHandle)))); - GTK_ADJUSTMENT(Widget)^.lower := Min; - GTK_ADJUSTMENT(Widget)^.Upper := Max; - GTK_ADJUSTMENT(Widget)^.Value := Position; - GTK_ADJUSTMENT(Widget)^.step_increment := LineSize; - GTK_ADJUSTMENT(Widget)^.page_increment := PageSize; + Adjustment := gtk_range_get_adjustment (GTK_RANGE(Pointer(wHandle))); + Adjustment^.lower := Min; + Adjustment^.Upper := Max; + Adjustment^.Value := Position; + Adjustment^.step_increment := LineSize; + Adjustment^.page_increment := PageSize; { now do some of the more sophisticated features } { Hint: For some unknown reason we have to disable the draw_value first, otherwise it's set always to true } @@ -363,7 +363,7 @@ begin trBottom: gtk_scale_set_value_pos (GTK_SCALE (Pointer(wHandle)), GTK_POS_BOTTOM); end; end; - //Not here (Delphi compatibility): gtk_signal_emit_by_name (GTK_Object (Widget), 'value_changed'); + //Not here (Delphi compatibility): gtk_signal_emit_by_name (GTK_Object (Adjustment), 'value_changed'); end; end; diff --git a/lcl/interfaces/gtk/gtkwscontrols.pp b/lcl/interfaces/gtk/gtkwscontrols.pp index 70a6030c6a..55e90dd938 100644 --- a/lcl/interfaces/gtk/gtkwscontrols.pp +++ b/lcl/interfaces/gtk/gtkwscontrols.pp @@ -328,7 +328,8 @@ begin end; end; -class procedure TGtkWSWinControl.SetCallbacks(const AGTKObject: PGTKObject; const AComponent: TComponent); +class procedure TGtkWSWinControl.SetCallbacks(const AGTKObject: PGTKObject; + const AComponent: TComponent); begin GtkWidgetSet.SetCallback(LM_SHOWWINDOW, AGTKObject, AComponent); GtkWidgetSet.SetCallback(LM_DESTROY, AGTKObject, AComponent); @@ -836,9 +837,11 @@ begin // SetCallbacks isn't called here, it should be done in the 'derived' class end; -class procedure TGtkWSBaseScrollingWinControl.SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); +class procedure TGtkWSBaseScrollingWinControl.SetCallbacks( + const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); begin - TGtkWSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject)); + TGtkWSWinControl.SetCallbacks(PGtkObject(AWidget), + TComponent(AWidgetInfo^.LCLObject)); SignalConnect( PGtkWidget(gtk_scrolled_window_get_hadjustment(PGTKScrolledWindow(AWidget))), diff --git a/lcl/interfaces/gtk2/gtk2int.pas b/lcl/interfaces/gtk2/gtk2int.pas index 760414891a..0443c99f05 100644 --- a/lcl/interfaces/gtk2/gtk2int.pas +++ b/lcl/interfaces/gtk2/gtk2int.pas @@ -104,7 +104,8 @@ type procedure SetSorted(Val : boolean); virtual; procedure UpdateItemCache; public - constructor Create(ListStore : PGtkListStore; ColumnIndex : Integer; TheOwner: TWinControl); + constructor Create(ListStore : PGtkListStore; + ColumnIndex : Integer; TheOwner: TWinControl); destructor Destroy; override; function Add(const S: string): Integer; override; procedure Assign(Source : TPersistent); override; @@ -193,7 +194,8 @@ const Returns: ------------------------------------------------------------------------------} -constructor TGtkListStoreStringList.Create(ListStore : PGtkListStore; ColumnIndex : Integer; TheOwner: TWinControl); +constructor TGtkListStoreStringList.Create(ListStore : PGtkListStore; + ColumnIndex : Integer; TheOwner: TWinControl); begin inherited Create; if ListStore = nil then RaiseException( @@ -232,10 +234,19 @@ end; ------------------------------------------------------------------------------} procedure TGtkListStoreStringList.SetSorted(Val : boolean); +var + i: Integer; begin if Val <> FSorted then begin + if Val then begin + for i:=0 to Count-2 do begin + if AnsiCompareText(Strings[i],Strings[i+1])<0 then begin + Sort; + break; + end; + end; + end; FSorted:= Val; - if FSorted then Sort; end; end; @@ -284,16 +295,17 @@ end; procedure TGtkListStoreStringList.Sort; var sl: TStringList; + OldSorted: Boolean; begin BeginUpdate; // sort internally (sorting in the widget would be slow and unpretty ;) sl:=TStringList.Create; sl.Assign(Self); - sl.Sort; // currently this is quicksort -> - // Disadvantages: - worst case on sorted list - // - not keeping order - // ToDo: replace by mergesort and add customsort + MergeSort(sl,@AnsiCompareText); + OldSorted:=Sorted; + FSorted:=false; Assign(sl); + FSorted:=OldSorted; sl.Free; EndUpdate; end; @@ -301,7 +313,6 @@ end; function TGtkListStoreStringList.IsEqual(List: TStrings): boolean; var i, Cnt: integer; - CmpList: TStringList; begin if List=Self then begin Result:=true; @@ -312,30 +323,20 @@ begin BeginUpdate; Cnt:=Count; if (Cnt<>List.Count) then exit; - CmpList:=TStringList.Create; - try - CmpList.Assign(List); - CmpList.Sorted:=FSorted; - for i:=0 to Cnt-1 do begin - if (Strings[i]<>CmpList[i]) or (Objects[i]<>CmpList.Objects[i]) then exit; - end; - finally - CmpList.Free; - end; + for i:=0 to Cnt-1 do + if (Strings[i]<>List[i]) or (Objects[i]<>List.Objects[i]) then exit; Result:=true; EndUpdate; end; procedure TGtkListStoreStringList.BeginUpdate; begin - if FUpdateCount=0 then Include(FStates,glsItemCacheNeedsUpdate); inc(FUpdateCount); end; procedure TGtkListStoreStringList.EndUpdate; begin dec(FUpdateCount); - if FUpdateCount=0 then Include(FStates,glsItemCacheNeedsUpdate); end; {------------------------------------------------------------------------------ @@ -347,22 +348,33 @@ end; procedure TGtkListStoreStringList.Assign(Source : TPersistent); var i, Cnt: integer; + CmpList: TStrings; + OldSorted: Boolean; begin if (Source=Self) or (Source=nil) then exit; if ((Source is TGtkListStoreStringList) and (TGtkListStoreStringList(Source).FGtkListStore=FGtkListStore)) then - RaiseException('TGtkListStoreStringList.Assign: There 2 lists with the same FGtkListStore'); + RaiseException('TGtkListStoreStringList.Assign: There are 2 lists with the same FGtkListStore'); BeginUpdate; + OldSorted:=Sorted; + CmpList:=nil; try if Source is TStrings then begin // clearing and resetting can change other properties of the widget, // => don't change if the content is already the same - if IsEqual(TStrings(Source)) then exit; + if Sorted then begin + CmpList:=TStringList.Create; + CmpList.Assign(TStrings(Source)); + MergeSort(TStringList(CmpList),@AnsiCompareText); + end else + CmpList:=TStrings(Source); + if IsEqual(CmpList) then exit; Clear; + FSorted:=false; Cnt:=TStrings(Source).Count; for i:=0 to Cnt - 1 do begin - AddObject(TStrings(Source)[i],TStrings(Source).Objects[i]); + AddObject(CmpList[i],CmpList.Objects[i]); end; // ToDo: restore other settings @@ -370,6 +382,8 @@ begin end else inherited Assign(Source); finally + fSorted:=OldSorted; + if CmpList<>Source then CmpList.Free; EndUpdate; end; end; @@ -392,7 +406,8 @@ begin ListItem:=FCachedItems[Index]; Item := nil; - gtk_tree_model_get(GTK_TREE_MODEL(FGtkListStore), @ListItem, [FColumnIndex, @Item, -1]); + gtk_tree_model_get(GTK_TREE_MODEL(FGtkListStore), @ListItem, + [FColumnIndex, @Item, -1]); if (Item <> nil) then begin Result:= StrPas(Item); g_free(Item); @@ -454,7 +469,7 @@ end; procedure TGtkListStoreStringList.Clear; begin Include(FStates,glsItemCacheNeedsUpdate); - gtk_list_store_clear(FGtkListStore) + gtk_list_store_clear(FGtkListStore); end; {------------------------------------------------------------------------------ @@ -542,7 +557,6 @@ begin gtk_list_store_set(FGtkListStore, @li, [FColumnIndex, PChar(S), -1]); Include(FStates,glsItemCacheNeedsUpdate); - finally EndUpdate; end; diff --git a/lcl/interfaces/gtk2/gtk2wschecklst.pp b/lcl/interfaces/gtk2/gtk2wschecklst.pp index 7ae4b816c9..cb4f35ab70 100644 --- a/lcl/interfaces/gtk2/gtk2wschecklst.pp +++ b/lcl/interfaces/gtk2/gtk2wschecklst.pp @@ -79,7 +79,7 @@ begin aWidget := WidgetInfo^.CoreWidget; aTreeModel := gtk_tree_view_get_model (GTK_TREE_VIEW(aWidget)); if (gtk_tree_model_get_iter_from_string (aTreeModel, @aTreeIter, arg1)) then begin - aTreeIter.stamp := GTK_LIST_STORE (aTreeModel)^.stamp; //strange hack + // aTreeIter.stamp := GTK_LIST_STORE (aTreeModel)^.stamp; //strange hack value := g_new0(SizeOf(TgValue), 1); gtk_tree_model_get_value(aTreeModel, @aTreeIter, 0, value); @@ -103,7 +103,7 @@ var begin aTreeModel := gtk_tree_view_get_model (treeview); if (gtk_tree_model_get_iter (aTreeModel, @aTreeIter, arg1)) then begin - aTreeIter.stamp := GTK_LIST_STORE (aTreeModel)^.stamp; //strange hack + // aTreeIter.stamp := GTK_LIST_STORE (aTreeModel)^.stamp; //strange hack value := g_new0(SizeOf(TgValue), 1); gtk_tree_model_get_value(aTreeModel, @aTreeIter, 0, value); @@ -121,7 +121,6 @@ class procedure TGtk2WSCustomCheckListBox.SetCallbacks(const AGtkWidget: PGtkWid // Selection: PGtkTreeSelection; begin TGtkWSBaseScrollingWinControl.SetCallbacks(AGtkWidget,AWidgetInfo); - TGtkWSWinControl.SetCallbacks(PGtkObject(AWidgetInfo^.CoreWidget), TComponent(AWidgetInfo^.LCLObject)); {Selection :=} gtk_tree_view_get_selection(PGtkTreeView(AWidgetInfo^.CoreWidget)); //SignalConnect(PGtkWidget(Selection), 'changed', @Gtk2WS_ListBoxChange, AWidgetInfo); @@ -161,10 +160,10 @@ begin gtk_list_store_set(ListStore, @Iter, [0, AChecked, -1]); end; -class function TGtk2WSCustomCheckListBox.CreateHandle(const AWinControl: TWinControl; - const AParams: TCreateParams): TLCLIntfHandle; +class function TGtk2WSCustomCheckListBox.CreateHandle( + const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; var - TempWidget: PGtkWidget; + TreeViewWidget: PGtkWidget; p: PGtkWidget; // ptr to the newly created GtkWidget liststore : PGtkListStore; Selection: PGtkTreeSelection; @@ -172,7 +171,6 @@ var column : PGtkTreeViewColumn; WidgetInfo: PWidgetInfo; begin - Result := TGtkWSBaseScrollingWinControl.CreateHandle(AWinControl,AParams); p:= PGtkWidget(Result); @@ -187,39 +185,41 @@ begin gtk_scrolled_window_set_shadow_type(PGtkScrolledWindow(p),GTK_SHADOW_IN); gtk_widget_show(p); - liststore := gtk_list_store_new (3, [G_TYPE_BOOLEAN, G_TYPE_STRING, G_TYPE_POINTER, nil]); - - TempWidget:= gtk_tree_view_new_with_model (GTK_TREE_MODEL (liststore)); + liststore := gtk_list_store_new (3, + [G_TYPE_BOOLEAN, G_TYPE_STRING, G_TYPE_POINTER, nil]); + TreeViewWidget:= gtk_tree_view_new_with_model (GTK_TREE_MODEL(liststore)); g_object_unref (G_OBJECT (liststore)); // Check Column renderer := gtk_cell_renderer_toggle_new(); - column := gtk_tree_view_column_new_with_attributes('', renderer, ['active', 0, nil]); + column := gtk_tree_view_column_new_with_attributes( + 'CHECKBTNS', renderer, ['active', 0, nil]); gtk_cell_renderer_toggle_set_active(GTK_CELL_RENDERER_TOGGLE(renderer), True); - gtk_tree_view_append_column (GTK_TREE_VIEW (TempWidget), column); + gtk_tree_view_append_column (GTK_TREE_VIEW (TreeViewWidget), column); gtk_tree_view_column_set_clickable (GTK_TREE_VIEW_COLUMN (column), TRUE); SignalConnect(PGtkWidget(renderer), 'toggled', @Gtk2WS_CheckListBoxToggle, WidgetInfo); - SignalConnect(PGtkWidget(renderer), 'row_activated', @Gtk2WS_CheckListBoxRowActivate, WidgetInfo); + SignalConnect(TreeViewWidget, 'row_activated', @Gtk2WS_CheckListBoxRowActivate, WidgetInfo); //g_signal_connect (renderer, 'toggled', G_CALLBACK (@gtk_clb_toggle), AWinControl); - //g_signal_connect (TempWidget, 'row_activated', G_CALLBACK (@gtk_clb_toggle_row_activated), AWinControl); + //g_signal_connect (TreeViewWidget, 'row_activated', G_CALLBACK (@gtk_clb_toggle_row_activated), AWinControl); // Text Column renderer := gtk_cell_renderer_text_new(); - column := gtk_tree_view_column_new_with_attributes ('LISTITEMS', renderer, ['text', 1, nil]); - gtk_tree_view_append_column (GTK_TREE_VIEW (TempWidget), column); + column := gtk_tree_view_column_new_with_attributes ( + 'LISTITEMS', renderer, ['text', 1, nil]); + gtk_tree_view_append_column (GTK_TREE_VIEW (TreeViewWidget), column); gtk_tree_view_column_set_clickable (GTK_TREE_VIEW_COLUMN (column), TRUE); - gtk_tree_view_set_headers_visible(GTK_TREE_VIEW (TempWidget), False); + gtk_tree_view_set_headers_visible(GTK_TREE_VIEW (TreeViewWidget), False); - gtk_container_add(GTK_CONTAINER(p), TempWidget); - gtk_widget_show(TempWidget); + gtk_container_add(GTK_CONTAINER(p), TreeViewWidget); + gtk_widget_show(TreeViewWidget); - SetMainWidget(p, TempWidget); - GetWidgetInfo(p, True)^.CoreWidget := TempWidget; + SetMainWidget(p, TreeViewWidget); + GetWidgetInfo(p, True)^.CoreWidget := TreeViewWidget; - Selection := gtk_tree_view_get_selection(PGtkTreeView(TempWidget)); + Selection := gtk_tree_view_get_selection(PGtkTreeView(TreeViewWidget)); case TCustomCheckListBox(AWinControl).MultiSelect of True : gtk_tree_selection_set_mode(Selection, GTK_SELECTION_MULTIPLE); @@ -236,6 +236,6 @@ initialization // To improve speed, register only classes // which actually implement something //////////////////////////////////////////////////// - RegisterWSComponent(TCheckListBox, TGtk2WSCustomCheckListBox); + RegisterWSComponent(TCustomCheckListBox, TGtk2WSCustomCheckListBox); //////////////////////////////////////////////////// end. diff --git a/lcl/interfaces/gtk2/gtk2wsstdctrls.pp b/lcl/interfaces/gtk2/gtk2wsstdctrls.pp index 558c20926d..5dcf86dc5d 100644 --- a/lcl/interfaces/gtk2/gtk2wsstdctrls.pp +++ b/lcl/interfaces/gtk2/gtk2wsstdctrls.pp @@ -95,11 +95,11 @@ type class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override; class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override; class function GetTopIndex(const ACustomListBox: TCustomListBox): integer; override; - class procedure SelectItem(const ACustomListBox: TCustomListBox; AIndex: integer; ASelected: boolean); override; + class procedure SelectItem(const ACustomListBox: TCustomListBox; AnIndex: integer; ASelected: boolean); override; class procedure SetBorder(const ACustomListBox: TCustomListBox); override; class procedure SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); override; class procedure SetSelectionMode(const ACustomListBox: TCustomListBox; const AExtendedSelect, - AMultiSelect: boolean); override; + AMultiSelect: boolean); override; class procedure SetSorted(const ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean); override; class procedure SetTopIndex(const ACustomListBox: TCustomListBox; const NewTopIndex: integer); override; class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; @@ -256,8 +256,8 @@ begin DeliverMessage(WidgetInfo^.LCLObject, Mess); end; -class function TGtk2WSCustomListBox.GetItemIndex(const ACustomListBox: TCustomListBox - ): integer; +class function TGtk2WSCustomListBox.GetItemIndex( + const ACustomListBox: TCustomListBox): integer; var Handle: HWND; Widget: PGtkWidget; @@ -286,17 +286,16 @@ begin end; end; end; - end; -class function TGtk2WSCustomListBox.GetTopIndex(const ACustomListBox: TCustomListBox - ): integer; +class function TGtk2WSCustomListBox.GetTopIndex( + const ACustomListBox: TCustomListBox): integer; begin Result:=inherited GetTopIndex(ACustomListBox); end; -class procedure TGtk2WSCustomListBox.SelectItem(const ACustomListBox: TCustomListBox; - AIndex: integer; ASelected: boolean); +class procedure TGtk2WSCustomListBox.SelectItem( + const ACustomListBox: TCustomListBox; AnIndex: integer; ASelected: boolean); var Handle: HWND; Widget: PGtkWidget; // pointer to gtk-widget (local use when neccessary) @@ -309,7 +308,7 @@ begin ListStoreModel := gtk_tree_view_get_model(PGtkTreeView(Widget)); Selection := gtk_tree_view_get_selection(PGtkTreeView(Widget)); - if gtk_tree_model_iter_nth_child(ListStoreModel, @Iter, nil, AIndex) then begin + if gtk_tree_model_iter_nth_child(ListStoreModel, @Iter, nil, AnIndex) then begin case ASelected of True: begin @@ -325,7 +324,8 @@ begin end; end; -class procedure TGtk2WSCustomListBox.SetBorder(const ACustomListBox: TCustomListBox); +class procedure TGtk2WSCustomListBox.SetBorder( + const ACustomListBox: TCustomListBox); begin // TODO debugln('TGtk2WSCustomListBox.SetBorder TODO'); @@ -451,20 +451,19 @@ begin SetCallbacks(p, WidgetInfo); end; -class procedure TGtk2WSCustomListBox.SetCallbacks(const AGtkWidget: PGtkWidget; - const AWidgetInfo: PWidgetInfo); +class procedure TGtk2WSCustomListBox.SetCallbacks( + const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); var -Selection: PGtkTreeSelection; + Selection: PGtkTreeSelection; begin TGtkWSBaseScrollingWinControl.SetCallbacks(AGtkWidget,AWidgetInfo); - TGtkWSWinControl.SetCallbacks(PGtkObject(AWidgetInfo^.CoreWidget), TComponent(AWidgetInfo^.LCLObject)); - + Selection := gtk_tree_view_get_selection(PGtkTreeView(AWidgetInfo^.CoreWidget)); SignalConnect(PGtkWidget(Selection), 'changed', @Gtk2WS_ListBoxChange, AWidgetInfo); end; -class function TGtk2WSCustomListBox.GetSelCount(const ACustomListBox: TCustomListBox - ): integer; +class function TGtk2WSCustomListBox.GetSelCount( + const ACustomListBox: TCustomListBox): integer; var Handle: HWND; Widget: PGtkWidget; // pointer to gtk-widget (local use when neccessary) @@ -482,8 +481,8 @@ begin g_list_free(Rows); end; -class function TGtk2WSCustomListBox.GetSelected(const ACustomListBox: TCustomListBox; - const AIndex: integer): boolean; +class function TGtk2WSCustomListBox.GetSelected( + const ACustomListBox: TCustomListBox; const AIndex: integer): boolean; var Handle: HWND; Widget: PGtkWidget; // pointer to gtk-widget (local use when neccessary) @@ -502,8 +501,8 @@ begin end; end; -class function TGtk2WSCustomListBox.GetStrings(const ACustomListBox: TCustomListBox - ): TStrings; +class function TGtk2WSCustomListBox.GetStrings( + const ACustomListBox: TCustomListBox): TStrings; var Widget: PGtkWidget;// pointer to gtk-widget Handle: HWND; @@ -523,21 +522,18 @@ begin csCheckListBox, csListBox: begin Widget := GetWidgetInfo(Pointer(Handle), True)^.CoreWidget; - Result := TGtkListStoreStringList.Create(gtk_tree_view_get_model(PGtkTreeView(Widget)), + Result := TGtkListStoreStringList.Create( + gtk_tree_view_get_model(PGtkTreeView(Widget)), Ord(ACustomListBox.fCompStyle = csCheckListBox) ,ACustomListBox); - if ACustomListBox is TCustomListBox then - TGtkListStoreStringList(Result).Sorted := ACustomListBox.Sorted; + TGtkListStoreStringList(Result).Sorted := ACustomListBox.Sorted; end; else raise Exception.Create('TGtk2WSCustomListBox.GetStrings'); end; - - end; { TGtk2WSCustomCheckBox } - class function TGtk2WSCustomCheckBox.RetrieveState( const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; var diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index ceaa118d28..b3a136ea6c 100644 --- a/lcl/lclproc.pas +++ b/lcl/lclproc.pas @@ -114,11 +114,18 @@ function CompareLineInfoCacheItems(Data1, Data2: Pointer): integer; function CompareAddrWithLineInfoCacheItem(Addr, Item: Pointer): integer; +type + TStringsSortCompare = function(const Item1, Item2: string): Integer; + + +procedure MergeSort(List: TFPList; const OnCompare: TListSortCompare); +procedure MergeSort(List: TStrings; const OnCompare: TStringsSortCompare); function ShortCutToText(ShortCut: TShortCut): string; function TextToShortCut(const ShortCutText: string): TShortCut; -function GetCompleteText(sText: string; iSelStart: Integer; bCaseSensitive, bSearchAscending: Boolean; slTextList: TStrings): string; +function GetCompleteText(sText: string; iSelStart: Integer; + bCaseSensitive, bSearchAscending: Boolean; slTextList: TStrings): string; function IsEditableTextKey(Key: Word): Boolean; // Hooks used to prevent unit circles @@ -166,6 +173,9 @@ function TruncToCardinal(const e: Extended): cardinal; function StrToDouble(const s: string): double; + + + // debugging procedure RaiseGDBException(const Msg: string); procedure DumpExceptionBackTrace; @@ -1085,6 +1095,140 @@ begin Result:=Double(StrToFloat(s)); end; +procedure MergeSort(List: TFPList; const OnCompare: TListSortCompare); +var + MergeList: PPointer; + + procedure Merge(Pos1, Pos2, Pos3: integer); + // merge two sorted arrays + // the first array ranges Pos1..Pos2-1, the second ranges Pos2..Pos3 + var Src1Pos,Src2Pos,DestPos,cmp,a:integer; + begin + while (Pos3>=Pos2) and (OnCompare(List[Pos2-1],List[Pos3])<=0) do + dec(Pos3); + if (Pos1>=Pos2) or (Pos2>Pos3) then exit; + Src1Pos:=Pos2-1; + Src2Pos:=Pos3; + DestPos:=Pos3; + while (Src2Pos>=Pos2) and (Src1Pos>=Pos1) do begin + cmp:=OnCompare(List[Src1Pos],List[Src2Pos]); + if cmp>0 then begin + MergeList[DestPos]:=List[Src1Pos]; + dec(Src1Pos); + end else begin + MergeList[DestPos]:=List[Src2Pos]; + dec(Src2Pos); + end; + dec(DestPos); + end; + while Src2Pos>=Pos2 do begin + MergeList[DestPos]:=List[Src2Pos]; + dec(Src2Pos); + dec(DestPos); + end; + for a:=DestPos+1 to Pos3 do + List[a]:=MergeList[a]; + end; + + procedure Sort(StartPos, EndPos: integer); + // sort an interval in List. Use MergeList as work space. + var + cmp, mid: integer; + p: Pointer; + begin + if StartPos=EndPos then begin + end else if StartPos+1=EndPos then begin + cmp:=OnCompare(List[StartPos],List[EndPos]); + if cmp>0 then begin + p:=List[StartPos]; + List[StartPos]:=List[EndPos]; + List[EndPos]:=p; + end; + end else if EndPos>StartPos then begin + mid:=(StartPos+EndPos) shr 1; + Sort(StartPos,mid); + Sort(mid+1,EndPos); + Merge(StartPos,mid+1,EndPos); + end; + end; + +begin + if (List=nil) or (List.Count<=1) then exit; + ReAllocMem(MergeList,List.Count*SizeOf(Pointer)); + Sort(0,List.Count-1); + Freemem(MergeList); +end; + +procedure MergeSort(List: TStrings; const OnCompare: TStringsSortCompare); +var + MergeList: PAnsiString; + + procedure Merge(Pos1, Pos2, Pos3: integer); + // merge two sorted arrays + // the first array ranges Pos1..Pos2-1, the second ranges Pos2..Pos3 + var Src1Pos,Src2Pos,DestPos,cmp,a:integer; + begin + while (Pos3>=Pos2) and (OnCompare(List[Pos2-1],List[Pos3])<=0) do + dec(Pos3); + if (Pos1>=Pos2) or (Pos2>Pos3) then exit; + Src1Pos:=Pos2-1; + Src2Pos:=Pos3; + DestPos:=Pos3; + while (Src2Pos>=Pos2) and (Src1Pos>=Pos1) do begin + cmp:=OnCompare(List[Src1Pos],List[Src2Pos]); + if cmp>0 then begin + MergeList[DestPos]:=List[Src1Pos]; + dec(Src1Pos); + end else begin + MergeList[DestPos]:=List[Src2Pos]; + dec(Src2Pos); + end; + dec(DestPos); + end; + while Src2Pos>=Pos2 do begin + MergeList[DestPos]:=List[Src2Pos]; + dec(Src2Pos); + dec(DestPos); + end; + for a:=DestPos+1 to Pos3 do + List[a]:=MergeList[a]; + end; + + procedure Sort(StartPos, EndPos: integer); + // sort an interval in List. Use MergeList as work space. + var + cmp, mid: integer; + s: string; + begin + if StartPos=EndPos then begin + end else if StartPos+1=EndPos then begin + cmp:=OnCompare(List[StartPos],List[EndPos]); + if cmp>0 then begin + s:=List[StartPos]; + List[StartPos]:=List[EndPos]; + List[EndPos]:=s; + end; + end else if EndPos>StartPos then begin + mid:=(StartPos+EndPos) shr 1; + Sort(StartPos,mid); + Sort(mid+1,EndPos); + Merge(StartPos,mid+1,EndPos); + end; + end; + +var + CurSize: PtrInt; + i: Integer; +begin + if (List=nil) or (List.Count<=1) then exit; + CurSize:=PtrInt(List.Count)*SizeOf(Pointer); + ReAllocMem(MergeList,CurSize); + FillChar(MergeList^,CurSize,0); + Sort(0,List.Count-1); + for i:=0 to List.Count-1 do MergeList[i]:=''; + Freemem(MergeList); +end; + procedure InitializeDebugOutput; var DebugFileName: string;