BSMorphButton控件

最新推荐文章于 2021-05-27 05:36:42 发布
最新推荐文章于 2021-05-27 05:36:42 发布
阅读量500 收藏
点赞数
分类专栏： Delphi
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/zang141588761/article/details/52585681
版权

BSMorphButton控件

 效果图

单元文件：

unit BSMorphButton;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs , extctrls;
const
  Maxize = (1294967280 Div SizeOf(TPoint));
  MaxPixelCount   =  32768;
  Mask0101 = $00FF00FF;
  Mask1010 = $FF00FF00; 
type
  EMorphButton = class(Exception);
  PRGBArray  =  ^TRGBArray;
  TRGBArray  =  array[0..MaxPixelCount-1] of TRGBTriple;
  TPnts = array[0..Maxize - 1] of TPoint;
  TBSMorphButton = class(TGraphicControl)
  private
    {Private Declarations}
    bmF      : TBitmap;
    bmT      : TBitmap;
    bmZ      : TBitmap;
    FPicFrom : TPicture;
    FPicTo   : TPicture;
    FclFrom  : TColor;
    FclTo    : TColor;
    FBRate   : integer;
    FStretch : Boolean;
    FProcMsg : Boolean;
    FFinish  : Boolean;
    FOnBegin : TNotifyEvent;
    FOnEnd   : TNotifyEvent;
    FOnReset : TNotifyEvent;
    FAutoRev : Boolean;
    FRevSwap : Boolean;
    FReverst : Boolean;
    FStrTmp  : Boolean;
    FDelay   : integer;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    procedure CMMouseEnter(var Msg:TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;
    procedure chgPicF(Sender : TObject);
    procedure chgPicT(Sender : TObject);
    procedure WMEraseBkgnd(Var Msg : TMessage); message WM_ERASEBKGND;
    procedure SetpicFrom(Pic : TPicture);
    procedure SetpicTo(Pic : TPicture);
    procedure SetclFrom(Col : TColor);
    procedure SetclTo(Col : TColor);
    procedure SetBRate(Val : integer);
    procedure SetStretch(Val : Boolean);
    procedure SetProcMsg(Val : Boolean);
    procedure Blend;
    procedure UnBlend;
    procedure Blendit(bFr,bTo,bLn : Pointer ; Width,Height : Integer ; Dens : LongInt);
  protected
    procedure WMPosChg(var Msg : TMessage); message WM_WINDOWPOSCHANGED;
  public
    {Public Declarations}
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure Reset;
    procedure Complete;
    property Finish : Boolean read FFinish write FFinish default FALSE;
  published
    {Published Declarations}
    property MorphPic1 : TPicture read FPicFrom write SetpicFrom;
    property MorphPic2 : TPicture read FPicTo write SetpicTo;
    property MorphColor1 : TColor read FclFrom write SetclFrom default clBlack;
    property MorphColor2 : TColor read FclTo write SetclTo default clWhite;
    property MorphRate : integer read FBRate write SetBRate default 32;
    property StretchToFit : Boolean read FStretch write SetStretch default TRUE;
    property ProcessMsgs : Boolean read FProcMsg write SetProcMsg default TRUE;
    property Hint;
    property OnClick;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
  end;
procedure Register;
{$R Data.res}
implementation
const HandCursor = 31;
Var
  EBX, ESI, EDI, ESP, EBP,
  FinA,
  Dens1, Dens2 : Longint;
constructor TBSMorphButton.Create(AOwner : TComponent);
Var
 Temp1:TBitmap;
begin
  inherited Create(AOwner);
  Screen.Cursors[HandCursor]:=LoadCursor (hInstance , 'CUR');
  Cursor:=HandCursor;
  FclFrom := clBlack;
  FclTo := clWhite;
  FBRate := 250;
  FStretch := TRUE;
  FStrTmp := TRUE;
  FProcMsg := TRUE;
  FFinish := FALSE;
  FAutoRev := FALSE;
  FRevSwap := TRUE;
  FReverst := FALSE;
  FDelay := 1;
  ControlStyle := ControlStyle + [csOpaque] + [csNoStdEvents];
  Temp1:=TBitmap.Create;
  Temp1.LoadFromResourceName (HInstance,'B1');
  FPicFrom := TPicture.Create;
   FPicFrom.Bitmap:=Temp1;
  Temp1.LoadFromResourceName (HInstance,'B2');
  FPicTo := TPicture.Create;
   FPicTo.Bitmap:=Temp1;
  bmF := TBitmap.Create;
  bmT := TBitmap.Create;
  bmZ := TBitmap.Create;
  bmZ.PixelFormat := pf24bit;
  bmF.Canvas.Brush.Color := clBlack;
  FPicFrom.OnChange := chgPicF;
  FPicTo.OnChange := chgPicT;
  Width := 120;
  Height := 50;
  bmF.Width := Width;
  bmF.Height := Height;
end;

procedure DoIco(I : TGraphic; B : TBitmap; C : TColor; W : integer; H : integer);
var
  bmIco : TBitmap;
begin
  bmIco := TBitmap.Create;
  bmIco.Width := I.Width;
  bmIco.Height := I.Height;
  bmIco.Canvas.Brush.Color := C;
  bmIco.Canvas.FillRect(RECT(0,0,bmIco.Width,bmIco.Height));
  bmIco.Canvas.Draw(0,0,I);
  B.Canvas.StretchDraw(RECT(0,0,W,H),bmIco);
  bmIco.Free;
end;

procedure TBSMorphButton.Reset;
var
  pTmp : TPicture;
  cTmp : TColor;
begin
  bmF.PixelFormat := pf24bit;
  bmT.PixelFormat := pf24bit;
  bmZ.PixelFormat := pf24bit;
  if FReverst = TRUE then begin
    cTmp := FclFrom;
    FclFrom := FclTo;
    FclTo := cTmp;
    pTmp := TPicture.Create;
    pTmp.Assign(FPicFrom);
    FPicFrom.Assign(FPicTo);
    FPicTo.Assign(pTmp);
    bmF.Canvas.Brush.Color := FclFrom;
    bmT.Canvas.Brush.Color := FclTo;
    FReverst := FALSE;
    pTmp.Free;
    FStretch := FStrTmp;
  end;
  if FStretch = TRUE then begin
    bmF.Width := Width;
    bmF.Height := Height;
    if FPicFrom.Graphic = nil then
      bmF.Canvas.FillRect(RECT(0,0,Width,Height))
    else begin
      if FPicFrom.Graphic is TMetaFile then
        bmF.Canvas.FillRect(RECT(0,0,Width,Height));
      if FPicFrom.Graphic is TIcon then begin
        DoIco(FPicFrom.Graphic, bmF, FclFrom, Width, Height);
      end
      else
      bmF.Canvas.StretchDraw(RECT(0,0,Width,Height),FPicFrom.Graphic);
    end;
    bmT.Width := Width;
    bmT.Height := Height;
    if FPicTo.Graphic = nil then
      bmT.Canvas.FillRect(RECT(0,0,Width,Height))
    else begin
      if FPicTo.Graphic is TMetaFile then
        bmT.Canvas.FillRect(RECT(0,0,Width,Height));
      if FPicTo.Graphic is TIcon then
        DoIco(FPicTo.Graphic, bmT, FclTo, Width, Height)
      else
      bmT.Canvas.StretchDraw(RECT(0,0,Width,Height),FPicTo.Graphic);
    end;
  end;
  if FStretch = FALSE then begin
    if (FPicTo.Graphic <> nil) and (FPicFrom.Graphic = nil) then begin
      Width := FPicTo.Width;
      Height := FPicTo.Height;
      bmT.Width := Width;
      bmT.Height := Height;
      if (FPicTo.Graphic is TMetaFile) or (FPicTo.Graphic is TIcon) then
        bmT.Canvas.FillRect(RECT(0,0,Width,Height));
      bmT.Canvas.Draw(0,0,FPicTo.Graphic);
      bmF.Width := Width;
      bmF.Height := Height;
      bmF.Canvas.FillRect(RECT(0,0,Width,Height));
    end;
    if (FPicFrom.Graphic <> nil) and (FPicTo.Graphic = nil) then begin
      Width := FPicFrom.Width;
      Height := FPicFrom.Height;
      bmF.Width := Width;
      bmF.Height := Height;
      if (FPicFrom.Graphic is TMetaFile) or (FPicFrom.Graphic is TIcon) then
        bmF.Canvas.FillRect(RECT(0,0,Width,Height));
      bmF.Canvas.Draw(0,0,FPicFrom.Graphic);
      bmT.Width := Width;
      bmT.Height := Height;
      bmT.Canvas.FillRect(RECT(0,0,Width,Height));
    end;
    if (FPicFrom.Graphic = nil) and (FPicTo.Graphic = nil) then begin
      bmF.Width := Width;
      bmF.Height := Height;
      bmF.Canvas.FillRect(RECT(0,0,Width,Height));
      bmT.Width := Width;
      bmT.Height := Height;
      bmT.Canvas.FillRect(RECT(0,0,Width,Height));
    end;
    if (FPicFrom.Graphic <> nil) and (FPicTo.Graphic <> nil) then begin
      Width := FPicFrom.Width;
      Height := FPicFrom.Height;
      bmF.Width := Width;
      bmF.Height := Height;
      if (FPicFrom.Graphic is TMetaFile) or (FPicFrom.Graphic is TIcon) then
        bmF.Canvas.FillRect(RECT(0,0,Width,Height));
      bmF.Canvas.Draw(0,0,FPicFrom.Graphic);
      bmT.Width := Width;
      bmT.Height := Height;
      if FPicTo.Graphic is TMetaFile then
        bmT.Canvas.FillRect(RECT(0,0,Width,Height));
      if FPicTo.Graphic is TIcon then begin
        DoIco(FPicTo.Graphic, bmT, FclTo, Width, Height);
      end
      else
      bmT.Canvas.StretchDraw(RECT(0,0,Width,Height),FPicTo.Graphic);
    end;
  end;
  bmZ.Width := bmF.Width;
  bmZ.Height := bmF.Height;
  Invalidate;
  if Assigned (FOnReset) then FOnReset(Self);
end;
procedure TBSMorphButton.WMEraseBkgnd(var Msg:TMessage);
begin
  Msg.Result := 1;
end;
procedure TBSMorphButton.Paint;
begin
 Canvas.Draw(0,0,bmF);
 Canvas.Brush.Style:=bsClear;
end;

procedure TBSMorphButton.Complete;
begin
  Canvas.Draw(0,0,bmT);
  if Assigned (FOnEnd) then FOnEnd(Self);
  FFinish := FALSE;
end;

Function Pt(B : TBitmap) : Pointer;
Begin
  Pt := B.Scanline[(B.Height-1)]
End;

procedure TBSMorphButton.Blendit(bFr,bTo,bLn : Pointer ; Width,Height : Integer ; Dens : LongInt); assembler;
ASM
  MOV &EBX, EBX
  MOV &EDI, EDI
  MOV &ESI, ESI
  MOV &ESP, ESP
  MOV &EBP, EBP

  MOV EBX, Dens 
  MOV Dens1, EBX

  NEG BL
  ADD BL, $20   
  MOV Dens2, EBX
  CMP Dens1, 0
  JZ  @Final
  MOV EDI, bFr
  MOV ESI, bTo
  MOV ECX, bLn

  MOV EAX, Width
  lea EAX, [EAX+EAX*2+3] 
  AND EAX, $FFFFFFFC
  IMUL Height
  ADD EAX, EDI
  MOV FinA, EAX

  MOV EBP,EDI
  MOV ESP,ESI
  MOV ECX,ECX

@LOOPA:  
  MOV  EAX, [EBP] 
  MOV  EDI, [ESP] 
  MOV  EBX, EAX   
  AND  EAX, Mask1010
  AND  EBX, Mask0101 
  SHR  EAX, 5       
  IMUL EAX, Dens2   
  IMUL EBX, Dens2   
  MOV  ESI, EDI     
  AND  EDI, Mask1010 
  AND  ESI, Mask0101 
  SHR  EDI, 5        
  IMUL EDI, Dens1    
  IMUL ESI, Dens1    
  ADD  EAX, EDI
  ADD  EBX, ESI     
  AND  EAX, Mask1010
  SHR  EBX, 5
  AND  EBX, Mask0101 
  OR   EAX, EBX      
  MOV [ECX], EAX     
  ADD  EBP, 4       
  ADD  ESP, 4
  ADD  ECX, 4
  CMP  EBP, FinA
  JNE  @LOOPA

@FINAL:

  MOV EBX, &EBX
  MOV EDI, &EDI
  MOV ESI, &ESI
  MOV ESP, &ESP
  MOV EBP, &EBP
End;
procedure TBSMorphButton.Blend;
var
  r : integer;
begin
  Reset;
  if FBRate < 1 then
    raise EMorphButton.Create('BlendRate must be between 0 and 256');
  if Assigned (FOnBegin) then FOnBegin(Self);
  bmZ.Canvas.Draw(0, 0, bmF);
  for r := 0 to FBRate do begin
  Blendit(Pt(bmZ),Pt(bmT),Pt(bmF),bmF.Width,bmF.Height,(r*$20 Div FBRate));
  RePaint;
  if FProcMsg = TRUE then
    Application.ProcessMessages;
    if FFinish = TRUE then begin
      Complete;
      Exit;
    end;
  end;
  if FAutoRev = TRUE then begin
    Sleep(FDelay * 1000);
  end;
  if Assigned (FOnEnd) then FOnEnd(Self);
end;
procedure TBSMorphButton.UnBlend;
var
  r : integer;
  pTmp : TPicture;
  cTmp : TColor;
begin
  FStrTmp := FStretch;
  FStretch := TRUE;
  bmF.Canvas.Brush.Color := FclTo;
  bmT.Canvas.Brush.Color := FclFrom;
  cTmp := FclFrom;
  FclFrom := FclTo;
  FclTo := cTmp;
  pTmp := TPicture.Create;
  pTmp.Assign(FPicFrom);
  FPicFrom.Assign(FPicTo);
  FPicTo.Assign(pTmp);
  pTmp.Free;
  Reset;
  FReverst := TRUE;
  bmZ.Canvas.Draw(0, 0, bmF);
  for r := 0 to FBRate do begin
  Blendit(Pt(bmZ),Pt(bmT),Pt(bmF),bmF.Width,bmF.Height,(r*$20 Div FBRate));
  RePaint;
  if FProcMsg = TRUE then
    Application.ProcessMessages;
    if FFinish = TRUE then begin
      Complete;
      Exit;
    end;
  end;
  Reset;
end;
procedure TBSMorphButton.WMPosChg(var Msg : TMessage);
begin
  Reset;
  Invalidate;
  inherited;
end;
procedure TBSMorphButton.CMMouseEnter(var Msg:TMessage);
begin
  inherited;
  if Assigned (FOnMouseEnter) then FOnMouseEnter(Self);
  Blend;
end;
procedure TBSMorphButton.CMMouseLeave(var Msg:TMessage);
begin
  inherited;
  if Assigned (FonMouseLeave) then FOnMouseLeave(Self);
  UnBlend;
end;
procedure TBSMorphButton.chgPicF(Sender : TObject);
begin
  if FReverst = TRUE then Exit;
  Reset;
  Invalidate;
end;
procedure TBSMorphButton.chgPicT(Sender : TObject);
begin
  if FReverst = TRUE then Exit;
  Reset;
  Invalidate;
end;
procedure TBSMorphButton.SetpicFrom(Pic : TPicture);
begin
  FPicFrom.Assign(Pic);
end;


procedure TBSMorphButton.SetpicTo(Pic : TPicture);
begin
  FPicTo.Assign(Pic);
end;


procedure TBSMorphButton.SetclFrom(Col : TColor);
begin
  if FclFrom <> Col then begin
    FclFrom := Col;
    bmF.Canvas.Brush.Color := Col;
    Reset;
    Invalidate;
  end;
end;


procedure TBSMorphButton.SetclTo(Col : TColor);
begin
  if FclTo <> Col then begin
    FclTo := Col;
    bmT.Canvas.Brush.Color := Col;
    Reset;
    Invalidate;
  end;
end;


procedure TBSMorphButton.SetBRate(Val : integer);
begin
  if FBRate <> Val then
    FBRate := Val;
  if FBRate < 1 then
    FBRate := 1;
  if FBRate > 255 then
    FBRate := 255;
end;


procedure TBSMorphButton.SetStretch(Val : Boolean);
begin
  if FStretch <> Val then begin
    FStretch := Val;
    Reset;
    Invalidate;
  end;
end;


procedure TBSMorphButton.SetProcMsg(Val : Boolean);
begin
  if FProcMsg <> Val then
    FProcMsg := Val;
end;


destructor TBSMorphButton.Destroy;
begin
  FPicFrom.Free;
  FPicTo.Free;
  bmF.Free;
  bmT.Free;
  bmZ.Free;
  inherited Destroy;
end;


procedure Register;
begin
  RegisterComponents('Samples', [TBSMorphButton]);
end;


end.


资源文件下载：

点击打开链接

小蚂蚁_CrkRes
关注
  • 0
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
专栏目录
一个酷炫的button变化动画开源库源码分析—Android morph Button（一）
kayan19901的博客
12-04 4205
最近很是喜爱一些酷炫的动画效果，特意在github上找了一些，看看他们是怎么做到的，做个分析，顺便可以对自定义控件和动画有进一步的认识。 先来看下这个库中button的变化效果是什么样的：是不是很酷炫，而且中间的变化过程很舒服，没有僵硬的感觉，应用的场景也比较广：只要点击按钮，执行一个操作之后，返回结果，这个结果以对错表示，如果是一个耗时的操作还可以显示执行的进度，有很好的用户体验。
【Android开发小记--3】按钮视图动画几种效果
丁丁的专栏
01-16 5876
下面是几种按钮动画的效果实现，分别有代码实现和XML中编辑。 首先是效果图：                一、Button透明度变化 //============================================================= // 1------透明动画效果 //===============
android morph button,circular-progress-button
weixin_39840606的博客
05-27 78
Before using this library, read information below This library is not more supported.If you want to add new feature or fix a bug, grab source code and do it. If you think yourfix or feature would be ...
Android代码-android-morphing-button
08-06
Description Android button which can morph from one shape to another. You can easily extend MorphingButton to add your own behaviour. Below is example of LinearProgressButton which extends MorphingButton. Sample code // sample demonstrate how to morph button to green circle with icon MorphingButton btnMorph = (MorphingButton) findViewById(R.id.btnMorph); // inside on click event MorphingButton.Params circle = MorphingButton.Params.create() .duration(500) .cornerRadius(dimen(R.d
Android 一行代码实现炫酷Button
那时候的坚持不懈的我的博客
09-19 1701
前言 以前有接触过这个,不过也只是看到github上面的,看起来很炫酷,最近有看动画这一方面,所以突然兴致大发, 简简单单实现一个自定义的View, 纯动画, 没有什么需要计算的地方. 效果图 使用方法 在app/build.gradle中添加下面一行代码: dependencies { compile 'com.example.thatnight:animbutton:1.5
labview图标控件
09-22
本资料集合主要关注“labview图标控件”，包含了多个美观大方的控件库，可以丰富你的LabVIEW应用程序的界面设计。 1. **Lava Lib UI Tools VistasStyle Expansion Pack (1.1.0.4.vip)** 这个扩展包提供了与Windows...
VBA EXCEL制作日历控件
03-17
在EXCEL中，可以通过双击单元格，调出日历控件，通过对日历控件的操作，将所选日期更新到单元格中，该控件代码完全开放免费，供大家学习和使用，感兴趣的同学可以多多关注www.allmlp.com，让我们共同成长共同学习。
wps中excel日期控件下载
最新发布
07-26
在WPS Office的Excel应用中，日期控件是一种非常实用的功能，它允许用户在工作表中插入一个可交互的日历小部件，以便于选择和输入日期。标题“wps中excel日期控件下载”提示我们要关注如何在WPS Excel中获取和安装这...
excel 日期控件
12-14
mscomct2.ocx是ActiveX插件公用管理模块，缺少它可能会造成部分软件不能正常运行，可能造成以下几种情况：如office窗体控件丢失，vb控件不可用，EXCEL日历控件没有找到等等，这些都是mscomct2.ocx控件包丢失所造成的...
LABVIEW美化控件
03-08
标题“LABVIEW美化控件”暗示了这个压缩包可能包含一系列经过设计和优化的自定义控件，这些控件可能具有独特的外观或增加了特定的功能，以提升LabVIEW应用的用户体验和视觉效果。在LabVIEW中，自定义控件分为两种...
Android Button动画与炫酷跳转
热门推荐
TongZhang1314的博客
01-17 1万+
背景 近日浏览国外的网站发现了一个酷炫的按钮动画，想着自己造轮子实现，同时也记录下实现的过程。由于是第一次写技术文章，不足之处请在评论区多多赐教。不胜感激。 先上效果图 这个是在国外网站看到的。想自己实现按钮动画与跳转。 步骤： 乍一看挺复杂，细细分析应该是多种动画效果的组合。刚开始点击按钮，按钮由长条变为圆形，圆形按钮中间有个白色的圆弧在不断旋转，然后按钮突然放大跳转界面。整理一下
Android动画——按钮动画的代码
MonKing__的博客
04-12 1771
安卓按钮动画实现
Android Button 中绚丽渐变效果的设置 如此简单。。。
weixin_30268071的博客
06-14 92
android:shape的使用 2011-11-01 10:38 Android中渐变效果的设置 在Drawable文件夹下建立xml文件： <?xml version="1.0" encoding="utf-8"?> <shape xmlns:android="http://schemas.android.com/apk/...
Android Button按钮点击背景和文字变化
yuxuehandong的博客
05-16 8405
Android 原生的按钮点击状态是有变化的，但是如果是自己加了一个.png格式的图片为背景色，按钮点击就不会有任何效果，为了达到点击按钮有一闪的效果，我们就需要准备两张图进行切换， 而且文字也要变色，老规矩废话不多说直接上代码：按钮背景图片放在 drawable/background_button.xml<?xml version="1.0" encoding="utf-8"?> <selecto
Android简单酷炫点击动画(附源码)
尘少的博客
01-10 4035
在Android5.0之前， Android的点击效果一直很low， 即使5.0的波纹效果也不尽如人意。而我之前写过一种比较酷炫的点击效果， 最近抽了点时间完善一下， 把阴影效果加入了进去， 大家先睹为快。使用起来很简单， 只需两步。第一步： 把我项目里的包复制到你得项目里， 如下图： 第二步： 把XML布局文件里， 有点击事件的View， 替换成我的BamView即可，
Android 自定义View实现动态炫酷按钮
HyperionChen
03-01 3728
普通按钮也就那么几种样式，看着都审美疲劳，先放效果图，演示Demo+源码在最后面 你会不会以为这个按钮是集结了很多动画的产物，我告诉你，并没有。所有的实现都是基于自定义View，采用最底层的onDraw一点一点的画出来的。没有采用一丁点的动画。虽然演示时间很短，但是要完成这么多变化，还是挺吃力。 首先讲解用法： public class MainActivity extend

“相关推荐”对你有帮助么？

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

小蚂蚁_CrkRes

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付：¥1
获取中
扫码支付

您的余额不足，请更换扫码支付或充值

打赏作者

实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

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

余额充值