背景が透明な線を描画するには、どのようなアプローチが良いか？ (ID:20605)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

別スレッドにあった

（４）OnPaintで実行するコードを持たせたクラスを定義し、それを動的に生成する

について試してみました。大きめに PaintBox1 を貼って、Button1, Button2 を使います。

unit Unit1;

interface

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

type
TEnumZukei = (ezLine, ezEllipse); // 図形クラスの区別

TZukei = class(TObject)  // 図形クラスのベース
public
  ez: TEnumZukei;
  color: TColor;
  width: integer;
end;

TLine = class(TZukei)  // 直線クラス
public
  start, stop: TPoint;
  constructor Create(strt, stp: TPoint); virtual;
end;

TEllipse = class(TZukei)  // 楕円クラス
public
  point1, point2: TPoint;
  constructor Create(pt1, pt2: TPoint); virtual;
end;

TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    ZukeiList: TObjectList;
    h, w: integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TLine.Create(strt, stp: TPoint);
begin
  ez := ezLine;
  start := strt;
  stop := stp;
end;

constructor TEllipse.Create(pt1, pt2: TPoint);
begin
  ez := ezEllipse;
  point1 := pt1;
  point2 := pt2;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ZukeiList := TObjectList.Create(true);
  w := PaintBox1.Width;
  h := PaintBox1.Height;
  Randomize;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  i: integer;
  cvs: TCanvas;
  p1, p2: TPoint;
begin
  if ZukeiList.Count = 0 then exit;

cvs := PaintBox1.Canvas;
  for i := 0 to ZukeiList.Count-1 do
  begin
    cvs.Pen.Color := TZukei(ZukeiList[i]).color;
    cvs.Pen.Width := TZukei(ZukeiList[i]).width;
    cvs.Brush.Style := bsClear;

case TZukei(ZukeiList[i]).ez of

ezLine: begin
        p1 := TLine(ZukeiList[i]).start;
        p2 := TLine(ZukeiList[i]).stop;
        cvs.MoveTo(p1.X, p1.Y);
        cvs.LineTo(p2.X, p2.Y);
      end;

ezEllipse: begin
        p1 := TEllipse(ZukeiList[i]).point1;
        p2 := TEllipse(ZukeiList[i]).point2;
        cvs.Ellipse(p1.X, p1.Y, p2.X, p2.Y);
      end;

end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  line: TLine;
  p1, p2: TPoint;
begin
  p1 := Point(Random(w), Random(h));
  p2 := Point(Random(w), Random(h));
  line := TLine.Create(p1, p2);
  line.color := RGB(Random(256), Random(256), Random(256));
  line.width := Random(6);
  ZukeiList.Add(line);
  PaintBox1.Refresh;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  ellipse: TEllipse;
  p1, p2: TPoint;
begin
  p1 := Point(Random(w), Random(h));
  p2 := Point(Random(w), Random(h));
  ellipse := TEllipse.Create(p1, p2);
  ellipse.color := RGB(Random(256), Random(256), Random(256));
  ellipse.width := Random(6);
  ZukeiList.Add(ellipse);
  PaintBox1.Refresh;
end;

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

end.

Button1Click では、直線クラスを動的に作って ZukeiList に Add したのち、PaintBox1.Refresh; ですべての図形を描きます。
Button2Click では、楕円クラスで同様にします。

←解決時は質問者本人がここをチェックしてください。

戻る