unit woGradientPanel;
{
        Webocton - GradientPanel

        Von TPanel abgeleitete Komponente welche einen Farbverlauf
        implementiert. Dieser Effekt kann beliebig an-/abgeschaltet
        werden (UseGradient) und über diverse Eigenschaften gesteuert
        werden (GradientColorA, GradientColorB, GradientDirection).

        Version vom: 27.09.2008

        Copyright 2004-2008 by Benedikt Loepp
        Webocton

        benedikt@webocton.de
        www.webocton.de

        ---

        Benötigt wird Borland Delphi+Visual Component Library
}

interface

uses
    SysUtils,
    Classes,
    Controls,
    ExtCtrls,
    Graphics,
    Windows,
    Themes;

type
    TwoGradientDirection = (gdTopToBottom, gdLeftToRight);

    TwoGradientPanel = class(TPanel)
    private
        FGradientColorA: TColor;
        FGradientColorB: TColor;
        FUseGradient: Boolean;
        FGradientDirection: TwoGradientDirection;
        procedure SetGradientColorA(Value: TColor);
        procedure SetGradientColorB(Value: TColor);
        procedure SetUseGradient(Value: Boolean);
        procedure SetGradientDirection(Value: TwoGradientDirection);
    protected
        procedure Paint; override;
    public
        constructor Create(AOwner: TComponent); override;
    published
        property GradientColorA: TColor read FGradientColorA write SetGradientColorA;
        property GradientColorB: TColor read FGradientColorB write SetGradientColorB;
        property UseGradient: Boolean read FUseGradient write SetUseGradient default TRUE;
        property GradientDirection: TwoGradientDirection read FGradientDirection write SetGradientDirection default gdLeftToRight;
    end;

procedure Register;

implementation

procedure Register;
begin
    RegisterComponents('Webocton - Components', [TwoGradientPanel]);
end;

constructor TwoGradientPanel.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);

    FUseGradient := TRUE;
    FGradientColorA := clGreen;
    FGradientColorB := clWhite;
    FGradientDirection := gdLeftToRight;
end;

procedure TwoGradientPanel.SetGradientDirection(Value: TwoGradientDirection);
begin
    FGradientDirection := Value;
    Paint;
end;

procedure TwoGradientPanel.SetUseGradient(Value: Boolean);
begin
    FUseGradient := Value;
    Paint;
end;

procedure TwoGradientPanel.SetGradientColorA(Value: TColor);
begin
    if (Value <> FGradientColorA) then
    begin
        FGradientColorA := Value;
        Paint;
    end;
end;

procedure TwoGradientPanel.SetGradientColorB(Value: TColor);
begin
    if (Value <> FGradientColorB) then
    begin
        FGradientColorB := Value;
        Paint;
    end;
end;

procedure TwoGradientPanel.Paint;
const
    Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);

var
    Rect: TRect;
    TopColor: TColor;
    BottomColor: TColor;
    FontHeight: Integer;
    Flags: Longint;

    i: Integer;

    rd: Double;
    gd: Double;
    bd: Double;

    r: Integer;
    g: Integer;
    b: Integer;

    r1: Integer;
    g1: Integer;
    b1: Integer;
    r2: Integer;
    g2: Integer;
    b2: Integer;

    procedure AdjustColors(Bevel: TPanelBevel);
    begin
        TopColor := clBtnHighlight;

        if (Bevel = bvLowered) then
            TopColor := clBtnShadow;

        BottomColor := clBtnShadow;

        if (Bevel = bvLowered) then
            BottomColor := clBtnHighlight;
    end;

begin
    Rect := GetClientRect;

    r := GetRValue(FGradientColorA);
    g := GetGValue(FGradientColorA);
    b := GetBValue(FGradientColorA);

    r1 := GetRValue(ColorToRGB(FGradientColorB));
    g1 := GetGValue(ColorToRGB(FGradientColorB));
    b1 := GetBValue(ColorToRGB(FGradientColorB));

    r2 := GetRValue(ColorToRGB(FGradientColorA));
    g2 := GetGValue(ColorToRGB(FGradientColorA));
    b2 := GetBValue(ColorToRGB(FGradientColorA));

    if (FGradientDirection = gdLeftToRight) then
    begin
        if (Rect.Right > 1) then
        begin
            rd := (r1 - r2) / (Rect.Right - 1);
            gd := (g1 - g2) / (Rect.Right - 1);
            bd := (b1 - b2) / (Rect.Right - 1);
        end
        else
        begin
            rd := (r1 - r2);
            gd := (g1 - g2);
            bd := (b1 - b2);
        end;

        for i := 1 to Rect.Right do
        begin
            Canvas.Pen.Color := RGB(r, g, b);
            Canvas.MoveTo(i - 1, 0);
            Canvas.LineTo(i - 1, Rect.Bottom);

            r := Trunc(r2 + i * rd);
            g := Trunc(g2 + i * gd);
            b := Trunc(b2 + i * bd);
        end;
    end
    else
    begin
        if (Rect.Bottom > 1) then
        begin
            rd := (r1 - r2) / (Rect.Bottom - 1);
            gd := (g1 - g2) / (Rect.Bottom - 1);
            bd := (b1 - b2) / (Rect.Bottom - 1);
        end
        else
        begin
            rd := (r1 - r2);
            gd := (g1 - g2);
            bd := (b1 - b2);
        end;

        for i := 1 to Rect.Bottom do
        begin
            Canvas.Pen.Color := RGB(r, g, b);
            Canvas.MoveTo(0, i - 1);
            Canvas.LineTo(Rect.Right, i - 1);

            r := Trunc(r2 + i * rd);
            g := Trunc(g2 + i * gd);
            b := Trunc(b2 + i * bd);
        end;
    end;

    if (((not ThemeServices.ThemesEnabled) or (not ParentBackground)) and (not FUseGradient)) then
    begin
        Canvas.Brush.Color := Color;
        Canvas.FillRect(Rect);
    end;

    if (BevelOuter <> bvNone) then
    begin
        AdjustColors(BevelOuter);
        Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
    end;
    Frame3D(Canvas, Rect, Color, Color, BorderWidth);
    if (BevelInner <> bvNone) then
    begin
        AdjustColors(BevelInner);
        Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
    end;

    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;

    Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
    Flags := DrawTextBiDiModeFlags(Flags);
    DrawText(Canvas.Handle, PChar(Caption), -1, Rect, Flags);
end;

end.