長方形や円の図形を少しずつ移動していくような作業をするプログラムを書くには？
長方形や円の図形を少しずつ移動していくような作業をするプログラムを教えてください。よろしくお願いします。
「長方形や円の図形」というのがTShapeであれば移動は簡単。
Canvasに描いた図形を動かしたいなら「描画、消す、位置を変えて描画」を繰り返すことになるでしょう。
ありがとうございます！
ただ本当に初心者すぎて、できればソースの例をアップしていただけないでしょうか。ぶしつけですがよろしくお願いします。
ちなみにpaintboxで図形は描きます。
フォームにPaintBoxを置いて・・・
procedure TForm1.Button1Click(Sender: TObject);
const
x: integer = 10;
y: integer = 10;
begin
PaintBox1.Canvas.Brush.Color := clBtnFace;
PaintBox1.Canvas.Pen.Color := clBtnFace;
PaintBox1.Canvas.Rectangle(x, y, x+10, y+10);
inc(x); inc(y);
PaintBox1.Canvas.Brush.Color := clRed;
PaintBox1.Canvas.Pen.Color := clBlue;
PaintBox1.Canvas.Rectangle(x, y, x+10, y+10);
end;
新規フォームに
Timer1: TTimer;
PaintBox1: TPaintBox;
を貼付け
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
のイベントを追加して下記ソースを実行してみてください。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
//図形
TMyShape = class
private
ax : Integer;
ay : Integer;
public
Velocity: Integer;
Angle : Double;
x : Double;
y : Double;
Color : TColor;
procedure CountUp();
procedure Draw(aBMP:TBitmap); virtual;
end;
//四角
TMyRect = class(TMyShape)
public
Width : Integer;
Height : Integer;
procedure Draw(aBMP:TBitmap); override;
end;
//丸
TMyCircle = class(TMyShape)
public
r : Integer;
procedure Draw(aBMP:TBitmap); override;
end;
//フォーム
TForm1 = class(TForm)
Timer1: TTimer;
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private 宣言 }
aMyRect : array [0..10] of TMyRect;
aMyCircle : array [0..10] of TMyCircle;
fBitmap : TBitmap;
procedure Timer1Timer(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure WMEraseBkGnd(var Msg: TMessage); message WM_ERASEBKGND;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//少しカッコいい描画(オマケ)
procedure Darker(aBMP: TBitmap);
var
p : PInteger;
a,r,g,b:Byte;
i,color: Integer;
begin
aBMP.PixelFormat := pf32bit;
p := aBMP.ScanLine[aBMP.Height-1];
for i := 0 to aBMP.Width*aBMP.Height - 1 do
begin
r := p^;
g := p^ shr 8;
b := p^ shr 16;
if r <> 0 then dec(r);
if g <> 0 then dec(g);
if b <> 0 then dec(b);
p^ := RGB(r,g,b);
inc(p);
end;
end;
{ TMyShape }
procedure TMyShape.Draw(aBMP: TBitmap);
begin
aBMP.Canvas.Pen.Color := Color;
aBMP.Canvas.Brush.Color:= Color;
ax := Round(x) mod aBMP.Width;
ay := Round(y) mod aBMP.Height;
if ax < 0 then ax := aBMP.Width + ax;
if ay < 0 then ay := aBMP.Height + ay;
end;
procedure TMyShape.CountUp();
begin
x := x + Velocity * Cos(Angle);
y := y + Velocity * Sin(Angle);
end;
{ TMyRect }
procedure TMyRect.Draw(aBMP: TBitmap);
begin
inherited;
aBMP.Canvas.Rectangle(ax-Width div 2,
ay-Height div 2,
ax+Width div 2,
ay+Height div 2);
end;
{ TMyCircle }
procedure TMyCircle.Draw(aBMP: TBitmap);
begin
inherited;
aBMP.Canvas.Ellipse(ax-r,
ay-r,
ax+r,
ay+r);
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var i:Integer;
begin
for i := 0 to Length(aMyRect) - 1 do
begin
aMyRect[i] := TMyRect.Create;
aMyRect[i].x := Random(ClientWidth);
aMyRect[i].y := Random(ClientHeight);
aMyRect[i].Width := 10 + Random(20);
aMyRect[i].Height := 10 + Random(20);
aMyRect[i].Velocity := 1 + Random(3);
aMyRect[i].Angle := 2*Pi/360 * Random(360);
aMyRect[i].Color := RGB(Random(255),Random(255),Random(255));
end;
for i := 0 to Length(aMyCircle) - 1 do
begin
aMyCircle[i] := TMyCircle.Create;
aMyCircle[i].x := Random(ClientWidth);
aMyCircle[i].y := Random(ClientHeight);
aMyCircle[i].r := 10 + Random(20);
aMyCircle[i].Velocity := 1 + Random(3);
aMyCircle[i].Angle := 2*Pi/360 * Random(360);
aMyCircle[i].Color := RGB(Random(255),Random(255),Random(255));
end;
fBitmap := TBitmap.Create;
fBitmap.Width := PaintBox1.Width;
fBitmap.Height:= PaintBox1.Height;
Timer1.Enabled := True;
Timer1.Interval := 1;
Timer1.OnTimer := Timer1Timer;
PaintBox1.Align := alClient;
PaintBox1.OnPaint:= PaintBox1Paint;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var i:Integer;
begin
Timer1.Enabled := False;
for i := 0 to Length(aMyRect) - 1 do
aMyRect[i].Free;
for i := 0 to Length(aMyCircle) - 1 do
aMyCircle[i].Free;
fBitmap.Free;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
fBitmap.Width := PaintBox1.Width;
fBitmap.Height := PaintBox1.Height;
fBitmap.Canvas.Pen.Color := clBlack;
fBitmap.Canvas.Brush.Color:= clBlack;
fBitmap.Canvas.Rectangle(0,0,fBitmap.Width,fBitmap.Height);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0,0,fBitmap);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var i:Integer;
begin
fBitmap.Canvas.Pen.Color := clBlack;
fBitmap.Canvas.Brush.Color:= clBlack;
fBitmap.Canvas.Rectangle(0,0,fBitmap.Width,fBitmap.Height);
//カッコよく描画したい場合は↑をコメントアウトして
//↓行を実行
//Darker(fBitmap);
for i := 0 to Length(aMyRect) - 1 do
begin
aMyRect[i].Draw(fBitmap);
aMyRect[i].CountUp();
end;
for i := 0 to Length(aMyCircle) - 1 do
begin
aMyCircle[i].Draw(fBitmap);
aMyCircle[i].CountUp();
end;
PaintBox1.Repaint;
end;
procedure TForm1.WMEraseBkGnd(var Msg: TMessage);
begin
Msg.Result := 0;
end;
end.
お二人ともありがとうございます。明日にならないと試せない状況なのですが、明日さっそくやらせていただきたいと思います。
| ツイート |  |