delphi下用Timage显示圆形的图像(还没有封装成控件)

2023-10-13 22:59

本文主要是介绍delphi下用Timage显示圆形的图像(还没有封装成控件),希望对大家解决编程问题提供一定的参考价值,需要的开发者们随着小编来一起学习吧!

可以不用再写代码了,直接上DEMO(参考附件)

第四个按钮是最后效果按钮。

(由于 不能加附件,看来直接上代码了):

unit Unit1;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, Spin;


type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    SpinEdit1: TSpinEdit;
    Button4: TButton;
    Panel1: TPanel;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    procedure MyDraw;
  public
    { Public declarations }
  end;


var
  Form1: TForm1;


implementation


{$R *.dfm}
uses Math;


procedure TForm1.Button1Click(Sender: TObject);
begin
  MyDraw;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
  
  desBmp, srcBmp: TBitmap;
  Bmp :TBitmap;
  FRgn :HRGN;
  R:TRect;
begin 
  Bmp := TBitmap.Create;
  try
    Bmp.PixelFormat := Image1.Picture.Bitmap.PixelFormat;
    Bmp.Width  :=100;
    Bmp.Height :=100;
    R := Image1.ClientRect;
    R.Left := 0;
    R.Top := 0;
    R.Bottom := 200;
    R.Right := 200;


    BitBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,Image1.Canvas.Handle,100, 0,SRCCOPY); //要拷贝的位图
    //FRgn:= CreateEllipticRgnIndirect(R);
    FRgn := CreateEllipticRgn(0,0,200,200); //创建圆形区域
    SelectClipRgn(Image1.Canvas.Handle,FRgn); //选择剪切区域
    ///Image2.Canvas.Draw(0,0,Bmp); //位图位于区域内的部分加载
    Image2.Picture.Assign(bmp);
    //Image2.Canvas.Ellipse(R);


  finally
    Bmp.Free;
  end;
  DeleteObject(FRgn);
end;


procedure TForm1.MyDraw;
var
  bf: BLENDFUNCTION;
  desBmp, srcBmp: TBitmap;
  rgn: HRGN;
begin
  with bf do
  begin
    BlendOp := AC_SRC_OVER;
    BlendFlags := 0;
    AlphaFormat := 0;
    SourceConstantAlpha := 150; // 透明度,0~255
  end;
 
  desBmp := TBitmap.Create;
  srcBmp := TBitmap.Create;
  try
    //这里进行了转换(jpg的适应了bitmap
    srcBmp.Assign(image1.Picture.Graphic);
    
    image1.Picture.Assign(nil);
    image1.Picture.Bitmap.Assign(nil);


    desBmp.Width := srcBmp.Width;
    desBmp.Height := srcBmp.Height;
    Windows.AlphaBlend(desBmp.Canvas.Handle, 0, 0,
      desBmp.Width, desBmp.Height, srcBmp.Canvas.Handle,
      0, 0, srcBmp.Width, srcBmp.Height, bf);


    rgn := CreateEllipticRgn(80,0, 200, 120); // 创建一个圆形区域
    SelectClipRgn(srcBmp.Canvas.Handle, rgn);
    //画个透明的圈圈    
    srcBmp.Canvas.Draw(0, 0, desBmp); 
    image1.Picture.Bitmap.Assign(srcBmp);
  finally
    desBmp.Free;
    srcBmp.Free;
  end
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  jp:TJPEGImage;
begin
  (*
   jp:=TJPEGImage.Create;
   jp.loadfromFile('1.jpg');
   Image1.Picture.Assign(jp);
   jp.Free;
   *)
   Image1.Picture.LoadFromFile('head.jpg');
   DoubleBuffered := True;
end;






procedure TForm1.Button3Click(Sender: TObject);
const
  BORDER = 3;
Var
  Bmp : TBitmap;
  w, h: Integer;
  x, y: Integer;    
  rgn: HRGN;
begin
  Bmp:=TBitmap.Create;
  try
    Bmp.PixelFormat:=pf24bit;
    Bmp.Canvas.Font.Name  :='Arial';                            // set the font to use
    Bmp.Canvas.Font.Size  :=20;                                 //set the size of the font
    Bmp.Canvas.Font.Color := clWhite;                           //set the color of the text
    w          := SpinEdit1.Value;//Bmp.Canvas.TextWidth(IntToStr(SpinEdit1.Value));   //calculate the width of the image
    h          := SpinEdit1.Value;//Bmp.Canvas.TextHeight(IntToStr(SpinEdit1.Value));  //calculate the height of the image
    Bmp.Width  := Max(w, h) + BORDER * 2;                       // get a square
    Bmp.Height := Max(w, h) + BORDER * 2;                       // get a square
    x          := (Bmp.Width  - w) div 2;                       // center
    y          := (Bmp.Height - h) div 2;                       // center
    Bmp.Canvas.Brush.Color := clBlue;                           //set the background
    //Bmp.Canvas.FillRect(Rect(0,0, Bmp.Width, Bmp.Height));      //paint the background which is transparent
    Bmp.Canvas.Brush.Color := clRed;                            // circle in red
    Bmp.Canvas.Pen.Color   := clRed;                            // circle in red
    //Bmp.Canvas.Ellipse(0, 0, Bmp.Width, Bmp.Height);            // draw the circle
    //Bmp.Canvas.TextOut(x, y, IntToStr(SpinEdit1.Value));            //draw the number


    BitBlt(Bmp.Canvas.Handle,0,0,Bmp.Width,Bmp.Height,Image1.Canvas.Handle,100, 0,SRCCOPY); //要拷贝的位图


    rgn := CreateEllipticRgn(0,0, 100, 100); // 创建一个圆形区域
    SelectClipRgn(bmp.Canvas.Handle, rgn);
    //Bmp.Canvas.Draw(0,0, bmp);


    Image2.Picture.Assign(bmp);                                   // assign the bmp to the image ; image.transparent = true, .stretch = true;
  finally
    Bmp.Free;
  end;
end;


procedure TForm1.Button4Click(Sender: TObject);
var
  bmp:TBitmap;
  Rhandle:HRGN;
  R:TRect;
begin


  Image2.Picture.LoadFromFile('head.jpg');
  Image2.AutoSize := true;
  R := Image2.ClientRect;
  bmp := TBitmap.Create;
  //bmp.LoadFromFile('1.bmp');
  bmp.Assign(Image2.Picture.Graphic);
  
  //Rhandle:=CreateRoundRectRgn(100,0,200,100,100,100);
  Rhandle:=CreateRoundRectRgn(0,0,Image2.Width,Image2.Height,Image2.Width,Image2.Height);


  Image2.Picture.Assign(nil);
  Image2.AutoSize := false;
  Image2.Stretch := false;
  Image2.Height := R.Bottom - R.Top;
  Image2.Width := R.Right - R.Left;


  Image2.Canvas.Brush.Color:=clRed;
  Image2.Canvas.FillRect(Image2.ClientRect);


  SelectclipRgn(Image2.Canvas.Handle,rHandle); 
  Image2.Canvas.Draw(0,0,bmp);
  deleteObject(Rhandle);
  Image2.Canvas.Brush.Style := bsClear;
  Image2.Picture.Bitmap.TransparentColor := clRed;
  Image2.Picture.Bitmap.Transparent      := True;
  Image2.Transparent:=True;
end;


end.


这篇关于delphi下用Timage显示圆形的图像(还没有封装成控件)的文章就介绍到这儿,希望我们推荐的文章对编程师们有所帮助!



http://www.chinasem.cn/article/206444

相关文章

Qt中QGroupBox控件的实现

《Qt中QGroupBox控件的实现》QGroupBox是Qt框架中一个非常有用的控件,它主要用于组织和管理一组相关的控件,本文主要介绍了Qt中QGroupBox控件的实现,具有一定的参考价值,感兴趣... 目录引言一、基本属性二、常用方法2.1 构造函数 2.2 设置标题2.3 设置复选框模式2.4 是否

Qt中QUndoView控件的具体使用

《Qt中QUndoView控件的具体使用》QUndoView是Qt框架中用于可视化显示QUndoStack内容的控件,本文主要介绍了Qt中QUndoView控件的具体使用,具有一定的参考价值,感兴趣的... 目录引言一、QUndoView 的用途二、工作原理三、 如何与 QUnDOStack 配合使用四、自

OpenCV图像形态学的实现

《OpenCV图像形态学的实现》本文主要介绍了OpenCV图像形态学的实现,包括腐蚀、膨胀、开运算、闭运算、梯度运算、顶帽运算和黑帽运算,文中通过示例代码介绍的非常详细,需要的朋友们下面随着小编来一起... 目录一、图像形态学简介二、腐蚀(Erosion)1. 原理2. OpenCV 实现三、膨胀China编程(

鸿蒙中Axios数据请求的封装和配置方法

《鸿蒙中Axios数据请求的封装和配置方法》:本文主要介绍鸿蒙中Axios数据请求的封装和配置方法,本文给大家介绍的非常详细,对大家的学习或工作具有一定的参考借鉴价值,需要的朋友参考下吧... 目录1.配置权限 应用级权限和系统级权限2.配置网络请求的代码3.下载在Entry中 下载AxIOS4.封装Htt

jupyter代码块没有运行图标的解决方案

《jupyter代码块没有运行图标的解决方案》:本文主要介绍jupyter代码块没有运行图标的解决方案,具有很好的参考价值,希望对大家有所帮助,如有错误或未考虑完全的地方,望不吝赐教... 目录jupyter代码块没有运行图标的解决1.找到Jupyter notebook的系统配置文件2.这时候一般会搜索到

SpringBoot中封装Cors自动配置方式

《SpringBoot中封装Cors自动配置方式》:本文主要介绍SpringBoot中封装Cors自动配置方式,具有很好的参考价值,希望对大家有所帮助,如有错误或未考虑完全的地方,望不吝赐教... 目录SpringBoot封装Cors自动配置背景实现步骤1. 创建 GlobalCorsProperties

Java导入、导出excel用法步骤保姆级教程(附封装好的工具类)

《Java导入、导出excel用法步骤保姆级教程(附封装好的工具类)》:本文主要介绍Java导入、导出excel的相关资料,讲解了使用Java和ApachePOI库将数据导出为Excel文件,包括... 目录前言一、引入Apache POI依赖二、用法&步骤2.1 创建Excel的元素2.3 样式和字体2.

JAVA封装多线程实现的方式及原理

《JAVA封装多线程实现的方式及原理》:本文主要介绍Java中封装多线程的原理和常见方式,通过封装可以简化多线程的使用,提高安全性,并增强代码的可维护性和可扩展性,需要的朋友可以参考下... 目录前言一、封装的目标二、常见的封装方式及原理总结前言在 Java 中,封装多线程的原理主要围绕着将多线程相关的操

Linux虚拟机不显示IP地址的解决方法(亲测有效)

《Linux虚拟机不显示IP地址的解决方法(亲测有效)》本文主要介绍了通过VMware新装的Linux系统没有IP地址的解决方法,主要步骤包括:关闭虚拟机、打开VM虚拟网络编辑器、还原VMnet8或修... 目录前言步骤0.问题情况1.关闭虚拟机2.China编程打开VM虚拟网络编辑器3.1 方法一:点击还原VM

CSS模拟 html 的 title 属性(鼠标悬浮显示提示文字效果)

《CSS模拟html的title属性(鼠标悬浮显示提示文字效果)》:本文主要介绍了如何使用CSS模拟HTML的title属性,通过鼠标悬浮显示提示文字效果,通过设置`.tipBox`和`.tipBox.tipContent`的样式,实现了提示内容的隐藏和显示,详细内容请阅读本文,希望能对你有所帮助... 效