Delphi制作带渐变颜色Panel

//这个是一个组件,不能直接运行,需要安装:-)

  1 //全部完整代码，欢迎使用
  2 
  3 unit GradientPanel;
  4 
  5 interface
  6     
  7 uses
  8   Windows, Messages, SysUtils, Classes, Controls, Graphics, ExtCtrls;
  9 
 10 type
 11   TGradientPosition = (gpLeftToRight, gpTopToBottom, gpRightToLeft,
 12     gpBottomToTop); //颜色渐变方向
 13   TGradientPanel = class(TCustomPanel)
 14   private
 15     //FAlignment: TAlignment;
 16     FGradient: Boolean; //是否渐变
 17     FGradientStartColor: TColor; //渐变开始颜色
 18     FGradientEndColor: TColor; //渐变结束颜色
 19     FBorderColor: TColor; //边框颜色
 20     FGradientPosition: TGradientPosition; //渐变方向
 21     FHasBorder: Boolean;
 22     FOnMouseLeave: TNotifyEvent; //鼠标离开事件通知
 23     FOnMouseEnter: TNotifyEvent; //鼠标进入事件通知
 24     IsMouseOver: Boolean; //鼠标悬停,按下,抬起
 25     procedure SetGradient(const Value: Boolean); //设置是否渐变
 26     procedure SetGradientStartColor(const Value: TColor); //设置开始颜色
 27     procedure SetGradientEndColor(const Value: TColor); //设置结束颜色
 28     procedure SetGradientPosition(const Value: TGradientPosition);
 29     procedure SetBorder(const Value: Boolean);
 30     procedure SetBorderColor(const Value: TColor);
 31     procedure DrawPanel();
 32     procedure DrawBorder();
 33     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
 34     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
 35   protected
 36     procedure Paint; override;
 37 
 38   public
 39     constructor Create(AOwner: TComponent); override;
 40     destructor Destroy; override;
 41 
 42   published
 43     property Gradient: Boolean read FGradient write SetGradient default True;
 44     property GradientStartColor: Tcolor read FGradientStartColor write
 45       SetGradientStartColor default clwhite;
 46     property GradientEndColor: Tcolor read FGradientEndColor write
 47       SetGradientEndColor default clSkyBlue;
 48     property GradientPosition: TGradientPosition read FGradientPosition write
 49       SetGradientPosition default gpTopToBottom;
 50     property HasBorder: Boolean read FHasBorder write SetBorder default True;
 51     property BorderColor: TColor read FBorderColor write SetBorderColor default
 52       clBlack;
 53     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
 54     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
 55 
 56     property Alignment;
 57     property Action;
 58     property Caption;
 59     property Align;
 60     property ShowHint;
 61     property Visible;
 62     property Font;
 63     property OnCanResize;
 64     property OnClick;
 65     property OnContextPopup;
 66     property OnDblClick;
 67     property OnDockDrop;
 68     property OnDockOver;
 69     property OnDragDrop;
 70     property OnDragOver;
 71     property OnEndDock;
 72     property OnEndDrag;
 73     property OnEnter;
 74     property OnExit;
 75     property OnGetSiteInfo;
 76     property OnKeyDown;
 77     property OnKeyPress;
 78     property OnKeyUp;
 79     property OnMouseDown;
 80     property OnMouseMove;
 81     property OnMouseUp;
 82     property OnMouseWheel;
 83     property OnMouseWheelDown;
 84     property OnMouseWheelUp;
 85     property OnResize;
 86     property OnStartDock;
 87     property OnStartDrag;
 88     property OnUnDock;
 89   end;
 90 
 91 procedure Register;
 92 
 93 implementation
 94 
 95 procedure Register;
 96 begin
 97   RegisterComponents('Samples', [TGradientPanel]);
 98 end;
 99 
 { TGradientPanel }
 
 procedure TGradientPanel.CMMouseEnter(var Message: TMessage);
 begin
   inherited;
   IsMouseOver := true;
 
   {触发OnMouseEnter 事件}
   if Assigned(FOnMouseEnter) then
     FOnMouseEnter(Self);
   //Paint;
 end;
 
 procedure TGradientPanel.CMMouseLeave(var Message: TMessage);
 begin
   inherited;
   isMouseOver := false;
 
   {出发OnMouseLeave事件}
   if Assigned(FOnMouseLeave) then
     FOnMouseLeave(Self);
   //Paint;
 end;
 
 constructor TGradientPanel.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FGradient := True;
   FGradientStartColor := clwhite;
   FGradientEndColor := clSkyBlue;
   FGradientPosition := gpTopToBottom;
   FHasBorder := True;
   FBorderColor := clBlack;
 end;
 
 destructor TGradientPanel.Destroy;
 begin
 
   inherited;
 end;
 
 procedure TGradientPanel.DrawBorder;
 begin
   if not HasBorder then
     Exit;
   Self.Canvas.Pen.Color := FBorderColor;
   Self.Canvas.MoveTo(0, 0);
   Self.Canvas.LineTo(Self.Width - 1, 0);
   Self.Canvas.LineTo(Self.Width - 1, Self.Height - 1);
   Self.Canvas.LineTo(0, Self.Height - 1);
   Self.Canvas.LineTo(0, 0);
 end;
 
 procedure TGradientPanel.DrawPanel;
 var
   i: Integer;
   F: Single;
   Rect: TRect;
   Flags: Longint;
   FontHeight: Integer;
 begin
   Flags:=DT_EXPANDTABS or DT_NOPREFIX or DT_VCENTER or DT_CENTER;
   if not FGradient then
     Exit;
   case FGradientPosition of
     gpLeftToRight:
       begin
         for I := 0 to Self.Width do
         begin
           F := i / Self.Width;
           Self.Canvas.Pen.Color := RGB(Round(GetRValue(FGradientStartColor) * F
             + GetRValue(FGradientEndColor) * (1 - F)),
             Round(GetGValue(FGradientStartColor) * f +
             GetGValue(FGradientEndColor) * (1 - F)),
             Round(GetBValue(FGradientStartColor) * f +
             GetBValue(FGradientEndColor) * (1 - F)));
           Self.Canvas.MoveTo(i, 0);
           Self.Canvas.LineTo(i, Self.Height);
         end;
       end;
     gpTopToBottom:
       begin
         for I := 0 to Self.Height do
         begin
           F := i / Self.Height;
           Self.Canvas.Pen.Color := RGB(Round(GetRValue(FGradientStartColor) * F
             + GetRValue(FGradientEndColor) * (1 - F)),
             Round(GetGValue(FGradientStartColor) * f +
             GetGValue(FGradientEndColor) * (1 - F)),
             Round(GetBValue(FGradientStartColor) * f +
             GetBValue(FGradientEndColor) * (1 - F)));
           Self.Canvas.MoveTo(0, i);
           Self.Canvas.LineTo(Self.Width, i);
         end;
       end;
     gpRightToLeft:
       begin
         for I := 0 to Self.Width do
         begin
           F := i / Self.Width;
           Self.Canvas.Pen.Color := RGB(Round(GetRValue(FGradientEndColor) * F
             + GetRValue(FGradientStartColor) * (1 - F)),
             Round(GetGValue(FGradientEndColor) * f +
             GetGValue(FGradientStartColor) * (1 - F)),
             Round(GetBValue(FGradientEndColor) * f +
             GetBValue(FGradientStartColor) * (1 - F)));
           Self.Canvas.MoveTo(i, 0);
           Self.Canvas.LineTo(i, Self.Height);
         end;
       end;
     gpBottomToTop:
       begin
         for I := 0 to Self.Height do
         begin
           F := i / Self.Height;
           Self.Canvas.Pen.Color := RGB(Round(GetRValue(FGradientEndColor) * F
             + GetRValue(FGradientStartColor) * (1 - F)),
             Round(GetGValue(FGradientEndColor) * f +
             GetGValue(FGradientStartColor) * (1 - F)),
             Round(GetBValue(FGradientEndColor) * f +
             GetBValue(FGradientStartColor) * (1 - F)));
           Self.Canvas.MoveTo(0, i);
           Self.Canvas.LineTo(Self.Width, i);
         end;
       end;
   end;
   Rect := GetClientRect;
   Canvas.Brush.Style := bsClear;
   Canvas.Font:=Self.Font;
   FontHeight := Canvas.TextHeight('W');
  
    with Rect do
     begin
       Top := ((Bottom + Top) - FontHeight) div 2;
       Bottom := Top + FontHeight;
     end;
   case Self.Alignment of
     taLeftJustify:
       begin
        Flags :=DT_EXPANDTABS or DT_NOPREFIX or DT_VCENTER or DT_LEFT
       end;
     taCenter:
       begin
        Flags :=DT_EXPANDTABS or DT_NOPREFIX or DT_VCENTER or DT_CENTER
       end;
     taRightJustify:
       begin
        Flags :=DT_EXPANDTABS or DT_NOPREFIX or DT_VCENTER or DT_RIGHT
       end;
   end;
     Flags := DrawTextBiDiModeFlags(Flags);
     DrawText(Canvas.Handle, PChar(Self.Caption), -1,
           Rect, Flags);
 end;
 
 procedure TGradientPanel.Paint;
 
 begin
   inherited;
 
   DrawPanel;
   DrawBorder;
 
 end;
 
 procedure TGradientPanel.SetBorder(const Value: Boolean);
 begin
   FHasBorder := Value;
   Invalidate;
 end;
 
 procedure TGradientPanel.SetBorderColor(const Value: TColor);
 begin
   FBorderColor := Value;
   Invalidate;
 end;
 
 procedure TGradientPanel.SetGradient(const Value: Boolean);
 begin
   FGradient := Value;
   Invalidate;
 end;
 
 procedure TGradientPanel.SetGradientEndColor(const Value: TColor);
 begin
   FGradientEndColor := Value;
   Invalidate;
 end;
 
 procedure TGradientPanel.SetGradientPosition(const Value: TGradientPosition);
 begin
   FGradientPosition := Value;
   Invalidate;
 end;
 
 procedure TGradientPanel.SetGradientStartColor(const Value: TColor);
 begin
   FGradientStartColor := Value;
   Invalidate;
 end;
 
 end.