円（ここでは1/4円）を描く過程を見る

解決

QA 2009-04-13 00:46:31 No: 33987

以下は円（ここでは1/4円）を描く過程を見るためのプログラムです。このフォームだけじっと見ていると(^^;)意図したとおりの動きをするのですが、他のソフトでフォームを隠す意地悪をすると先に行き過ぎてしまいます。これを避けるためにはどうしたらいいでしょう？
//実座標から表示座標を求める
function TForm1.RealToDispX(x: Extended): Integer;
begin
Result := Round(FOx+x*20);
end;

function TForm1.RealToDispY(y: Extended): Integer;
begin
Result := Round(FOy-y*20);
end;

procedure TForm1.FDrawCircleRadius(TargetCanvas: TCanvas);
begin
  with TargetCanvas do
  begin //円の半径を描く
    Pen.Width := 1;
    Pen.Color := clGreen;
    FTh := FTh+Pi/36;   //角度の変化（180/36 = 5度）
    FEx := 10*Sin(FTh);
    FEy := 10*Cos(FTh);
    Pen.Color := clGreen;
    MoveTo( RealToDispX(0),RealToDispY(0) );
    LineTo( RealToDispX(FEx),RealToDispY(FEy) );
  end;
end;

procedure TForm1.FDrawCircle(TargetCanvas: TCanvas; Last: Integer);
var
  i: Integer;
  Ex,Ey,Th : Extended;
begin  //円を描く
  with TargetCanvas do
  begin
    Pen.Width := 1;
    Pen.Color := clGreen;
    Th := 0;    Ex := 0;    Ey := 10;
    MoveTo( RealToDispX(Ex),RealToDispY(Ey) );
    i := 0;
    while i < Last do
    begin
      Th := Th+Pi/36;
      Ex := 10*Sin(Th);    Ey := 10*Cos(Th);
      LineTo( RealToDispX(Ex),RealToDispY(Ey) );
      Inc(i,20); //5:全円 10:半円 20:1/4円
    end;
  end;
end;

procedure TForm1.FDraw;
begin
  FUraBmp.Canvas.Brush.Color := clWhite;
  FUraBmp.Canvas.FillRect(PaintBox1.Canvas.ClipRect);
  FDrawCircleRadius(FUraBmp.Canvas);
  FDrawCircle(FUraBmp.Canvas,Fi);
  PaintBox1.Canvas.Draw(0, 0, FUraBmp);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Fi := 20;  //5:全円 10:半円 20:1/4円
  FTh := 0;   FEx := 0;  FEy := 0;
  FOx := PaintBox1.Width div 2;   //原点-x
  FOy := PaintBox1.Height div 2;  //原点-y
  FUraBmp := TBitmap.Create;  //裏画面
  FUraBmp.Width := PaintBox1.Width;
  FUraBmp.Height := PaintBox1.Height;
  Timer1.Interval := 500;
  Timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FUraBmp.Free;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
FDraw;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Inc(Fi,20);  //5:全円 10:半円 20:1/4円
  PaintBox1Paint(Nil);
  if Fi >= 360 then
  begin
    Fi := 0;     FTh := 0;
    FEx := 0;    FEy := 0;
  end;
end;

end.

KHE00221 2009-04-13 01:49:12 No: 33988

>他のソフトでフォームを隠す意地悪をすると先に行き過ぎてしまいます。
これは
PaintBox の上の他のウィンドウを動かすと
procedure TForm1.PaintBox1Paint(Sender: TObject);
が呼ばれてしまうので
Timer1Timer(Sender: TObject); で呼んでいる以上に
PaintBox1Paint(Nil);が実行されている為です。

なので
FDrawCircleRadius(TargetCanvas: TCanvas); にある

FTh := FTh+Pi/36; //角度の変化（180/36 = 5度）

をTimer1Timerに移動させればよいでしょう

QA 2009-04-13 04:08:29 No: 33989

> Timer1Timer(Sender: TObject); で呼んでいる以上に
> PaintBox1Paint(Nil);が実行されている為です。
ああ、そのとおりですね。ありがとうございました。