published TForm.SessionProperties, added property editor and activated the storage components for fpc 1.9.5 because of rttiutils

git-svn-id: trunk@5806 -

ideintf/propedits.pp

@@ -741,6 +741,16 @@ type
   end;
 
 
+{ TSessionPropertiesPropertyEditor
+  PropertyEditor editor for TControl.SessionProperties properties.
+  Show a dialog on Edit. }
+
+  TSessionPropertiesPropertyEditor = class(TStringPropertyEditor)
+  public
+    function GetAttributes: TPropertyAttributes; override;
+    procedure Edit; override;
+  end;
+
 { TListElementPropertyEditor
   A property editor for a single element of a TListPropertyEditor
   This editor simply redirects all methods to the TListPropertyEditor }
@@ -1888,8 +1898,8 @@ type
   TGetStrFunc = function(const StrValue:ansistring):Integer of object;
 var
   I:Integer;
-  Values:TStringList;
+  Values: TStringList;
-  AddValue:TGetStrFunc;
+  AddValue: TGetStrFunc;
 begin
   if not AutoFill then Exit;
   Values:=TStringList.Create;
@@ -4735,6 +4745,46 @@ begin
   Result:='';
 end;
 
+{ TSessionPropertiesPropertyEditor }
+
+function TSessionPropertiesPropertyEditor.GetAttributes: TPropertyAttributes;
+begin
+  Result:=[paDialog,paRevertable];
+end;
+
+procedure TSessionPropertiesPropertyEditor.Edit;
+var
+  Dialog: TStringsPropEditorDlg;
+  s: String;
+  i: Integer;
+  c: Char;
+begin
+  Dialog:=TStringsPropEditorDlg.Create(Application);
+  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);
+    end;
+  finally
+    Dialog.Free;
+  end;
+end;
+
 //==============================================================================
 
 
@@ -5789,6 +5839,8 @@ begin
     nil,'',TCaptionPropertyEditor);
   RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('TStrings'),
     nil,'',TStringsPropertyEditor);
+  RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('AnsiString'),
+    nil,'SessionProperties',TSessionPropertiesPropertyEditor);
   RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('TModalResult'),
     nil,'ModalResult',TModalResultPropertyEditor);
   RegisterPropertyEditor(DummyClassForPropTypes.PTypeInfos('TShortCut'),

lcl/controls.pp

@@ -2355,11 +2355,13 @@ var
   EndPos: LongInt;
   PropertyStr: String;
   AControl: TControl;
+  PointPos: LongInt;
 begin
   ARoot:=Root;
   if ARoot is TControl then begin
     AControl:=TControl(ARoot);
     PropsAsStr:=AControl.SessionProperties;
+    //debugln('PropsAsStr=',PropsAsStr);
     StartPos:=1;
     while (StartPos<=length(PropsAsStr)) do begin
       EndPos:=StartPos;
@@ -2367,6 +2369,15 @@ begin
         inc(EndPos);
       if (EndPos>StartPos) then begin
         PropertyStr:=copy(PropsAsStr,StartPos,EndPos-StartPos);
+        //debugln('A PropertyStr=',PropertyStr);
+        // if no point char, then prepend the owner name as default
+        PointPos:=StartPos;
+        while (PointPos<EndPos) and (PropsAsStr[PointPos]<>'.') do
+          inc(PointPos);
+        if PointPos=EndPos then
+          PropertyStr:=AControl.Name+'.'+PropertyStr;
+        // add to list
+        //debugln('B PropertyStr=',PropertyStr);
         List.Add(PropertyStr);
       end;
       StartPos:=EndPos+1;
@@ -2395,6 +2406,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.235  2004/08/16 20:40:26  mattias
+  published TForm.SessionProperties, added property editor and activated the storage components for fpc 1.9.5 because of rttiutils
+
   Revision 1.234  2004/08/13 16:40:47  mazen
   + TCharater type used to allow UTF8 keyboard with gtk2
 

lcl/forms.pp

@@ -555,9 +555,10 @@ type
     property OnResize;
     property OnShow;
     property ParentFont;
-    property PixelsPerInch stored False;
+    property PixelsPerInch;
     property PopupMenu;
     property Position;
+    property SessionProperties;
     property ShowHint;
     property TextHeight;
     property Visible;

lcl/inipropstorage.pas

@@ -19,6 +19,10 @@ unit IniPropStorage;
 
 interface
 
+{$IFDEF VER1_9_5}
+  {$DEFINE EnableSessionProps}
+{$ENDIF}
+
 {$IFNDEF VER1_0}
 uses
   Classes, SysUtils, Forms, IniFiles, PropertyStorage;
@@ -36,19 +40,19 @@ Type
     FIniFileName: String;
     FIniSection: String;
   protected
-    Function IniFileClass : TIniFileClass; virtual;
+    Function IniFileClass: TIniFileClass; virtual;
     procedure StorageNeeded(ReadOnly: Boolean);override;
     procedure FreeStorage; override;
-    Function GetIniFileName : string; virtual;
+    Function GetIniFileName: string; virtual;
-    Function RootSection : String; Override;
+    Function RootSection: String; Override;
-    Property IniFile : TCustomIniFile Read FIniFile;
+    Property IniFile: TCustomIniFile Read FIniFile;
   public
     function  DoReadString(const Section, Ident, Default: string): string; override;
     procedure DoWriteString(const Section, Ident, Value: string); override;
     procedure DoEraseSections(const ARootSection : String);override;
   public
-    property IniFileName : String Read FIniFileName Write FIniFileName;
+    property IniFileName: String Read FIniFileName Write FIniFileName;
-    property IniSection : String Read FIniSection Write FIniSection;
+    property IniSection: String Read FIniSection Write FIniSection;
   end;
   
   { TIniPropStorage }
@@ -58,7 +62,6 @@ Type
     property IniFileName;
     property IniSection;
     property Active;
-    property StoredValues;
     property OnSaveProperties;
     property OnRestoreProperties;
   end;

lcl/propertystorage.pas

@@ -19,6 +19,10 @@ unit PropertyStorage;
 
 interface
 
+{$IFDEF VER1_9_5}
+  {$DEFINE EnableSessionProps}
+{$ENDIF}
+
 {$IFNDEF VER1_0}
 uses
   Classes, SysUtils, RTLConst

lcl/xmlpropstorage.pas

@@ -19,6 +19,10 @@ unit XMLPropStorage;
 
 interface
 
+{$IFDEF VER1_9_5}
+  {$DEFINE EnableSessionProps}
+{$ENDIF}
+
 {$IFNDEF VER1_0}
 uses
   Classes, SysUtils, Forms, PropertyStorage, XMLCfg, DOM;
@@ -59,7 +63,6 @@ type
     property FileName;
     property RootNodePath;
     property Active;
-    property StoredValues;
     property OnSaveProperties;
     property OnRestoreProperties;
   end;
@@ -131,12 +134,12 @@ function TCustomXMLPropStorage.DoReadString(const Section, Ident, Default: strin
   ): string;
 begin
   Result:=FXML.GetValue(FixPath(Section)+'/'+Ident, Default);
-  writeln('TCustomXMLPropStorage.DoReadString Section=',Section,' Ident=',Ident,' Result=',Result);
+  //debugln('TCustomXMLPropStorage.DoReadString Section=',Section,' Ident=',Ident,' Result=',Result);
 end;
 
 procedure TCustomXMLPropStorage.DoWriteString(const Section, Ident, Value: string);
 begin
-  writeln('TCustomXMLPropStorage.DoWriteString Section=',Section,' Ident=',Ident,' Value=',Value);
+  //debugln('TCustomXMLPropStorage.DoWriteString Section=',Section,' Ident=',Ident,' Value=',Value);
   FXML.SetValue(FixPath(Section)+'/'+Ident, Value);
 end;