码迷,mamicode.com
首页 > Windows程序 > 详细

用Delphi写软件播放器

时间:2017-07-27 13:41:03      阅读:310      评论:0      收藏:0      [点我收藏+]

标签:透明   canvas   select   ring   proc   const   控件   matrix   pen   

  最近打算用Delphi写软件播放器,主要是界面问题,如果用Delphi控件来做界面,那实在是太麻烦了。所以最后决定用Delphi结合HTML来做,主要用到的是Delphi的webbrower来做,这样做的速度可能是原来的10倍,还不止。不过还是要写播放器方面的UI的,希望早日做好吧。用空还是要把http://blog.csdn.net/henreash/article/details/7571660使用GDI+绘制的360风格按钮控件 这个来学习滵学习的,其实Delphi来写界面来说还是比较简单的,写form就麻烦一些。

下面给出代码

将下面的代码拷贝到一个单元中,创建一个包,加入这个单元后安装.使用的时候设置好背景颜色,边框颜色,图标(png格式)相对路径的文件名称.这个控件可以利用PNG图像的颜色透明特性,背景色默认透明度为50%,可以将按钮后面的内容显示出来.GDIPAPI, GDIPOBJ, GDIPUTIL三个单元可用万一的博客上寻找下载地址.

技术分享

技术分享

技术分享

unit u360StyleButton;
  
interface  
  
uses  
  SysUtils, Classes, Controls, StdCtrls,Graphics, Messages, Windows,
  GDIPAPI, GDIPOBJ, GDIPUTIL;
  
type
  TBtn360Style = class(TButton)
  private
    FBkgColor: TColor; //鼠标悬停是的背景颜色
    FEdgColor: TColor; //边框颜色
    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; //必须重新找个函数 否则会按默认样式绘制
  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(128, FEdgColor and $FF, (FEdgColor shr 8) and $FF, (FEdgColor shr 16) 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(128, FBkgColor and $FF, (FBkgColor shr 8) and $FF, (FBkgColor shr 16) and $FF);
      img2.SetPixel(i, j, color);
    end;
  ARect := ClientRect;
  with DrawItemStruct do
    IsDown := itemState and ODS_SELECTED <> 0;
  if FMouseEnter then   //鼠标在按钮上 则绘制一个背景及边框
  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;
  //按钮被按下时的状态绘制
  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 + 10, img.GetHeight + 10, UnitPixel, imgAtt);
    FreeAndNil(imgAtt);
  end
  else  //绘制一个未按下的按钮
    g.DrawImage(img, (Width - img.GetWidth) div 2, 10);
  FreeAndNil(img);
  FreeAndNil(img2);
  FreeAndNil(g);
  FreeAndNil(pen);

  //绘制Caption文本内容    
  FCanvas.Font := Self.Font;   
  ARect:=ClientRect;   
  wh:=FCanvas.TextExtent(Caption);   
  FCanvas.Pen.Width := 1;   
  FCanvas.Brush.Style := bsClear;   
  if not Enabled then   
  begin //按钮失效时应多绘一次Caption文本    
    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.  

为防止以后忘掉,还是加一些说明。SNIS-623 HITMA-270

用Delphi写软件播放器

标签:透明   canvas   select   ring   proc   const   控件   matrix   pen   

原文地址:http://www.cnblogs.com/yaogua/p/7244209.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!