DELPHI IMAGE 上画透明圆 计算两点直线距离

本文介绍了一种在图形界面中实现局部透明效果的方法,通过使用Delphi编程语言,结合三角函数和AlphaBlend函数,实现了在指定区域内创建椭圆形透明效果。文章提供了详细的代码示例,展示了如何通过调整参数来改变透明区域的位置和大小。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

说明:一个程序用到要区域干扰界面显示,就想到了这个方法,代码可运行,这里只有简单的示例,不要纠结能完成什么功能。三角函数在编程过程中还真能用上。

注意:IMAGE要加载.BMP的图片。

一、放一个IMAGE

二、上代码

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.jpeg, Vcl.ExtCtrls,
  Vcl.StdCtrls, ComCtrls, Math;

type
  TForm2 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Button2: TButton;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    procedure MyDraw;
    procedure add_MyDraw(x, y, x_width, y_heigth: integer);
    procedure Button1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; x, y: integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState;
      x, y: integer);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

  // pt: tpoint;
  // md: Boolean;
  // cx, cy: Integer;
implementation

{$R *.dfm}

procedure TForm2.add_MyDraw(x, y, x_width, y_heigth: integer);
var
  bf: BLENDFUNCTION;
  desBmp, srcBmp: TBitmap;
  rgn: HRGN;
begin
  with bf do
  begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    AlphaFormat := 0;
    SourceConstantAlpha := 180; // 透明度,0~255
  end;
  desBmp := TBitmap.Create;
  srcBmp := TBitmap.Create;
  try
    srcBmp.Assign(Image1.Picture.Bitmap);
    desBmp.Canvas.Pen.Color := clBlack;
    desBmp.Canvas.Brush.Style := bsClear;
    desBmp.Canvas.Brush.Color := clBlack;
    desBmp.Width := srcBmp.Width;
    desBmp.Height := srcBmp.Height;
    Winapi.Windows.AlphaBlend(desBmp.Canvas.Handle, 0, 0, desBmp.Width,
      desBmp.Height, srcBmp.Canvas.Handle, 0, 0, srcBmp.Width,
      srcBmp.Height, bf);
    rgn := CreateEllipticRgn(x, y, x_width, y_heigth); // 创建一个圆形区域

    SelectClipRgn(srcBmp.Canvas.Handle, rgn);
    srcBmp.Canvas.Draw(0, 0, desBmp);
    Image1.Picture.Bitmap.Assign(nil);
    Image1.Picture.Bitmap.Assign(srcBmp);
  finally
    desBmp.Free;
    srcBmp.Free;
  end
end;

procedure TForm2.MyDraw;
var
  bf: BLENDFUNCTION;
  desBmp, srcBmp: TBitmap;
  rgn: HRGN;
begin
  with bf do
  begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    AlphaFormat := 0;
    SourceConstantAlpha := 180; // 透明度,0~255
  end;
  desBmp := TBitmap.Create;
  srcBmp := TBitmap.Create;
  try
    srcBmp.Assign(Image1.Picture.Bitmap);

    desBmp.Canvas.Pen.Color := clBlack;
    desBmp.Canvas.Brush.Style := bsClear;
    desBmp.Canvas.Brush.Color := clBlack;

    desBmp.Width := srcBmp.Width;
    desBmp.Height := srcBmp.Height;
    Winapi.Windows.AlphaBlend(desBmp.Canvas.Handle, 0, 0, desBmp.Width,
      desBmp.Height, srcBmp.Canvas.Handle, 0, 0, srcBmp.Width,
      srcBmp.Height, bf);
    rgn := CreateEllipticRgn(20, 20, 200, 200); // 创建一个圆形区域
    SelectClipRgn(srcBmp.Canvas.Handle, rgn);
    srcBmp.Canvas.Draw(0, 0, desBmp);
    Image1.Picture.Bitmap.Assign(nil);
    Image1.Picture.Bitmap.Assign(srcBmp);
  finally
    desBmp.Free;
    srcBmp.Free;
  end
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  s_x, s_y, e_x, e_y: integer;
  s_x1, s_y1, e_x1, e_y1: integer;
  x_cen, y_cen, x_cen1, y_cen1: integer;
  d: Real;
begin
  // MyDraw;
  // add_MyDraw(10,10,200,200);
  s_x := 30;
  s_y := 30;
  e_x := 200;
  e_y := 200;

  s_x1 := 40;
  s_y1 := 30;
  e_x1 := 210;
  e_y1 := 200;

  add_MyDraw(s_x, s_y, e_x, e_y);
  add_MyDraw(s_x1, s_y1, e_x1, e_y1);
  // 求得中心点
  x_cen := (e_x - s_x) div 2 + s_x; //
  y_cen := (e_y - s_y) div 2 + s_y;
  x_cen1 := (e_x1 - s_x1) div 2 + s_x1; //
  y_cen1 := (e_y1 - s_y1) div 2 + s_y1;
  // sqrt((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2));
  // 取得两个中心点的距离
  d := sqrt((x_cen - x_cen1) * (x_cen - x_cen1) + (y_cen - y_cen1) *
    (y_cen - y_cen1));
  Edit3.Text := inttostr(ceil(d));
  // edit3.Text:=inttostr(sqrt((x_cen-x_cen1)*(x_cen-x_cen1)+(y_cen-y_cen1)*(y_cen-y_cen1)));
  // 取得中心点

  Edit1.Text := inttostr(x_cen); //
  Edit2.Text := inttostr(y_cen); //
  { image1.Canvas.Brush.Color:= clBlack;
    image1.Canvas.Font.Size := 28;
    image1.Canvas.Font.Color := clWhite ; //clred
    image1.Canvas.Font.Name := '黑体';
    image1.Canvas.TextOut(100, 100,'sssss'); //17 }
  // jpg.Assign(image4.Picture.Graphic);
  // jpg.CompressionQuality :=65;
  // jpg.Compress;
  // jpg.SaveToFile('c:\x.jpg');

end;

procedure TForm2.Button2Click(Sender: TObject);
var
  x_cen, y_cen: integer;
  len_xy: integer;
begin
  x_cen := strtoint(Edit7.Text);
  y_cen := strtoint(Edit8.Text);
  len_xy := strtoint(Edit9.Text);
  add_MyDraw(x_cen - len_xy, y_cen - len_xy, x_cen + len_xy, y_cen + len_xy);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; x, y: integer);
begin
  Edit5.Text := inttostr(x);
  Edit6.Text := inttostr(y);
  { md := True;
    cx := x;
    cy := y; }
end;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState;
  x, y: integer);
begin
  { if md then
    begin
    // img1.Canvas.Brush.Color := clWhite; //画笔颜色设置为白色
    // img1.Canvas.Brush.Style := bsclear;
    //img1.Canvas.FillRect(img1.ClientRect); //把画布背景填充为白色
    image1.Canvas.Pen.Color := clRed;
    image1.Canvas.Rectangle(cx, cy, X, Y);

    end; }
end;

end.

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值