tutorials
/
lazarus-tutorials
1
0
Fork 0
Code Releases Activity

Fix polymorphic drawing example

This commit is contained in:
Timothy Warren 2021-10-07 17:15:42 -04:00
parent 18f01a9ebc
commit a8c63d1f5a
3 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
drawing demo/drawing.pas
View File

@ -5,7 +5,7 @@ unit drawing;
interface interface
uses uses
Classes, SysUtils, Controls, ExtCtrls, Graphics; Classes, Controls, Graphics;
type TDrawing = class(TGraphicControl) type TDrawing = class(TGraphicControl)
private private

1
drawing demo/drawingdemo.lpi
View File

@ -39,6 +39,7 @@
<Filename Value="drawingdisplay.pas"/> <Filename Value="drawingdisplay.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/> <ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
</Unit1> </Unit1>
<Unit2> <Unit2>

8
drawing demo/drawingdisplay.pas
View File

@ -5,14 +5,14 @@ unit drawingdisplay;
interface interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, drawing; Forms, ExtCtrls, drawing;
type type
{ TForm1 } { TForm1 }
TForm1 = class(TForm) TForm1 = class(TForm)
rgShape: TRadioGroup;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure rgShapeClick(Sender: TObject); procedure rgShapeClick(Sender: TObject);
private private
rgShape: TRadioGroup;
FDrawing: TDrawing; FDrawing: TDrawing;
procedure CreateANewDrawing; procedure CreateANewDrawing;
public public
@ -25,6 +25,8 @@ var
implementation implementation
{$R *.lfm}
procedure TForm1.CreateANewDrawing; procedure TForm1.CreateANewDrawing;
begin begin
if (rgShape.ItemIndex < 0) then Exit; if (rgShape.ItemIndex < 0) then Exit;
@ -56,7 +58,5 @@ begin
CreateANewDrawing; CreateANewDrawing;
end; end;
{$R *.lfm}
end. end.