Recently intends to use Delphi to write software players, mainly interface problems, if you use the Delphi control to do the interface, it is too troublesome. So finally decided to use Delphi combined with HTML to do, the main use is the Delphi Webbrower to do, so the speed may be the original 10 times times, but also. But still want to write the UI of the player aspect, hope to do well soon. Empty or want to http://blog.csdn.net/henreash/article/details/7571660 use GDI + Draw 360 Style button control this to learn 滵 learning, in fact, Delphi to write interface is relatively simple, Writing a form is a bit of a hassle.
The code is given below
Copy the following code into a single unit, create a package, and install it after adding the unit. Use to set the background color, border color, icon (PNG format) relative path of the file name. This control can take advantage of the color transparency of PNG images, the default transparency of background color is 50%, You can display the contents of the button after it. Gdipapi, Gdipobj, gdiputil three units can be found on the blog if possible.
Unit U360stylebutton;
Interface
Uses
Sysutils, Classes, Controls, Stdctrls,graphics, Messages, Windows,
Gdipapi, Gdipobj, Gdiputil;
Type
Tbtn360style = Class (TButton)
Private
Fbkgcolor:tcolor; Mouse hover Yes background color
Fedgcolor:tcolor; Border color
Fcanvas:tcanvas;
Fmouseenter:boolean;
fpngfilename:string;
Procedure Cndrawitem (var message:twmdrawitem); Message Cn_drawitem;
Procedure Setpngfilename (const value:string);
Procedure Setbkgcolor (const value:tcolor);
Procedure Setedgcolor (const value:tcolor);
Protected
Procedure CreateParams (Var params:tcreateparams); override;
Procedure Cmmouseenter (var message:tmessage); Message Cm_mouseenter;
Procedure Cmmouseleave (var message:tmessage); Message Cm_mouseleave;
Procedure SetButtonStyle (Adefault:boolean); override; You must find a function again, otherwise it will be drawn as the default style.
Public
Constructor Create (aowner:tcomponent); override;
destructor Destroy;override;
Published
Property pngfilename:string read Fpngfilename write setpngfilename;
Property Bkgcolor:tcolor read Fbkgcolor write Setbkgcolor;
Property Edgcolor:tcolor read Fedgcolor write Setedgcolor;
End
Procedure Register;
Implementation
Constructor Tbtn360style.create (aowner:tcomponent);
Begin
Inherited Create (Aowner);
DoubleBuffered: = True;
Fcanvas: = tcanvas.create;
Fbkgcolor: = Clblue;
Fedgcolor: = Clskyblue;
End
destructor Tbtn360style.destroy;
Begin
Fcanvas.free;
Inherited Destroy;
End
Procedure Tbtn360style.createparams (var params:tcreateparams);
Begin
Inherited CreateParams (Params);
With Params do Style: = Style or Bs_ownerdraw;
End
Procedure Tbtn360style.setedgcolor (const value:tcolor);
Begin
If Fedgcolor <> Value Then
Begin
Fedgcolor: = Value;
Invalidate;
End
End
Procedure Tbtn360style.setbkgcolor (const value:tcolor);
Begin
If Fbkgcolor <> Value Then
Begin
Fbkgcolor: = Value;
Invalidate;
End
End
Procedure Tbtn360style.setbuttonstyle (Adefault:boolean);
Begin
If csdesigning in Componentstate then
inherited;
End
Procedure Tbtn360style.setpngfilename (const value:string);
Begin
If Fpngfilename <> Value Then
Begin
Fpngfilename: = Value;
Invalidate;
End
End
Procedure Tbtn360style.cmmouseenter (var message:tmessage);
Begin
inherited;
Fmouseenter: = True;
Invalidate;
End
Procedure Tbtn360style.cmmouseleave (var message:tmessage);
Begin
inherited;
Fmouseenter: = False;
Invalidate;
End
Procedure Tbtn360style.cndrawitem (var message:twmdrawitem);
Var
Isdown:boolean;
Arect:trect;
Drawitemstruct:tdrawitemstruct;
Wh:tsize;
G:tgpgraphics;
Pen:tgppen;
Img:tgpimage;
Img2:tgpbitmap;
Imgatt:tgpimageattributes;
I, J:integer;
Const
Colormatrix:tcolormatrix = (
(1.0, 0.0, 0.0, 0.0, 0.0),
(0.0, 1.0, 0.0, 0.0, 0.0),
(0.0, 0.0, 1.0, 0.0, 0.0),
(0.0, 0.0, 0.0, 1.0, 0.0),
(1.0, 0.0, 0.0, 0.0, 1.0));
Begin
drawitemstruct:=message.drawitemstruct^;
Fcanvas.handle: = DRAWITEMSTRUCT.HDC;
G: = Tgpgraphics.create (Fcanvas.handle);
Pen: = Tgppen.create (Gdipapi. Makecolor (Fedgcolor and $FF, (Fedgcolor shr 8) and $FF, (Fedgcolor shr) and $FF);
IMG: = tgpimage.create (Fpngfilename);
Img2: = Tgpbitmap.create (Width, Height);
For I: = 0 to Img2. GetWidth do
For J: = 0 to Img2. GetHeight do
Begin
Color: = Gdipapi. Makecolor (Fbkgcolor and $FF, (Fbkgcolor shr 8) and $FF, (Fbkgcolor shr) and $FF);
Img2. SetPixel (i, J, color);
End
Arect: = Clientrect;
With Drawitemstruct do
Isdown: = itemState and ods_selected <> 0;
If Fmouseenter then//mouse on button to draw a background and border
Begin
Perform ($000b, 0, 0);
G.drawimage (img2, 0, 0, Width, Height);
G.drawrectangle (pen, 0, 0, Width-1, Height-1);
Perform ($000b, 1, 0);
End
The state drawn when the button is pressed
If Isdown Then
Begin
Imgatt: = tgpimageattributes.create;
Imgatt.setcolormatrix (ColorMatrix, Colormatrixflagsdefault, Coloradjusttypedefault);
G.drawimage (IMG, makerect (0, 0, IMG). GetWidth, IMG. GetHeight),
-10, -10, IMG. GetWidth + Ten, img. GetHeight + ten, Unitpixel, Imgatt);
Freeandnil (Imgatt);
End
else//Draw a button that is not pressed
G.drawimage (IMG, width-img. getwidth) Div 2, 10);
Freeandnil (IMG);
Freeandnil (IMG2);
Freeandnil (g);
Freeandnil (pen);
Draw Caption text content
Fcanvas.font: = Self.font;
Arect:=clientrect;
Wh:=fcanvas.textextent (Caption);
FCanvas.Pen.Width: = 1;
FCanvas.Brush.Style: = Bsclear;
If not Enabled then
The Begin//button should be painted once more caption text when it fails
FCanvas.Font.Color: = Clbtnhighlight;
Fcanvas.textout ((Width Div 2)-(wh.cx Div 2), height-wh.cy-10,caption);
FCanvas.Font.Color: = Clbtnshadow;
End
Else
Fcanvas.textout ((Width Div 2)-(wh.cx Div 2), height-wh.cy-10,caption);
Fcanvas.handle: = 0;
End
Procedure Register;
Begin
Registercomponents (' henreashpackages ', [Tbtn360style]);
End
End.
To prevent forgetting later, add some instructions. SNIS-623 HITMA-270
Write software player with Delphi