画像の上に図形を描き、その図形のマウスオーバー時に強調表示 (ID:41116)

名前

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

本文

結局、VCLのリファレンスを読まないことには、目的の動作をするにはどの関数を組み合わせたら良いかは分かりません。
ポリゴン描画で中を透明にしたければ、
image2.Canvas.Brush.Style := bsClear;です。
TImageはあくまで表示専用ですので、
描画を色々変更する場合はその他にイメージを保持しておかなくてはなりません。

YYさんがやりたい事はこんな感じですかね？
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, ExtCtrls, GIFimg;

type
  TMyPolygon = class(TObject)
  private
    fPolygon : array of TPoint;
    function GetCount: Integer;
    procedure SetCount(const Value: Integer);
    function GetPolygon(aIndex: Integer): TPoint;
    procedure SetPolygon(aIndex: Integer; const Value: TPoint);
  public
    function IsIn(aPos:TPoint):Boolean;
    procedure Add(aPos:TPoint);
    procedure Draw(aCanvas:TCanvas; aColor:TColor);
    property Count:Integer read GetCount write SetCount;
    property Polygon[aIndex:Integer]:TPoint read GetPolygon write SetPolygon;
  end;

TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    fPolygon : array of TPoint;
    fMyPolygonInMouse:Boolean;
    fMyPolygon:TMyPolygon;
    fBmp:TBitmap;
    procedure Draw;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//http://delfusa.main.jp/delfusafloor/archive/www.nifty.ne.jp_forum_fdelphi/samples/00786.html
function PolygonExterior(x,y,n:integer;pt:array of TPoint):boolean;
var i,ct,nx,dx,dy,rx,ry:integer;
begin
pt[n]:=pt[0]; {始点は終点と等しいとします}
ct :=0;
 for i:=0 to n-1 do begin
  rx:=x-pt[i].x;
  nx:=x-pt[i+1].x;
   if ((rx<0)and(nx>=0)) or ((rx>=0) and (nx<0))  then begin
    ry:=y-pt[i].y;
    dx:= pt[i+1].x- pt[i].x;
    dy:= pt[i+1].y- pt[i].y;
    if longint(rx)*longint(dy)<longint(ry)*longint(dx)
       then Inc (ct) else Dec(ct);
   end;
  end;
  Result:=ct=0;
end;

{ TMyPolygon }

procedure TMyPolygon.Add(aPos: TPoint);
var
  aCount:Integer;
begin
  aCount := Count;
  SetLength(fPolygon,aCount+1);
  Polygon[aCount]:=aPos;
end;

procedure TMyPolygon.Draw(aCanvas: TCanvas; aColor: TColor);
var
  i: Integer;
begin
  if Count <= 0 then
    Exit;
  aCanvas.Pen.Color := aColor;
  //aCanvas.Brush.Style := bsClear;
  //aCanvas.Polyline(fPolygon);
  aCanvas.MoveTo(Polygon[Count-1].X,Polygon[Count-1].Y);
  for i := 0 to Count-1 do
    aCanvas.LineTo(Polygon[i].X,Polygon[i].Y);
end;

function TMyPolygon.GetCount: Integer;
begin
  Result:=Length(fPolygon);
end;

function TMyPolygon.GetPolygon(aIndex: Integer): TPoint;
begin
  Result := fPolygon[aIndex];
end;

function TMyPolygon.IsIn(aPos: TPoint): Boolean;
begin
  Result:= not PolygonExterior(aPos.X,aPos.Y,Count,fPolygon);
end;

procedure TMyPolygon.SetCount(const Value: Integer);
begin
  SetLength(fPolygon,Value);
end;

procedure TMyPolygon.SetPolygon(aIndex: Integer; const Value: TPoint);
begin
  fPolygon[aIndex]:=Value;
end;

{ TForm1 }

procedure TForm1.Draw;
begin
  Image1.Canvas.Draw(0,0,fBmp);
  if fMyPolygonInMouse then
    fMyPolygon.Draw(Image1.Canvas,clRed) else
    fMyPolygon.Draw(Image1.Canvas,clBlue);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  aGif:TGIFImage;
begin
  fMyPolygon := TMyPolygon.Create;
  aGif := TGIFImage.Create;
  aGif.LoadFromFile('test.gif');
  fBmp := TBitmap.Create;
  fBmp.Assign(aGif);
  aGif.Free;
  Draw;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  fMyPolygon.Count:=0;
  Draw;
  fMyPolygon.Add(Point(X,Y));
  Image1.Canvas.Pen.Color := clAqua;
  Image1.Canvas.MoveTo(X,Y);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  aBool:Boolean;
begin
  if ssLeft in Shift then
  begin
    Image1.Canvas.LineTo(X,Y);
    fMyPolygon.Add(Point(X,Y));
  end else begin
    aBool := fMyPolygonInMouse;
    fMyPolygonInMouse := fMyPolygon.IsIn(Point(X,Y));
    if aBool <> fMyPolygonInMouse then
      Draw;
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  fMyPolygonInMouse := fMyPolygon.IsIn(Point(X,Y));
  Draw;
end;

end.

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

戻る