Using Multiple Coded Forms
How to combine the code from several canvas projects into a form-based project
All of the Smart Pascal contributions to date have been canvas projects. Here we show that motion graphics can perform well in form-based projects. The starting point in the development of the demo Compendium was the supplied Mega Demo in the Forms & Components section, and a little of the original code remains unaltered. We reuse much of the code of contributions by Felix Thompson (Ball Trajectory and MaxCircles), Alex Karet (BlendingEllipses) and George Wright (ObjectMovingBalls).
- Start a new visual components project.
- To prevent overwriting another project in the same folder, make Unit1 internal (and do not save a copy of it).
- Remove the form (because all of the forms are created in code). You can simply select it in the Project Manager then press the Delete key.
- Save the project as Compendium.
- Copy and paste the code of Unit1 below to replace the original.
- Click on Compendium in the Project Manager and replace the project code with the code of Compendium.spr below.
The visual graphics become slow when they are being computed simultaneously, so we allow the user to view each one then free it and remove that option from the menu.
If the program does not work, try another browser such as Chrome. If you see no display at school, the security system might have blocked it. You can try instead this direct link to the program running on its own page.
Code of Unit1
We developed this code using Version 2.2 of Smart Mobile Studio. Download the project file of an update that compiles with Version 3.0 from here.
unit Unit1; { Motion Graphics copyright (c) 2014 Alex Karet (BlendingEllipses), Felix Thompson (MaxCircles and BallTrajectory) and George Wright (ObjectMovingBalls) Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License, as described at http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/ Motion Graphics included in Compendium by PPS, 2016 } interface uses System.Types, System.Colors, System.Lists, SmartCL.System, SmartCL.Controls, SmartCL.Components, SmartCL.Forms, SmartCL.Graphics, SmartCL.Application, SmartCL.Effects, SmartCL.Time; type THeaderForm = class(TW3CustomForm) private FHeader: TW3HeaderControl; protected procedure Resize; override; procedure InitializeObject; override; procedure FinalizeObject; override; public property Header: TW3HeaderControl read FHeader; end; TBaseView = class(TW3GraphicControl) // Base view for four motion graphics views public FTimer: TW3EventRepeater; FFrameCount: integer; protected procedure FinalizeObject; override; end; TBaseForm = class(THeaderForm) // Base form for four motion graphics forms public FView: TBaseView; protected procedure InitializeObject; override; end; TMainForm = class(THeaderForm) private FMenu: TW3ListMenu; FBallTrajectory, FMaxCircles, FBlendingEllipses, FObjectMovingBalls: TW3ListItem; procedure HandleMenuItemClicked(Sender: TObject); protected procedure Resize; override; procedure InitializeObject; override; procedure FinalizeObject; override; end; // BallTrajectory TBallTrajectoryView = class(TBaseView) private t: Integer; mX, mY, vX, vY : Real; protected procedure Paint; override; procedure InitializeObject; override; end; TBallTrajectoryForm = class(TBaseForm) public FBallTrajectoryView: TBallTrajectoryView; protected procedure InitializeObject; override; end; // Max Circles TMaxCirclesView = class(TBaseView) private PastX, PastY, PastR : Array [1..100000] of Integer; Colour1, Colour2, Colour3, CircleCount, W, HW, CurX, CurY, CurR, MaxX, MaxY, MaxR : Integer; protected procedure Paint; override; procedure InitializeObject; override; end; TMaxCirclesForm = class(TBaseForm) public FMaxCirclesView: TMaxCirclesView; protected procedure InitializeObject; override; end; // BlendingEllipses TBlendingEllipsesView = class(TBaseView) private first: boolean = true; protected procedure Paint; override; procedure InitializeObject; override; end; TBlendingEllipsesForm = class(TBaseForm) public FBlendingEllipsesView: TBlendingEllipsesView; protected procedure InitializeObject; override; end; // ObjectMovingBalls TBall = class(TObject) private x, y, width, height : float; colour : string; Speed : integer; public constructor create(newX, newY, newHeight, newWidth: float; newColour: string; newSpeed : integer); procedure move; end; TObjectMovingBallsView = class(TBaseView) private const DELAY = 50; Ball : array [0..6] of TBall; Timer : integer; protected procedure Paint; override; procedure InitializeObject; override; end; TObjectMovingBallsForm = class(TBaseForm) public FObjectMovingBallsView: TObjectMovingBallsView; protected procedure InitializeObject; override; end; implementation procedure TBaseView.FinalizeObject; begin if Assigned(FTimer) then FTimer.Free; inherited; end; // BallTrajectory procedure TBallTrajectoryView.InitializeObject; begin inherited; mX := 150; // The ball starts in the centre of the mY := 150; // screen after each refresh. vX := (100 - RandomInt(200)); // A random horizontal and vY := 20* (10 - RandomInt(20)); // vertical velocity is chosen. w3_setStyle(Handle, 'backgroundColor', '#FFFFFF'); end; procedure TBallTrajectoryView.Paint; begin inc(FFrameCount); if FFrameCount < 30 then exit; Canvas.FillStyle := 'white'; Canvas.FillRectF(0, 0, 600, 600); //The screen in drawn with edges. Canvas.FillStyle := 'Black'; Canvas.FillRectF(0, 299 , 300, 1); Canvas.FillStyle := 'Black'; Canvas.FillRectF(299, 0, 1, 300); Canvas.FillStyle := 'Black'; Canvas.FillRectF(0, 0 , 300, 1); Canvas.FillStyle := 'Black'; Canvas.FillRectF(0, 0, 1, 300); t += 1; vY := vY - 0.2 * t; //Vertical velocity always increases downwards - gravity. mY -= 0.1 * vY; //The speeds are added to the current location mX -= 0.1 * vX; //to give the new position. if mY + 10 >= 300 then //This stops the ball from going underground, begin //it reverses its direction on collision and vy := -vY * 0.9; //loses a factor of its speed - restitution. mY := 290; end; if mY - 10 <= 0 then begin vy := -vY * 0.9; mY := 10; end; if (mX + 10 >= 300) AND (Abs(vX) > 0.01) then begin vX := -vX * 0.9; mX := 290; end; // The same happens here but for the walls. if (mX - 10 <= 0) AND (Abs(vX) > 0.01) then begin vX := -vX * 0.9; mX := 10; end; //If the ball is on the ground it loses if (mY = 290) then //horizontal speed - friction. begin vX := vX * 0.95; end; Canvas.FillStyle := 'Black'; //The ball is drawn Canvas.BeginPath; Canvas.Ellipse(Round(mX) + 10, Round(mY) + 10, Round(mX) -10, Round(mY) - 10); Canvas.Fill; end; procedure TBallTrajectoryForm.InitializeObject; begin inherited; Header.Title.Caption := 'BallTrajectory by Felix Thompson'; FView := TBallTrajectoryView.Create(Self); FView.SetBounds(10, 50, 300, 300); end; // MaxCircles procedure TMaxCirclesView.InitializeObject; begin inherited; Randomize; W := 300; // The width is set and the half-width is calculated HW := W DIV 2; // as they are both used repeatedly w3_setStyle(Handle, 'backgroundColor', '#000000'); end; procedure TMaxCirclesView.Paint; var Count, Count2, Count3 : Integer; begin inc(FFrameCount); if FFrameCount < 50 then exit; if CircleCount = 0 then begin //The screen is drawn a specific Canvas.FillStyle := 'Black'; //colour when the program starts. Canvas.FillRect(0, 0, W, W); end; Colour1 := RandomInt(175); Colour2 := RandomInt(100) + 156; //The colours are biased to be Colour3 := RandomInt(100) + 100; //certain hues. CurX := RandomInt(W + 1); //The first circle is plotted CurY := RandomInt(W + 1); //randomly. CurR := HW - ABS(HW - CurX); if CurR > (HW - ABS(HW - CurY)) then //This makes the radius such that CurR := HW - ABS(HW - CurY); //it touches the closest edge. MaxR := 0; if CircleCount <> 0 then begin for Count := 1 to W do begin CurX := Count; for Count2 := 1 to W do begin //This scans through each pixel CurY := Count2; //and determines the maximum size //of a circle plotted at that point CurR := HW - ABS(HW - CurX); if CurR > (HW - ABS(HW - CurY)) then CurR := HW - ABS(HW - CurY); //Here it finds the radius that makes for Count3 := 1 to CircleCount do //it touch the edge of another circle. begin if CurR > (Sqrt(Sqr(CurX - PastX[Count3]) + Sqr(CurY - PastY[Count3])) - PastR[Count3]) then CurR := Round(Sqrt(Sqr(CurX - PastX[Count3]) + Sqr(CurY - PastY[Count3])) - PastR[Count3]); if CurR <= 0 then Break; //If the pixel is inside a circle it is end; //discounted if CurR > MaxR then begin //It checks if it is the largest possible MaxX := CurX; //circle drawable. If it is it saves the point MaxY := CurY; MaxR := CurR; end; end; end; CurX := MaxX; //The centre and radius of the largest CurY := MaxY; //circle is loaded for use. CurR := MaxR; end; if CurR <> 0 then //Checks that the circle has size. begin Canvas.FillStyle := 'rgb('+IntToStr(Colour1)+ ',' + IntToStr(Colour2) + ',' + IntToStr(Colour3) + ')'; Canvas.BeginPath; //Draw the circle. Canvas.Ellipse(CurX - CurR, CurY - CurR, CurX + CurR, CurY + CurR); Canvas.Fill; Inc(CircleCount); //The location and size is saved PastX[CircleCount] := CurX; //so the circles will not overlap. PastY[CircleCount] := CurY; PastR[CircleCount] := CurR; end; end; procedure TMaxCirclesForm.InitializeObject; begin inherited; Header.Title.Caption := 'MaxCircles by Felix Thompson'; FView := TMaxCirclesView.Create(Self); FView.SetBounds(10, 50, 300, 300); end; // BlendingEllipses procedure TBlendingEllipsesView.InitializeObject; begin inherited; Randomize; AlphaBlend := True; w3_setStyle(Handle, 'backgroundColor', '#000000'); end; procedure TBlendingEllipsesView.Paint; var Draw: array [1..4] of integer; color: integer; begin inc(FFrameCount); if FFrameCount < 30 then exit; // Clear background if first then begin Canvas.FillStyle := 'black'; Canvas.FillRectF(0, 0, 600, 400); first := False; end; draw[1] := RandomInt(600); draw[2] := RandomInt(400); draw[3] := draw[1] + RandomInt(100); draw[4] := draw[2] + RandomInt(100); color := round((random * 10) / 2); Canvas.FillStyle := 'rgba(' + inttostr(randomint(255)) + ',' + inttostr(randomint(255)) + ',' + inttostr(randomint(255)) + ',' + floattostr(random / 2) + ')'; Canvas.BeginPath; Canvas.Ellipse(draw[1], draw[2], draw[3], draw[4]); Canvas.Fill; end; procedure TBlendingEllipsesForm.InitializeObject; begin inherited; Header.Title.Caption := 'BlendingEllipses by Alex Karet'; FView := TBlendingEllipsesView.Create(Self); FView.SetBounds(10, 50, 600, 400); end; // ObjectMovingBalls constructor TBall.create(newX, newY, newHeight, newWidth : float; newColour : string; newSpeed : integer); begin x := newX; y := newY; height := newHeight; width := newWidth; colour := newColour; speed := newSpeed; end; procedure TBall.move; begin if (x < 300 - width) and (y <= 0) then x += speed; if (x >= 300 - width) and (y < 300 - height) then y += speed; if (x > 0) and (y >= 300 - height) then x -= speed; if (y > 0) and (x <= 0) then y -= speed; if x > 300 - width then x := 300 - width; if x < 0 then x := 0; if y < 0 then y := 0; if y > 300 - height then y := 300 - height; end; procedure TObjectMovingBallsView.InitializeObject; begin inherited; Randomize; Timer := 0; //newX, newY, newHeight, newWidth, newColour, newSpeed Ball[0] := TBall.create(- DELAY, 0, DELAY - 10, DELAY - 10, 'red', 1); Ball[1] := TBall.create(- DELAY * 2, 0, DELAY - 10, DELAY - 10, 'orange', 2); Ball[2] := TBall.create(- DELAY * 3, 0, DELAY - 10, DELAY - 10, 'yellow', 3); Ball[3] := TBall.create(- DELAY * 4, 0, DELAY - 10, DELAY - 10, 'green', 4); Ball[4] := TBall.create(- DELAY * 5, 0, DELAY - 10, DELAY - 10, 'blue', 5); Ball[5] := TBall.create(- DELAY * 6, 0, DELAY - 10, DELAY - 10, 'purple', 6); Ball[6] := TBall.create(- DELAY * 7, 0, DELAY - 10, DELAY - 10, 'rgb(153, 50, 204)', 7); w3_setStyle(Handle, 'backgroundColor', '#FFFFFF'); end; procedure TObjectMovingBallsView.Paint; var i: integer; begin inc(FFrameCount); if FFrameCount < 30 then exit; if Timer = 0 then begin // Clear background Canvas.FillStyle := 'white'; Canvas.FillRectF(0, 0, 400, 400); end; while i <= 6 do begin Canvas.FillStyle := (Ball[i].colour); Canvas.BeginPath; Canvas.Ellipse(Ball[i].x, Ball[i].y, Ball[i].x + Ball[i].width, Ball[i].y + Ball[i].height); Canvas.ClosePath; Canvas.Fill; Ball[i].move; inc(i); end; i := 0; Timer += 1; end; procedure TObjectMovingBallsForm.InitializeObject; begin inherited; Header.Title.Caption := 'ObjectMovingBalls by George Wright'; FView := TObjectMovingBallsView.Create(Self); FView.SetBounds(10, 50, 600, 400); end; procedure TMainForm.InitializeObject; begin inherited; Header.BackButton.Visible := False; Header.Title.Caption := Application.Name; FMenu := TW3ListMenu.Create(Self); FMenu.Enabled := True; FBallTrajectory := FMenu.Items.Add; FBallTrajectory.Text := 'BallTrajectory by Felix Thompson'; FBallTrajectory.TagValue := 1; FBallTrajectory.OnClick := HandleMenuItemClicked; FMaxCircles := FMenu.Items.Add; FMaxCircles.Text := 'MaxCircles by Felix Thompson'; FMaxCircles.TagValue := 2; FMaxCircles.OnClick := HandleMenuItemClicked; FBlendingEllipses := FMenu.Items.Add; FBlendingEllipses.Text := 'BlendingEllipses by Alex Karet'; FBlendingEllipses.TagValue := 3; FBlendingEllipses.OnClick := HandleMenuItemClicked; FObjectMovingBalls := FMenu.Items.Add; FObjectMovingBalls.Text := 'ObjectMovingBalls by GeorgeWright'; FObjectMovingBalls.TagValue := 4; FObjectMovingBalls.OnClick := HandleMenuItemClicked; var Quit := FMenu.Items.Add; Quit.Text := 'Quit'; Quit.TagValue := 5; Quit.OnClick := HandleMenuItemClicked; end; procedure TMainForm.FinalizeObject; begin FMenu.Free; inherited; end; procedure TMainForm.HandleMenuItemClicked(Sender: TObject); begin if TW3ListItem(Sender).TagValue = 5 then begin Application.Terminate; exit; end; var TargetForm := Application.Forms[TW3ListItem(Sender).TagValue]; Application.GotoFormByRef(TargetForm, feFromRight); case TW3ListItem(Sender).TagValue of 1: begin var View := TBallTrajectoryForm(TargetForm).FView; View.FTimer := TW3EventRepeater.Create(lambda View.Paint end, 20); FMenu.Items.RemoveByRef(FBallTrajectory); end; 2: begin var View := TMaxCirclesForm(TargetForm).FView; View.FTimer := TW3EventRepeater.Create(lambda View.Paint end, 10); FMenu.Items.RemoveByRef(FMaxCircles); end; 3: begin var View := TBlendingEllipsesForm(TargetForm).FView; View.FTimer := TW3EventRepeater.Create(lambda View.Paint end, 1); FMenu.Items.RemoveByRef(FBlendingEllipses); end; 4: begin var View := TObjectMovingBallsForm(TargetForm).FView; View.FTimer := TW3EventRepeater.Create(lambda View.Paint end, 20); FMenu.Items.RemoveByRef(FObjectMovingBalls); end; end; end; procedure TMainForm.Resize; var DeltaY: Integer; begin inherited; if Assigned(FMenu) then begin DeltaY := 108; FMenu.SetBounds(10, DeltaY, Width - 20, Height - 20); end; end; procedure TBaseForm.InitializeObject; begin inherited; Header.BackButton.OnClick := lambda FView.Free; Application.GotoFormByRef(Application.Forms[0], feToLeft); end; end; procedure THeaderForm.InitializeObject; begin inherited; FHeader := TW3HeaderControl.Create(Self); FHeader.Height := 44; FHeader.BackButton.Visible := True; FHeader.Title.AlignText := taLeft; end; procedure THeaderForm.FinalizeObject; begin FHeader.Free; inherited; end; procedure THeaderForm.Resize; begin inherited Resize; FHeader.SetBounds(0, 0, ClientWidth, 44); end; end.
Code of Compendium.spr
uses SmartCL.System, SmartCL.Application, Unit1; {$IFDEF SMART_INTERNAL_HANDLE_EXCEPTIONS} try {$ENDIF} var Application := TW3CustomApplication.Create; Application.CreateForm(TMainForm, True); Application.CreateForm(TBallTrajectoryForm); Application.CreateForm(TMaxCirclesForm); Application.CreateForm(TBlendingEllipsesForm); Application.CreateForm(TObjectMovingBallsForm); Application.RunApp; {$IFDEF SMART_INTERNAL_HANDLE_EXCEPTIONS} except on e: Exception do ShowMessage(e.Message); end; {$ENDIF}