From 01daa56c3844e099b3635176b325d8f031360d02 Mon Sep 17 00:00:00 2001 From: mattias Date: Sat, 30 Jul 2005 20:09:09 +0000 Subject: [PATCH] added new session property storage editor from Michael VC git-svn-id: trunk@7459 - --- .gitattributes | 3 + designer/objinspext.pas | 4 + ideintf/allideintf.pas | 2 +- ideintf/frmselectprops.lfm | 187 ++++++++++++++++++++ ideintf/frmselectprops.lrs | 53 ++++++ ideintf/frmselectprops.pas | 276 +++++++++++++++++++++++++++++ ideintf/objinspstrconsts.pas | 10 +- ideintf/propedits.pp | 328 ++++------------------------------- 8 files changed, 562 insertions(+), 301 deletions(-) create mode 100644 ideintf/frmselectprops.lfm create mode 100644 ideintf/frmselectprops.lrs create mode 100644 ideintf/frmselectprops.pas diff --git a/.gitattributes b/.gitattributes index 6f59161927..35eaf9076c 100644 --- a/.gitattributes +++ b/.gitattributes @@ -951,6 +951,9 @@ ideintf/fieldslist.lfm svneol=native#text/plain ideintf/fieldslist.lrs svneol=native#text/pascal ideintf/fieldslist.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/helpfpdoc.pas svneol=native#text/pascal ideintf/helphtml.pas svneol=native#text/pascal diff --git a/designer/objinspext.pas b/designer/objinspext.pas index 52ed3f1602..44fd058d21 100644 --- a/designer/objinspext.pas +++ b/designer/objinspext.pas @@ -93,6 +93,10 @@ begin Add(TCustomCheckBox,'Checked'); Add(TCustomRadioGroup,'Items'); Add(TCustomRadioGroup,'ItemIndex'); + Add(TCustomForm,'OnCreate'); + Add(TCustomForm,'OnDestroy'); + Add(TCustomForm,'OnResize'); + Add(TCustomListBox,'Items'); Result.DeleteDoubles; end; diff --git a/ideintf/allideintf.pas b/ideintf/allideintf.pas index 89890a943a..5c81d45832 100644 --- a/ideintf/allideintf.pas +++ b/ideintf/allideintf.pas @@ -25,7 +25,7 @@ uses ImageListEditor, ComponentTreeView, ActionsEditor, HelpIntf, TextTools, FormEditingIntf, SrcEditorIntf, ComponentReg, PackageIntf, HelpHTML, FieldsEditor, ConfigStorage, HelpFPDoc, ProjectIntf, LazIDEIntf, NewItemIntf, - MacroIntf, MenuIntf; + MacroIntf, MenuIntf, FrmSelectProps; implementation diff --git a/ideintf/frmselectprops.lfm b/ideintf/frmselectprops.lfm new file mode 100644 index 0000000000..6203787885 --- /dev/null +++ b/ideintf/frmselectprops.lfm @@ -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 diff --git a/ideintf/frmselectprops.lrs b/ideintf/frmselectprops.lrs new file mode 100644 index 0000000000..f3943daea9 --- /dev/null +++ b/ideintf/frmselectprops.lrs @@ -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 +]); diff --git a/ideintf/frmselectprops.pas b/ideintf/frmselectprops.pas new file mode 100644 index 0000000000..54028928d7 --- /dev/null +++ b/ideintf/frmselectprops.pas @@ -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. + diff --git a/ideintf/objinspstrconsts.pas b/ideintf/objinspstrconsts.pas index b27fff7b40..7218b486cb 100644 --- a/ideintf/objinspstrconsts.pas +++ b/ideintf/objinspstrconsts.pas @@ -189,6 +189,7 @@ resourcestring oiStdActDataSetEditHint = 'Edit'; oiStdActDataSetPostHint = 'Post'; oiStdActDataSetCancel1Hint = 'Cancel'; + oisComponents = 'Components'; oiStdActDataSetRefreshHint = 'Refresh'; oisStdActionListEditor = 'Standard Action Classes'; @@ -196,11 +197,18 @@ resourcestring // TFileNamePropertyEditor oisSelectAFile = 'Select a file'; + oisPropertiesOf = 'Properties of %s'; oisAllFiles = 'All files (*.*)|*.*'; // property editors oisSort = 'Sort'; + oisDLinesDChars = '%d lines, %d chars'; 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 ' +'unable to find file %s%s%s.'; oisHelpTheMacroSInBrowserParamsWillBeReplacedByTheURL = 'The macro %s in ' @@ -231,7 +239,7 @@ resourcestring oisClearPicture = 'Clear picture'; oisLoad = '&Load'; oisSave = '&Save'; - oisCLear = 'C&lear'; + oisClear = 'C&lear'; oisErrorLoadingImage = 'Error loading image'; oisErrorLoadingImage2 = 'Error loading image %s%s%s:%s%s'; diff --git a/ideintf/propedits.pp b/ideintf/propedits.pp index 414ea49d0b..db5ffa1444 100644 --- a/ideintf/propedits.pp +++ b/ideintf/propedits.pp @@ -19,12 +19,7 @@ For more information see the big comment part below. ToDo: - -digits for floattypes -> I hope, I guessed right -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" -> taking my own @@ -39,19 +34,13 @@ unit PropEdits; interface -{$IFNDEF VER1_0} - {$DEFINE EnableSessionProps} -{$ENDIF} {$DEFINE NewListPropEdit} uses Classes, TypInfo, SysUtils, LCLProc, Forms, Controls, GraphType, Graphics, StdCtrls, Buttons, ComCtrls, Menus, LCLType, ExtCtrls, LCLIntf, Dialogs, - Grids, EditBtn, - {$IFDEF EnableSessionProps} - PropertyStorage, - {$ENDIF} - TextTools, ColumnDlg, ObjInspStrConsts; + Grids, EditBtn, PropertyStorage, TextTools, FrmSelectProps, ColumnDlg, + ObjInspStrConsts; const MaxIdentLength: Byte = 63; @@ -2085,199 +2074,6 @@ begin IValue:=0; 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; begin with FPropList^[Index] do Result:=GetFloatProp(Instance,PropInfo); @@ -2336,15 +2132,6 @@ end; function TPropertyEditor.GetName:shortstring; begin 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; function TPropertyEditor.GetOrdValue:Longint; @@ -3063,11 +2850,7 @@ end; function TFloatPropertyEditor.GetValue: ansistring; const - Precisions: array[TFloatType] of Integer = (7, 15, 19, 19, 19 -{$ifdef VER1_0} - , 15, 31 -{$endif VER1_0} - ); + Precisions: array[TFloatType] of Integer = (7, 15, 19, 19, 19); begin Result := FloatToStrF(GetFloatValue, ffGeneral, Precisions[GetTypeData(GetPropType)^.FloatType], 0); @@ -4037,11 +3820,6 @@ begin and (Result[1] in ['O','o']) and (Result[2] in ['N','n']) then 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; function TMethodPropertyEditor.GetValue: ansistring; @@ -4051,37 +3829,12 @@ end; procedure TMethodPropertyEditor.GetValues(Proc: TGetStringProc); begin -DebugLn('### TMethodPropertyEditor.GetValues'); - Proc('(None)'); + //DebugLn('### TMethodPropertyEditor.GetValues'); + Proc(oisNone); PropertyHook.GetMethods(GetTypeData(GetPropType), Proc); end; 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 CreateNewMethod: Boolean; CurValue: ansistring; @@ -4091,7 +3844,7 @@ var begin CurValue:=GetValue; if CurValue=NewValue then exit; - DebugLn('### TMethodPropertyEditor.SetValue A OldValue="',CurValue,'" NewValue=',NewValue); + //DebugLn('### TMethodPropertyEditor.SetValue A OldValue="',CurValue,'" NewValue=',NewValue); NewMethodExists:=IsValidIdent(NewValue) and PropertyHook.MethodExists(NewValue,GetTypeData(GetPropType), NewMethodIsCompatible,NewMethodIsPublished,NewIdentIsMethod); @@ -4148,13 +3901,13 @@ begin PropertyHook.ShowMethod(NewValue); end; end; -DebugLn('### TMethodPropertyEditor.SetValue END NewValue=',GetValue); + //DebugLn('### TMethodPropertyEditor.SetValue END NewValue=',GetValue); end; { TPersistentPropertyEditor } function TPersistentPropertyEditor.FilterFunc( - const ATestEditor: TPropertyEditor{IProperty}): Boolean; + const ATestEditor: TPropertyEditor): Boolean; begin Result := not (paNotNestable in ATestEditor.GetAttributes); end; @@ -4165,7 +3918,7 @@ begin end; function TPersistentPropertyEditor.GetSelections: - TPersistentSelectionList{IDesignerSelections}; + TPersistentSelectionList; var I: Integer; begin @@ -4224,13 +3977,10 @@ end; procedure TPersistentPropertyEditor.GetProperties(Proc:TGetPropEditProc); var LPersistents: TPersistentSelectionList; - //LDesigner: TIDesigner; begin LPersistents := GetSelections; if LPersistents <> nil then begin - //if not Supports(FindRootDesigner(LPersistents[0]), IDesigner, LDesigner) then - // LDesigner := Designer; GetPersistentProperties(LPersistents, tkAny, PropertyHook, Proc, nil); end; end; @@ -4262,7 +4012,7 @@ end; procedure TPersistentPropertyEditor.GetValues(Proc: TGetStringProc); begin - Proc('(none)'); + Proc(oisNone); if Assigned(PropertyHook) then PropertyHook.GetComponentNames(GetTypeData(GetPropType), Proc); end; @@ -4271,13 +4021,13 @@ procedure TPersistentPropertyEditor.SetValue(const NewValue: ansistring); var Component: TComponent; begin if NewValue=GetValue then exit; - if (NewValue = '') or (NewValue='(none)') then + if (NewValue = '') or (NewValue=oisNone) then Component := nil else begin if Assigned(PropertyHook) then begin Component := PropertyHook.GetComponent(NewValue); if not (Component is GetTypeData(GetPropType)^.ClassType) then begin - raise EPropertyError.Create('Invalid property value'{@SInvalidPropertyValue}); + raise EPropertyError.Create(oisInvalidPropertyValue); end; end; end; @@ -4404,7 +4154,8 @@ end; procedure TComponentNamePropertyEditor.SetValue(const NewValue: ansistring); begin 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); PropertyHook.ComponentRenamed(TComponent(GetComponent(0))); end; @@ -4748,7 +4499,7 @@ var begin CurValue := TShortCut(OrdValue); if CurValue = scNone then - Result := '(None)'//srNone + Result := oisNone else Result := ShortCutToText(CurValue); end; @@ -4757,7 +4508,7 @@ procedure TShortCutPropertyEditor.GetValues(Proc: TGetStrProc); var I: Integer; begin - Proc('(none)'{srNone}); + Proc(oisNone); for I := 1 to High(ShortCuts) do Proc(ShortCutToText(ShortCuts[I])); end; @@ -4766,11 +4517,11 @@ var NewValue: TShortCut; begin NewValue := 0; - if (Value <> '') and (AnsiCompareText(Value, '(none)'{srNone}) <> 0) then + if (Value <> '') and (AnsiCompareText(Value, oisNone) <> 0) then begin NewValue := TextToShortCut(Value); if NewValue = 0 then - raise EPropertyError.Create('Invalid Property Value'{@SInvalidPropertyValue}); + raise EPropertyError.Create(oisInvalidPropertyValue); end; SetOrdValue(NewValue); end; @@ -4824,7 +4575,7 @@ begin Parent:= Self; SetBounds(x,y,MaxX-2*x, Height); Anchors:= [akLeft, akTop, akRight]; - Caption:= '0 lines, 0 chars'; + Caption:= ois0Lines0Chars; end; Memo := TMemo.Create(self); @@ -4899,7 +4650,7 @@ end; procedure TStringsPropEditorDlg.MemoChanged(Sender : TObject); 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))]); end; @@ -5246,36 +4997,17 @@ begin end; procedure TSessionPropertiesPropertyEditor.Edit; -var - Dialog: TStringsPropEditorDlg; - s: String; - i: Integer; - c: Char; begin - Dialog:=TStringsPropEditorDlg.Create(nil); - try - Dialog.Editor:=Self; - s:=GetStrValue; - for i:=1 to length(s) do if s[i]=';' then s[i]:=#10; - Dialog.Memo.Text:=s; - if Dialog.ShowModal=mrOk then begin - s:=Dialog.Memo.Text; - i:=1; - 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); + With TSelectPropertiesForm.Create(Application) do + Try + PropertyComponent:=GetComponent(0) as TComponent; + SelectedProperties:=GetStrValue; + Caption:=Format(oisPropertiesOf, [TComponent(GetComponent(0)).Name]); + If (ShowModal=mrOK) then + SetStrValue(SelectedProperties); + Finally + Free; end; - finally - Dialog.Free; - end; end; //============================================================================== @@ -6404,10 +6136,8 @@ begin nil, 'AnchorSideRight', THiddenPropertyEditor); RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('TAnchorSide'), nil, 'AnchorSideBottom', THiddenPropertyEditor); - {$IFDEF EnableSessionProps} RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('AnsiString'), TCustomPropertyStorage, 'Filename', TFileNamePropertyEditor); - {$ENDIF} end; procedure FinalPropEdits;