delphi 水晶按钮
2019独角兽企业重金招聘Python工程师标准>>>
unit CrystalButton;
interface
uses
SysUtils, Classes, Windows, Messages, Graphics, Controls, StdCtrls, Forms;
type
PTriVertex = ^TTriVertex;
TTriVertex = packed record
x: Longint;
y: Longint;
Red: Word;
Green: Word;
Blue: Word;
Alpha: Word;
end;
TFillDir = (fdHorizontal, fdVertical);
type
TCrystalButton = class(TGraphicControl)
private
FMouseOver: Boolean;
FDown: Boolean;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure GetRGB(C: TColor; out R, G, B: Integer);
procedure SolidGradient(DC: HDC; Rect: TRect; Color1, Color2,Color3: TColor; Dir: TFillDir = fdVertical); overload;
public
constructor Create(AOwner: TComponent); override;
procedure Click; override;
published
property Caption;
property Enabled;
property Font;
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property Height;
property Width;
property Left;
property Top;
property Name;
property Visible;
property Cursor;
end;
procedure Register;
implementation
//uses uGradientFill;
function GradientFillEx(DC: HDC; Vertex: PTriVertex; NumVertex: ULONG; Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall; external msimg32 name 'GradientFill';
//function GradientFillEx;
procedure ods(const str: string);
begin
OutputDebugString(PChar(str));
end;
{ TButtonEx }
procedure TCrystalButton.Click;
begin
inherited Click;
end;
procedure TCrystalButton.CMMouseEnter(var Message: TMessage);
begin
FMouseOver := True;
Repaint;
if Parent <> nil then
Parent.Perform(CM_MOUSEENTER, 0, Longint(Self));
end;
procedure TCrystalButton.CMMouseLeave(var Message: TMessage);
begin
FMouseOver := False;
if FDown then
FDown := False;
Repaint;
if Parent <> nil then
Parent.Perform(CM_MOUSELEAVE, 0, Longint(Self));
end;
constructor TCrystalButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csCaptureMouse, csDoubleClicks];
ParentFont := True;
end;
procedure TCrystalButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button = mbLeft) and Enabled then
begin
if not FDown then
begin
FDown := True;
repaint;
end;
end;
end;
procedure TCrystalButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
pt: TPoint;
Rect: TRect;
DoClick: Boolean;
begin
inherited MouseUp(Button, Shift, X, Y);
if FDown then
begin
pt.X := X;
pt.Y := Y;
Rect := ClientRect;
DoClick := PtInRect(Rect, pt);
if DoClick then
begin
FDown := False;
repaint;
end;
if DoClick then Click;
end;
end;
procedure TCrystalButton.Paint;
var
Rect: TRect;
clr1, clr2,clr3: TColor;
begin
Rect := ClientRect;
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := RGB(85, 148, 22);
Canvas.RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 6, 6);
if FDown then
begin
InflateRect(Rect, -1, -1);
clr3 := RGB($ef,$9a, $90);
clr2 := RGB($ff,$ff, $ff );
clr1 := RGB($ef,$9a, $90);
SolidGradient(Canvas.Handle, Rect, clr1, clr2,clr3);
end
else
begin
if FMouseOver then
begin
InflateRect(Rect, -1, -1);
clr3 := RGB($66, $cc,$99);
clr2 := RGB($66, $cc,$99);
clr1 := RGB($ff,$ff, $ff );
SolidGradient(Canvas.Handle, Rect, clr1, clr2,clr3);
end
else
begin
InflateRect(Rect, -1, -1);
clr3 := RGB($33, $cc,$99);
clr2 := RGB($33, $cc,$99);
clr1 := RGB($ff,$ff, $ff);
SolidGradient(Canvas.Handle, Rect, clr1, clr2,clr3);
end
end;
// Canvas.Font.Color := clBlack;//clWhite;
// Canvas.Font.Style := [fsBold];
Canvas.Font:=self.Font;
DrawText(Canvas.Handle, PChar(Caption), -1, Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;
procedure TCrystalButton.GetRGB(C: TColor; out R, G, B: Integer);
begin
if Integer(C) < 0 then C := GetSysColor(C and $000000FF);
R := C and $FF;
G := C shr 8 and $FF;
B := C shr 16 and $FF;
end;
procedure TCrystalButton.SolidGradient(DC: HDC; Rect: TRect; Color1, Color2,Color3: TColor; Dir: TFillDir = fdVertical);
var
vert: array[0..3] of TTriVertex;
gRect:array[0..1] of TGradientRect;
nMode: Cardinal;
begin
vert[0].x := Rect.Left;
vert[0].y := Rect.Top;
vert[0].Red := GetRValue(Color1) shl 8;
vert[0].Green := GetGValue(Color1) shl 8;
vert[0].Blue := GetBValue(Color1) shl 8;
vert[0].Alpha := 0;
vert[1].x := Rect.Right;
vert[1].y := Rect.Bottom div 2;
vert[1].Red := GetRValue(Color2) shl 8;
vert[1].Green := GetGValue(Color2) shl 8;
vert[1].Blue := GetBValue(Color2) shl 8;
vert[1].Alpha := 0;
vert[2].x := Rect.Left;
vert[2].y := Rect.Bottom div 2;
vert[2].Red := GetRValue(Color2) shl 8;
vert[2].Green := GetGValue(Color2) shl 8;
vert[2].Blue := GetBValue(Color2) shl 8;
vert[2].Alpha := 0;
vert[3].x := Rect.Right;//Right;
vert[3].y := Rect.Bottom;
vert[3].Red := GetRValue(Color3) shl 8;
vert[3].Green := GetGValue(Color3) shl 8;
vert[3].Blue := GetBValue(Color3) shl 8;
vert[3].Alpha := 0;
gRect[0].UpperLeft := 0;
gRect[0].LowerRight := 1;
gRect[1].UpperLeft := 2;
gRect[1].LowerRight := 3;
if Dir = fdVertical then
nMode := GRADIENT_FILL_RECT_V
else
nMode := GRADIENT_FILL_RECT_H;
GradientFillEx(DC, @vert, 4, @gRect, 2, nMode);
end;
procedure Register;
begin
RegisterComponents('Samples', [TCrystalButton]);
end;
end.
显示效果如下
转载于:https://my.oschina.net/jingshishengxu/blog/684158
delphi 水晶按钮相关推荐
- Photoshop五步制作水晶按钮
用Photoshop五步制作简单实用水晶按钮 类水晶的按钮,在很多地方都能用道,那么有没有快速的方法制作出逼真的水晶按钮呢?呵呵,我在这里介绍一下我的制作方法,(是在观察了很多类水晶按钮之后)发现如下 ...
- Winform中实现自定义水晶按钮控件(附代码下载)
场景 效果 注: 博客主页: https://blog.csdn.net/badao_liumang_qizhi 关注公众号 霸道的程序猿 获取编程相关电子书.教程推送与免费下载. 实现 新建一个用户 ...
- 利用.NET绘图技术制作水晶按钮控件(转)
UI(User Interface)编程在整个项目开发过程中是个颇为重要的环节,任何好的解决方案若没有良好的用户界面呈现给最终用户,那么就算包含了最先进的技术也 不能算是好程序.UI编程体现在两个方面 ...
- Photoshop 制作水晶按钮
1.新建文件,宽.高都为5,单位cm,分辨率200,模式为RGB,白色背景. 2.用圆形选框工具画出圆形选框,在选区内点鼠标右键,选"通过拷贝的图层"项(图层1). 3.新建图层( ...
- 利用.NET绘图技术制作水晶按钮控件[转]
UI(User Interface)编程在整个项目开发过程中是个颇为重要的环节,任何好的解决方案若没有良好的用户界面呈现给最终用户,那么就算包含了最先进的技术也不能算是好程序.UI编程体现在两个方面, ...
- Phtoshop五步制作水晶按钮
类水晶的按钮,在很多地方都能用到,那么有没有快速的方法制作出逼真的水晶按钮呢?呵呵,我在这里介绍一下我的制作方法,(是在观察了很多类水晶按钮之后)发现如下方法最为简单,而且制作的效果尚可.所以介绍给大 ...
- C#制作高仿360安全卫士窗体(四)- 水晶按钮
项目越来越紧,我也乐此不疲.自从上次C#制作高仿360安全卫士窗体(三)出来之后,就开始有一些人在说为什么还在坚持写这么落后的东西.我想说的是,我是从事企业信息化工作的,所有程序都只对内部使用.所以只 ...
- PS打造漂亮的数码金属水晶按钮
本教程介绍金属按钮的制作方法.制作的时候需要注意好图层的位置及光的渲染.尤其要突出金属的光泽,装饰部分使用滤镜效果完成.整体感觉非常的精致. 最终效果 1.建立一新文档,用深灰色填充背景层.在文档的水 ...
- css3 实现水晶按钮
background-image: -webkit-gradient(linear, left top, left bottom, color-stop(0%, #ee432e), color-sto ...
- 50款巧夺天工的PSD按钮素材
1.两款白色安卓滑动按钮PSD素材 下载地址>>> 2.黑色质感音量调节旋钮PSD素材 下载地址>>> 3.苹果风格导航按钮PSD素材 下载地址>>&g ...
最新文章
- JQuery变量数字相加的研究
- python虚拟环境的使用
- Catia V5-6R2015安装教程
- 查询附近的人——GEO
- 广东人大常委会党组会议强调:要加快人工智能等领域的相关立法工作。【Python】
- 一统江湖的大前端(7)React.js-从开发者到工程师
- 软件构建中的设计(一)
- Java基础:接口多态的综合案例 —— 笔记本电脑
- 苹果无线笔记本怎么连不上win服务器,苹果笔记本连不上无线_苹果笔记本连不上wifi...
- 用计算机收传真,使用计算机发送和接收传真.doc
- 网络安全工程师面试分享
- 多示例论文泛读:Revisiting Multiple Instance Neural Networks (2016 mi-Net MI-Net)
- Transactions
- Frank-Cucumber - Core Frank Steps
- 如何为公司创造价值?
- php微信支付na,PHP公众号支付宝支付实现
- 【附源码】计算机毕业设计JAVA医院病历管理系统
- 高质量文章导航-持续更新中
- MySQL数据库中插入图片
- CG cosh, exp, sinh, smoothstep, tanh, perlin_easeCurve1/2 曲线