Write software player with Delphi

Source: Internet
Author: User
Tags border color textout

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

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.