diff --git a/polymorphic class/mainform.lfm b/polymorphic class/mainform.lfm new file mode 100644 index 0000000..ab48e2f --- /dev/null +++ b/polymorphic class/mainform.lfm @@ -0,0 +1,36 @@ +object MainForm: TMainForm + Left = 417 + Height = 240 + Top = 298 + Width = 320 + Caption = 'MainForm' + ClientHeight = 240 + ClientWidth = 320 + OnCreate = FormCreate + LCLVersion = '2.0.12.0' + object rgPeople: TRadioGroup + Left = 16 + Height = 185 + Top = 16 + Width = 281 + AutoFill = True + Caption = 'Chose a TPerson Instance' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 166 + ClientWidth = 271 + Items.Strings = ( + 'David Beckham' + 'William Shakespeare' + 'Mae West' + 'Blaise Pascal' + ) + OnClick = rgPeopleClick + TabOrder = 0 + end +end diff --git a/polymorphic class/person.pas b/polymorphic class/person.pas new file mode 100644 index 0000000..887dece --- /dev/null +++ b/polymorphic class/person.pas @@ -0,0 +1,60 @@ +unit person; + +{$mode objfpc}{$H+} + +interface + +uses Dialogs; + +type + TPerson = class + procedure Speak; virtual; abstract; + end; + + {TBeckham} + TBeckham = class(TPerson) + procedure Speak; override; + end; + + {TShakespeare} + TShakespeare = class(TPerson) + procedure Speak; override; + end; + + {TWest} + TWest = class(TPerson) + procedure Speak; override; + end; + + {TBlaise} + TBlaise = class(TPerson) + procedure Speak; override; + end; + +implementation + + {TBlaise} + procedure TBlaise.Speak; + begin + ShowMessage('Le coeur a ses raisons que la raison ne connait point'); + end; + + {TWest} + procedure TWest.Speak; + begin + ShowMessage('I used to be Snow White... but I drifted'); + end; + + {TShakespeare} + procedure TShakespeare.Speak; + begin + ShowMessage('The robbed that smiles steals something from the thief'); + end; + + {TBeckham} + procedure TBeckham.Speak; + begin + ShowMessage('I''ve got more clothes than Victoria!'); + end; +end. + diff --git a/polymorphic class/polymorphic.ico b/polymorphic class/polymorphic.ico new file mode 100644 index 0000000..0341321 Binary files /dev/null and b/polymorphic class/polymorphic.ico differ diff --git a/polymorphic class/polymorphic.lpi b/polymorphic class/polymorphic.lpi new file mode 100644 index 0000000..cf76a0c --- /dev/null +++ b/polymorphic class/polymorphic.lpi @@ -0,0 +1,84 @@ + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="3"> + <Unit0> + <Filename Value="polymorphic.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="unitmain.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + <Unit2> + <Filename Value="person.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="polymorphic"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf2Set"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/polymorphic class/polymorphic.lpr b/polymorphic class/polymorphic.lpr new file mode 100644 index 0000000..474fca2 --- /dev/null +++ b/polymorphic class/polymorphic.lpr @@ -0,0 +1,22 @@ +program polymorphic; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, unitmain, person + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + Application.CreateForm(TMainForm, Form1); + Application.Run; +end. + diff --git a/polymorphic class/unitmain.pas b/polymorphic class/unitmain.pas new file mode 100644 index 0000000..4ccadbe --- /dev/null +++ b/polymorphic class/unitmain.pas @@ -0,0 +1,51 @@ +unit unitmain; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, person; + +type + +{ TMainform } + TMainform = class(TForm) + rgPeople: TRadioGroup; + procedure FormCreate(Sender: TObject); + procedure rgPeopleClick(Sender: TObject); + end; + +var + Form1: TMainform; + +implementation + +{$R mainform.lfm} + +{ TMainform } + +procedure TMainform.FormCreate(Sender: TObject); +begin + +end; + +procedure TMainform.rgPeopleClick(Sender: TObject); +var p: TPerson; +begin + if rgPeople.ItemIndex < 0 then Exit; + + // Select the appropriate Person + case rgPeople.ItemIndex of + 0: p := TBeckham.Create; + 1: p := TShakespeare.Create; + 2: p := TWest.Create; + 3: p := TBlaise.Create; + end; + + p.Speak; + p.Free; +end; + +end. +