fixed loading project flags and added RTTI example for readonly properties

git-svn-id: trunk@6373 -
2025-04-09 18:08:35 +02:00 · 2004-12-13 16:43:37 +00:00 · 2004-12-13 16:43:37 +00:00 · 545441282f
commit 545441282f
parent 12e60697a3
13 changed files with 370 additions and 11 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -154,10 +154,15 @@ components/rtticontrols/examples/example1.pas svneol=native#text/pascal
 components/rtticontrols/examples/example2.lfm svneol=native#text/plain
 components/rtticontrols/examples/example2.lrs svneol=native#text/pascal
 components/rtticontrols/examples/example2.pas svneol=native#text/pascal
+components/rtticontrols/examples/example3.lfm svneol=native#text/plain
+components/rtticontrols/examples/example3.lrs svneol=native#text/pascal
+components/rtticontrols/examples/example3.pas svneol=native#text/pascal
 components/rtticontrols/examples/exampleproject1.lpi svneol=native#text/plain
 components/rtticontrols/examples/exampleproject1.lpr svneol=native#text/pascal
 components/rtticontrols/examples/exampleproject2.lpi svneol=native#text/plain
 components/rtticontrols/examples/exampleproject2.lpr svneol=native#text/pascal
+components/rtticontrols/examples/exampleproject3.lpi svneol=native#text/plain
+components/rtticontrols/examples/exampleproject3.lpr svneol=native#text/pascal
 components/rtticontrols/rttictrls.lrs svneol=native#text/pascal
 components/rtticontrols/rttictrls.pas svneol=native#text/pascal
 components/rtticontrols/runtimetypeinfocontrols.lpk svneol=native#text/pascal
--- a/components/rtticontrols/examples/example1.pas
+++ b/components/rtticontrols/examples/example1.pas
@ -14,7 +14,7 @@

  Abstract:
    Example for RTTI controls.
-    Demonstrates a few RTTI controls.
+    Demonstrates a few RTTI controls without any code.
 }
 unit Example1;

--- a/components/rtticontrols/examples/example3.lfm
+++ b/components/rtticontrols/examples/example3.lfm
@ -0,0 +1,61 @@
+object Form1: TForm1
+  ActiveControl = XTIEdit
+  Caption = 'Form1'
+  ClientHeight = 300
+  ClientWidth = 400
+  OnCreate = Form1Create
+  OnDestroy = Form1Destroy
+  OnPaint = Form1Paint
+  PixelsPerInch = 90
+  HorzScrollBar.Page = 401
+  VertScrollBar.Page = 301
+  Left = 290
+  Height = 300
+  Top = 163
+  Width = 400
+  object XTIEdit: TTIEdit
+    TabStop = True
+    TabOrder = 0
+    Left = 80
+    Height = 23
+    Top = 56
+    Width = 80
+  end
+  object YTIEdit: TTIEdit
+    TabStop = True
+    TabOrder = 1
+    Left = 80
+    Height = 23
+    Top = 99
+    Width = 80
+  end
+  object XLabel: TLabel
+    Caption = 'X:'
+    Left = 9
+    Height = 17
+    Top = 62
+    Width = 65
+  end
+  object YLabel: TLabel
+    Caption = 'Y:'
+    Left = 9
+    Height = 17
+    Top = 105
+    Width = 65
+  end
+  object SizeLabel: TLabel
+    Caption = 'Size:'
+    Left = 9
+    Height = 17
+    Top = 148
+    Width = 65
+  end
+  object SizeTIEdit: TTIEdit
+    TabStop = True
+    TabOrder = 5
+    Left = 80
+    Height = 23
+    Top = 142
+    Width = 80
+  end
+end
--- a/components/rtticontrols/examples/example3.lrs
+++ b/components/rtticontrols/examples/example3.lrs
@ -0,0 +1,18 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TForm1','FORMDATA',[
+  'TPF0'#6'TForm1'#5'Form1'#13'ActiveControl'#7#7'XTIEdit'#7'Caption'#6#5'Form1'
+  +#12'ClientHeight'#3','#1#11'ClientWidth'#3#144#1#8'OnCreate'#7#11'Form1Creat'
+  +'e'#9'OnDestroy'#7#12'Form1Destroy'#7'OnPaint'#7#10'Form1Paint'#13'PixelsPer'
+  +'Inch'#2'Z'#18'HorzScrollBar.Page'#3#145#1#18'VertScrollBar.Page'#3'-'#1#4'L'
+  +'eft'#3'"'#1#6'Height'#3','#1#3'Top'#3#163#0#5'Width'#3#144#1#0#7'TTIEdit'#7
+  +'XTIEdit'#7'TabStop'#9#8'TabOrder'#2#0#4'Left'#2'P'#6'Height'#2#23#3'Top'#2
+  +'8'#5'Width'#2'P'#0#0#7'TTIEdit'#7'YTIEdit'#7'TabStop'#9#8'TabOrder'#2#1#4'L'
+  +'eft'#2'P'#6'Height'#2#23#3'Top'#2'c'#5'Width'#2'P'#0#0#6'TLabel'#6'XLabel'#7
+  +'Caption'#6#2'X:'#4'Left'#2#9#6'Height'#2#17#3'Top'#2'>'#5'Width'#2'A'#0#0#6
+  +'TLabel'#6'YLabel'#7'Caption'#6#2'Y:'#4'Left'#2#9#6'Height'#2#17#3'Top'#2'i'
+  +#5'Width'#2'A'#0#0#6'TLabel'#9'SizeLabel'#7'Caption'#6#5'Size:'#4'Left'#2#9#6
+  +'Height'#2#17#3'Top'#3#148#0#5'Width'#2'A'#0#0#7'TTIEdit'#10'SizeTIEdit'#7'T'
+  +'abStop'#9#8'TabOrder'#2#5#4'Left'#2'P'#6'Height'#2#23#3'Top'#3#142#0#5'Widt'
+  +'h'#2'P'#0#0#0
+]);
--- a/components/rtticontrols/examples/example3.pas
+++ b/components/rtticontrols/examples/example3.pas
@ -0,0 +1,144 @@
+{
+ *****************************************************************************
+ *                                                                           *
+ *  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: Mattias Gaertner
+
+  Abstract:
+    Example for RTTI controls.
+    Demonstrates how to write your own property editors to access readonly
+    properties.
+}
+unit Example3;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, RTTICtrls,
+  StdCtrls, PropEdits;
+
+type
+  { TBall - a class with some readonly properties and a procedure to set the
+    properties. }
+
+  TBall = class(TPersistent)
+  private
+    FX: integer;
+    FY: integer;
+    FSize: word;
+  public
+    procedure SetBall(const NewX, NewY: integer; const NewSize: word);
+  published
+    // published readonly properties
+    property X: integer read FX;
+    property Y: integer read FY;
+    property Size: word read FSize;
+  end;
+  
+  { TBallPropertyEditor - a property editor for the TBall properties }
+  
+  TBallPropertyEditor = class(TIntegerPropertyEditor)
+  public
+    procedure SetValue(const NewValue: ansistring);  override;
+  end;
+
+  
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    SizeTIEdit: TTIEdit;
+    XLabel: TLabel;
+    YLabel: TLabel;
+    SizeLabel: TLabel;
+    XTIEdit: TTIEdit;
+    YTIEdit: TTIEdit;
+    procedure Form1Create(Sender: TObject);
+    procedure Form1Destroy(Sender: TObject);
+    procedure Form1Paint(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+    Ball1: TBall;
+  end; 
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{ TBall }
+
+procedure TBall.SetBall(const NewX, NewY: integer; const NewSize: word);
+begin
+  if (FX=NewX) and (FY=NewY) and (FSize=NewSize) then exit;
+  FX:=NewX;
+  FY:=NewY;
+  FSize:=NewSize;
+  Form1.Invalidate;
+end;
+
+{ TForm1 }
+
+procedure TForm1.Form1Create(Sender: TObject);
+begin
+  Ball1:=TBall.Create;
+  Ball1.SetBall(200,100,20);
+  
+  XTIEdit.Link.SetObjectAndProperty(Ball1,'X');
+  YTIEdit.Link.SetObjectAndProperty(Ball1,'Y');
+  SizeTIEdit.Link.SetObjectAndProperty(Ball1,'Size');
+end;
+
+procedure TForm1.Form1Destroy(Sender: TObject);
+begin
+  Ball1.Free;
+end;
+
+procedure TForm1.Form1Paint(Sender: TObject);
+begin
+  with Canvas do begin
+    Brush.Color:=clBlue;
+    Ellipse(Ball1.X-Ball1.Size,Ball1.Y-Ball1.Size,
+            Ball1.X+Ball1.Size,Ball1.Y+Ball1.Size);
+  end;
+end;
+
+{ TBallPropertyEditor }
+
+procedure TBallPropertyEditor.SetValue(const NewValue: ansistring);
+var
+  L: integer;
+  Ball: TBall;
+  X: integer;
+  Y: integer;
+  Size: word;
+  PropName: String;
+begin
+  L := StrToIntDef(NewValue,0);
+  Ball:=GetComponent(0) as TBall;
+  PropName:=GetName;
+  if CompareText(PropName,'X')=0 then X:=L else X:=Ball.X;
+  if CompareText(PropName,'Y')=0 then Y:=L else Y:=Ball.Y;
+  if CompareText(PropName,'Size')=0 then Size:=Word(L) else Size:=Ball.Size;
+  Ball.SetBall(X,Y,Size);
+end;
+
+initialization
+  {$I example3.lrs}
+  RegisterPropertyEditor(TypeInfo(integer),TBall,'X',TBallPropertyEditor);
+  RegisterPropertyEditor(TypeInfo(integer),TBall,'Y',TBallPropertyEditor);
+  RegisterPropertyEditor(TypeInfo(word),TBall,'Size',TBallPropertyEditor);
+
+end.
+
--- a/components/rtticontrols/examples/exampleproject2.lpi
+++ b/components/rtticontrols/examples/exampleproject2.lpi
@ -4,21 +4,26 @@
    <Version Value="5"/>
    <General>
      <MainUnit Value="0"/>
-      <ActiveEditorIndexAtStart Value="0"/>
+      <ActiveEditorIndexAtStart Value="1"/>
      <IconPath Value="./"/>
      <TargetFileExt Value=""/>
      <Title Value="exampleproject2"/>
    </General>
-    <JumpHistory Count="0" HistoryIndex="-1"/>
-    <Units Count="2">
+    <JumpHistory Count="1" HistoryIndex="0">
+      <Position1>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/helpmanager.pas"/>
+        <Caret Line="120" Column="15" TopLine="106"/>
+      </Position1>
+    </JumpHistory>
+    <Units Count="5">
      <Unit0>
        <Filename Value="exampleproject2.lpr"/>
        <IsPartOfProject Value="True"/>
        <UnitName Value="ExampleProject2"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="30"/>
      </Unit0>
      <Unit1>
-        <CursorPos X="11" Y="48"/>
+        <CursorPos X="23" Y="46"/>
        <EditorIndex Value="0"/>
        <Filename Value="example2.pas"/>
        <ComponentName Value="Form1"/>
@ -27,8 +32,31 @@
        <ResourceFilename Value="example2.lrs"/>
        <TopLine Value="22"/>
        <UnitName Value="Example2"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="30"/>
      </Unit1>
+      <Unit2>
+        <CursorPos X="28" Y="47"/>
+        <EditorIndex Value="1"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/helpmanager.pas"/>
+        <Loaded Value="True"/>
+        <TopLine Value="29"/>
+        <UnitName Value="HelpManager"/>
+        <UsageCount Value="15"/>
+      </Unit2>
+      <Unit3>
+        <CursorPos X="20" Y="1803"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/lcl/controls.pp"/>
+        <TopLine Value="1779"/>
+        <UnitName Value="Controls"/>
+        <UsageCount Value="9"/>
+      </Unit3>
+      <Unit4>
+        <CursorPos X="13" Y="144"/>
+        <Filename Value="/home/mattias/pascal/wichtig/lazarus/components/rtticontrols/rttictrls.pas"/>
+        <TopLine Value="125"/>
+        <UnitName Value="RTTICtrls"/>
+        <UsageCount Value="10"/>
+      </Unit4>
    </Units>
    <PublishOptions>
      <Version Value="2"/>
--- a/components/rtticontrols/examples/exampleproject3.lpi
+++ b/components/rtticontrols/examples/exampleproject3.lpi
@ -0,0 +1,76 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="5"/>
+    <General>
+      <Flags>
+        <SaveClosedFiles Value="False"/>
+        <SaveOnlyProjectUnits Value="True"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="exampleproject3"/>
+    </General>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="exampleproject3.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ExampleProject3"/>
+        <UsageCount Value="21"/>
+      </Unit0>
+      <Unit1>
+        <CursorPos X="9" Y="55"/>
+        <EditorIndex Value="0"/>
+        <Filename Value="example3.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <Loaded Value="True"/>
+        <ResourceFilename Value="example3.lrs"/>
+        <TopLine Value="38"/>
+        <UnitName Value="Example3"/>
+        <UsageCount Value="21"/>
+      </Unit1>
+    </Units>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="RunTimeTypeInfoControls"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="3"/>
+    <SearchPaths>
+      <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
--- a/components/rtticontrols/examples/exampleproject3.lpr
+++ b/components/rtticontrols/examples/exampleproject3.lpr
@ -0,0 +1,15 @@
+program ExampleProject3;
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces, // this includes the LCL widgetset
+  Forms
+  { add your units here }, Example3;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
--- a/components/rtticontrols/rttictrls.pas
+++ b/components/rtticontrols/rttictrls.pas
@ -1294,7 +1294,6 @@ begin
  ChangedOptions:=(FOptions-NewOptions)+(NewOptions-FOptions);
  //debugln('TCustomPropertyLink.SetOptions Old=',dbgs(ploReadOnIdle in FOptions),
  //  ' New=',dbgs(ploReadOnIdle in NewOptions),' Changed=',dbgs(ploReadOnIdle in ChangedOptions));
-  RaiseGDBException('');
  FOptions:=NewOptions;
  if (ploReadOnIdle in ChangedOptions) then UpdateIdleHandler;
 end;
@ -1408,7 +1407,7 @@ var
  OldEditorExisted: Boolean;
 begin
  if (FEditor<>nil) or (FTIObject=nil) or (FTIPropertyName='') then exit;
-  //writeln('TCustomPropertyLink.CreateEditor A ',FTIObject.ClassName+':'+FTIPropertyName);
+  //debugln('TCustomPropertyLink.CreateEditor A ',FTIObject.ClassName+':'+FTIPropertyName);
  OldEditorExisted:=FEditor<>nil;
  CreateHook;
  Selection := TPersistentSelectionList.Create;
@ -1419,6 +1418,7 @@ begin
  finally
    Selection.Free;
  end;
+  //debugln('TCustomPropertyLink.CreateEditor B ',dbgsName(FEditor));
  {if FEditor=nil then begin
    raise Exception.Create('Unable to create property editor for '
                           +FTIObject.ClassName+':'+FTIPropertyName);
--- a/ide/project.pp
+++ b/ide/project.pp
@ -360,7 +360,6 @@ type
    fFirst: array[TUnitInfoList] of TUnitInfo;

    fDestroying: boolean;
-    FFlags: TProjectFlags;
    fIconPath: String;
    fJumpHistory: TProjectJumpHistory;
    fLastReadLPIFileDate: TDateTime;
@ -3130,6 +3129,9 @@ end.

 {
  $Log$
+  Revision 1.171  2004/12/13 16:43:37  mattias
+  fixed loading project flags and added RTTI example for readonly properties
+
  Revision 1.170  2004/11/20 11:20:05  mattias
  implemented creating classes at run time from any TComponent descendant

--- a/ideintf/projectintf.pas
+++ b/ideintf/projectintf.pas
@ -459,10 +459,10 @@ type

  TLazProject = class(TPersistent)
  private
-    FFlags: TProjectFlags;
    FLazCompilerOptions: TLazCompilerOptions;
    fTitle: String;
  protected
+    FFlags: TProjectFlags;
    procedure SetLazCompilerOptions(const AValue: TLazCompilerOptions);
    function GetMainFile: TLazProjectFile; virtual; abstract;
    function GetMainFileID: Integer; virtual; abstract;
--- a/lcl/include/buttoncontrol.inc
+++ b/lcl/include/buttoncontrol.inc
@ -45,6 +45,12 @@ begin
  if UseOnChange and Assigned(OnChange) then OnChange(Self);
 end;

+procedure TButtonControl.Loaded;
+begin
+  inherited Loaded;
+  fLastCheckedOnChange:=Checked;
+end;
+
 procedure TButtonControl.Click;
 begin
  DoOnChange;
--- a/lcl/stdctrls.pp
+++ b/lcl/stdctrls.pp
@ -788,6 +788,7 @@ type
    procedure DoOnChange; virtual;
    procedure Click; override;
    function ColorIsStored: boolean; override;
+    procedure Loaded; override;
  protected
    property Checked: Boolean read GetChecked write SetChecked stored IsCheckedStored default False;
    property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled;
@ -1181,6 +1182,9 @@ end.
 { =============================================================================

  $Log$
+  Revision 1.172  2004/12/13 16:43:37  mattias
+  fixed loading project flags and added RTTI example for readonly properties
+
  Revision 1.171  2004/11/03 14:18:35  mattias
  implemented preferred size for controls for theme depending AutoSizing