paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-05 14:58:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

gtk2 intf: fixed TTrackBar, added MergeSort for TFPList and TStrings

Browse Source 
git-svn-id: trunk@9471 -
This commit is contained in:
mattias 2006-06-22 01:54:58 +00:00
parent 3bcc757e68
commit 486838638b
11 changed files with 253 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/checklst.pas
View File

@ -138,7 +138,6 @@ begin
FItemDataOffset := inherited GetCachedDataSize;
end;
procedure TCustomCheckListBox.DoChange(var Msg);
begin
clickChecked;

9
lcl/include/trackbar.inc
View File

@ -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.

1
lcl/interfaces/gtk/gtkobject.inc
View File

@ -3632,6 +3632,7 @@ begin
LM_DESTROY :
begin
//DebugLn(['TGtkWidgetSet.SetCallback ',DbgSName(ALCLObject)]);
ConnectSenderSignal(gObject, 'destroy', @gtkdestroyCB);
end;

7
lcl/interfaces/gtk/gtkproc.inc
View File

@ -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;

2
lcl/interfaces/gtk/gtkproc.pp
View File

@ -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);

16
lcl/interfaces/gtk/gtkwscomctrls.pp
View File

@ -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;

9
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -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))),

66
lcl/interfaces/gtk2/gtk2int.pas
View File

@ -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;

46
lcl/interfaces/gtk2/gtk2wschecklst.pp
View File

@ -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.

52
lcl/interfaces/gtk2/gtk2wsstdctrls.pp
View File

@ -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

146
lcl/lclproc.pas
View File

@ -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;