描画中の線や図形を仮表示するには

解決


Delphi大好き  2009-02-25 21:32:26  No: 33464

超初歩的な質問ですいません。
いつも拝見させて貰っています。

描画中の線や図形を仮表示させる際、
XORで描画して表示し、同じ位置に描画し消しますよね?

それが、どうしても出来ません。

Delphiのグラフィックを学習しているのですが、
Delphi付属(D3.1)のサンプルでは難しすぎ解読出来ず、
自前で仮の線や図形を描画させることが出来ません。

簡単に理解できる学習法や、他に仮描画する方法は無いでしょうか?

超初歩的な質問ですいませんm(__;m。


delphi大好き  2009-02-25 22:19:03  No: 33465

色々試したら、自力で何とかここまで出来ました^^。
まだバグバグですが^^;

突っ込みどころあったらよろしくお願いしますm(__)m。

var
  Form1: TForm1;
  x1,y1,x2,y2:integer;
  sw:boolean=false;
implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  sw := true;;
  x1 := x; y1 := y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if sw then begin
    canvas.LineTo(x2,y2);
    Canvas.Pen.Color := clWhite;
    Canvas.Pen.Mode  := pmXor;
    canvas.MoveTo(x1,y1);
    canvas.LineTo(x,y);
  end;
  canvas.MoveTo(x1,y1);
  x2 := x; y2 := y;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  sw := false;
  canvas.LineTo(x2,y2);
end;


delphi大好き  2009-02-26 00:13:58  No: 33466

色々いじってる内に出来ちゃいました^^;
線の方は出来たのですが、図形の場合方も、
同じ要領なのでしょうか?
あとでまた書き込む予定です。
よろしくお願いしますm(__)m。

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if sw then begin
    Canvas.Pen.Color := clWhite;
    Canvas.Pen.Mode  := pmXor;
    canvas.MoveTo(x1,y1);
    canvas.LineTo(x2,y2);
    canvas.MoveTo(x1,y1);
    canvas.LineTo(x,y);
  end;
  canvas.MoveTo(x1,y1);
  x2 := x; y2 := y;
end;


Delphi大好き  2009-02-26 07:29:58  No: 33467

幸運にも自力解決出来ました^^。

一応同じ初心者の人に役に立てばと思い、
ソースだけ載せていきます。
相談掲示板に感謝です^^。
それとソース長文すいませんです;

var
  Form1: TForm1;
  x1,y1,x2,y2,tool:integer;
  sw:boolean=false;
  sw2:boolean=false;
implementation
const
  line   =0;
  rect   =1;
{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  sw := true;
  x1 := x; y1 := y;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  case tool of
  line: begin
    if sw then begin
      sw2 := true;
      Canvas.Pen.Color := clWhite;
      Canvas.Pen.Mode  := pmXor;
      canvas.MoveTo(x1,y1);
      canvas.LineTo(x2,y2);
      canvas.MoveTo(x1,y1);
      canvas.LineTo(x,y);
    end;
    canvas.MoveTo(x1,y1);
    x2 := x; y2 := y;
  end;

  rect:begin
    if sw then begin
      Canvas.Pen.Color := clWhite;
      Canvas.Pen.Mode  := pmXor;
      canvas.Rectangle(x1,y1,x2,y2);
      canvas.Rectangle(x1,y1,x,y);
    end;
    x2:=x; y2:=y;
  end;

  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case tool of
  line:begin
    sw := false;
    if not sw2 then
    exit;
    Canvas.Pen.Color := clred;
    Canvas.Pen.Mode  := pmcopy;
    canvas.LineTo(x2,y2);
    sw2 := false;
  end;

  rect:begin
    Canvas.Pen.Color := clred;
    Canvas.Pen.Mode  := pmcopy;
    canvas.Rectangle(x1,y1,x,y);
    sw := false;
  end;

  end;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  tool := RadioGroup1.ItemIndex;
end;


※返信する前に利用規約をご確認ください。

※Google reCAPTCHA認証からCloudflare Turnstile認証へ変更しました。






  このエントリーをはてなブックマークに追加