added new session property storage editor from Michael VC

git-svn-id: trunk@7459 -
This commit is contained in:
mattias 2005-07-30 20:09:09 +00:00
parent cc5784c6eb
commit 01daa56c38
8 changed files with 562 additions and 301 deletions

3
.gitattributes vendored
View File

@ -951,6 +951,9 @@ ideintf/fieldslist.lfm svneol=native#text/plain
ideintf/fieldslist.lrs svneol=native#text/pascal ideintf/fieldslist.lrs svneol=native#text/pascal
ideintf/fieldslist.pas svneol=native#text/pascal ideintf/fieldslist.pas svneol=native#text/pascal
ideintf/formeditingintf.pas svneol=native#text/pascal ideintf/formeditingintf.pas svneol=native#text/pascal
ideintf/frmselectprops.lfm svneol=native#text/plain
ideintf/frmselectprops.lrs svneol=native#text/plain
ideintf/frmselectprops.pas svneol=native#text/plain
ideintf/graphpropedits.pas svneol=native#text/pascal ideintf/graphpropedits.pas svneol=native#text/pascal
ideintf/helpfpdoc.pas svneol=native#text/pascal ideintf/helpfpdoc.pas svneol=native#text/pascal
ideintf/helphtml.pas svneol=native#text/pascal ideintf/helphtml.pas svneol=native#text/pascal

View File

@ -93,6 +93,10 @@ begin
Add(TCustomCheckBox,'Checked'); Add(TCustomCheckBox,'Checked');
Add(TCustomRadioGroup,'Items'); Add(TCustomRadioGroup,'Items');
Add(TCustomRadioGroup,'ItemIndex'); Add(TCustomRadioGroup,'ItemIndex');
Add(TCustomForm,'OnCreate');
Add(TCustomForm,'OnDestroy');
Add(TCustomForm,'OnResize');
Add(TCustomListBox,'Items');
Result.DeleteDoubles; Result.DeleteDoubles;
end; end;

View File

@ -25,7 +25,7 @@ uses
ImageListEditor, ComponentTreeView, ActionsEditor, HelpIntf, TextTools, ImageListEditor, ComponentTreeView, ActionsEditor, HelpIntf, TextTools,
FormEditingIntf, SrcEditorIntf, ComponentReg, PackageIntf, HelpHTML, FormEditingIntf, SrcEditorIntf, ComponentReg, PackageIntf, HelpHTML,
FieldsEditor, ConfigStorage, HelpFPDoc, ProjectIntf, LazIDEIntf, NewItemIntf, FieldsEditor, ConfigStorage, HelpFPDoc, ProjectIntf, LazIDEIntf, NewItemIntf,
MacroIntf, MenuIntf; MacroIntf, MenuIntf, FrmSelectProps;
implementation implementation

187
ideintf/frmselectprops.lfm Normal file
View File

@ -0,0 +1,187 @@
object SelectPropertiesForm: TSelectPropertiesForm
Caption = 'Select properties'
ClientHeight = 462
ClientWidth = 485
OnCreate = SelectPropertiesFormCreate
PixelsPerInch = 112
Position = poDesktopCenter
HorzScrollBar.Page = 484
VertScrollBar.Page = 461
Left = 411
Height = 462
Top = 175
Width = 485
object PTop: TPanel
Align = alTop
BevelOuter = bvNone
ClientHeight = 248
ClientWidth = 485
FullRepaint = False
TabOrder = 0
OnResize = PTopResize
Height = 248
Width = 485
object PProperties: TPanel
Align = alRight
BevelOuter = bvNone
ClientHeight = 248
ClientWidth = 221
FullRepaint = False
TabOrder = 0
Left = 264
Height = 248
Width = 221
object LProperties: TLabel
Align = alTop
BorderSpacing.OnChange = nil
BorderSpacing.Around = 3
Caption = '&Properties'
Color = clNone
Layout = tlCenter
Left = 3
Height = 25
Top = 3
Width = 215
end
object LBProperties: TListBox
Align = alClient
BorderSpacing.OnChange = nil
MultiSelect = True
Sorted = True
TabOrder = 0
TopIndex = -1
Height = 217
Top = 31
Width = 221
end
end
object PComponents: TPanel
Align = alLeft
BevelOuter = bvNone
Caption = 'PComponents'
ClientHeight = 248
ClientWidth = 200
FullRepaint = False
TabOrder = 1
Height = 248
Width = 200
object LComponents: TLabel
Align = alTop
Anchors = [akTop, akLeft]
BorderSpacing.Around = 3
Caption = 'Co&mponents'
Color = clNone
Layout = tlCenter
Left = 3
Height = 23
Top = 3
Width = 194
end
object LBComponents: TListBox
Align = alClient
OnSelectionChange = LBComponentsSelectionChange
Sorted = True
TabOrder = 0
TopIndex = -1
Height = 219
Top = 29
Width = 200
end
end
end
object VSplitter: TSplitter
Align = alTop
Beveled = True
Cursor = crVSplit
Height = 8
ParentColor = True
Width = 485
Cursor = crVSplit
Height = 8
Top = 248
Width = 485
end
object PBottom: TPanel
Align = alClient
BevelOuter = bvNone
ClientHeight = 206
ClientWidth = 485
Constraints.MinHeight = 190
FullRepaint = False
TabOrder = 1
Height = 206
Top = 256
Width = 485
object LLBSelected: TLabel
BorderSpacing.Around = 3
Caption = '&Selected Properties'
Color = clNone
Left = 10
Height = 17
Top = 3
Width = 286
end
object LBSelected: TListBox
Anchors = [akTop, akLeft, akRight, akBottom]
MultiSelect = True
TabOrder = 0
TopIndex = -1
Left = 8
Height = 177
Top = 24
Width = 375
end
object BAdd: TButton
Anchors = [akTop, akRight]
Caption = '&Add'
OnClick = BAddClick
TabOrder = 1
Left = 399
Height = 25
Top = 24
Width = 75
end
object BDelete: TButton
Anchors = [akTop, akRight]
Caption = '&Delete'
OnClick = BDeleteClick
TabOrder = 2
Left = 399
Height = 25
Top = 56
Width = 75
end
object BClear: TButton
Anchors = [akTop, akRight]
Caption = 'C&lear'
OnClick = BClearClick
TabOrder = 3
Left = 399
Height = 25
Top = 88
Width = 75
end
object BOK: TButton
Anchors = [akRight, akBottom]
Caption = '&OK'
Default = True
ModalResult = 1
TabOrder = 4
Left = 399
Height = 25
Top = 169
Width = 75
end
object BCancel: TButton
Anchors = [akRight, akBottom]
Cancel = True
Caption = '&Cancel'
ModalResult = 2
TabOrder = 5
Left = 399
Height = 25
Top = 137
Width = 75
end
end
end

View File

@ -0,0 +1,53 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TSelectPropertiesForm','FORMDATA',[
'TPF0'#21'TSelectPropertiesForm'#20'SelectPropertiesForm'#7'Caption'#6#17'Sel'
+'ect properties'#12'ClientHeight'#3#206#1#11'ClientWidth'#3#229#1#8'OnCreate'
+#7#26'SelectPropertiesFormCreate'#13'PixelsPerInch'#2'p'#8'Position'#7#15'po'
+'DesktopCenter'#18'HorzScrollBar.Page'#3#228#1#18'VertScrollBar.Page'#3#205#1
+#4'Left'#3#155#1#6'Height'#3#206#1#3'Top'#3#175#0#5'Width'#3#229#1#0#6'TPane'
+'l'#4'PTop'#5'Align'#7#5'alTop'#10'BevelOuter'#7#6'bvNone'#12'ClientHeight'#3
+#248#0#11'ClientWidth'#3#229#1#11'FullRepaint'#8#8'TabOrder'#2#0#8'OnResize'
+#7#10'PTopResize'#6'Height'#3#248#0#5'Width'#3#229#1#0#6'TPanel'#11'PPropert'
+'ies'#5'Align'#7#7'alRight'#10'BevelOuter'#7#6'bvNone'#12'ClientHeight'#3#248
+#0#11'ClientWidth'#3#221#0#11'FullRepaint'#8#8'TabOrder'#2#0#4'Left'#3#8#1#6
+'Height'#3#248#0#5'Width'#3#221#0#0#6'TLabel'#11'LProperties'#5'Align'#7#5'a'
+'lTop'#22'BorderSpacing.OnChange'#13#20'BorderSpacing.Around'#2#3#7'Caption'
+#6#11'&Properties'#5'Color'#7#6'clNone'#6'Layout'#7#8'tlCenter'#4'Left'#2#3#6
+'Height'#2#25#3'Top'#2#3#5'Width'#3#215#0#0#0#8'TListBox'#12'LBProperties'#5
+'Align'#7#8'alClient'#22'BorderSpacing.OnChange'#13#11'MultiSelect'#9#6'Sort'
+'ed'#9#8'TabOrder'#2#0#8'TopIndex'#2#255#6'Height'#3#217#0#3'Top'#2#31#5'Wid'
+'th'#3#221#0#0#0#0#6'TPanel'#11'PComponents'#5'Align'#7#6'alLeft'#10'BevelOu'
+'ter'#7#6'bvNone'#7'Caption'#6#11'PComponents'#12'ClientHeight'#3#248#0#11'C'
+'lientWidth'#3#200#0#11'FullRepaint'#8#8'TabOrder'#2#1#6'Height'#3#248#0#5'W'
+'idth'#3#200#0#0#6'TLabel'#11'LComponents'#5'Align'#7#5'alTop'#7'Anchors'#11
+#5'akTop'#6'akLeft'#0#20'BorderSpacing.Around'#2#3#7'Caption'#6#11'Co&mponen'
+'ts'#5'Color'#7#6'clNone'#6'Layout'#7#8'tlCenter'#4'Left'#2#3#6'Height'#2#23
+#3'Top'#2#3#5'Width'#3#194#0#0#0#8'TListBox'#12'LBComponents'#5'Align'#7#8'a'
+'lClient'#17'OnSelectionChange'#7#27'LBComponentsSelectionChange'#6'Sorted'#9
+#8'TabOrder'#2#0#8'TopIndex'#2#255#6'Height'#3#219#0#3'Top'#2#29#5'Width'#3
+#200#0#0#0#0#0#9'TSplitter'#9'VSplitter'#5'Align'#7#5'alTop'#7'Beveled'#9#6
+'Cursor'#7#8'crVSplit'#6'Height'#2#8#11'ParentColor'#9#5'Width'#3#229#1#6'Cu'
+'rsor'#7#8'crVSplit'#6'Height'#2#8#3'Top'#3#248#0#5'Width'#3#229#1#0#0#6'TPa'
+'nel'#7'PBottom'#5'Align'#7#8'alClient'#10'BevelOuter'#7#6'bvNone'#12'Client'
+'Height'#3#206#0#11'ClientWidth'#3#229#1#21'Constraints.MinHeight'#3#190#0#11
+'FullRepaint'#8#8'TabOrder'#2#1#6'Height'#3#206#0#3'Top'#3#0#1#5'Width'#3#229
+#1#0#6'TLabel'#11'LLBSelected'#20'BorderSpacing.Around'#2#3#7'Caption'#6#20
+'&Selected Properties'#5'Color'#7#6'clNone'#4'Left'#2#10#6'Height'#2#17#3'To'
+'p'#2#3#5'Width'#3#30#1#0#0#8'TListBox'#10'LBSelected'#7'Anchors'#11#5'akTop'
+#6'akLeft'#7'akRight'#8'akBottom'#0#11'MultiSelect'#9#8'TabOrder'#2#0#8'TopI'
+'ndex'#2#255#4'Left'#2#8#6'Height'#3#177#0#3'Top'#2#24#5'Width'#3'w'#1#0#0#7
+'TButton'#4'BAdd'#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#4'&Add'#7
+'OnClick'#7#9'BAddClick'#8'TabOrder'#2#1#4'Left'#3#143#1#6'Height'#2#25#3'To'
+'p'#2#24#5'Width'#2'K'#0#0#7'TButton'#7'BDelete'#7'Anchors'#11#5'akTop'#7'ak'
+'Right'#0#7'Caption'#6#7'&Delete'#7'OnClick'#7#12'BDeleteClick'#8'TabOrder'#2
+#2#4'Left'#3#143#1#6'Height'#2#25#3'Top'#2'8'#5'Width'#2'K'#0#0#7'TButton'#6
+'BClear'#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#6'C&lear'#7'OnClic'
+'k'#7#11'BClearClick'#8'TabOrder'#2#3#4'Left'#3#143#1#6'Height'#2#25#3'Top'#2
+'X'#5'Width'#2'K'#0#0#7'TButton'#3'BOK'#7'Anchors'#11#7'akRight'#8'akBottom'
+#0#7'Caption'#6#3'&OK'#7'Default'#9#11'ModalResult'#2#1#8'TabOrder'#2#4#4'Le'
+'ft'#3#143#1#6'Height'#2#25#3'Top'#3#169#0#5'Width'#2'K'#0#0#7'TButton'#7'BC'
+'ancel'#7'Anchors'#11#7'akRight'#8'akBottom'#0#6'Cancel'#9#7'Caption'#6#7'&C'
+'ancel'#11'ModalResult'#2#2#8'TabOrder'#2#5#4'Left'#3#143#1#6'Height'#2#25#3
+'Top'#3#137#0#5'Width'#2'K'#0#0#0#0
]);

276
ideintf/frmselectprops.pas Normal file
View File

@ -0,0 +1,276 @@
{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
Author: Michael Van Canneyt
}
unit frmSelectProps;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ObjInspStrConsts, Buttons, ExtCtrls;
type
{ TSelectPropertiesForm }
TSelectPropertiesForm = class(TForm)
BAdd: TButton;
BDelete: TButton;
BClear: TButton;
BOK: TButton;
BCancel: TButton;
LLBSelected: TLabel;
LBComponents: TListBox;
LComponents: TLabel;
LBProperties: TListBox;
LBSelected: TListBox;
PBottom: TPanel;
PComponents: TPanel;
PTop: TPanel;
PProperties: TPanel;
LProperties: TLabel;
VSplitter: TSplitter;
procedure BAddClick(Sender: TObject);
procedure BClearClick(Sender: TObject);
procedure BDeleteClick(Sender: TObject);
procedure LBComponentsSelectionChange(Sender: TObject; User: boolean);
procedure PTopResize(Sender: TObject);
procedure SelectPropertiesFormCreate(Sender: TObject);
private
FSelectedComponent : TComponent;
FPropComponent: TComponent;
function GetSelectedProps: String;
procedure SetPropComponent(const AValue: TComponent);
procedure SetSelectedProps(const AValue: String);
Procedure ShowComponents;
Procedure ShowProperties(C : TComponent);
Procedure AddSelectedProperties;
Procedure DeleteSelectedProperties;
public
Property PropertyComponent : TComponent Read FPropComponent Write SetPropComponent;
Property SelectedProperties : String Read GetSelectedProps Write SetSelectedProps;
end;
var
SelectPropertiesForm: TSelectPropertiesForm;
implementation
uses TypInfo, RTTIUtils;
{ TSelectPropertiesForm }
procedure TSelectPropertiesForm.SetPropComponent(const AValue: TComponent);
begin
if FPropComponent=AValue then exit;
begin
FPropComponent:=AValue;
ShowComponents;
end
end;
procedure TSelectPropertiesForm.LBComponentsSelectionChange(Sender: TObject;
User: boolean);
Var
C : TComponent;
begin
With Sender as TListBox do
if ItemIndex=-1 then
C:=Nil
else
C:=Items.Objects[ItemIndex] as TComponent;
ShowProperties(C);
end;
procedure TSelectPropertiesForm.PTopResize(Sender: TObject);
Var
W : Integer;
begin
W:=(PTop.Width-50) div 2;
PProperties.Width:=W;
PComponents.Width:=W;
end;
procedure TSelectPropertiesForm.SelectPropertiesFormCreate(Sender: TObject);
begin
BAdd.Caption:=ilesAdd;
BDelete.Caption:=oisDelete;
BClear.Caption:=sccsILBtnClear;
BOK.Caption:=oisOk;
BCancel.Caption:=oiStdActDataSetCancel1Hint;
LComponents.Caption:=oisComponents;
LProperties.Caption:=oisProperties;
end;
procedure TSelectPropertiesForm.BAddClick(Sender: TObject);
begin
AddSelectedProperties;
end;
procedure TSelectPropertiesForm.BClearClick(Sender: TObject);
begin
LBSelected.Items.Clear;
ShowProperties(FSelectedComponent);
end;
procedure TSelectPropertiesForm.BDeleteClick(Sender: TObject);
begin
DeleteSelectedProperties;
end;
function TSelectPropertiesForm.GetSelectedProps: String;
begin
LBSelected.Items.Delimiter:=';';
Result:=LBSelected.Items.DelimitedText;
end;
procedure TSelectPropertiesForm.SetSelectedProps(const AValue: String);
Var
L : TStringList;
I : Integer;
begin
L:=TStringList.Create;
Try
L.Delimiter:=';';
L.DelimitedText:=AValue;
For I:=0 to L.Count-1 do
L[i]:=Trim(L[i]);
L.Sort;
LBSelected.Items.Assign(L);
Finally
L.Free;
end;
end;
procedure TSelectPropertiesForm.ShowComponents;
Var
C : TComponent;
I : Integer;
begin
With LBComponents.Items do
try
BeginUpdate;
Clear;
If Assigned(FPropComponent) then
begin
AddObject(FPropComponent.Name,FPropComponent);
For I:=0 to FPropComponent.ComponentCount-1 do
begin
C:=FPropComponent.Components[I];
AddObject(C.Name,C);
end;
end;
Finally
EndUpdate;
end;
If LBComponents.Items.Count>0 then
LBComponents.ItemIndex:=0;
end;
procedure TSelectPropertiesForm.ShowProperties(C : TComponent);
Var
L : TPropInfoList;
I : Integer;
N,S : String;
P : PPropInfo;
begin
With LBProperties do
try
Items.BeginUpdate;
Clear;
FSelectedComponent:=C;
If (C<>Nil) then
begin
N:=C.Name;
L:=TPropInfoList.Create(C,tkProperties);
Try
For I:=0 to L.Count-1 do
begin
P:=L[I];
If (C<>FPropComponent) then
S:=N+'.'+P^.Name;
If LBSelected.Items.IndexOf(S)=-1 then
LBProperties.Items.Add(P^.Name);
end;
Finally
L.Free;
end;
end;
Finally
Items.EndUpdate;
end;
end;
procedure TSelectPropertiesForm.AddSelectedProperties;
Var
I : Integer;
N : String;
begin
If Assigned(FSelectedComponent) then
With LBProperties do
try
Items.BeginUpdate;
LBSelected.Items.BeginUpdate;
For I:=Items.Count-1 downto 0 do
If Selected[i] then
begin
N:=Items[i];
If (FSelectedComponent<>FPropComponent) then
N:=FSelectedComponent.Name+'.'+N;
LBSelected.Items.Add(N);
Items.Delete(I);
end;
Finally
LBSelected.Items.EndUpdate;
Items.EndUpdate;
end;
end;
procedure TSelectPropertiesForm.DeleteSelectedProperties;
Var
I : Integer;
begin
With LBSelected do
try
Items.BeginUpdate;
For I:=Items.Count-1 downto 0 do
If Selected[i] then
Items.Delete(I);
Finally
Items.EndUpdate;
end;
ShowProperties(FSelectedComponent);
end;
initialization
{$I frmselectprops.lrs}
end.

View File

@ -189,6 +189,7 @@ resourcestring
oiStdActDataSetEditHint = 'Edit'; oiStdActDataSetEditHint = 'Edit';
oiStdActDataSetPostHint = 'Post'; oiStdActDataSetPostHint = 'Post';
oiStdActDataSetCancel1Hint = 'Cancel'; oiStdActDataSetCancel1Hint = 'Cancel';
oisComponents = 'Components';
oiStdActDataSetRefreshHint = 'Refresh'; oiStdActDataSetRefreshHint = 'Refresh';
oisStdActionListEditor = 'Standard Action Classes'; oisStdActionListEditor = 'Standard Action Classes';
@ -196,11 +197,18 @@ resourcestring
// TFileNamePropertyEditor // TFileNamePropertyEditor
oisSelectAFile = 'Select a file'; oisSelectAFile = 'Select a file';
oisPropertiesOf = 'Properties of %s';
oisAllFiles = 'All files (*.*)|*.*'; oisAllFiles = 'All files (*.*)|*.*';
// property editors // property editors
oisSort = 'Sort'; oisSort = 'Sort';
oisDLinesDChars = '%d lines, %d chars';
oisStringsEditorDialog = 'Strings Editor Dialog'; oisStringsEditorDialog = 'Strings Editor Dialog';
ois0Lines0Chars = '0 lines, 0 chars';
oisInvalidPropertyValue = 'Invalid property value';
oisNone = '(none)';
oisComponentNameIsNotAValidIdentifier = 'Component name %s%s%s is not a '
+'valid identifier';
oisHelpTheHelpDatabaseWasUnableToFindFile = 'The help database %s%s%s was ' oisHelpTheHelpDatabaseWasUnableToFindFile = 'The help database %s%s%s was '
+'unable to find file %s%s%s.'; +'unable to find file %s%s%s.';
oisHelpTheMacroSInBrowserParamsWillBeReplacedByTheURL = 'The macro %s in ' oisHelpTheMacroSInBrowserParamsWillBeReplacedByTheURL = 'The macro %s in '
@ -231,7 +239,7 @@ resourcestring
oisClearPicture = 'Clear picture'; oisClearPicture = 'Clear picture';
oisLoad = '&Load'; oisLoad = '&Load';
oisSave = '&Save'; oisSave = '&Save';
oisCLear = 'C&lear'; oisClear = 'C&lear';
oisErrorLoadingImage = 'Error loading image'; oisErrorLoadingImage = 'Error loading image';
oisErrorLoadingImage2 = 'Error loading image %s%s%s:%s%s'; oisErrorLoadingImage2 = 'Error loading image %s%s%s:%s%s';

View File

@ -19,12 +19,7 @@
For more information see the big comment part below. For more information see the big comment part below.
ToDo: ToDo:
-digits for floattypes -> I hope, I guessed right
-TIntegerSet missing -> taking my own -TIntegerSet missing -> taking my own
-Save ColorDialog settings
-System.TypeInfo(Type) missing -> exists already in the fpc 1.1 version
but because I want it now with the stable version I will use my
workaround
-StrToInt64 has a bug. It prints infinitly "something happened" -StrToInt64 has a bug. It prints infinitly "something happened"
-> taking my own -> taking my own
@ -39,19 +34,13 @@ unit PropEdits;
interface interface
{$IFNDEF VER1_0}
{$DEFINE EnableSessionProps}
{$ENDIF}
{$DEFINE NewListPropEdit} {$DEFINE NewListPropEdit}
uses uses
Classes, TypInfo, SysUtils, LCLProc, Forms, Controls, GraphType, Graphics, Classes, TypInfo, SysUtils, LCLProc, Forms, Controls, GraphType, Graphics,
StdCtrls, Buttons, ComCtrls, Menus, LCLType, ExtCtrls, LCLIntf, Dialogs, StdCtrls, Buttons, ComCtrls, Menus, LCLType, ExtCtrls, LCLIntf, Dialogs,
Grids, EditBtn, Grids, EditBtn, PropertyStorage, TextTools, FrmSelectProps, ColumnDlg,
{$IFDEF EnableSessionProps} ObjInspStrConsts;
PropertyStorage,
{$ENDIF}
TextTools, ColumnDlg, ObjInspStrConsts;
const const
MaxIdentLength: Byte = 63; MaxIdentLength: Byte = 63;
@ -2085,199 +2074,6 @@ begin
IValue:=0; IValue:=0;
end; end;
{$IFDEF VER1_0 workaround}
Function CallSingleFunc(s : Pointer; Address : Pointer;
Index, IValue : Longint) : Single; assembler;
{$asmmode att}
var
saveedi,saveesi : dword;
asm
movl %edi,saveedi
movl %esi,saveesi
movl S,%esi
movl Address,%edi
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LINoPush
movl IValue,%eax
pushl %eax
.LINoPush:
push %esi
call %edi
//
movl saveedi,%edi
movl saveesi,%esi
end;
Function CallDoubleFunc(s : Pointer; Address : Pointer;
Index, IValue : Longint) : Double; assembler;
var
saveedi,saveesi : dword;
asm
movl %edi,saveedi
movl %esi,saveesi
movl S,%esi
movl Address,%edi
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LINoPush
movl IValue,%eax
pushl %eax
.LINoPush:
push %esi
call %edi
//
movl saveedi,%edi
movl saveesi,%esi
end;
Function CallExtendedFunc(s : Pointer; Address : Pointer;
Index, IValue : Longint) : Extended; assembler;
var
saveedi,saveesi : dword;
asm
movl %edi,saveedi
movl %esi,saveesi
movl S,%esi
movl Address,%edi
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LINoPush
movl IValue,%eax
pushl %eax
.LINoPush:
push %esi
call %edi
//
movl saveedi,%edi
movl saveesi,%esi
end;
Function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
var
Index,Ivalue : longint;
Value : Extended;
begin
SetIndexValues(PropInfo,Index,Ivalue);
case (PropInfo^.PropProcs) and 3 of
ptField:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
Value:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
ftDouble:
Value:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
ftExtended:
Value:=PExtended(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
{$ifndef m68k}
ftcomp:
Value:=PComp(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
{$endif m68k}
end;
ptStatic:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
Value:=CallSingleFunc(Instance,PropInfo^.GetProc,Index,IValue);
ftDouble:
Value:=CallDoubleFunc(Instance,PropInfo^.GetProc,Index,IValue);
ftExtended:
Value:=CallExtendedFunc(Instance,PropInfo^.GetProc,Index,IValue);
end;
ptVirtual:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
Value:=CallSingleFunc(Instance,
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,
Index,IValue);
ftDouble:
Value:=CallDoubleFunc(Instance,
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,
Index,IValue);
ftExtended:
Value:=CallExtendedFunc(Instance,
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,
Index,IValue);
end;
end;
Result:=Value;
end;
Procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
Value : Extended);
type
TMySetExtendedProc = procedure(const AValue: Extended) of object;
TMySetExtendedProcIndex = procedure(Index: integer; const AValue: Extended) of object;
TMySetDoubleProc = procedure(const AValue: Double) of object;
TMySetDoubleProcIndex = procedure(Index: integer; const AValue: Double) of object;
TMySetSingleProc = procedure(const AValue: Single) of object;
TMySetSingleProcIndex = procedure(Index: integer; const AValue: Single) of object;
Var IValue,Index : longint;
AMethod: TMethod;
begin
SetIndexValues(PropInfo,Index,Ivalue);
case (PropInfo^.PropProcs shr 2) and 3 of
ptfield:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Single(Value);
ftDouble:
PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Double(Value);
ftExtended:
PExtended(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
{$ifndef m68k}
ftcomp:
PComp(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Comp(Value);
{$endif m68k}
{ Uncommenting this code results in an internal error!!
ftFixed16:
PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
ftfixed32:
PFixed32(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
}
end;
ptStatic, ptVirtual:
begin
if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
AMethod.Code:=PropInfo^.SetProc
else
AMethod.Code:=
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^;
AMethod.Data:=Instance;
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
if Index=0 then
TMySetSingleProc(AMethod)(Single(Value))
else
TMySetSingleProcIndex(AMethod)(IValue,Single(Value));
ftDouble:
if Index=0 then
TMySetDoubleProc(AMethod)(Double(Value))
else
TMySetDoubleProcIndex(AMethod)(IValue,Double(Value));
ftExtended:
if Index=0 then
TMySetExtendedProc(AMethod)(Value)
else
TMySetExtendedProcIndex(AMethod)(IValue,Value);
end;
end;
end;
end;
{$ENDIF VER1_0}
function TPropertyEditor.GetFloatValueAt(Index:Integer):Extended; function TPropertyEditor.GetFloatValueAt(Index:Integer):Extended;
begin begin
with FPropList^[Index] do Result:=GetFloatProp(Instance,PropInfo); with FPropList^[Index] do Result:=GetFloatProp(Instance,PropInfo);
@ -2336,15 +2132,6 @@ end;
function TPropertyEditor.GetName:shortstring; function TPropertyEditor.GetName:shortstring;
begin begin
Result:=FPropList^[0].PropInfo^.Name; Result:=FPropList^[0].PropInfo^.Name;
{$IFDEF Ver1_0}
// the 1.0.x fpc has only uppercase RTTI
// -> make it a little bit nicer
Result:=lowercase(Result);
if length(Result)>0 then
Result[1]:=upcase(Result[1]);
if (length(Result)>2) and (Result[1]='O') and (Result[2]='n') then
Result[3]:=upcase(Result[3]);
{$ENDIF}
end; end;
function TPropertyEditor.GetOrdValue:Longint; function TPropertyEditor.GetOrdValue:Longint;
@ -3063,11 +2850,7 @@ end;
function TFloatPropertyEditor.GetValue: ansistring; function TFloatPropertyEditor.GetValue: ansistring;
const const
Precisions: array[TFloatType] of Integer = (7, 15, 19, 19, 19 Precisions: array[TFloatType] of Integer = (7, 15, 19, 19, 19);
{$ifdef VER1_0}
, 15, 31
{$endif VER1_0}
);
begin begin
Result := FloatToStrF(GetFloatValue, ffGeneral, Result := FloatToStrF(GetFloatValue, ffGeneral,
Precisions[GetTypeData(GetPropType)^.FloatType], 0); Precisions[GetTypeData(GetPropType)^.FloatType], 0);
@ -4037,11 +3820,6 @@ begin
and (Result[1] in ['O','o']) and (Result[2] in ['N','n']) and (Result[1] in ['O','o']) and (Result[2] in ['N','n'])
then then
System.Delete(Result,1,2); System.Delete(Result,1,2);
{$IFDEF Ver1_0}
// the 1.0.x compilers have only uppercase RTTI. Make the names a little more
// nicer
Result := copy(Result,1,1)+lowercase(copy(Result,2,length(Result)-1));
{$ENDIF}
end; end;
function TMethodPropertyEditor.GetValue: ansistring; function TMethodPropertyEditor.GetValue: ansistring;
@ -4051,37 +3829,12 @@ end;
procedure TMethodPropertyEditor.GetValues(Proc: TGetStringProc); procedure TMethodPropertyEditor.GetValues(Proc: TGetStringProc);
begin begin
DebugLn('### TMethodPropertyEditor.GetValues'); //DebugLn('### TMethodPropertyEditor.GetValues');
Proc('(None)'); Proc(oisNone);
PropertyHook.GetMethods(GetTypeData(GetPropType), Proc); PropertyHook.GetMethods(GetTypeData(GetPropType), Proc);
end; end;
procedure TMethodPropertyEditor.SetValue(const NewValue: ansistring); procedure TMethodPropertyEditor.SetValue(const NewValue: ansistring);
{
procedure CheckChainCall(const MethodName: shortstring; Method: TMethod);
var
Persistent: TPersistent;
Component: TComponent;
InstanceMethod: shortstring;
Instance: TComponent;
begin
Persistent := GetComponent(0);
if Persistent is TComponent then begin
Component := TComponent(Persistent);
if (Component.Name <> '')
and (TObject(Method.Data) <> PropertyHook.LookupRoot)
and (TObject(Method.Data) is TComponent) then
begin
Instance := TComponent(Method.Data);
InstanceMethod := Instance.MethodName(Method.Code);
if InstanceMethod <> '' then begin
PropertyHook.ChainCall(MethodName, Instance.Name, InstanceMethod,
GetTypeData(GetPropType));
end;
end;
end;
end;
}
var var
CreateNewMethod: Boolean; CreateNewMethod: Boolean;
CurValue: ansistring; CurValue: ansistring;
@ -4091,7 +3844,7 @@ var
begin begin
CurValue:=GetValue; CurValue:=GetValue;
if CurValue=NewValue then exit; if CurValue=NewValue then exit;
DebugLn('### TMethodPropertyEditor.SetValue A OldValue="',CurValue,'" NewValue=',NewValue); //DebugLn('### TMethodPropertyEditor.SetValue A OldValue="',CurValue,'" NewValue=',NewValue);
NewMethodExists:=IsValidIdent(NewValue) NewMethodExists:=IsValidIdent(NewValue)
and PropertyHook.MethodExists(NewValue,GetTypeData(GetPropType), and PropertyHook.MethodExists(NewValue,GetTypeData(GetPropType),
NewMethodIsCompatible,NewMethodIsPublished,NewIdentIsMethod); NewMethodIsCompatible,NewMethodIsPublished,NewIdentIsMethod);
@ -4148,13 +3901,13 @@ begin
PropertyHook.ShowMethod(NewValue); PropertyHook.ShowMethod(NewValue);
end; end;
end; end;
DebugLn('### TMethodPropertyEditor.SetValue END NewValue=',GetValue); //DebugLn('### TMethodPropertyEditor.SetValue END NewValue=',GetValue);
end; end;
{ TPersistentPropertyEditor } { TPersistentPropertyEditor }
function TPersistentPropertyEditor.FilterFunc( function TPersistentPropertyEditor.FilterFunc(
const ATestEditor: TPropertyEditor{IProperty}): Boolean; const ATestEditor: TPropertyEditor): Boolean;
begin begin
Result := not (paNotNestable in ATestEditor.GetAttributes); Result := not (paNotNestable in ATestEditor.GetAttributes);
end; end;
@ -4165,7 +3918,7 @@ begin
end; end;
function TPersistentPropertyEditor.GetSelections: function TPersistentPropertyEditor.GetSelections:
TPersistentSelectionList{IDesignerSelections}; TPersistentSelectionList;
var var
I: Integer; I: Integer;
begin begin
@ -4224,13 +3977,10 @@ end;
procedure TPersistentPropertyEditor.GetProperties(Proc:TGetPropEditProc); procedure TPersistentPropertyEditor.GetProperties(Proc:TGetPropEditProc);
var var
LPersistents: TPersistentSelectionList; LPersistents: TPersistentSelectionList;
//LDesigner: TIDesigner;
begin begin
LPersistents := GetSelections; LPersistents := GetSelections;
if LPersistents <> nil then if LPersistents <> nil then
begin begin
//if not Supports(FindRootDesigner(LPersistents[0]), IDesigner, LDesigner) then
// LDesigner := Designer;
GetPersistentProperties(LPersistents, tkAny, PropertyHook, Proc, nil); GetPersistentProperties(LPersistents, tkAny, PropertyHook, Proc, nil);
end; end;
end; end;
@ -4262,7 +4012,7 @@ end;
procedure TPersistentPropertyEditor.GetValues(Proc: TGetStringProc); procedure TPersistentPropertyEditor.GetValues(Proc: TGetStringProc);
begin begin
Proc('(none)'); Proc(oisNone);
if Assigned(PropertyHook) then if Assigned(PropertyHook) then
PropertyHook.GetComponentNames(GetTypeData(GetPropType), Proc); PropertyHook.GetComponentNames(GetTypeData(GetPropType), Proc);
end; end;
@ -4271,13 +4021,13 @@ procedure TPersistentPropertyEditor.SetValue(const NewValue: ansistring);
var Component: TComponent; var Component: TComponent;
begin begin
if NewValue=GetValue then exit; if NewValue=GetValue then exit;
if (NewValue = '') or (NewValue='(none)') then if (NewValue = '') or (NewValue=oisNone) then
Component := nil Component := nil
else begin else begin
if Assigned(PropertyHook) then begin if Assigned(PropertyHook) then begin
Component := PropertyHook.GetComponent(NewValue); Component := PropertyHook.GetComponent(NewValue);
if not (Component is GetTypeData(GetPropType)^.ClassType) then begin if not (Component is GetTypeData(GetPropType)^.ClassType) then begin
raise EPropertyError.Create('Invalid property value'{@SInvalidPropertyValue}); raise EPropertyError.Create(oisInvalidPropertyValue);
end; end;
end; end;
end; end;
@ -4404,7 +4154,8 @@ end;
procedure TComponentNamePropertyEditor.SetValue(const NewValue: ansistring); procedure TComponentNamePropertyEditor.SetValue(const NewValue: ansistring);
begin begin
if (not IsValidIdent(NewValue)) or (NewValue='') then if (not IsValidIdent(NewValue)) or (NewValue='') then
raise Exception.Create('Component name "'+NewValue+'" is not a valid identifier'); raise Exception.Create(Format(oisComponentNameIsNotAValidIdentifier, ['"',
NewValue, '"']));
inherited SetValue(NewValue); inherited SetValue(NewValue);
PropertyHook.ComponentRenamed(TComponent(GetComponent(0))); PropertyHook.ComponentRenamed(TComponent(GetComponent(0)));
end; end;
@ -4748,7 +4499,7 @@ var
begin begin
CurValue := TShortCut(OrdValue); CurValue := TShortCut(OrdValue);
if CurValue = scNone then if CurValue = scNone then
Result := '(None)'//srNone Result := oisNone
else else
Result := ShortCutToText(CurValue); Result := ShortCutToText(CurValue);
end; end;
@ -4757,7 +4508,7 @@ procedure TShortCutPropertyEditor.GetValues(Proc: TGetStrProc);
var var
I: Integer; I: Integer;
begin begin
Proc('(none)'{srNone}); Proc(oisNone);
for I := 1 to High(ShortCuts) do Proc(ShortCutToText(ShortCuts[I])); for I := 1 to High(ShortCuts) do Proc(ShortCutToText(ShortCuts[I]));
end; end;
@ -4766,11 +4517,11 @@ var
NewValue: TShortCut; NewValue: TShortCut;
begin begin
NewValue := 0; NewValue := 0;
if (Value <> '') and (AnsiCompareText(Value, '(none)'{srNone}) <> 0) then if (Value <> '') and (AnsiCompareText(Value, oisNone) <> 0) then
begin begin
NewValue := TextToShortCut(Value); NewValue := TextToShortCut(Value);
if NewValue = 0 then if NewValue = 0 then
raise EPropertyError.Create('Invalid Property Value'{@SInvalidPropertyValue}); raise EPropertyError.Create(oisInvalidPropertyValue);
end; end;
SetOrdValue(NewValue); SetOrdValue(NewValue);
end; end;
@ -4824,7 +4575,7 @@ begin
Parent:= Self; Parent:= Self;
SetBounds(x,y,MaxX-2*x, Height); SetBounds(x,y,MaxX-2*x, Height);
Anchors:= [akLeft, akTop, akRight]; Anchors:= [akLeft, akTop, akRight];
Caption:= '0 lines, 0 chars'; Caption:= ois0Lines0Chars;
end; end;
Memo := TMemo.Create(self); Memo := TMemo.Create(self);
@ -4899,7 +4650,7 @@ end;
procedure TStringsPropEditorDlg.MemoChanged(Sender : TObject); procedure TStringsPropEditorDlg.MemoChanged(Sender : TObject);
begin begin
StatusLabel.Text:= Format('%d lines, %d chars', [Memo.Lines.Count, StatusLabel.Text:= Format(oisDLinesDChars, [Memo.Lines.Count,
(Length(Memo.Lines.Text) - Memo.Lines.Count * Length(LineEnding))]); (Length(Memo.Lines.Text) - Memo.Lines.Count * Length(LineEnding))]);
end; end;
@ -5246,36 +4997,17 @@ begin
end; end;
procedure TSessionPropertiesPropertyEditor.Edit; procedure TSessionPropertiesPropertyEditor.Edit;
var
Dialog: TStringsPropEditorDlg;
s: String;
i: Integer;
c: Char;
begin begin
Dialog:=TStringsPropEditorDlg.Create(nil); With TSelectPropertiesForm.Create(Application) do
try Try
Dialog.Editor:=Self; PropertyComponent:=GetComponent(0) as TComponent;
s:=GetStrValue; SelectedProperties:=GetStrValue;
for i:=1 to length(s) do if s[i]=';' then s[i]:=#10; Caption:=Format(oisPropertiesOf, [TComponent(GetComponent(0)).Name]);
Dialog.Memo.Text:=s; If (ShowModal=mrOK) then
if Dialog.ShowModal=mrOk then begin SetStrValue(SelectedProperties);
s:=Dialog.Memo.Text; Finally
i:=1; Free;
while i<=length(s) do begin
c:=s[i];
if c in [#13,#10] then begin
s[i]:=';';
inc(i);
if (i<=length(s)) and (s[i] in [#10,#13]) and (c<>s[i]) then
System.Delete(s,i,1);
end else
inc(i);
end;
SetStrValue(s);
end; end;
finally
Dialog.Free;
end;
end; end;
//============================================================================== //==============================================================================
@ -6404,10 +6136,8 @@ begin
nil, 'AnchorSideRight', THiddenPropertyEditor); nil, 'AnchorSideRight', THiddenPropertyEditor);
RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('TAnchorSide'), RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('TAnchorSide'),
nil, 'AnchorSideBottom', THiddenPropertyEditor); nil, 'AnchorSideBottom', THiddenPropertyEditor);
{$IFDEF EnableSessionProps}
RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('AnsiString'), RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('AnsiString'),
TCustomPropertyStorage, 'Filename', TFileNamePropertyEditor); TCustomPropertyStorage, 'Filename', TFileNamePropertyEditor);
{$ENDIF}
end; end;
procedure FinalPropEdits; procedure FinalPropEdits;