mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-17 04:29:25 +02:00
TGTKListStringList now keeps selection on Put and Move
git-svn-id: trunk@5641 -
This commit is contained in:
mattias
parent
63820778bb
commit
13b1bfe34a
@ -841,12 +841,12 @@ end;
|
||||
|
||||
function TFontPropertyEditor.GetAttributes: TPropertyAttributes;
|
||||
var
|
||||
AComponent: TPersistent;
|
||||
APersistent: TPersistent;
|
||||
begin
|
||||
Result := [paMultiSelect, paSubProperties, paDialog, paReadOnly];
|
||||
AComponent:=GetComponent(0);
|
||||
if (AComponent<>nil) and (AComponent is TControl)
|
||||
and (not (AComponent is TStaticText)) then
|
||||
APersistent:=GetPersistent(0);
|
||||
if (APersistent<>nil) and (APersistent is TControl)
|
||||
and (not (APersistent is TStaticText)) then
|
||||
Result:=Result+[paDisableSubProperties]-[paDialog];
|
||||
end;
|
||||
|
||||
|
||||
@ -156,13 +156,16 @@ type
|
||||
|
||||
|
||||
{ THelpDatabase
|
||||
Base class for a collection of help files or entries }
|
||||
Base class for a collection of help files or entries.
|
||||
BasePathObject: THelpDatabase can be created by packages and/or projects.
|
||||
The IDE will set BasePathObject accordingly. }
|
||||
|
||||
THelpDatabaseID = string;
|
||||
THelpDatabases = class;
|
||||
|
||||
THelpDatabase = class(TPersistent)
|
||||
private
|
||||
FBasePathObject: TObject;
|
||||
FID: THelpDatabaseID;
|
||||
FDatabases: THelpDatabases;
|
||||
FRefCount: integer;
|
||||
@ -199,6 +202,7 @@ type
|
||||
property Databases: THelpDatabases read FDatabases write SetDatabases;
|
||||
property ID: THelpDatabaseID read FID write SetID;
|
||||
property SupportedMimeTypes: TStrings read FSupportedMimeTypes;
|
||||
property BasePathObject: TObject read FBasePathObject write FBasePathObject;
|
||||
end;
|
||||
|
||||
THelpDatabaseClass = class of THelpDatabase;
|
||||
|
||||
@ -264,10 +264,10 @@ type
|
||||
PropInfo:PPropInfo;
|
||||
end;
|
||||
|
||||
TInstPropList = array[0..1023] of TInstProp;
|
||||
TInstPropList = array[0..999999] of TInstProp;
|
||||
PInstPropList = ^TInstPropList;
|
||||
|
||||
TGetPropEditProc=procedure(Prop:TPropertyEditor) of object;
|
||||
TGetPropEditProc = procedure(Prop: TPropertyEditor) of object;
|
||||
|
||||
TPropEditDrawStateType = (pedsSelected, pedsFocused, pedsInEdit,
|
||||
pedsInComboList, pedsPainted);
|
||||
@ -325,7 +325,7 @@ type
|
||||
procedure Edit; virtual;
|
||||
function GetAttributes: TPropertyAttributes; virtual;
|
||||
function IsReadOnly: boolean; virtual;
|
||||
function GetComponent(Index: Integer):TPersistent;
|
||||
function GetPersistent(Index: Integer): TPersistent;
|
||||
function GetEditLimit: Integer; virtual;
|
||||
function GetName: shortstring; virtual;
|
||||
procedure GetProperties(Proc: TGetPropEditProc); virtual;
|
||||
@ -747,8 +747,6 @@ type
|
||||
A property editor with dynamic sub properties representing a list of objects.
|
||||
UNDER CONSTRUCTION by Mattias}
|
||||
|
||||
// MWE: changed TObject to TPersistent, TObject decendants can't have properties
|
||||
|
||||
TListPropertyEditor = class(TPropertyEditor)
|
||||
private
|
||||
FSaveElementLock: integer;
|
||||
@ -882,35 +880,44 @@ type
|
||||
The type information pointer returned by the TypeInfo built-in function
|
||||
(e.g. TypeInfo(TMyRange) or TypeInfo(TShapes)).
|
||||
|
||||
ComponentClass
|
||||
Type of the component to which to restrict this type editor. This
|
||||
PersistentClass
|
||||
Type of the persistent object to which to restrict this type editor. This
|
||||
parameter can be left nil which will mean this type editor applies to all
|
||||
properties of PropertyEditorType.
|
||||
|
||||
PropertyEditorName
|
||||
The name of the property to which to restrict this type editor. This
|
||||
parameter is ignored if ComponentClass is nil. This parameter can be
|
||||
parameter is ignored if PersistentClass is nil. This parameter can be
|
||||
an empty string ('') which will mean that this editor applies to all
|
||||
properties of PropertyEditorType in ComponentClass.
|
||||
properties of PropertyEditorType in PersistentClass.
|
||||
|
||||
editorClass
|
||||
The class of the editor to be created whenever a property of the type
|
||||
passed in PropertyEditorTypeInfo is displayed in the Object Inspector.
|
||||
The class will be created by calling EditorClass.Create. }
|
||||
|
||||
procedure RegisterPropertyEditor(PropertyType:PTypeInfo;
|
||||
ComponentClass:TClass; const PropertyName:shortstring;
|
||||
EditorClass:TPropertyEditorClass);
|
||||
procedure RegisterPropertyEditor(PropertyType: PTypeInfo;
|
||||
PersistentClass: TClass; const PropertyName: shortstring;
|
||||
EditorClass: TPropertyEditorClass);
|
||||
|
||||
type
|
||||
TPropertyEditorMapperFunc=function(Obj:TPersistent;
|
||||
PropInfo:PPropInfo):TPropertyEditorClass;
|
||||
const
|
||||
AllTypeKinds = [tkInteger..High(TTypeKind)];
|
||||
|
||||
procedure RegisterPropertyEditorMapper(Mapper:TPropertyEditorMapperFunc);
|
||||
|
||||
type
|
||||
TPropertyEditorFilterFunc =
|
||||
function(const ATestEditor: TPropertyEditor): Boolean of object;
|
||||
TPropInfoFilterFunc =
|
||||
function(const APropInfo: PPropInfo): Boolean of object;
|
||||
|
||||
procedure GetPersistentProperties(ASelection: TPersistentSelectionList;
|
||||
AFilter: TTypeKinds; AHook: TPropertyEditorHook; AProc: TGetPropEditProc;
|
||||
APropInfoFilterFunc: TPropInfoFilterFunc;
|
||||
AEditorFilterFunc: TPropertyEditorFilterFunc);
|
||||
|
||||
procedure GetPersistentProperties(ASelection: TPersistentSelectionList;
|
||||
AFilter: TTypeKinds; AHook: TPropertyEditorHook; AProc: TGetPropEditProc;
|
||||
@ -1319,7 +1326,7 @@ begin
|
||||
if ListPropertyEditors=nil then exit;
|
||||
for i:=0 to ListPropertyEditors.Count-1 do begin
|
||||
Editor:=TListPropertyEditor(ListPropertyEditors[i]);
|
||||
if (Editor.GetComponent(0)=AnObject)
|
||||
if (Editor.GetPersistent(0)=AnObject)
|
||||
and (Editor.OnSubPropertiesChanged<>nil) then
|
||||
Editor.UpdateSubProperties;
|
||||
end;
|
||||
@ -1400,7 +1407,7 @@ type
|
||||
//Group:Integer;
|
||||
PropertyType:PTypeInfo;
|
||||
PropertyName:shortstring;
|
||||
ComponentClass:TClass;
|
||||
PersistentClass:TClass;
|
||||
EditorClass:TPropertyEditorClass;
|
||||
end;
|
||||
|
||||
@ -1530,7 +1537,7 @@ end;
|
||||
{ GetComponentProperties }
|
||||
|
||||
procedure RegisterPropertyEditor(PropertyType:PTypeInfo;
|
||||
ComponentClass: TClass; const PropertyName:shortstring;
|
||||
PersistentClass: TClass; const PropertyName:shortstring;
|
||||
EditorClass:TPropertyEditorClass);
|
||||
var
|
||||
P:PPropertyClassRec;
|
||||
@ -1542,9 +1549,9 @@ begin
|
||||
// XXX
|
||||
//P^.Group:=CurrentGroup;
|
||||
P^.PropertyType:=PropertyType;
|
||||
P^.ComponentClass:=ComponentClass;
|
||||
P^.PersistentClass:=PersistentClass;
|
||||
P^.PropertyName:=PropertyName;
|
||||
//if Assigned(ComponentClass) then P^.PropertyName:=PropertyName;
|
||||
//if Assigned(PersistentClass) then P^.PropertyName:=PropertyName;
|
||||
P^.EditorClass:=EditorClass;
|
||||
PropertyClassList.Insert(0,P);
|
||||
end;
|
||||
@ -1594,12 +1601,12 @@ begin
|
||||
GetTypeData(P^.PropertyType)^.ClassType)
|
||||
)
|
||||
then
|
||||
if ((P^.ComponentClass=nil) or (Obj.InheritsFrom(P^.ComponentClass))) and
|
||||
if ((P^.PersistentClass=nil) or (Obj.InheritsFrom(P^.PersistentClass))) and
|
||||
((P^.PropertyName='')
|
||||
or (CompareText(PropInfo^.Name,P^.PropertyName)=0))
|
||||
then
|
||||
if (C=nil) or // see if P is better match than C
|
||||
((C^.ComponentClass=nil) and (P^.ComponentClass<>nil)) or
|
||||
((C^.PersistentClass=nil) and (P^.PersistentClass<>nil)) or
|
||||
((C^.PropertyName='') and (P^.PropertyName<>''))
|
||||
or // P's proptype match is exact,but C's does not
|
||||
((C^.PropertyType<>PropType) and (P^.PropertyType=PropType))
|
||||
@ -1610,9 +1617,9 @@ begin
|
||||
GetTypeData(P^.PropertyType)^.ClassType.InheritsFrom(
|
||||
GetTypeData(C^.PropertyType)^.ClassType))
|
||||
or // P's component class is more specific than C's component class
|
||||
((P^.ComponentClass<>nil) and (C^.ComponentClass<>nil) and
|
||||
(P^.ComponentClass<>C^.ComponentClass) and
|
||||
(P^.ComponentClass.InheritsFrom(C^.ComponentClass)))
|
||||
((P^.PersistentClass<>nil) and (C^.PersistentClass<>nil) and
|
||||
(P^.PersistentClass<>C^.PersistentClass) and
|
||||
(P^.PersistentClass.InheritsFrom(C^.PersistentClass)))
|
||||
then
|
||||
C:=P;
|
||||
Inc(I);
|
||||
@ -1630,6 +1637,7 @@ end;
|
||||
|
||||
procedure GetPersistentProperties(ASelection: TPersistentSelectionList;
|
||||
AFilter: TTypeKinds; AHook: TPropertyEditorHook; AProc: TGetPropEditProc;
|
||||
APropInfoFilterFunc: TPropInfoFilterFunc;
|
||||
AEditorFilterFunc: TPropertyEditorFilterFunc);
|
||||
var
|
||||
I, J, SelCount: Integer;
|
||||
@ -1656,8 +1664,9 @@ begin
|
||||
PropInfo := Candidates[I];
|
||||
// check if property is readable
|
||||
if (PropInfo^.GetProc=nil)
|
||||
or (not GShowReadOnlyProps and ((PropInfo^.PropType^.Kind <> tkClass)
|
||||
and (PropInfo^.SetProc = nil)))
|
||||
or ((not GShowReadOnlyProps) and (PropInfo^.PropType^.Kind <> tkClass)
|
||||
and (PropInfo^.SetProc = nil))
|
||||
or (Assigned(APropInfoFilterFunc) and (not APropInfoFilterFunc(PropInfo)))
|
||||
then begin
|
||||
Candidates.Delete(I);
|
||||
Continue;
|
||||
@ -1741,6 +1750,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetPersistentProperties(ASelection: TPersistentSelectionList;
|
||||
AFilter: TTypeKinds; AHook: TPropertyEditorHook; AProc: TGetPropEditProc;
|
||||
AEditorFilterFunc: TPropertyEditorFilterFunc);
|
||||
begin
|
||||
GetPersistentProperties(ASelection,AFilter,AHook,AProc,nil,AEditorFilterFunc);
|
||||
end;
|
||||
|
||||
procedure GetPersistentProperties(AItem: TPersistent;
|
||||
AFilter: TTypeKinds; AHook: TPropertyEditorHook; AProc: TGetPropEditProc;
|
||||
AEditorFilterFunc: TPropertyEditorFilterFunc);
|
||||
@ -1751,7 +1767,7 @@ begin
|
||||
Selection := TPersistentSelectionList.Create;
|
||||
try
|
||||
Selection.Add(AItem);
|
||||
GetPersistentProperties(Selection, AFilter, AHook, AProc, AEditorFilterFunc);
|
||||
GetPersistentProperties(Selection,AFilter,AHook,AProc,AEditorFilterFunc);
|
||||
finally
|
||||
Selection.Free;
|
||||
end;
|
||||
@ -1833,7 +1849,7 @@ begin
|
||||
Result:=paReadOnly in GetAttributes;
|
||||
end;
|
||||
|
||||
function TPropertyEditor.GetComponent(Index:Integer):TPersistent;
|
||||
function TPropertyEditor.GetPersistent(Index: Integer): TPersistent;
|
||||
begin
|
||||
Result:=FPropList^[Index].Instance;
|
||||
end;
|
||||
@ -3032,7 +3048,7 @@ begin
|
||||
Result:=true;
|
||||
if FSubPropertiesChanged then exit;
|
||||
FSubPropertiesChanged:=true;
|
||||
if SavedList<>GetComponent(0) then exit;
|
||||
if SavedList<>GetPersistent(0) then exit;
|
||||
if ReadElementCount<>SavedElements.Count then exit;
|
||||
for i:=0 to SavedElements.Count-1 do
|
||||
if TPersistent(SavedElements[i])<>ReadElement(i) then exit;
|
||||
@ -3083,7 +3099,7 @@ procedure TListPropertyEditor.DoSaveElements;
|
||||
var
|
||||
i, ElementCount: integer;
|
||||
begin
|
||||
SavedList:=GetComponent(0);
|
||||
SavedList:=GetPersistent(0);
|
||||
ElementCount:=GetElementCount;
|
||||
SavedElements.Count:=ElementCount;
|
||||
for i:=0 to ElementCount-1 do
|
||||
@ -3201,18 +3217,18 @@ Type
|
||||
protected
|
||||
CollectionList : TLISTBOX;
|
||||
ButtonPanel: TPANEL;
|
||||
AddButton: TSPEEDBUTTON;
|
||||
DeleteButton: TSPEEDBUTTON;
|
||||
AddButton: TSpeedButton;
|
||||
DeleteButton: TSpeedButton;
|
||||
procedure ListCLICK(Sender: TObject);
|
||||
procedure AddCLICK(Sender: TObject);
|
||||
procedure DeleteCLICK(Sender: TObject);
|
||||
procedure UpdateCaption;
|
||||
public
|
||||
Collection : TCollection;
|
||||
ComponentName,
|
||||
PropertyName : String;
|
||||
Collection: TCollection;
|
||||
PersistentName: string;
|
||||
PropertyName: string;
|
||||
Procedure PropagateList;
|
||||
Constructor Create(AOwner : TComponent); Override;
|
||||
Constructor Create(AOwner: TComponent); Override;
|
||||
end;
|
||||
|
||||
const
|
||||
@ -3266,7 +3282,7 @@ procedure TCollectionPropertyEditorForm.UpdateCaption;
|
||||
begin
|
||||
//I think to match Delphi this should be formated like
|
||||
//"Editing ComponentName.PropertyName[Index]"
|
||||
Caption:= 'Editing ' + ComponentName + '.' + PropertyName;
|
||||
Caption:= 'Editing ' + PersistentName + '.' + PropertyName;
|
||||
If CollectionList.ItemIndex > -1 then
|
||||
Caption := Caption + '[' +
|
||||
IntToStr(CollectionList.ItemIndex) + ']';
|
||||
@ -3396,7 +3412,7 @@ begin
|
||||
CollectionForm := TCollectionPropertyEditorForm.Create(Application);
|
||||
CollectionForm.Collection := TCollection(GetOrdValue);
|
||||
CollectionForm.PropertyName := GetPropInfo^.Name;
|
||||
CollectionForm.ComponentName := '';//What if its in a Persistent child?
|
||||
CollectionForm.PersistentName := '';
|
||||
CollectionForm.Caption := 'Editing ' + GetPropInfo^.Name;
|
||||
CollectionForm.PropagateList;
|
||||
CollectionForm.Show;
|
||||
@ -3487,12 +3503,12 @@ var I: Integer;
|
||||
begin
|
||||
Result:='';
|
||||
if PropertyHook.LookupRoot=nil then exit;
|
||||
if GetComponent(0) = PropertyHook.LookupRoot then begin
|
||||
if GetPersistent(0) = PropertyHook.LookupRoot then begin
|
||||
Result := PropertyHook.GetRootClassName;
|
||||
if (Result <> '') and (Result[1] = 'T') then
|
||||
System.Delete(Result, 1, 1);
|
||||
end else begin
|
||||
Result := PropertyHook.GetObjectName(GetComponent(0));
|
||||
Result := PropertyHook.GetObjectName(GetPersistent(0));
|
||||
for I := Length(Result) downto 1 do
|
||||
if Result[I] in ['.','[',']'] then
|
||||
System.Delete(Result, I, 1);
|
||||
@ -3859,7 +3875,7 @@ begin
|
||||
if (not IsValidIdent(NewValue)) or (NewValue='') then
|
||||
raise Exception.Create('Component name "'+NewValue+'" is not a valid identifier');
|
||||
inherited SetValue(NewValue);
|
||||
PropertyHook.ComponentRenamed(TComponent(GetComponent(0)));
|
||||
PropertyHook.ComponentRenamed(TComponent(GetPersistent(0)));
|
||||
end;
|
||||
|
||||
{ TDatePropertyEditor }
|
||||
|
||||
@ -1790,7 +1790,7 @@ uses
|
||||
WSControls, // Widgetset uses circle is allowed
|
||||
|
||||
Forms, // the circle can't be broken without breaking Delphi compatibility
|
||||
Buttons, // needed for clicking default and cancel buttons
|
||||
//Buttons, // needed for clicking default and cancel buttons
|
||||
Math; // Math is in RTL and only a few functions are used.
|
||||
|
||||
var
|
||||
@ -2330,6 +2330,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.220 2004/07/03 11:11:08 mattias
|
||||
TGTKListStringList now keeps selection on Put and Move
|
||||
|
||||
Revision 1.219 2004/07/01 20:42:11 micha
|
||||
implement better ExecuteXXAction design; break dependency on TButton class in TCustomForm
|
||||
|
||||
|
||||
@ -137,6 +137,20 @@ begin
|
||||
CNSendMessage(LM_SETPROPERTIES, Self, nil);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TCustomMemo.WordWrapIsStored: boolean;
|
||||
------------------------------------------------------------------------------}
|
||||
function TCustomMemo.WordWrapIsStored: boolean;
|
||||
begin
|
||||
Result:=not WordWrap;
|
||||
end;
|
||||
|
||||
procedure TCustomMemo.ControlKeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
if (Key=VK_RETURN) or (Key=VK_TAB) then exit;
|
||||
inherited ControlKeyDown(Key, Shift);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCustomMemo.SetWordWrap
|
||||
Params:
|
||||
@ -158,6 +172,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.27 2004/07/03 11:11:08 mattias
|
||||
TGTKListStringList now keeps selection on Put and Move
|
||||
|
||||
Revision 1.26 2004/05/15 20:17:09 mattias
|
||||
replaced WMSize by DoSetBounds
|
||||
|
||||
|
||||
@ -18,16 +18,5 @@
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
{ TMemo }
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TMemo.WordWrapIsStored: boolean;
|
||||
------------------------------------------------------------------------------}
|
||||
function TMemo.WordWrapIsStored: boolean;
|
||||
begin
|
||||
Result:=not WordWrap;
|
||||
end;
|
||||
|
||||
|
||||
// included by stdctrls.pp
|
||||
|
||||
|
||||
@ -3143,7 +3143,7 @@ var
|
||||
begin
|
||||
ShiftState := KeyDataToShiftState(Message.KeyData);
|
||||
|
||||
// let controls handle the key
|
||||
// handle LCL special keys
|
||||
ControlKeyDown(Message.CharCode, ShiftState);
|
||||
if Message.CharCode=VK_UNKNOWN then exit;
|
||||
|
||||
@ -3756,6 +3756,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.250 2004/07/03 11:11:08 mattias
|
||||
TGTKListStringList now keeps selection on Put and Move
|
||||
|
||||
Revision 1.249 2004/07/02 12:23:24 micha
|
||||
fix capture return/escape key if no handler
|
||||
|
||||
|
||||
@ -18,13 +18,6 @@
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
{$IFOPT H+}
|
||||
{$DEFINE H_PLUS}
|
||||
{$ELSE}
|
||||
{$H+}
|
||||
{$UNDEF H_PLUS}
|
||||
{$ENDIF}
|
||||
|
||||
const
|
||||
GtkListItemGtkListTag = 'GtkList';
|
||||
GtkListItemLCLListTag = 'LCLList';
|
||||
@ -56,7 +49,7 @@ end;}
|
||||
Handler for draw events of every item in a TGtkListStringList.
|
||||
------------------------------------------------------------------------------}
|
||||
function gtkListItemDrawAfterCB(Widget: PGtkWidget; area: PGDKRectangle;
|
||||
data: gPointer) : GBoolean; cdecl;
|
||||
data: gPointer): GBoolean; cdecl;
|
||||
var
|
||||
Msg: TLMDrawListItem;
|
||||
ItemIndex: integer;
|
||||
@ -303,20 +296,19 @@ begin
|
||||
Exclude(FStates,glsItemCacheNeedsUpdate);
|
||||
end;
|
||||
|
||||
function TGtkListStringList.CacheValid: boolean;
|
||||
begin
|
||||
Result:=not (glsItemCacheNeedsUpdate in FStates);
|
||||
end;
|
||||
|
||||
procedure TGtkListStringList.PutObject(Index: Integer; AnObject: TObject);
|
||||
var
|
||||
ListItem : PGtkListItem;
|
||||
begin
|
||||
//DebugLn('[TGtkListStringList.Get] Index=',Index,' Count=',Count);
|
||||
if (Index < 0) or (Index >= Count) then
|
||||
RaiseException('TGtkListStringList.PutObject Out of bounds.')
|
||||
else if FGtkList<>nil then begin
|
||||
UpdateItemCache;
|
||||
ListItem:=FCachedItems[Index];
|
||||
if ListItem <> nil then begin
|
||||
gtk_object_set_data(PGtkObject(ListItem),'LCLStringsObject',AnObject);
|
||||
end;
|
||||
end;
|
||||
//DebugLn('[TGtkListStringList.PutObject] Index=',Index,' Count=',Count);
|
||||
ListItem:=GetListItem(Index);
|
||||
if ListItem <> nil then
|
||||
gtk_object_set_data(PGtkObject(ListItem),'LCLStringsObject',AnObject);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -480,46 +472,82 @@ function TGtkListStringList.Get(Index : integer) : string;
|
||||
var
|
||||
Item : PChar;
|
||||
ALabel : PGtkLabel;
|
||||
ListItem : PGtkListItem;
|
||||
begin
|
||||
//DebugLn('[TGtkListStringList.Get] Index=',Index,' Count=',Count);
|
||||
if (Index < 0) or (Index >= Count) then
|
||||
RaiseException('TGtkListStringList.Get Out of bounds.')
|
||||
//DebugLn('[TGtkListStringList.Get] Index=',Index,' Count=',Count);
|
||||
ALabel:=GetLabel(Index);
|
||||
|
||||
if ALabel = nil then
|
||||
Result:= ''
|
||||
else begin
|
||||
UpdateItemCache;
|
||||
ListItem:=FCachedItems[Index];
|
||||
|
||||
if FWithCheckBox
|
||||
then ALabel := PPointer(PGTKBox(PGtkBin(ListItem)^.child)^.Children^.Next^.Data)^
|
||||
else ALabel := PGTKLabel(PGtkBin(ListItem)^.child);
|
||||
|
||||
if ALabel = nil then
|
||||
Result:= ''
|
||||
else begin
|
||||
Item:=nil;
|
||||
gtk_label_get(ALabel, @Item);
|
||||
Result:= StrPas(Item);
|
||||
end;
|
||||
end;
|
||||
Item:=nil;
|
||||
gtk_label_get(ALabel, @Item);
|
||||
Result:= StrPas(Item);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGtkListStringList.GetObject(Index: Integer): TObject;
|
||||
var
|
||||
ListItem : PGtkListItem;
|
||||
begin
|
||||
//DebugLn('[TGtkListStringList.Get] Index=',Index,' Count=',Count);
|
||||
//DebugLn('[TGtkListStringList.GetObject] Index=',Index,' Count=',Count);
|
||||
Result:=nil;
|
||||
if (Index < 0) or (Index >= Count) then
|
||||
RaiseException('TGtkListStringList.GetObject Out of bounds.')
|
||||
else if FGtkList<>nil then begin
|
||||
UpdateItemCache;
|
||||
ListItem:=FCachedItems[Index];
|
||||
if ListItem<>nil then begin
|
||||
Result:=TObject(gtk_object_get_data(PGtkObject(ListItem),'LCLStringsObject'));
|
||||
end;
|
||||
ListItem:=GetListItem(Index);
|
||||
if ListItem<>nil then
|
||||
Result:=TObject(gtk_object_get_data(PGtkObject(ListItem),'LCLStringsObject'));
|
||||
end;
|
||||
|
||||
procedure TGtkListStringList.Put(Index: Integer; const S: string);
|
||||
var
|
||||
ALabel: PGtkLabel;
|
||||
NewText: PChar;
|
||||
SortedIndex: Integer;
|
||||
begin
|
||||
//DebugLn('[TGtkListStringList.Put] Index=',Index,' Count=',Count);
|
||||
if Sorted then begin
|
||||
SortedIndex:=GetInsertPosition(S);
|
||||
// we move instead of insert => adjust position
|
||||
if SortedIndex>Index then dec(SortedIndex);
|
||||
end else
|
||||
SortedIndex:=Index;
|
||||
|
||||
// change label
|
||||
ALabel:=GetLabel(Index);
|
||||
if ALabel = nil then
|
||||
RaiseException('TGtkListStringList.Put');
|
||||
if S<>'' then
|
||||
NewText:=PChar(S)
|
||||
else
|
||||
NewText:=#0;
|
||||
gtk_label_set_text(ALabel, NewText);
|
||||
|
||||
// repair sorting
|
||||
if Sorted and (SortedIndex<>Index) then begin
|
||||
Move(Index,SortedIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGtkListStringList.GetListItem(Index: integer): PGtkListItem;
|
||||
begin
|
||||
if (Index < 0) or (Index >= Count) then
|
||||
RaiseException('TGtkListStringList.Get Out of bounds.')
|
||||
else begin
|
||||
UpdateItemCache;
|
||||
Result:=FCachedItems[Index];
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGtkListStringList.GetLabel(Index: integer): PGtkLabel;
|
||||
var
|
||||
ListItem: PGtkListItem;
|
||||
begin
|
||||
ListItem:=GetListItem(Index);
|
||||
|
||||
if FWithCheckBox then
|
||||
Result := PPointer(PGTKBox(PGtkBin(ListItem)^.child)^.Children^.Next^.Data)^
|
||||
else
|
||||
Result := PGTKLabel(PGtkBin(ListItem)^.child);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TGtkListStringList.GetCount
|
||||
Params:
|
||||
@ -626,34 +654,24 @@ end;
|
||||
procedure TGtkListStringList.Insert(Index : integer; const S : string);
|
||||
var
|
||||
li, cb, box: PGtkWidget;
|
||||
l, m, r, cmp: integer;
|
||||
item_requisition: TGtkRequisition;
|
||||
OldCount: LongInt;
|
||||
|
||||
procedure RaiseIndexOutOfBounds;
|
||||
begin
|
||||
RaiseException('TGtkListStringList.Insert: Index '+IntToStr(Index)
|
||||
+' out of bounds. Count='+IntToStr(OldCount));
|
||||
end;
|
||||
|
||||
begin
|
||||
OldCount:=Count;
|
||||
BeginUpdate;
|
||||
try
|
||||
if FSorted then begin
|
||||
l:=0;
|
||||
r:=OldCount-1;
|
||||
m:=l;
|
||||
while (l<=r) do begin
|
||||
m:=(l+r) shr 1;
|
||||
cmp:=AnsiCompareText(S,Strings[m]);
|
||||
if cmp<0 then
|
||||
r:=m-1
|
||||
else if cmp>0 then
|
||||
l:=m+1
|
||||
else
|
||||
break;
|
||||
end;
|
||||
if (m<OldCount) and (AnsiCompareText(S,Strings[m])>0) then
|
||||
inc(m);
|
||||
Index:=m;
|
||||
Index:=GetInsertPosition(S);
|
||||
end;
|
||||
if (Index < 0) or (Index > OldCount) then
|
||||
RaiseException('TGtkListStringList.Insert: Index '+IntToStr(Index)
|
||||
+' out of bounds. Count='+IntToStr(OldCount));
|
||||
RaiseIndexOutOfBounds;
|
||||
if Owner = nil then RaiseException(
|
||||
'TGtkListStringList.Insert Unspecified owner');
|
||||
|
||||
@ -675,6 +693,7 @@ begin
|
||||
end;
|
||||
ConnectItemCallbacks(PGtkListItem(li));
|
||||
// grow capacity
|
||||
UpdateItemCache;
|
||||
if (FCachedCapacity<=OldCount) then begin
|
||||
if FCachedCapacity=0 then FCachedCapacity:=1;
|
||||
while (FCachedCapacity<=OldCount) do
|
||||
@ -709,7 +728,63 @@ begin
|
||||
//DebugLn('[TGtkListStringList.Insert] END Index=',Index,' Count=',Count,' ',S,',',Count);
|
||||
end;
|
||||
|
||||
function TGtkListStringList.GetInsertPosition(const S: string): integer;
|
||||
var
|
||||
l: Integer;
|
||||
Cnt: LongInt;
|
||||
r: Integer;
|
||||
m: LongInt;
|
||||
cmp: LongInt;
|
||||
begin
|
||||
Cnt:=Count;
|
||||
if FSorted then begin
|
||||
l:=0;
|
||||
r:=Cnt-1;
|
||||
m:=l;
|
||||
while (l<=r) do begin
|
||||
m:=(l+r) shr 1;
|
||||
cmp:=AnsiCompareText(S,Strings[m]);
|
||||
if cmp<0 then
|
||||
r:=m-1
|
||||
else if cmp>0 then
|
||||
l:=m+1
|
||||
else
|
||||
break;
|
||||
end;
|
||||
if (m<Cnt) and (AnsiCompareText(S,Strings[m])>0) then
|
||||
inc(m);
|
||||
Result:=m;
|
||||
end else begin
|
||||
Result:=Cnt;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGtkListStringList.Move(FromIndex, ToIndex: Integer);
|
||||
var
|
||||
Item: PGtkListItem;
|
||||
begin
|
||||
if (FromIndex=ToIndex) then exit;
|
||||
|
||||
//debugln('TGtkListStringList.Move From=',dbgs(FromIndex),' To=',dbgs(ToIndex));
|
||||
Item:=GetListItem(FromIndex);
|
||||
|
||||
// move in gtk
|
||||
MoveGListLink(FGtkList^.children,FromIndex,ToIndex);
|
||||
if (GTK_WIDGET_VISIBLE (PGtkWidget(FGtkList))) then
|
||||
gtk_widget_queue_resize (PGtkWidget(FGtkList));
|
||||
|
||||
// move in cache
|
||||
if CacheValid then begin
|
||||
if FromIndex<ToIndex then begin
|
||||
System.Move(FCachedItems[FromIndex+1],FCachedItems[FromIndex],
|
||||
SizeOf(PGtkListItem)*(ToIndex-FromIndex));
|
||||
end else begin
|
||||
System.Move(FCachedItems[ToIndex],FCachedItems[ToIndex+1],
|
||||
SizeOf(PGtkListItem)*(FromIndex-ToIndex));
|
||||
end;
|
||||
FCachedItems[ToIndex]:=Item;
|
||||
end;
|
||||
end;
|
||||
|
||||
{*************************************************************}
|
||||
{ TGtkCListStringList methods }
|
||||
@ -724,7 +799,8 @@ end;
|
||||
constructor TGtkCListStringList.Create(List : PGtkCList);
|
||||
begin
|
||||
inherited Create;
|
||||
if List = nil then RaiseException('TGtkCListStringList.Create: Unspecified list widget');
|
||||
if List = nil then
|
||||
RaiseException('TGtkCListStringList.Create: Unspecified list widget');
|
||||
FGtkCList:= List;
|
||||
end;
|
||||
|
||||
@ -882,15 +958,12 @@ begin
|
||||
gtk_clist_set_row_data(FGtkCList, Index, AObject);
|
||||
end;
|
||||
|
||||
{$IFDEF H_PLUS}
|
||||
{$UNDEF H_PLUS}
|
||||
{$ELSE}
|
||||
{$H-}
|
||||
{$ENDIF}
|
||||
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.26 2004/07/03 11:11:08 mattias
|
||||
TGTKListStringList now keeps selection on Put and Move
|
||||
|
||||
Revision 1.25 2004/06/27 12:37:18 mattias
|
||||
fixed gtk lists sorted
|
||||
|
||||
|
||||
@ -36,9 +36,12 @@ type
|
||||
FUpdateCount: integer;
|
||||
FWithCheckBox: Boolean;
|
||||
protected
|
||||
function GetListItem(Index: integer): PGtkListItem;
|
||||
function GetLabel(Index: integer): PGtkLabel;
|
||||
function GetCount: integer; override;
|
||||
function Get(Index : Integer) : string; override;
|
||||
function GetObject(Index: Integer): TObject; override;
|
||||
procedure Put(Index: Integer; const S: string); override;
|
||||
procedure PutObject(Index: Integer; AnObject: TObject); override;
|
||||
procedure SetSorted(Val : boolean); virtual;
|
||||
procedure ConnectItemCallbacks(Index: integer);
|
||||
@ -47,6 +50,7 @@ type
|
||||
procedure RemoveItemCallbacks(Index: integer); virtual;
|
||||
procedure RemoveAllCallbacks; virtual;
|
||||
procedure UpdateItemCache;
|
||||
function CacheValid: boolean;
|
||||
public
|
||||
constructor Create(List : PGtkList; TheOwner: TWinControl;
|
||||
const AWithCheckBox: Boolean);
|
||||
@ -57,6 +61,8 @@ type
|
||||
procedure Delete(Index : integer); override;
|
||||
function IndexOf(const S: string): Integer; override;
|
||||
procedure Insert(Index : integer; const S: string); override;
|
||||
function GetInsertPosition(const S: string): integer;
|
||||
procedure Move(FromIndex, ToIndex: Integer); override;
|
||||
procedure Sort; virtual;
|
||||
function IsEqual(List: TStrings; CompareObjects: boolean): boolean;
|
||||
procedure BeginUpdate;
|
||||
@ -90,6 +96,9 @@ type
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.10 2004/07/03 11:11:08 mattias
|
||||
TGTKListStringList now keeps selection on Put and Move
|
||||
|
||||
Revision 1.9 2004/06/27 12:37:18 mattias
|
||||
fixed gtk lists sorted
|
||||
|
||||
|
||||
@ -3020,6 +3020,43 @@ begin
|
||||
g_list_insert(First,Data,NewPos);
|
||||
end;
|
||||
|
||||
procedure MoveGListLink(First: PGList; FromIndex, ToIndex: integer);
|
||||
var
|
||||
Item: PGList;
|
||||
InsertAfter: PGList;
|
||||
i: Integer;
|
||||
begin
|
||||
if (FromIndex=ToIndex) then exit;
|
||||
Item:=First;
|
||||
i:=0;
|
||||
while (i<FromIndex) do begin
|
||||
Item:=Item^.next;
|
||||
inc(i);
|
||||
end;
|
||||
// unbind
|
||||
if Item^.next<>nil then Item^.next^.prev:=Item^.prev;
|
||||
if Item^.prev<>nil then Item^.prev^.next:=Item^.next;
|
||||
Item^.next:=nil;
|
||||
Item^.prev:=nil;
|
||||
// insert
|
||||
if ToIndex=0 then begin
|
||||
Item^.next:=First;
|
||||
First^.prev:=Item;
|
||||
end else begin
|
||||
i:=0;
|
||||
InsertAfter:=First;
|
||||
while (i<ToIndex-1) do begin
|
||||
if InsertAfter^.next=nil then break;
|
||||
InsertAfter:=InsertAfter^.next;
|
||||
inc(i);
|
||||
end;
|
||||
Item^.prev:=InsertAfter;
|
||||
Item^.next:=InsertAfter^.next;
|
||||
InsertAfter^.next:=Item;
|
||||
if Item^.next<>nil then Item^.next^.prev:=Item;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function GetControlWindow(Widget: Pointer) : PGDKWindow;
|
||||
|
||||
@ -6805,6 +6842,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.287 2004/07/03 11:11:09 mattias
|
||||
TGTKListStringList now keeps selection on Put and Move
|
||||
|
||||
Revision 1.286 2004/06/28 15:45:48 mattias
|
||||
fixed a mem violation in gtk intf paint msg conversion
|
||||
|
||||
|
||||
@ -289,6 +289,7 @@ function LockOnChange(GtkObject: PGtkObject; LockOffset: integer): integer;
|
||||
|
||||
// glib
|
||||
procedure MoveGListLinkBehind(First, Item, After: PGList);
|
||||
procedure MoveGListLink(First: PGList; FromIndex, ToIndex: integer);
|
||||
|
||||
// properties
|
||||
function ObjectToGTKObject(const AnObject: TObject): PGtkObject;
|
||||
|
||||
@ -385,7 +385,6 @@ type
|
||||
procedure SetStyle(Val : TListBoxStyle); virtual;
|
||||
procedure DrawItem(Index: Integer; ARect: TRect;
|
||||
State: TOwnerDrawState); virtual;
|
||||
|
||||
property OnMeasureItem: TMeasureItemEvent
|
||||
read FOnMeasureItem write FOnMeasureItem;
|
||||
public
|
||||
@ -404,12 +403,12 @@ type
|
||||
property BorderStyle default bsSingle;
|
||||
property Canvas: TCanvas read FCanvas;
|
||||
property Constraints;
|
||||
property ExtendedSelect : boolean read FExtendedSelect write SetExtendedSelect;
|
||||
property ExtendedSelect: boolean read FExtendedSelect write SetExtendedSelect;
|
||||
property Font;
|
||||
property IntegralHeight: boolean read FIntegralHeight write FIntegralHeight; // not implemented
|
||||
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
|
||||
property ItemIndex : integer read GetItemIndex write SetItemIndex;
|
||||
property Items : TStrings read FItems write SetItems;
|
||||
property ItemIndex: integer read GetItemIndex write SetItemIndex;
|
||||
property Items: TStrings read FItems write SetItems;
|
||||
property MultiSelect: boolean read FMultiSelect write SetMultiSelect;
|
||||
property OnChangeBounds;
|
||||
property OnClick;
|
||||
@ -584,6 +583,8 @@ type
|
||||
procedure SetScrollBars(const Value : TScrollStyle);
|
||||
procedure InitializeWnd; override;
|
||||
procedure Loaded; override;
|
||||
function WordWrapIsStored: boolean;
|
||||
procedure ControlKeyDown(var Key: Word; Shift : TShiftState); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -592,7 +593,7 @@ type
|
||||
public
|
||||
property Lines: TStrings read FLines write SetLines;
|
||||
property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars;
|
||||
property WordWrap: Boolean read FWordWrap write SetWordWrap default true;
|
||||
property WordWrap: Boolean read FWordWrap write SetWordWrap stored WordWrapIsStored default true;
|
||||
//property Font : TFont read FFont write FFont;
|
||||
property HorzScrollBar: TMemoScrollBar
|
||||
read FHorzScrollBar write SetHorzScrollBar stored StoreScrollBars;
|
||||
@ -643,8 +644,6 @@ type
|
||||
{ TMemo }
|
||||
|
||||
TMemo = class(TCustomMemo)
|
||||
protected
|
||||
function WordWrapIsStored: boolean;
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
@ -670,7 +669,7 @@ type
|
||||
property ScrollBars;
|
||||
property Tabstop;
|
||||
property Visible;
|
||||
property WordWrap stored WordWrapIsStored;
|
||||
property WordWrap;
|
||||
end;
|
||||
|
||||
|
||||
@ -1559,6 +1558,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.150 2004/07/03 11:11:08 mattias
|
||||
TGTKListStringList now keeps selection on Put and Move
|
||||
|
||||
Revision 1.149 2004/06/27 09:34:23 mattias
|
||||
fixed TStringGrid goEditing from Jesus
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user