Delphi. Фигуры Лиссажу

Решил немного побаловаться, вспомнить институт и нарисовать в VCL фигуры Лиссажу. Исходный код частично взял на одном из форумов, немного доработал. Рисовал прямоугольником на Canvas. Получилось вот что…

Исходный код получился таким…

unit Lissagu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, ExtCtrls, ComCtrls;

type

  TMainForm = class(TForm)
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    Image: TImage;
    tbX: TTrackBar;
    pnl1: TPanel;
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    Timer: TTimer;
    bStart: TButton;
    Label1: TLabel;
    tbY: TTrackBar;
    bClearCanvas: TButton;
    procedure bStartClick(Sender: TObject);
    procedure tbXChange(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tbYChange(Sender: TObject);
    procedure bClearCanvasClick(Sender: TObject);
  private
    FRunning:Boolean;
    function SignalX:single;
    function SignalY:single;
    procedure Draw;

    procedure ClearCanvas;

  public
    t:single;
    Scale: TPoint;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.bClearCanvasClick(Sender: TObject);
begin
 bStartClick(Self);
 ClearCanvas;


  FRunning := false;
  Timer.Enabled := false;
  bStart.Caption := 'Start';
  t:=0;

end;





procedure TMainForm.bStartClick(Sender: TObject);
begin
  ClearCanvas;
  if not FRunning then
  begin
    bStart.Caption := 'Stop';
    Image.Canvas.Brush.Color:=clWhite;
    Image.Canvas.FillRect(Image.ClientRect);
  end
  else
  begin
    bStart.Caption := 'Start';
    t:=0;
  end;

  FRunning := not FRunning;
  Timer.Enabled := FRunning;

end;

procedure TMainForm.ClearCanvas;
var MyRect:Trect; P:TPoint;
begin

canvas.fillrect(Image.canvas.cliprect);
canvas.fillrect(canvas.cliprect);



end;

procedure TMainForm.Draw;
// Процедура рисует маленьким прямоугольником
var
  center:TPoint;
  pt:TPoint;
begin
  center:=Point(Image.width div 2, Image.height div 2);
  pt.X := center.X+Round(scale.X* signalX());
  pt.Y := center.Y+Round(scale.Y* signalY());

  //Ставим точку в виде прямоугольника
  Image.Canvas.Brush.Color := clBLue;
  Image.Canvas.Rectangle(pt.X-3,pt.Y-3,pt.X+3,pt.Y+3);  // Drawing with Rectangle

end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  ClearCanvas;
  Scale := Point(tbX.Position,tbY.Position);
end;

Function TMainForm.SignalX:single;
begin
  Result:=Sin(SpinEdit1.Value*t);
end;

function TMainForm.SignalY:single;
begin
  Result:=Sin(SpinEdit2.Value*t);
end;

procedure TMainForm.tbXChange(Sender: TObject);
begin
  Scale.x := tbX.Position;
end;

procedure TMainForm.tbYChange(Sender: TObject);
begin
  Scale.Y := tbY.Position;
end;

procedure TMainForm.TimerTimer(Sender: TObject);
begin
  t:=t+0.05;
  draw
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

unit Lissagu;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Spin, ExtCtrls, ComCtrls;

type

TMainForm = class(TForm)

SpinEdit1: TSpinEdit;

SpinEdit2: TSpinEdit;

Image: TImage;

tbX: TTrackBar;

pnl1: TPanel;

lbl1: TLabel;

lbl2: TLabel;

lbl3: TLabel;

Timer: TTimer;

bStart: TButton;

Label1: TLabel;

tbY: TTrackBar;

bClearCanvas: TButton;

procedure bStartClick(Sender: TObject);

procedure tbXChange(Sender: TObject);

procedure TimerTimer(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure tbYChange(Sender: TObject);

procedure bClearCanvasClick(Sender: TObject);

private

FRunning:Boolean;

function SignalX:single;

function SignalY:single;

procedure Draw;

procedure ClearCanvas;

public

t:single;

Scale: TPoint;

end;

var

MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.bClearCanvasClick(Sender: TObject);

begin

bStartClick(Self);

ClearCanvas;

FRunning := false;

Timer.Enabled := false;

bStart.Caption := 'Start';

t:=0;

end;

procedure TMainForm.bStartClick(Sender: TObject);

begin

ClearCanvas;

if not FRunning then

begin

bStart.Caption := 'Stop';

Image.Canvas.Brush.Color:=clWhite;

Image.Canvas.FillRect(Image.ClientRect);

end

else

begin

bStart.Caption := 'Start';

t:=0;

end;

FRunning := not FRunning;

Timer.Enabled := FRunning;

end;

procedure TMainForm.ClearCanvas;

var MyRect:Trect; P:TPoint;

begin

canvas.fillrect(Image.canvas.cliprect);

canvas.fillrect(canvas.cliprect);

end;

procedure TMainForm.Draw;

// Процедура рисует маленьким прямоугольником

var

center:TPoint;

pt:TPoint;

begin

center:=Point(Image.width div 2, Image.height div 2);

pt.X := center.X+Round(scale.X* signalX());

pt.Y := center.Y+Round(scale.Y* signalY());

//Ставим точку в виде прямоугольника

Image.Canvas.Brush.Color := clBLue;

Image.Canvas.Rectangle(pt.X-3,pt.Y-3,pt.X+3,pt.Y+3); // Drawing with Rectangle

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

ClearCanvas;

Scale := Point(tbX.Position,tbY.Position);

end;

Function TMainForm.SignalX:single;

begin

Result:=Sin(SpinEdit1.Value*t);

end;

function TMainForm.SignalY:single;

begin

Result:=Sin(SpinEdit2.Value*t);

end;

procedure TMainForm.tbXChange(Sender: TObject);

begin

Scale.x := tbX.Position;

end;

procedure TMainForm.tbYChange(Sender: TObject);

begin

Scale.Y := tbY.Position;

end;

procedure TMainForm.TimerTimer(Sender: TObject);

begin

t:=t+0.05;

draw

end;

end.

Delphi. Фигуры Лиссажу

MY PROJECTS

Recent Posts

Categories