Menu
▾
▴
[JVCL-Checkins] CVS: dev/filler/source JvFillBasicImpl.pas,1.5,1.6 JvFillIntf.pas,1.4,1.5 JvFillPropEdits.pas,1.2,1.3 JvFillRegFillers.pas,1.2,1.3 JvFillerControls.pas,1.4,1.5 JvFillerEditor.pas,1.4,1.5
|
From: Marcel B. <jed...@us...> - 2003-04-18 11:19:03
|
Update of /cvsroot/jvcl/dev/filler/source
In directory sc8-pr-cvs1:/tmp/cvs-serv31583/dev/filler/source
Modified Files:
JvFillBasicImpl.pas JvFillIntf.pas JvFillPropEdits.pas
JvFillRegFillers.pas JvFillerControls.pas JvFillerEditor.pas
Log Message:
* Fixed TJvFillListBox implementation: could not draw if filler did not provide any rendering mechanism
* Added property editor for Items property of any filler implementation
* Update filler editor
Index: JvFillBasicImpl.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/filler/source/JvFillBasicImpl.pas,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** JvFillBasicImpl.pas 15 Apr 2003 13:44:46 -0000 1.5
--- JvFillBasicImpl.pas 18 Apr 2003 11:18:57 -0000 1.6
***************
*** 341,344 ****
--- 341,345 ----
begin
FCaption := Value;
+ Item.Items.Filler.NotifyConsumers(frUpdate);
end;
***************
*** 353,356 ****
--- 354,358 ----
begin
FAlignment := Value;
+ Item.Items.Filler.NotifyConsumers(frUpdate);
end;
***************
*** 363,366 ****
--- 365,369 ----
begin
FImageIndex := Index;
+ Item.Items.Filler.NotifyConsumers(frUpdate);
end;
***************
*** 373,376 ****
--- 376,380 ----
begin
FSelectedIndex := Value;
+ Item.Items.Filler.NotifyConsumers(frUpdate);
end;
***************
*** 715,718 ****
--- 719,723 ----
TJvFillerItemsList(ItemsImpl).List.Add(Item.GetImplementer);
Result := Item;
+ Items.Filler.NotifyConsumers(frAdd);
end;
***************
*** 720,723 ****
--- 725,729 ----
begin
TJvFillerItemsList(ItemsImpl).List.Clear;
+ Items.Filler.NotifyConsumers(frUpdate);
end;
***************
*** 725,728 ****
--- 731,735 ----
begin
TJvFillerItemsList(ItemsImpl).List.Delete(Index);
+ Items.Filler.NotifyConsumers(frDelete);
end;
***************
*** 735,738 ****
--- 742,746 ----
Pointer(Item) := nil;
TJvFillerItemsList(ItemsImpl).List.Remove(Impl);
+ Items.Filler.NotifyConsumers(frDelete);
end;
Index: JvFillIntf.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/filler/source/JvFillIntf.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** JvFillIntf.pas 15 Apr 2003 13:44:46 -0000 1.4
--- JvFillIntf.pas 18 Apr 2003 11:18:57 -0000 1.5
***************
*** 143,148 ****
end;
! { Support interface for filler editor. May be implemented by IFillerItem implementers who
! allow their item to be extended with additional interfaces. }
IFillerItemDesigner = interface
['{8F1A1283-2D13-4A28-9616-08B3EF73F29A}']
--- 143,148 ----
end;
! { Support interface for filler editor. Must be implemented by IFillerItem implementers who
! allow their item to be edited in the filler editor. }
IFillerItemDesigner = interface
['{8F1A1283-2D13-4A28-9616-08B3EF73F29A}']
***************
*** 213,218 ****
--- 213,445 ----
end;
+ { An instance of this class is created when an item is selected in the FillerEditor. The class
+ provides a reference to the item selected. Based on the interfaces supported by the item,
+ published properties are "injected" into this class. }
+ TJvFillerItem = class(TPersistent)
+ private
+ FItem: IFillerItem;
+ protected
+ function Item: IFillerItem;
+ function GetOwner: TPersistent; override;
+ public
+ constructor Create(AnItem: IFillerItem);
+ function GetNamePath: string; override;
+ end;
+
+ TJvFillerItemClass = class of TJvFillerItem;
+
+ procedure RegisterFillerIntfProp(const IID: TGUID; const PropClass: TJvFillerItemClass);
+
implementation
+ uses
+ SysUtils, TypInfo;
+
+ type
+ PPropData = ^TPropData;
+
+ TIntfItem = record
+ GUID: TGUID;
+ PropClass: TJvFillerItemClass;
+ end;
+ TIntfItems = array of TIntfItem;
+
+ var
+ GIntfPropReg: TIntfItems;
+
+ function LocateReg(IID: TGUID): Integer;
+ begin
+ Result := High(GIntfPropReg);
+ while (Result >= 0) and not CompareMem(@GIntfPropReg[Result].GUID, @IID, SizeOf(TGUID)) do
+ Dec(Result);
+ end;
+
+ procedure RegisterFillerIntfProp(const IID: TGUID; const PropClass: TJvFillerItemClass);
+ var
+ IIDIdx: Integer;
+ begin
+ IIDIdx := LocateReg(IID);
+ if IIDIdx < 0 then
+ begin
+ IIDIdx := Length(GIntfPropReg);
+ SetLength(GIntfPropReg, IIDIdx + 1);
+ GIntfPropReg[IIDIdx].GUID := IID;
+ end;
+ GIntfPropReg[IIDIdx].PropClass := PropClass;
+ end;
+
+ function StringBaseLen(NumItems: Integer; StartString: PChar): Integer;
+ begin
+ Result := 0;
+ while (NumItems > 0) do
+ begin
+ Inc(Result, 1 + PByte(StartString)^);
+ Inc(StartString, 1 + PByte(StartString)^);
+ Dec(NumItems);
+ end;
+ end;
+
+ function PropListSize(ListPos: PChar): Integer;
+ var
+ Cnt: Integer;
+ BaseInfoSize: Integer;
+ begin
+ Result := SizeOf(Word);
+ Cnt := PWord(ListPos)^;
+ Inc(ListPos, Result);
+ BaseInfoSize := SizeOf(TPropInfo) - SizeOf(ShortString) + 1;
+ while Cnt > 0 do
+ begin
+ Inc(Result, BaseInfoSize + Length(PPropInfo(ListPos)^.Name));
+ Inc(ListPos, BaseInfoSize + Length(PPropInfo(ListPos)^.Name));
+ Dec(Cnt);
+ end;
+ end;
+
+ function TypeInfoSize(TypeInfo: PTypeInfo): Integer;
+ var
+ TypeData: PTypeData;
+ begin
+ Result := 2 + Length(TypeInfo.Name);
+ TypeData := GetTypeData(TypeInfo);
+ case TypeInfo.Kind of
+ tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
+ begin
+ Inc(Result, SizeOf(TOrdType));
+ case TypeInfo.Kind of
+ tkInteger, tkChar, tkEnumeration, tkWChar:
+ begin
+ Inc(Result, 8);
+ if TypeInfo.Kind = tkEnumeration then
+ Inc(Result, 4 + StringBaseLen(TypeData.MaxValue - TypeData.MinValue + 1, @TypeData.NameList));
+ end;
+ tkSet:
+ Inc(Result, 4);
+ end;
+ end;
+ tkFloat:
+ Inc(Result, SizeOf(TFloatType));
+ tkString:
+ Inc(Result);
+ tkClass:
+ begin
+ Inc(Result, SizeOf(TClass) + SizeOf(PPTypeInfo) + SizeOf(SmallInt) + StringBaseLen(1, @TypeData.UnitName));
+ Inc(Result, PropListSize(Pointer(Integer(@TypeData.UnitName) + StringBaseLen(1, @TypeData.UnitName))));
+ end;
+ end;
+ end;
+
+ function CloneTypeInfo(OrgTypeInfo: PTypeInfo; AdditionalSpace: Longint = 0): PTypeInfo;
+ var
+ P: PChar;
+ begin
+ P := AllocMem(SizeOf(Pointer) + TypeInfoSize(OrgTypeInfo) + AdditionalSpace);
+ PInteger(P)^ := Integer(OrgTypeInfo);
+ Inc(P, 4);
+ Result := PTypeInfo(P);
+ Move(OrgTypeInfo^ , Result^, TypeInfoSize(OrgTypeInfo));
+ end;
+
+ procedure CreateTypeInfo(const AClass: TClass);
+ var
+ P: PChar;
+ PNewInfo: Pointer;
+ OldProtect: Cardinal;
+ begin
+ P := Pointer(AClass);
+ Dec(P, 60); // Now pointing to TypeInfo of the VMT table.
+ { Below the typeinfo is cloned, while an additional 2048 bytes are reserved at the end. This 2048
+ bytes will be used to "inject" additional properties. Since each property takes 27 + the length
+ of the property name bytes, assuming an average of 40 bytes/property will allow approximately 50
+ properties to be appended to the existing property list. }
+ PNewInfo := CloneTypeInfo(Pointer(PInteger(P)^), 2048);
+ if VirtualProtect(P, 4, PAGE_READWRITE, OldProtect) then
+ try
+ PInteger(P)^ := Integer(PNewInfo);
+ finally
+ VirtualProtect(P, 4, OldProtect, OldProtect);
+ end;
+ end;
+
+ procedure ClearTypeInfo(const AClass: TClass);
+ var
+ P: PChar;
+ PNewType: PChar;
+ OldProtect: Cardinal;
+ begin
+ P := Pointer(AClass);
+ Dec(P, 60); // Now pointing to TypeInfo of the VMT table.
+ PNewType := Pointer(PInteger(P)^); // The new type currently in use.
+ Dec(PNewType, 4); // Points to the original PTypeInfo value.
+ if VirtualProtect(P, 4, PAGE_READWRITE, OldProtect) then
+ try
+ PInteger(P)^ := Integer(PInteger(PNewType)^);
+ finally
+ VirtualProtect(P, 4, OldProtect, OldProtect);
+ end;
+ end;
+
+ function GetPropData(TypeData: PTypeData): PPropData;
+ begin
+ Result := PPropData(Integer(@TypeData.UnitName) + StringBaseLen(1, @TypeData.UnitName));
+ end;
+
+ procedure ClearPropList(const AClass: TClass);
+ var
+ RTTI: PTypeInfo;
+ TypeData: PTypeData;
+ PropList: PPropData;
+ begin
+ RTTI := PTypeInfo(AClass.ClassInfo);
+ TypeData := GetTypeData(RTTI);
+ TypeData.PropCount := 0;
+ PropList := GetPropData(TypeData);
+ PropList.PropCount := 0;
+ end;
+
+ procedure CopyPropInfo(var Source, Dest: PPropInfo; var PropNum: Smallint);
+ var
+ BaseInfoSize: Integer;
+ NameLen: Integer;
+ begin
+ BaseInfoSize := SizeOf(TPropInfo) - SizeOf(ShortString) + 1;
+ NameLen := Length(Source.Name);
+ Move(Source^, Dest^, BaseInfoSize + NameLen);
+ Dest.NameIndex := PropNum;
+ Inc(PChar(Source), BaseInfoSize + NameLen);
+ Inc(PChar(Dest), BaseInfoSize + NameLen);
+ Inc(PropNum);
+ end;
+
+ procedure AppendPropList(const AClass: TClass; PropList: PPropInfo; Count: Integer);
+ var
+ RTTI: PTypeInfo;
+ TypeData: PTypeData;
+ ClassPropList: PPropInfo;
+ ExistingCount: Integer;
+ BaseInfoSize: Integer;
+ PropNum: Smallint;
+ begin
+ RTTI := PTypeInfo(AClass.ClassInfo);
+ TypeData := GetTypeData(RTTI);
+ TypeData.PropCount := TypeData.PropCount + Count;
+ ClassPropList := PPropInfo(GetPropData(TypeData));
+ ExistingCount := PPropData(ClassPropList).PropCount;
+ PropNum := ExistingCount;
+ PPropData(ClassPropList).PropCount := ExistingCount + Count;
+ Inc(PChar(ClassPropList), 2);
+ BaseInfoSize := SizeOf(TPropInfo) - SizeOf(ShortString) + 1;
+ while ExistingCount > 0 do
+ begin
+ Inc(PChar(ClassPropList), BaseInfoSize + Length(ClassPropList.Name));
+ Dec(ExistingCount);
+ end;
+ while Count > 0 do
+ begin
+ CopyPropInfo(PropList, ClassPropList, PropNum);
+ Dec(Count);
+ end;
+ end;
+
{ TJvFillerOptions }
***************
*** 229,232 ****
--- 456,584 ----
end;
+ { TJvFillerItem }
+
+ function TJvFillerItem.Item: IFillerItem;
+ begin
+ Result := FItem;
+ end;
+
+ function TJvFillerItem.GetOwner: TPersistent;
+ begin
+ if Item <> nil then
+ Result := (Item.Items.Filler as IInterfaceComponentReference).GetComponent
+ else
+ Result := inherited GetOwner;
+ end;
+
+ constructor TJvFillerItem.Create(AnItem: IFillerItem);
+ var
+ I: Integer;
+ IUnk: IUnknown;
+ PrpData: PPropData;
+ begin
+ inherited Create;
+ FItem := AnItem;
+ ClearPropList(ClassType);
+ for I := High(GIntfPropReg) downto 0 do
+ begin
+ if Supports(AnItem, GIntfPropReg[I].GUID, IUnk) then
+ begin
+ PrpData := GetPropData(GetTypeData(GIntfPropReg[I].PropClass.ClassInfo));
+ AppendPropList(ClassType, PPropInfo(Cardinal(PrpData) + 2), PrpData.PropCount);
+ end;
+ end;
+ end;
+
+ function TJvFillerItem.GetNamePath: string;
+ var
+ Comp: TPersistent;
+ begin
+ Comp := GetOwner;
+ if (Comp <> nil) and (Comp is TComponent) then
+ Result := (Comp as TComponent).Name
+ else
+ Result := '<unknown>';
+ if Item <> nil then
+ Result := Result + ': Item[' + Item.GetID + ']'
+ else
+ Result := Result + ': <no item>';
+ end;
+
+ type
+ TJvFillerItemTextPropView = class(TJvFillerItem)
+ protected
+ function GetCaption: string;
+ procedure SetCaption(Value: string);
+ published
+ property Caption: string read GetCaption write SetCaption;
+ end;
+
+ function TJvFillerItemTextPropView.GetCaption: string;
+ begin
+ Result := (Item as IFillerItemText).Caption;
+ end;
+
+ procedure TJvFillerItemTextPropView.SetCaption(Value: string);
+ begin
+ (Item as IFillerItemText).Caption := Value;
+ end;
+
+ type
+ TJvFillerItemImagePropView = class(TJvFillerItem)
+ protected
+ function GetAlignment: TAlignment;
+ procedure SetAlignment(Value: TAlignment);
+ function GetImageIndex: Integer;
+ procedure SetImageIndex(Value: Integer);
+ function GetSelectedIndex: Integer;
+ procedure SetSelectedIndex(Value: Integer);
+ published
+ property Alignment: TAlignment read GetAlignment write SetAlignment;
+ property ImageIndex: Integer read GetImageIndex write SetImageIndex;
+ property SelectedIndex: Integer read GetSelectedIndex write SetSelectedIndex;
+ end;
+
+ function TJvFillerItemImagePropView.GetAlignment: TAlignment;
+ begin
+ Result := (Item as IFillerItemImage).Alignment;
+ end;
+
+ procedure TJvFillerItemImagePropView.SetAlignment(Value: TAlignment);
+ begin
+ (Item as IFillerItemImage).Alignment := Value;
+ end;
+
+ function TJvFillerItemImagePropView.GetImageIndex: Integer;
+ begin
+ Result := (Item as IFillerItemImage).ImageIndex
+ end;
+
+ procedure TJvFillerItemImagePropView.SetImageIndex(Value: Integer);
+ begin
+ (Item as IFillerItemImage).ImageIndex := Value;
+ end;
+
+ function TJvFillerItemImagePropView.GetSelectedIndex: Integer;
+ begin
+ Result := (Item as IFillerItemImage).SelectedIndex;
+ end;
+
+ procedure TJvFillerItemImagePropView.SetSelectedIndex(Value: Integer);
+ begin
+ (Item as IFillerItemImage).SelectedIndex := Value;
+ end;
+
+ procedure RegFillerItemInterfaces;
+ begin
+ RegisterFillerIntfProp(IFillerItemText, TJvFillerItemTextPropView);
+ RegisterFillerIntfProp(IFillerItemImage, TJvFillerItemImagePropView);
+ end;
+
+ initialization
+ CreateTypeInfo(TJvFillerItem);
+ RegFillerItemInterfaces;
+
+ finalization
+ ClearTypeInfo(TJvFillerItem);
end.
Index: JvFillPropEdits.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/filler/source/JvFillPropEdits.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** JvFillPropEdits.pas 13 Apr 2003 13:19:00 -0000 1.2
--- JvFillPropEdits.pas 18 Apr 2003 11:18:58 -0000 1.3
***************
*** 9,12 ****
--- 9,16 ----
implementation
+ uses
+ Classes, Consts, DsgnIntf, SysUtils, TypInfo,
+ JvFillBasicImpl, JvFillIntf, JvFillerEditor, JvFillStringList;
+
{$IFNDEF COMPILER6_UP}
***************
*** 16,24 ****
interfaces. }
- uses
- Classes, Consts, DsgnIntf, SysUtils, TypInfo,
- JvFillBasicImpl, JvFillIntf;
- // Dialogs; // for testing only!! remove later!!
-
type
TInterfaceProperty = class(TComponentProperty)
--- 20,23 ----
***************
*** 39,42 ****
--- 38,52 ----
function GetInterfaceGUID: TGUID; override;
end;
+ {$ENDIF COMPILER6_UP}
+
+ TTreeFillerTreeProperty = class(TEnumProperty)
+ public
+ procedure Edit; override;
+ function GetAttributes: TPropertyAttributes; override;
+ function GetValue: string; override;
+ procedure SetValue(const Value: string); override;
+ end;
+
+ {$IFNDEF COMPILER6_UP}
{ TInterfaceProperty }
***************
*** 88,91 ****
--- 98,122 ----
{$ENDIF COMPILER6_UP}
+ { TTreeFillerTreeProperty }
+
+ procedure TTreeFillerTreeProperty.Edit;
+ begin
+ EditFiller(TJvCustomFiller(GetComponent(0)), Designer, GetName);
+ end;
+
+ function TTreeFillerTreeProperty.GetAttributes: TPropertyAttributes;
+ begin
+ Result := [paDialog, paReadOnly];
+ end;
+
+ function TTreeFillerTreeProperty.GetValue: string;
+ begin
+ Result := 'Filler tree';
+ end;
+
+ procedure TTreeFillerTreeProperty.SetValue(const Value: string);
+ begin
+ end;
+
procedure RegFillerPropEdits;
begin
***************
*** 93,96 ****
--- 124,128 ----
RegisterPropertyEditor(TypeInfo(TComponent), TComponent, 'Filler', TFillerProperty);
{$ENDIF COMPILER6_UP}
+ RegisterPropertyEditor(TypeInfo(TJvTreeFillerTree), TComponent, '', TTreeFillerTreeProperty);
end;
Index: JvFillRegFillers.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/filler/source/JvFillRegFillers.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** JvFillRegFillers.pas 9 Apr 2003 09:12:19 -0000 1.2
--- JvFillRegFillers.pas 18 Apr 2003 11:18:58 -0000 1.3
***************
*** 14,18 ****
procedure Register;
begin
! RegisterComponents('Jv Filler Providers', [TJvFontFiller, TJvStringsFiller]);
end;
--- 14,18 ----
procedure Register;
begin
! RegisterComponents('Jv Filler Providers', [TJvFontFiller, TJvStringsFiller, TJvTreeFiller]);
end;
Index: JvFillerControls.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/filler/source/JvFillerControls.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** JvFillerControls.pas 13 Apr 2003 13:19:00 -0000 1.4
--- JvFillerControls.pas 18 Apr 2003 11:18:58 -0000 1.5
***************
*** 216,219 ****
--- 216,222 ----
var
ItemsRenderer: IFillerItemsRenderer;
+ Item: IFillerItem;
+ ItemRenderer: IFillerItemRenderer;
+ ItemText: IFillerItemText;
begin
if (FillerIntf <> nil) and Supports(FillerIntf, IFillerItemsRenderer, ItemsRenderer) then
***************
*** 228,231 ****
--- 231,264 ----
Canvas.Brush.Color := Color;
ItemsRenderer.DrawItemByIndex(Canvas, Rect, Index, State);
+ end
+ else if FillerIntf <> nil then
+ begin
+ Item := (FillerIntf as IFillerItems).getItem(Index);
+ if Supports(Item, IFillerItemRenderer, ItemRenderer) then
+ begin
+ Canvas.Font := Font;
+ if odSelected in State then
+ begin
+ Canvas.Brush.Color := clHighlight;
+ Canvas.Font.Color := clHighlightText;
+ end
+ else
+ Canvas.Brush.Color := Color;
+ ItemRenderer.Draw(Canvas, Rect, State);
+ end
+ else if Supports(Item, IFillerItemText, ItemText) then
+ begin
+ Canvas.Font := Font;
+ if odSelected in State then
+ begin
+ Canvas.Brush.Color := clHighlight;
+ Canvas.Font.Color := clHighlightText;
+ end
+ else
+ Canvas.Brush.Color := Color;
+ Canvas.TextRect(Rect, Rect.Left, Rect.Top, ItemText.Caption);
+ end
+ else
+ inherited;
end
else
Index: JvFillerEditor.pas
===================================================================
RCS file: /cvsroot/jvcl/dev/filler/source/JvFillerEditor.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** JvFillerEditor.pas 15 Apr 2003 13:44:46 -0000 1.4
--- JvFillerEditor.pas 18 Apr 2003 11:18:58 -0000 1.5
***************
*** 5,9 ****
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
! JvFillIntf, ComCtrls, ImgList, ActnList, Menus;
type
--- 5,10 ----
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
! ComCtrls, ImgList, ActnList, Menus, DsgnIntf, ExtCtrls,
! ToolWin, JvFillIntf, JvFillBasicImpl;
type
***************
*** 14,18 ****
TFillerEditItems = array of TFillerEditItem;
! TfrmFillerEditor = class(TForm)
lvFiller: TListView;
alFillerEditor: TActionList;
--- 15,19 ----
TFillerEditItems = array of TFillerEditItem;
! TfrmFillerEditor = class(TForm, IFillerNotify)
lvFiller: TListView;
alFillerEditor: TActionList;
***************
*** 20,29 ****
aiDeleteItem: TAction;
aiClearSub: TAction;
- aiClear: TAction;
pmFillerEditor: TPopupMenu;
miAddItem: TMenuItem;
miDeleteItem: TMenuItem;
miClearSub: TMenuItem;
! miClear: TMenuItem;
procedure lvFillerData(Sender: TObject; Item: TListItem);
procedure lvFillerCustomDrawItem(Sender: TCustomListView;
--- 21,39 ----
aiDeleteItem: TAction;
aiClearSub: TAction;
pmFillerEditor: TPopupMenu;
miAddItem: TMenuItem;
miDeleteItem: TMenuItem;
miClearSub: TMenuItem;
! ilActions: TImageList;
! miDivider1: TMenuItem;
! pmToolbar: TPopupMenu;
! miTextLabels: TMenuItem;
! tbrActions: TToolBar;
! tbAddItem: TToolButton;
! tbDivider1: TToolButton;
! tbDeleteItem: TToolButton;
! tbClearSub: TToolButton;
! pnlSpacer: TPanel;
! pmAddMenu: TPopupMenu;
procedure lvFillerData(Sender: TObject; Item: TListItem);
procedure lvFillerCustomDrawItem(Sender: TCustomListView;
***************
*** 37,48 ****
procedure aiDeleteItemExecute(Sender: TObject);
procedure aiClearSubExecute(Sender: TObject);
- procedure aiClearExecute(Sender: TObject);
procedure lvFillerResize(Sender: TObject);
private
{ Private declarations }
FFiller: IFiller;
FViewItems: TFillerEditItems;
function GetFillerItem(Index: Integer): IFillerItem;
function LocateID(ID: string): Integer;
procedure UpdateLV;
procedure UpdateColumnSize;
--- 47,67 ----
procedure aiDeleteItemExecute(Sender: TObject);
procedure aiClearSubExecute(Sender: TObject);
procedure lvFillerResize(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure miTextLabelsClick(Sender: TObject);
private
{ Private declarations }
FFiller: IFiller;
+ FDesigner: IFormDesigner;
FViewItems: TFillerEditItems;
+ FOrgSelect: IDesignerSelections;
+ FPropView: TJvFillerItem;
+ FRootItem: TJvBaseFillerItem;
function GetFillerItem(Index: Integer): IFillerItem;
function LocateID(ID: string): Integer;
+ procedure ResetSelection;
+ procedure SetNewSelection(AnItem: IFillerItem);
procedure UpdateLV;
procedure UpdateColumnSize;
***************
*** 55,64 ****
procedure InsertItems(var Index: Integer; Items: IFillerItems);
procedure SetFiller(Value: IFiller);
public
{ Public declarations }
property Filler: IFiller read FFiller write SetFiller;
end;
! function EditFiller(AFiller: IFiller): Boolean;
implementation
--- 74,89 ----
procedure InsertItems(var Index: Integer; Items: IFillerItems);
procedure SetFiller(Value: IFiller);
+ procedure SetDesigner(Value: IFormDesigner);
+ { IFillerNotify }
+ procedure FillerChanging(const AFiller: IFiller; AReason: TJvFillerChangeReason);
+ procedure FillerChanged(const AFiller: IFiller; AReason: TJvFillerChangeReason);
public
{ Public declarations }
+ PropName: string;
property Filler: IFiller read FFiller write SetFiller;
+ property Designer: IFormDesigner read FDesigner write SetDesigner;
end;
! procedure EditFiller(AFiller: IFiller; ADesigner: IFormDesigner; PropName: string);
implementation
***************
*** 69,73 ****
Commctrl, Dialogs,
JvTypes;
!
const
vifHasChildren = Integer($80000000);
--- 94,101 ----
Commctrl, Dialogs,
JvTypes;
!
! resourcestring
! SFillerEditorCaption = 'Editing %s%s...';
!
const
vifHasChildren = Integer($80000000);
***************
*** 77,88 ****
vifHasDsgn = Integer($08000000);
! function EditFiller(AFiller: IFiller): Boolean;
begin
! with TfrmFillerEditor.Create(Screen.ActiveCustomForm) do
try
! Filler := AFiller;
! Result := ShowModal = mrOk;
! finally
! Free;
end;
end;
--- 105,171 ----
vifHasDsgn = Integer($08000000);
! var
! EditorList: TList;
!
! type
! TJvFillerRootItem = class(TJvBaseFillerItem)
! protected
! function _AddRef: Integer; override; stdcall;
! function _Release: Integer; override; stdcall;
! procedure InitID; override;
! public
! function GetInterface(const IID: TGUID; out Obj): Boolean; override;
! end;
!
! function TJvFillerRootItem._AddRef: Integer;
begin
! Result := -1;
! end;
!
! function TJvFillerRootItem._Release: Integer;
! begin
! Result := -1;
! end;
!
! procedure TJvFillerRootItem.InitID;
! begin
! SetID('ROOT');
! end;
!
! function TJvFillerRootItem.GetInterface(const IID: TGUID; out Obj): Boolean;
! begin
! Result := inherited GetInterface(IID, Obj);
! if not Result then
! Result := TExtensibleInterfacedObject(Items.GetImplementer).GetInterface(IID, Obj);
! end;
!
! procedure EditFiller(AFiller: IFiller; ADesigner: IFormDesigner; PropName: string);
! var
! EditorForm: TfrmFillerEditor;
! I: Integer;
! begin
! if EditorList = nil then
! EditorList := TList.Create;
!
! I := EditorList.Count - 1;
! while (I >= 0) do
! begin
! EditorForm := TfrmFillerEditor(EditorList[I]);
! if (EditorForm.Filler = AFiller) and (EditorForm.Designer = ADesigner) then
! begin
! EditorForm.Show;
! EditorForm.BringToFront;
! Exit;
! end;
! Dec(I);
! end;
! EditorForm := TfrmFillerEditor.Create(nil);
try
! EditorForm.PropName := PropName;
! EditorForm.Filler := AFiller;
! EditorForm.Designer := ADesigner;
! EditorForm.Show;
! except
! EditorForm.Free;
end;
end;
***************
*** 103,107 ****
function TfrmFillerEditor.GetFillerItem(Index: Integer): IFillerItem;
begin
! Result := (Filler as IFillerIDSearch).FindByID(FViewItems[Index].ID, True);
end;
--- 186,193 ----
function TfrmFillerEditor.GetFillerItem(Index: Integer): IFillerItem;
begin
! if Index = 0 then
! Result := FRootItem
! else
! Result := (Filler as IFillerIDSearch).FindByID(FViewItems[Index].ID, True);
end;
***************
*** 115,122 ****
if Result < 0 then
begin
! Item := (Filler as IFillerIDSearch).FindByID(ID, True);
if Item <> nil then
begin
Item := Item.Items.Parent;
if Item <> nil then
begin
--- 201,213 ----
if Result < 0 then
begin
! if ID = (FRootItem as IFillerItem).GetID then
! Item := FRootItem
! else
! Item := (Filler as IFillerIDSearch).FindByID(ID, True);
if Item <> nil then
begin
Item := Item.Items.Parent;
+ if Item = nil then
+ Item := FRootItem;
if Item <> nil then
begin
***************
*** 135,138 ****
--- 226,246 ----
end;
+ procedure TfrmFillerEditor.ResetSelection;
+ begin
+ if (Designer <> nil) and (FOrgSelect <> nil) then
+ Designer.SetSelections(FOrgSelect);
+ if FPropView <> nil then
+ FreeAndNil(FPropView);
+ end;
+
+ procedure TfrmFillerEditor.SetNewSelection(AnItem: IFillerItem);
+ begin
+ if FPropView <> nil then
+ FreeAndNil(FPropView);
+ FPropView := TJvFillerItem.Create(AnItem);
+ if Designer <> nil then
+ Designer.SelectComponent(FPropView);
+ end;
+
procedure TfrmFillerEditor.UpdateLV;
begin
***************
*** 155,164 ****
I: Integer;
! function MakeMenuItem(const Idx: Integer): TMenuItem;
var
S: string;
begin
Dsgn.getKind(Idx, S);
! Result := TMenuItem.Create(miAddItem);
Result.Caption := S;
Result.OnClick := aiAddItem.OnExecute;
--- 263,272 ----
I: Integer;
! function MakeMenuItem(const Idx: Integer; const AOwner: TComponent): TMenuItem;
var
S: string;
begin
Dsgn.getKind(Idx, S);
! Result := TMenuItem.Create(AOwner);
Result.Caption := S;
Result.OnClick := aiAddItem.OnExecute;
***************
*** 186,194 ****
--- 294,312 ----
end;
end;
+
+ // Update OI
+ if Item = nil then
+ ResetSelection
+ else
+ SetNewSelection(Item);
+
// Update action states
miAddItem.Clear;
+ pmAddMenu.Items.Clear;
if (Dsgn = nil) or (Dsgn.getCount = 0) then
begin
miAddItem.Action := aiAddItem;
+ tbAddItem.Action := aiAddItem;
+ tbAddItem.Style := tbsButton;
end
else
***************
*** 196,212 ****
miAddItem.Action := nil;
miAddItem.OnClick := nil;
for I := 0 to Dsgn.getCount - 1 do
! miAddItem.Add(MakeMenuItem(I));
miAddItem.Visible := Man <> nil;
miAddItem.Enabled := (Man <> nil) and (Items <> nil);
end;
! aiAddItem.Visible := Man <> nil;
aiDeleteItem.Visible := ParentMan <> nil;
! aiClearSub.Visible := Man <> nil;
aiAddItem.Enabled := (Man <> nil) and (Items <> nil);
! aiDeleteItem.Enabled := (ParentMan <> nil) and (Item <> nil);
aiClearSub.Enabled := (Man <> nil) and (Items <> nil) and (Items.Count > 0);
- aiClear.Enabled := Supports(Filler, IFillerItems, Items) and Supports(Items, IFillerItemManagment, Man) and (Items.Count > 0);
- aiClear.Visible := Man <> nil;
end;
--- 314,336 ----
miAddItem.Action := nil;
miAddItem.OnClick := nil;
+ tbAddItem.Action := nil;
+ tbAddItem.OnClick := nil;
+ tbAddItem.Style := tbsDropDown;
for I := 0 to Dsgn.getCount - 1 do
! begin
! miAddItem.Add(MakeMenuItem(I, miAddItem));
! pmAddMenu.Items.Add(MakeMenuItem(I, pmAddMenu));
! end;
miAddItem.Visible := Man <> nil;
miAddItem.Enabled := (Man <> nil) and (Items <> nil);
+ tbAddItem.Visible := miAddItem.Visible;
+ tbAddItem.Enabled := miAddItem.Enabled;
end;
! { aiAddItem.Visible := Man <> nil;
aiDeleteItem.Visible := ParentMan <> nil;
! aiClearSub.Visible := Man <> nil;}
aiAddItem.Enabled := (Man <> nil) and (Items <> nil);
! aiDeleteItem.Enabled := (ParentMan <> nil) and (Item <> nil) and (Item.GetImplementer <> FRootItem);
aiClearSub.Enabled := (Man <> nil) and (Items <> nil) and (Items.Count > 0);
end;
***************
*** 218,222 ****
begin
Info := FViewItems[Index];
! if Info.Flags and vifHasChildren <> 0 then
begin
if Info.Flags and vifExpanded <> 0 then
--- 342,346 ----
begin
Info := FViewItems[Index];
! if (Info.Flags and vifHasChildren <> 0) and ((Index > 0) or (Info.Flags and vifExpanded = 0)) then
begin
if Info.Flags and vifExpanded <> 0 then
***************
*** 224,228 ****
else
begin
! Item := (Filler as IFillerIDSearch).FindByID(Info.ID, True);
if (Item <> nil) and Supports(Item, IFillerItems, Items) then
begin
--- 348,355 ----
else
begin
! if Index = 0 then
! Item := FRootItem
! else
! Item := (Filler as IFillerIDSearch).FindByID(Info.ID, True);
if (Item <> nil) and Supports(Item, IFillerItems, Items) then
begin
***************
*** 256,260 ****
FillChar(FViewItems[High(FViewItems)], SizeOf(FViewItems[0]), 0);
SetLength(FViewItems, High(FViewItems));
! if PrevIsParent and (Index <= High(FViewItems)) and ((FViewItems[Index - 1].Flags and $00FFFFFF) <> ((FViewItems[Index].Flags and $00FFFFFF) - 1)) then
FViewItems[Index - 1].Flags := FViewItems[Index - 1].Flags and not (vifHasChildren or vifExpanded);
end;
--- 383,387 ----
FillChar(FViewItems[High(FViewItems)], SizeOf(FViewItems[0]), 0);
SetLength(FViewItems, High(FViewItems));
! if PrevIsParent and ((Index = High(FViewItems)) or ((FViewItems[Index - 1].Flags and $00FFFFFF) <> ((FViewItems[Index].Flags and $00FFFFFF) - 1))) then
FViewItems[Index - 1].Flags := FViewItems[Index - 1].Flags and not (vifHasChildren or vifExpanded);
end;
***************
*** 375,388 ****
var
LstIdx: Integer;
begin
FFiller := Value;
SetLength(FViewItems, 0); // Clears the list
- LstIdx := 0;
if Filler <> nil then
InsertItems(LstIdx, Filler as IFillerItems);
UpdateLV;
UpdateSelectedItem;
end;
procedure TfrmFillerEditor.lvFillerData(Sender: TObject; Item: TListItem);
var
--- 502,560 ----
var
LstIdx: Integer;
+ FillerImpl: TComponent;
begin
+ if Filler <> nil then
+ Filler.UnRegisterChangeNotify(Self);
+ if FRootItem <> nil then
+ FreeAndNil(FRootItem);
FFiller := Value;
SetLength(FViewItems, 0); // Clears the list
if Filler <> nil then
+ begin
+ FRootItem := TJvFillerRootItem.Create(Filler as IFillerItems);
+ AddSubItem(-1, FRootItem);
+ LstIdx := 1;
InsertItems(LstIdx, Filler as IFillerItems);
+ Filler.RegisterChangeNotify(Self);
+ FillerImpl := (Filler as IInterfaceComponentReference).GetComponent;
+ Caption := Format(SFillerEditorCaption, [FillerImpl.Name, '.' + PropName]);
+ end;
UpdateLV;
UpdateSelectedItem;
end;
+ procedure TfrmFillerEditor.SetDesigner(Value: IFormDesigner);
+ begin
+ if Value <> FDesigner then
+ begin
+ if FDesigner <> nil then
+ ResetSelection;
+ FOrgSelect := TDesignerSelectionList.Create;
+ FDesigner := Value;
+ if Designer <> nil then
+ Designer.GetSelections(FOrgSelect);
+ end;
+ end;
+
+ procedure TfrmFillerEditor.FillerChanging(const AFiller: IFiller; AReason: TJvFillerChangeReason);
+ begin
+ case AReason of
+ frDestroy:
+ SetFiller(nil);
+ frUpdate:
+ lvFiller.Invalidate;
+ end;
+ end;
+
+ procedure TfrmFillerEditor.FillerChanged(const AFiller: IFiller; AReason: TJvFillerChangeReason);
+ begin
+ case AReason of
+ frDestroy:
+ SetFiller(nil);
+ frUpdate:
+ lvFiller.Invalidate;
+ end;
+ end;
+
procedure TfrmFillerEditor.lvFillerData(Sender: TObject; Item: TListItem);
var
***************
*** 395,399 ****
ItemData := FViewItems[Item.Index];
Item.Indent := ItemData.Flags and $00FFFFFF;
! FillerItem := (FFiller as IFillerIDSearch).FindByID(ItemData.ID, True);
if FillerItem <> nil then
begin
--- 567,574 ----
ItemData := FViewItems[Item.Index];
Item.Indent := ItemData.Flags and $00FFFFFF;
! if ItemData.ID = (FRootItem as IFillerItem).GetID then
! FillerItem := FRootItem
! else
! FillerItem := (FFiller as IFillerIDSearch).FindByID(ItemData.ID, True);
if FillerItem <> nil then
begin
***************
*** 401,405 ****
Item.Caption := ItemText.Caption
else
! Item.Caption := 'Item has no text support.';
end
else
--- 576,585 ----
Item.Caption := ItemText.Caption
else
! begin
! if FillerItem.GetImplementer = FRootItem then
! Item.Caption := 'Root'
! else
! Item.Caption := 'Item has no text support.';
! end;
end
else
***************
*** 555,558 ****
--- 735,739 ----
if Supports(Items, IFillerItemManagment, Mangr) then
begin
+ ResetSelection;
Mangr.Remove(Item);
Pointer(Item) := nil;
***************
*** 562,565 ****
--- 743,747 ----
DeleteItem(I);
UpdateLV;
+ UpdateSelectedItem;
end;
end;
***************
*** 592,610 ****
end;
! procedure TfrmFillerEditor.aiClearExecute(Sender: TObject);
! var
! Mangr: IFillerItemManagment;
begin
! if Supports(Filler, IFillerItemManagment, Mangr) then
! Mangr.Clear
! else
! raise EJVCLException.Create('Unable to delete items; IFillerItemManagment is not supported.');
! SetLength(FViewItems, 0);
! UpdateLV;
end;
! procedure TfrmFillerEditor.lvFillerResize(Sender: TObject);
begin
! UpdateColumnSize;
end;
--- 774,813 ----
end;
! procedure TfrmFillerEditor.lvFillerResize(Sender: TObject);
begin
! UpdateColumnSize;
end;
! procedure TfrmFillerEditor.FormCreate(Sender: TObject);
begin
! if EditorList.IndexOf(Self) = -1 then
! EditorList.Add(Self);
! end;
!
! procedure TfrmFillerEditor.FormDestroy(Sender: TObject);
! begin
! ResetSelection;
! Filler := nil;
! Designer := nil;
! EditorList.Remove(Self);
! end;
!
! procedure TfrmFillerEditor.FormClose(Sender: TObject;
! var Action: TCloseAction);
! begin
! Action := caFree;
! end;
!
! procedure TfrmFillerEditor.miTextLabelsClick(Sender: TObject);
! begin
! if TMenuItem(Sender).Checked then
! begin
! tbrActions.ShowCaptions := False;
! tbrActions.ButtonWidth := 22;
! tbrActions.ButtonHeight := 22;
! end
! else
! tbrActions.ShowCaptions := True;
! TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
end;
|