如何用Delphi制作360安全卫士的部分风格!!

a81826664 2011-12-09 01:48:53
如何用Delphi制作360安全卫士的部分风格,如下图:(主要透明效果)
...全文
1185 22 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
22 条回复
切换为时间正序
请发表友善的回复…
发表回复
qq911074740 2012-06-19
  • 打赏
  • 举报
回复
[Quote=引用 13 楼 的回复:]

你留个邮箱吧,有空我发个DEMO控件的代码给你参考参考,
按你贴的图,基本上是要实现一个透明按钮,原理么,楼上也有人说了,用自绘,
[/Quote]
发一份给我谢谢
ym5566@qq.com
a81826664 2011-12-13
  • 打赏
  • 举报
回复
已经收到,好像Delphi 7里安装不了该组件 你的组件是D2007的吗?
DelphiTeacher 2011-12-13
  • 打赏
  • 举报
回复
已发

[Quote=引用 19 楼 a81826664 的回复:]

引用 18 楼 delphiteacher 的回复:
引用 14 楼 cplm88 的回复:

引用 13 楼 delphiteacher 的回复:
你留个邮箱吧,有空我发个DEMO控件的代码给你参考参考,
按你贴的图,基本上是要实现一个透明按钮,原理么,楼上也有人说了,用自绘,


cplm88@163.com

谢谢!!!


看错了,以为你是楼主,呵呵,没发,不好……
[/Quote]
a81826664 2011-12-13
  • 打赏
  • 举报
回复
[Quote=引用 18 楼 delphiteacher 的回复:]
引用 14 楼 cplm88 的回复:

引用 13 楼 delphiteacher 的回复:
你留个邮箱吧,有空我发个DEMO控件的代码给你参考参考,
按你贴的图,基本上是要实现一个透明按钮,原理么,楼上也有人说了,用自绘,


cplm88@163.com

谢谢!!!


看错了,以为你是楼主,呵呵,没发,不好意思。。只发给有需要的
[/Quote]

DelphiTeacher
您好 我的邮箱是 81826664@qq.com 能发份给我吗?
DelphiTeacher 2011-12-13
  • 打赏
  • 举报
回复
[Quote=引用 14 楼 cplm88 的回复:]

引用 13 楼 delphiteacher 的回复:
你留个邮箱吧,有空我发个DEMO控件的代码给你参考参考,
按你贴的图,基本上是要实现一个透明按钮,原理么,楼上也有人说了,用自绘,


cplm88@163.com

谢谢!!!
[/Quote]

看错了,以为你是楼主,呵呵,没发,不好意思。。只发给有需要的
DelphiTeacher 2011-12-13
  • 打赏
  • 举报
回复
[Quote=引用 14 楼 cplm88 的回复:]

引用 13 楼 delphiteacher 的回复:
你留个邮箱吧,有空我发个DEMO控件的代码给你参考参考,
按你贴的图,基本上是要实现一个透明按钮,原理么,楼上也有人说了,用自绘,


cplm88@163.com

谢谢!!!
[/Quote]


DEMO已发邮箱,
效果基本上是这样:正常状态,鼠标停靠状态,鼠标按下状态

为了附带一些BUTTON的属性,特地尝试了一下从TBUTTON继承而不是我经常用的TCustomControl,
不过基本上也差不多
在这里贴一份控件的代码,很多公共函数没附上,但控件自绘的普通方法就是这样,没有什么难度和神秘的

unit Skin360Button;

interface

uses
Windows,SysUtils,Classes,Controls,StdCtrls,Messages,Graphics,
GdiPlus,GdiSkinHelper,GdiPlusHelpers,Math;

type
TSkin360Button=class(TCustomButton)
private
FMouseDown:Boolean;
FCanvas:TCanvas;
FParentBkGndBitmap:TBitmap;
FHoverPicture: TPicture;
FDownPicture: TPicture;
FHoverBitmap: IGPBitmap;
FDownBitmap: IGPBitmap;
FIconBitmap:IGPBitmap;
FIconPicture: TPicture;
FIconHeight: Integer;
FIconWidth: Integer;
procedure OnIconPictureChanged(Sender:TObject);
procedure OnHoverPictureChanged(Sender:TObject);
procedure OnDownPictureChanged(Sender:TObject);
procedure SetDownPicture(const Value: TPicture);
procedure SetHoverPicture(const Value: TPicture);
procedure MakeGPBitmapByPicture(var ABitmap: IGPBitmap; APicture: TPicture);
procedure SetIconPicture(const Value: TPicture);
procedure SetIconHeight(const Value: Integer);
procedure SetIconWidth(const Value: Integer);
protected
procedure Paint;virtual;
procedure PaintWindow(DC:HDC);
procedure WMPaint(var Message:TWMPaint);message WM_PAINT;
procedure WMEraseBkGnd(var Message:TWMEraseBkGnd);message WM_ERASEBKGND;
procedure WMLButtonDown(var Message:TMessage);message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message:TMessage);message WM_LBUTTONUP;
public
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
published
property HoverPicture:TPicture read FHoverPicture write SetHoverPicture;
property DownPicture:TPicture read FDownPicture write SetDownPicture;
property IconPicture:TPicture read FIconPicture write SetIconPicture;
property IconWidth:Integer read FIconWidth write SetIconWidth;
property IconHeight:Integer read FIconHeight write SetIconHeight;
published
property Action;
property Align;
property Anchors;
property BiDiMode;
property Cancel;
property Caption;
property CommandLinkHint;
property Constraints;
property Default;
property DisabledImageIndex;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property DropDownMenu;
property ElevationRequired;
property Enabled;
property Font;
property HotImageIndex;
property ImageAlignment;
property ImageIndex;
property ImageMargins;
property Images;
property ModalResult;
property ParentBiDiMode;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property PressedImageIndex;
property SelectedImageIndex;
property ShowHint;
property Style;
property TabOrder;
property TabStop;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnDropDownClick;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;


procedure Register;

implementation

procedure Register;
begin
RegisterComponents('SkinEngine',[TSkin360Button]);
end;



{ TSkin360Button }
procedure DrawParentImageDefault(ASelf: TControl; DC: HDC);
var
SaveIndex: Integer;
P: TPoint;
begin
if ASelf.Parent=nil then Exit;
if Not (csDesigning in ASelf.ComponentState) then
begin
SaveIndex := SaveDC(DC);
GetViewportOrgEx(DC, P);
SetViewportOrgEx(DC, P.X - ASelf.Left, P.Y - ASelf.Top, nil);
IntersectClipRect(DC, 0, 0, ASelf.Parent.Width, ASelf.Parent.Height);
ASelf.Parent.Perform(WM_ERASEBKGND, DC, 0);
ASelf.Parent.Perform(WM_PrintClient, DC, prf_Client);
RestoreDC(DC, SaveIndex);
end;
end;

procedure TSkin360Button.MakeGPBitmapByPicture(var ABitmap:IGPBitmap;APicture:TPicture);
begin
if (APicture.Graphic=nil)
or APicture.Graphic.Empty then
begin
ABitmap:=nil;
end
else
begin
ABitmap:=TSkinHelper.CreateBitmap(APicture.Graphic)
end;
end;

constructor TSkin360Button.Create(AOwner: TComponent);
begin
inherited;
FHoverPicture:=TPicture.Create;
FDownPicture:=TPicture.Create;
FIconPicture:=TPicture.Create;
FHoverPicture.OnChange:=Self.OnHoverPictureChanged;
FDownPicture.OnChange:=Self.OnDownPictureChanged;
FIconPicture.OnChange:=Self.OnIconPictureChanged;

FParentBkGndBitmap:=TBitmap.Create;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;

FIconHeight:=16;
FIconWidth:=16;
end;

destructor TSkin360Button.Destroy;
begin
FIconPicture.Free;
FHoverPicture.Free;
FDownPicture.Free;
FParentBkGndBitmap.Free;
FCanvas.Free;
inherited;
end;

procedure TSkin360Button.OnDownPictureChanged(Sender: TObject);
begin
MakeGPBitmapByPicture(FDownBitmap,FDownPicture);
end;


procedure TSkin360Button.OnHoverPictureChanged(Sender: TObject);
begin
MakeGPBitmapByPicture(FHoverBitmap,FHoverPicture);
end;

procedure TSkin360Button.OnIconPictureChanged(Sender: TObject);
begin
MakeGPBitmapByPicture(FIconBitmap,FIconPicture);
end;

procedure TSkin360Button.Paint;
var
tmpBitmap:IGPBitmap;
tmpIconDrawRect:TRect;
tmpCaptionDrawRect:TRect;
tmpGraphics:IGPGraphics;
begin
FParentBkGndBitmap.SetSize(Width,Height);
//绘制父控件到缓存位图
DrawParentImageDefault(Self,FParentBkGndBitmap.Canvas.Handle);

tmpBitmap:=nil;
if Self.FMouseDown then
begin
tmpBitmap:=Self.FDownBitmap;
end
else if Self.MouseInClient then
begin
tmpBitmap:=Self.FHoverBitmap;
end;
//绘制背景图片
if (tmpBitmap<>nil) then
begin
//九宫格绘制
TSkinHelper.StretchDrawImageInRectByMargins(FParentBkGndBitmap.Canvas.ToGPGraphics,
tmpBitmap,
TGPRect.Create(0,0,Width,Height),
8,8,8,8);
end;
//确定图标的绘制矩形
tmpIconDrawRect.Left:=Ceil((Width-Self.FIconWidth) / 2);
tmpIconDrawRect.Top:=5;
tmpIconDrawRect.Right:=tmpIconDrawRect.Left+Self.FIconWidth;
tmpIconDrawRect.Bottom:=tmpIconDrawRect.Top+Self.FIconHeight;
//绘制标题的绘制矩形
tmpCaptionDrawRect.Left:=Ceil((Width-TSkinHelper.CalcFontWidth(FParentBkGndBitmap.Canvas.ToGPGraphics,Caption,Font)) / 2);
tmpCaptionDrawRect.Top:=tmpIconDrawRect.Bottom+5;
tmpCaptionDrawRect.Right:=Width;
tmpCaptionDrawRect.Bottom:=Height;
//绘制标题
tmpGraphics:=FParentBkGndBitmap.Canvas.ToGPGraphics;
tmpGraphics.TextRenderingHint:=TGPTextRenderingHint.TextRenderingHintAntiAlias;
TSkinHelper.DrawShadowText(tmpGraphics,
Caption,Font,
tmpCaptionDrawRect.Left,
tmpCaptionDrawRect.Top,
3,0,
TGPColor.CreateFromColorRef(clWhite));
//绘制图标
TSkinHelper.StretchDrawImageInRect(FParentBkGndBitmap.Canvas.ToGPGraphics,
Self.FIconBitmap,
TGPRect.Create(tmpIconDrawRect));
//显示到界面上
Bitblt(FCanvas.Handle,0,0,Width,Height,
FParentBkGndBitmap.Canvas.Handle,0,0,SRCCOPY);
end;

procedure TSkin360Button.PaintWindow(DC: HDC);
begin
FCanvas.Lock;
try
FCanvas.Handle := DC;
try
TControlCanvas(FCanvas).UpdateTextFlags;
Paint;
finally
FCanvas.Handle := 0;
end;
finally
FCanvas.Unlock;
end;
end;

procedure TSkin360Button.SetDownPicture(const Value: TPicture);
begin
FDownPicture.Assign(Value);
Invalidate;
end;


procedure TSkin360Button.SetHoverPicture(const Value: TPicture);
begin
FHoverPicture.Assign(Value);
Invalidate;
end;

procedure TSkin360Button.SetIconHeight(const Value: Integer);
begin
if FIconHeight<>Value then
begin
FIconHeight := Value;
Invalidate;
end;
end;

procedure TSkin360Button.SetIconPicture(const Value: TPicture);
begin
FIconPicture.Assign(Value);
Invalidate;
end;

procedure TSkin360Button.SetIconWidth(const Value: Integer);
begin
if FIconWidth<>Value then
begin
FIconWidth := Value;
Invalidate;
end;
end;


procedure TSkin360Button.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
Message.Result:=1;
end;

procedure TSkin360Button.WMLButtonDown(var Message: TMessage);
begin
Inherited;
Self.FMouseDown:=True;
Invalidate;
end;

procedure TSkin360Button.WMLButtonUp(var Message: TMessage);
begin
Inherited;
Self.FMouseDown:=False;
Invalidate;
end;

procedure TSkin360Button.WMPaint(var Message: TWMPaint);
var
DC: HDC;
PS: TPaintStruct;
begin
DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS);
try
PaintWindow(DC);
finally
if Message.DC = 0 then EndPaint(Handle, PS);
end;
end;


end.




纯冰糖 2011-12-13
  • 打赏
  • 举报
回复
BodSoft DirectUI Library V1.3

网上搜一下,目前流行软件的界面都可以模仿。
一剑飘雪 2011-12-13
  • 打赏
  • 举报
回复
[Quote=引用 13 楼 delphiteacher 的回复:]

你留个邮箱吧,有空我发个DEMO控件的代码给你参考参考,
按你贴的图,基本上是要实现一个透明按钮,原理么,楼上也有人说了,用自绘,
[/Quote]
也发一个给我把,344986457@qq.com 谢谢
cplm88 2011-12-12
  • 打赏
  • 举报
回复
[Quote=引用 13 楼 delphiteacher 的回复:]
你留个邮箱吧,有空我发个DEMO控件的代码给你参考参考,
按你贴的图,基本上是要实现一个透明按钮,原理么,楼上也有人说了,用自绘,
[/Quote]

cplm88@163.com

谢谢!!!
爱蹄子的羊头 2011-12-12
  • 打赏
  • 举报
回复
完全用画的就行了吧

在"不得闲" 的控件里面看过透明的 button
DelphiTeacher 2011-12-12
  • 打赏
  • 举报
回复
你留个邮箱吧,有空我发个DEMO控件的代码给你参考参考,
按你贴的图,基本上是要实现一个透明按钮,原理么,楼上也有人说了,用自绘,
smhpnuaa 2011-12-12
  • 打赏
  • 举报
回复
有很多用Delphi写的卫士,360的不少边缘作品一开始也是Delphi写的
a81826664 2011-12-11
  • 打赏
  • 举报
回复
[Quote=引用 3 楼 jubobo 的回复:]
TMS控件能够做到这个样式,不过皮肤还是要自己来做的。
[/Quote]
TMS哪个控件有这个 能详细说下吗?能不能提供下TMS控件 我邮箱 81826664@qq.com
「已注销」 2011-12-11
  • 打赏
  • 举报
回复
学习一下,以后用得着
changsn 2011-12-10
  • 打赏
  • 举报
回复
去百度搜:delphi GDI+
DelphiTeacher 2011-12-10
  • 打赏
  • 举报
回复
透明效果这个,你只要在控件绘制之前先绘制父控件的图片就行了。
最简单的方法是通过消息,让父控件绘制:
Self.Parent.Perform(WM_ERASEBKGND, DC, 0);
Self.Parent.Perform(WM_PrintClient, DC, prf_Client);
透明图片的话,如果要求不高,比如不需要拉伸,透明度调节,灰度等等呢,那么PngImage就可以了,毕竟GDI速度快是王道
我建议楼主学习一下功能强大的GDI+,呵呵,省去很多烦恼。。
孤独的行者牛 2011-12-10
  • 打赏
  • 举报
回复
显摆就不要了吧,贴出主要的源代码才是王道……
不得闲 2011-12-10
  • 打赏
  • 举报
回复
随意折腾!很多方法,用各种控件,自己写都行!
都先生 2011-12-09
  • 打赏
  • 举报
回复
TMS控件能够做到这个样式,不过皮肤还是要自己来做的。
freespace8 2011-12-09
  • 打赏
  • 举报
回复
Pngimage
加载更多回复(1)

5,926

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧