Adds an example for testing motion graphics

git-svn-id: trunk@34346 -
This commit is contained in:
sekelsenmat 2011-12-21 10:57:34 +00:00
parent 829de72590
commit 4a93ca7438
7 changed files with 249 additions and 0 deletions

6
.gitattributes vendored
View File

@ -3804,6 +3804,12 @@ examples/messages/uasynccall.lfm svneol=native#text/plain
examples/messages/uasynccall.pas svneol=native#text/plain
examples/messages/unit1.lfm svneol=native#text/plain
examples/messages/unit1.pas svneol=native#text/pascal
examples/motiongraphics/mainform.lfm svneol=native#text/plain
examples/motiongraphics/mainform.pas svneol=native#text/pascal
examples/motiongraphics/motiongraphics.ico -text
examples/motiongraphics/motiongraphics.lpi svneol=native#text/plain
examples/motiongraphics/motiongraphics.lpr svneol=native#text/pascal
examples/motiongraphics/motiongraphics.res -text
examples/multithreading/criticalsectionexample1.lpi svneol=native#text/plain
examples/multithreading/criticalsectionexample1.lpr svneol=native#text/plain
examples/multithreading/criticalsectionunit1.lfm svneol=native#text/plain

View File

@ -0,0 +1,37 @@
object Form1: TForm1
Left = 323
Height = 240
Top = 171
Width = 320
Caption = 'Motion Graphics Test'
ClientHeight = 240
ClientWidth = 320
OnPaint = FormPaint
LCLVersion = '0.9.31'
object Label1: TLabel
Left = 6
Height = 18
Top = 6
Width = 46
Caption = 'Speed:'
ParentColor = False
end
object trackSpeed: TTrackBar
Left = 56
Height = 31
Top = 8
Width = 256
Frequency = 10
Max = 100
Min = 10
OnChange = trackSpeedChange
Position = 30
TabOrder = 0
end
object timerRedraw: TTimer
Interval = 100
OnTimer = timerRedrawTimer
left = 99
top = 133
end
end

View File

@ -0,0 +1,95 @@
unit mainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, ComCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Label1: TLabel;
timerRedraw: TTimer;
trackSpeed: TTrackBar;
procedure FormPaint(Sender: TObject);
procedure timerRedrawTimer(Sender: TObject);
procedure trackSpeedChange(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
CurStep: Double;
procedure RotatePolygon(var APoints: array of TPoint; AAngle: Double);
function RotatePoint(APoint, ACenter: TPoint; AAngle: Double): TPoint;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.timerRedrawTimer(Sender: TObject);
begin
CurStep := CurStep + 0.1;
if CurStep > 360 then CurStep := 0;
Form1.Invalidate;
end;
procedure TForm1.trackSpeedChange(Sender: TObject);
begin
timerRedraw.Interval := 1000 div trackSpeed.Position;
end;
procedure TForm1.RotatePolygon(var APoints: array of TPoint; AAngle: Double);
var
lCenter: TPoint;
i: Integer;
begin
lCenter := Point(0, 0);
for i := 0 to Length(APoints)-1 do
begin
lCenter.X := lCenter.X + APoints[i].X;
lCenter.Y := lCenter.Y + APoints[i].Y;
end;
lCenter.X := lCenter.X div Length(APoints);
lCenter.Y := lCenter.Y div Length(APoints);
for i := 0 to Length(APoints)-1 do
APoints[i] := RotatePoint(APoints[i], lCenter, AAngle);
end;
function TForm1.RotatePoint(APoint, ACenter: TPoint; AAngle: Double): TPoint;
var
dx, dy: Double;
begin
dx := (ACenter.Y * Sin(AAngle)) - (ACenter.X * Cos(AAngle)) + ACenter.X;
dy := -(ACenter.X * Sin(AAngle)) - (ACenter.Y * Cos(AAngle)) + ACenter.Y;
Result.X := Round((APoint.X * Cos(AAngle)) - (APoint.Y * Sin(AAngle)) + dx);
Result.Y := Round((APoint.X * Sin(AAngle)) + (APoint.Y * Cos(AAngle)) + dy);
end;
procedure TForm1.FormPaint(Sender: TObject);
var
lPoints: array[0..2] of TPoint;
begin
lPoints[0].X := 100;
lPoints[0].Y := 100;
lPoints[1].X := 200;
lPoints[1].Y := 0;
lPoints[2].X := 200;
lPoints[2].Y := 200;
RotatePolygon(lPoints, CurStep);
Canvas.Polygon(lPoints);
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,90 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<MacroValues Count="1">
<Macro1 Name="LCLWidgetType" Value="customdrawn"/>
</MacroValues>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="motiongraphics.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="motiongraphics"/>
</Unit0>
<Unit1>
<Filename Value="mainform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="motiongraphics"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,21 @@
program motiongraphics;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, mainform
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Binary file not shown.