diff --git a/.gitattributes b/.gitattributes index 5468257ac4..9ef4e6c6bf 100644 --- 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 diff --git a/components/rtticontrols/examples/example1.pas b/components/rtticontrols/examples/example1.pas index aa36af32f2..10f0ab52de 100644 --- 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; diff --git a/components/rtticontrols/examples/example3.lfm b/components/rtticontrols/examples/example3.lfm new file mode 100644 index 0000000000..f6454955d2 --- /dev/null +++ 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 diff --git a/components/rtticontrols/examples/example3.lrs b/components/rtticontrols/examples/example3.lrs new file mode 100644 index 0000000000..254e7e3273 --- /dev/null +++ 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 +]); diff --git a/components/rtticontrols/examples/example3.pas b/components/rtticontrols/examples/example3.pas new file mode 100644 index 0000000000..85c137c837 --- /dev/null +++ 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. + diff --git a/components/rtticontrols/examples/exampleproject2.lpi b/components/rtticontrols/examples/exampleproject2.lpi index dda0df6ca0..ff56710965 100644 --- a/components/rtticontrols/examples/exampleproject2.lpi +++ b/components/rtticontrols/examples/exampleproject2.lpi @@ -4,21 +4,26 @@ - + </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"/> diff --git a/components/rtticontrols/examples/exampleproject3.lpi b/components/rtticontrols/examples/exampleproject3.lpi new file mode 100644 index 0000000000..c4ede465d5 --- /dev/null +++ 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> diff --git a/components/rtticontrols/examples/exampleproject3.lpr b/components/rtticontrols/examples/exampleproject3.lpr new file mode 100644 index 0000000000..26120f4b23 --- /dev/null +++ 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. + diff --git a/components/rtticontrols/rttictrls.pas b/components/rtticontrols/rttictrls.pas index e316f377db..edd774f650 100644 --- 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); diff --git a/ide/project.pp b/ide/project.pp index 3d96a9390f..35af86e5cd 100644 --- 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 diff --git a/ideintf/projectintf.pas b/ideintf/projectintf.pas index 45571b54a0..78337e7df3 100644 --- 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; diff --git a/lcl/include/buttoncontrol.inc b/lcl/include/buttoncontrol.inc index 968b67ab02..14ac11ba63 100644 --- 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; diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index 3d45915c48..030710ebbe 100644 --- 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