• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

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

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

可以不用再写代码了,直接上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.



鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
delphi执行sql总结发布时间:2022-07-18
下一篇:
一个简单的MDI示范程序(Delphi)发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap