描画中の線や図形を仮表示するには (ID:33467)

名前

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

本文

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

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

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;

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

戻る