您的位置: 首页  >  IT文章  >  Delphi  >  GDI+命中有关问题，小弟我放了一张Gif图片就无法命中，不放就可以

GDI+命中有关问题，小弟我放了一张Gif图片就无法命中，不放就可以

分类: IT文章 • 2024-04-18 12:54:30
GDI+命中问题，我放了一张Gif图片就无法命中，不放就可以
Delphi(Pascal) code

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,Winapi.GDIPAPI,Winapi.GDIPOBJ,Winapi.GDIPUTIL,
  Vcl.StdCtrls, Vcl.ExtCtrls,Vcl.Imaging.pngimage,Vcl.Imaging.GIFImg;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  i:Integer=10;
  path,Path1,Path2: TGPGraphicsPath;
  g:TGPGraphics;
  p: TGPPen;
  pen:TGPpen;
  newimg:TImage;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin
 if Timer1.Enabled then
 Timer1.Enabled:=False
 else
 Timer1.Enabled:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
 var
 gif:TGIFImage;
begin
gif:=TGIFImage.Create;
gif.LoadFromFile('F:\Program Files\duowan\yy-4\4.16.0.5\yygame_image\未命名.gif');
gif.Animate:=True;
 newimg:=TImage.Create(Self);
 newimg.Picture.Assign(gif);
 newimg.Left:=10;
 newimg.Top:=20;
 newimg.AutoSize:=true;
 //newimg.Parent:=Form1;  //GIF图片随着线冒一起动
 newimg.Transparent:=True;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
try
if path.IsOutlineVisible(x,y,p,g) then  Text:='在基础线上';
if Path1.IsVisible(MakePoint(x,y)) then   Text:='在圆内';
if path2.IsOutlineVisible(x,y,pen,g) then Text:='在线上';
except
  //
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if Button=mbLeft then
begin
if path.IsOutlineVisible(x,y,p,g) then ShowMessage('左键在基础先上按下并弹起');
//if Path2.IsOutlineVisible(x,y,pen,g) then ShowMessage('左键在线上按下并弹起');
end;

end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  g := TGPGraphics.Create(Canvas.Handle);
  p:= TGPPen.Create(aclGray, 2);
  path:=TGPGraphicsPath.Create;
  path.AddLine(10,20,300,20);
  Path1 := TGPGraphicsPath.Create;
  Path1.AddEllipse(MakeRect(i+2,15,5,5));
  Path2 := TGPGraphicsPath.Create;
  Path2.AddLine(10,20,I,20);
  g.DrawPath(p,path);
  g.DrawPath(Pen,Path1);
  g.DrawPath(Pen,Path2);
  p.Free;
  g.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  image:TGPImage;
begin
I:=I+1;
Repaint;
g := TGPGraphics.Create(Canvas.Handle);
image:=TGPImage.Create('F:\Program Files\duowan\yy-4\4.16.0.5\yygame_image\yg_ico_gametool_n.png');
Pen := TGPPen.Create(aclWhite,2);
g.DrawPath(Pen,Path1);
g.DrawPath(Pen,Path2);
g.DrawImage(image,MakeRect(i,15,10,10));
newimg.Left:=i;
end;


新手，代码写的很乱。。
其实是想自己画一个播放器的那个条条，QQ音乐上面后面也带了GIF图片的效果，实现是可以，但是无法命中，去除GIF图片后就可以命中，求高手帮帮忙

------解决方案--------------------
不是很理解你的“命中”是指命中什么东西，如果是因newimg阻挡了窗体点击，可以按下面代码处理：
Delphi(Pascal) code

......
procedure TForm1.FormCreate(Sender: TObject);
var gif:TGIFImage;
begin
  gif:=TGIFImage.Create;
  gif.LoadFromFile('F:\Program Files\duowan\yy-4\4.16.0.5\yygame_image\未命名.gif');
  gif.Animate:=True;
  newimg:=TImage.Create(Self);
  newimg.Picture.Assign(gif);
  newimg.Left:=10;
  newimg.Top:=20;
  newimg.AutoSize:=true;
  //newimg.Parent:=Form1;  //GIF图片随着线冒一起动
  newimg.Transparent:=True;
  newimg.OnMouseMove:=FormMouseMove;
  newimg.OnMouseUp:=FormMouseUp;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var x1,y1:integer;
begin
  x1:=x;
  y1:=y;
  if Sender.ClassName='TImage' then begin
    x1:=x1+newimg.Left;
    y1:=y1+newimg.Top;
  end;
  try
    if path.IsOutlineVisible(x1,y1,p,g) then  Text:='在基础线上';
    if Path1.IsVisible(MakePoint(x1,y1)) then   Text:='在圆内';
    if path2.IsOutlineVisible(x1,y1,pen,g) then Text:='在线上';
  except
  //
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var x1,y1:integer;
begin
  x1:=x;
  y1:=y;
  if Sender.ClassName='TImage' then begin
    x1:=x1+newimg.Left;
    y1:=y1+newimg.Top;
  end;
  if Button=mbLeft then begin
    if path.IsOutlineVisible(x1,y1,p,g) then ShowMessage('左键在基础先上按下并弹起');
    //if Path2.IsOutlineVisible(x1,y1,pen,g) then ShowMessage('左键在线上按下并弹起');
  end;
end
......

相关推荐