PC World Komputer 1998 April A/Pcwk4a98.iso/PROGRAM/DELPHI16/KTMBEVEL/KTMBEVEL.PAS

Pascal/Delphi Source File | 1997-11-19 | 31.5 KB | 1,227 lines

unit ktMBevel; { v2.1b    11/20/1997 - Bugfix in bspPortrait painting}

interface

uses
    {$IFDEF    Win32} Windows,    {$ELSE}    WinTypes,    WinProcs,    {$ENDIF} Classes,
    ExtCtrls,    Controls,    Graphics,    SysUtils,    Messages;

type
    TBevelStyle    =    (bstLowered, bstNone,    bstRaised);
    TBevelShape    =    (bspBottomLine,    bspLeftLine, bspPortrait,    bspRect, bspRightLine,
                                    bspTopLine);
    TBevelWidth    =    1..MaxInt;
    TBorderWidth = 0..MaxInt;
    TDensity = 0..100;
    TShadowStyle = (ssBlack, ssCopy, ssDithered, ssMask, ssMaskNotPen, ssMerge,
                                    ssMergeNotPen, ssNot,    ssNotAND,    ssNotCopy, ssNotMask,    ssNotMerge,
                                    ssNotOR, ssNotXOR, ssTransparent,    ssWhite, ssXOR);
    TTransparence    =    (trNone, trSemi, trTransparent);

type
    TktMBevel    =    class(TGraphicControl)
    private
        FBevelInner: TBevelStyle;
        FBevelOuter: TBevelStyle;
        FBevelWidth: TBevelWidth;
        FBorderWidth:    TBorderWidth;
        FColor:    TColor;
        FColorDensity: TDensity;
        FColorFixed: Boolean;
        FColorHighlight: TColor;
        FColorShadow:    TColor;
        FDensityDepended:    Boolean;
        FEdgeSize: Integer;
        FShadowColor:    TColor;
        FShadowDensity:    TDensity;
        FShadowed: Boolean;
        FShadowOffsetX:    Integer;
        FShadowOffsetY:    Integer;
        FShadowStyle:    TShadowStyle;
        FShape:    TBevelShape;
        FTransparence: TTransparence;
        TempDensity: TDensity;
        procedure    SetBevelInner(Value: TBevelStyle);
        procedure    SetBevelOuter(Value: TBevelStyle);
        procedure    SetBevelWidth(Value: TBevelWidth);
        procedure    SetBorderWidth(Value:    TBorderWidth);
        procedure    SetColor(Value:    TColor);
        procedure    SetColorDensity(Value: TDensity);
        procedure    SetColorHighlight(Value: TColor);
        procedure    SetColorFixed(Value: Boolean);
        procedure    SetColorShadow(Value:    TColor);
        procedure    SetDensityDepended(Value:    Boolean);
        procedure    SetEdgeSize(Value: Integer);
        procedure    SetShadowColor(Value:    TColor);
        procedure    SetShadowDensity(Value:    TDensity);
        procedure    SetShadowed(Value: Boolean);
        procedure    SetShadowOffsetX(Value:    Integer);
        procedure    SetShadowOffsetY(Value:    Integer);
        procedure    SetShadowStyle(Value:    TShadowStyle);
        procedure    SetShape(Value:    TBevelShape);
        procedure    SetTransparence(Value: TTransparence);
    protected
        procedure    Paint; override;
    public
        constructor    Create(AOwner: TComponent);    override;
        destructor Destroy;    override;
    published
        property Align;
        property BevelInner: TBevelStyle read    FBevelInner    write    SetBevelInner
                                default    bstRaised;
        property BevelOuter: TBevelStyle read    FBevelOuter    write    SetBevelOuter
                                default    bstLowered;
        property BevelWidth: TBevelWidth read    FBevelWidth    write    SetBevelWidth    default    1;
        property BorderWidth:    TBorderWidth read    FBorderWidth write SetBorderWidth
                                default    0;
        property Color:    TColor read    FColor write SetColor    default    clBtnFace;
        property ColorFixed: Boolean read    FColorFixed    write    SetColorFixed    default    True;
        property ColorHighlight: TColor    read FColorHighlight write SetColorHighlight
                                default    clBtnHighlight;
        property ColorShadow:    TColor read    FColorShadow write SetColorShadow
                                default    clBtnShadow;
        property ColorDensity: TDensity    read FColorDensity write SetColorDensity
                                default    100;
        property DensityDepended:    Boolean    read FDensityDepended    write
                                SetDensityDepended default True;
        property EdgeSize: Integer read    FEdgeSize    write    SetEdgeSize    default    15;
        property ParentShowHint;
        property ShadowColor:    TColor read    FShadowColor write SetShadowColor
                                default    clGray;
        property ShadowDensity:    TDensity read    FShadowDensity write SetShadowDensity
                                default    60;
        property Shadowed: Boolean read    FShadowed    write    SetShadowed    default    False;
        property ShadowOffsetX:    Integer    read FShadowOffsetX    write    SetShadowOffsetX
                                default    3;
        property ShadowOffsetY:    Integer    read FShadowOffsetY    write    SetShadowOffsetY
                                default    3;
        property ShadowStyle:    TShadowStyle read    FShadowStyle write SetShadowStyle
                                default    ssDithered;
        property Shape:    TBevelShape    read FShape    write    SetShape default bspRect;
        property ShowHint;
        property Transparence: TTransparence read    FTransparence    write    SetTransparence
                                default    trNone;
        property Visible;
end;

    {    TktMultiBevel    Class    Inheritance    }

    TktMultiBevel    =    class(TktMBevel)
    private
    protected
    public
        constructor    Create(AOwner: TComponent);    override;
    published
        property Align;
        property BevelInner;
        property BevelOuter;
        property BevelWidth;
        property BorderWidth;
        property Color;
        property ColorFixed;
        property ColorHighlight;
        property ColorShadow;
        property EdgeSize;
        property ParentShowHint;
        property ShadowColor;
        property Shadowed;
        property ShadowOffsetX;
        property ShadowOffsetY;
        property ShadowStyle;
        property Shape;
        property ShowHint;
        property Transparence;
        property Visible;
    end;

    {    TktBevelButton Class Inheritance }

    TktBevelButton = class(TktMBevel)
    private
        FOnEnter:    TNotifyEvent;
        FOnExit: TNotifyEvent;
        FOnMouseDown:    TNotifyEvent;
        FOnMouseUp:    TNotifyEvent;
    protected
        procedure    Paint; override;
        procedure    MouseDown(Button:    TMouseButton;    Shift: TShiftState;    X, Y:    Integer);    override;
        procedure    MouseUp(Button:    TMouseButton;    Shift: TShiftState;    X, Y:    Integer);    override;
    public
        constructor    Create(AOwner: TComponent);    override;
        procedure    CMMouseEnter(var msg:TMessage);    message    CM_MOUSEENTER;
        procedure    CMMouseLeave(var msg:    TMessage); message CM_MOUSELEAVE;
    published
        property Align;
        property BevelInner;
        property BevelOuter;
        property BevelWidth;
        property BorderWidth;
        property Color;
        property ColorDensity;
        Property DensityDepended;
        property ColorFixed;
        property ColorHighlight;
        property ColorShadow;
        property EdgeSize;
        property ParentShowHint;
        property ShadowColor;
        property ShadowDensity;
        property Shadowed;
        property ShadowOffsetX;
        property ShadowOffsetY;
        property ShadowStyle;
        property Shape;
        property ShowHint;
        property Transparence;
        property Visible;

        property OnClick;
        property OnEnter:    TNotifyEvent read    FOnEnter write FOnEnter;
        property OnExit: TNotifyEvent    read FOnExit write FOnExit;
        property OnMouseDown:    TNotifyEvent read    FOnMouseDown write FOnMouseDown;
        property OnMouseUp:    TNotifyEvent read    FOnMouseUp write FOnMouseUp;
    end;

procedure    Register;


implementation

{$IFDEF    Win32}
    {$R    *.d32}
{$ELSE}
    {$R    *.d16}
{$ENDIF}


procedure    Register;
begin
    RegisterComponents('Samples',[TktMultiBevel, TktBevelButton]);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}

{     Utilities    }

function Min(X,    Y: Integer): Integer;
begin
    if X < Y then    Result:= X else    Result:= Y;
end;

function Max(X,    Y: Integer): Integer;
begin
    if X > Y then    Result:= X else    Result:= Y;
end;

function CheckBackground(Canvas: TCanvas;    var    Rect:    TRect):    Boolean;
var
    x: Integer;    SColor:    TColor;
begin
    Result:= False;
    with Canvas, Rect    do
    begin
        SColor:= Pixels[Left,Top];
        for    x:=    Left + 1 to    Right    -    1    do
        begin
            Result:= abs((SColor - Pixels[x, Top]))    >    2;
            if Result    =    True then    Break;
        end;
    end;
end;

function CorrectColor(C    :    Real)    :    Integer;
begin
    Result :=    Round(C);
    if Result    >    255    then Result    := 255;
    if Result    <    0    then Result    := 0;
end;

function MergeColorExt(C1, C2    :    TColor;    Grade: Byte) : TColor;
var
    R, G,    B    :    Real;
begin
    R    := (GetRValue(C1)    *    Grade    /    100    +    GetRValue(C2)    *    (100-Grade)    /    100);
    G    := (GetGValue(C1)    *    Grade    /    100    +    GetGValue(C2)    *    (100-Grade)    /    100);
    B    := (GetBValue(C1)    *    Grade    /    100    +    GetBValue(C2)    *    (100-Grade)    /    100);
    Result :=    RGB(CorrectColor(R), CorrectColor(G),    CorrectColor(B));
end;

procedure    Frame3DPortrait(Canvas:    TCanvas; var Rect: TRect;
 topColor, BottomColor:    TColor;    Width: Integer;    Edge:    Integer);
var
    P1,    P2,    P3,    P4,    P5,    P6,    P7,    P8:    TPoint;
    i: Integer;
begin
    dec(Rect.Bottom);
    dec(Rect.Right);
    for    i:=    0    to Width - 1 do
    begin
        with Canvas, Rect    do
        begin
            P1.x:= Left    +    i;
            P1.y:= Bottom    -    Edge - i div 2;
            P2.x:= P1.x;
            P2.y:= Top + Edge    +    i    div    2;
            P3.x:= Left    +    Edge + i div 2;
            P3.y:= Top + i;
            P4.x:= Right - Edge    -    i    div    2;
            P4.y:= P3.y;
            P5.x:= Right - i;
            P5.y:= P2.y;
            P6.x:= P5.x;
            P6.y:= P1.y;
            P7.x:= P4.x;
            P7.y:= Bottom    -    i;
            P8.x:= P3.x;
            P8.y:= P7.y;
            Pen.Width:=    1;
            Pen.Color:=    TopColor;
            PolyLine([P1,    P2,    P3,    P4,    P5]);
            Pen.Color:=    BottomColor;
            PolyLine([P5,    P6,    P7,    P8,    P1]);
        end;
    end;
    for    i:=    1    to (Width    -    1) div 2 do
    begin
        with Canvas, Rect    do
        begin
            Pen.Color:=    TopColor;
            P2.x:= Left    +    2*i    -    1;
            P2.y:= Top + Edge    +    i;
            MoveTo(Left    +    Edge + i - 1,Top + 2*i);
            LineTo(P2.x,P2.y);
            P5.x:= Right - 2*i + 1;
            P5.y:= P2.y;
            MoveTo(Right - Edge    -    i    +    1,Top    +    2*i);
            LineTo(P5.x,P5.y);
            Pen.Color:=    BottomColor;
            P6.x:= P5.x;
            P6.y:= Bottom    -    Edge - i;
            MoveTo(Right - Edge    -    i    +    1,Bottom - 2*i);
            LineTo(P6.x,P6.y);
            P1.x:= P2.x;
            P1.y:= P6.y;
            MoveTo(Left    +    Edge + i - 1,Bottom    -    2*i);
            LineTo(P1.x,P1.y);
        end;
    end;
end;

procedure    EffectRect(Canvas: TCanvas;    var    Rect:    TRect; Pen:    TPen);
var
    i: Integer;
begin
    with Canvas, Rect    do
    begin
        if (Right    -Left) < (Bottom -Top) then
        begin
            for    i:=    Left to    Right    do
            begin
                MoveTo(i,    Top);
                LineTo(i,    Bottom + 1);
            end;
        end
        else
        begin
            for    i:=    Top    to Bottom    do
            begin
                MoveTo(Left, i);
                LineTo(Right + 1,    i);
            end;
        end;
    end;
end;

procedure    DitheredRect(Canvas: TCanvas;    var    Rect:    TRect; Color:    TColor;
                        Density: Integer);
var
    x, y:    Integer;
begin
    with Canvas, Rect    do
    begin
        for    y:=    Top    to Bottom    do
            for    x:=    Left to    Right    do
                Pixels[x,    y]:= MergeColorExt(Color,    Pixels[x,    y],    Density);
    end;
end;

procedure    FrameDitheredRect(Canvas:    TCanvas; var Rect: TRect;
     Color:    TColor;    Density, Width:    Integer);
var
    i, j,    k, l,    x, y:    Integer;
begin
    dec(Rect.Right);
    dec(Rect.Bottom);
    with Canvas, Rect    do
    begin
        i:=    Top    +    Width;
        j:=    Bottom - Width;
        k:=    Left + Width - 1;
        l:=    Right    -    Width    +    1;
        for    y:=    Top    to Bottom    do
        begin
            if (y    <    i) or    (y > j)    then
                for    x:=    Left to    Right    do
                    Pixels[x,    y]:= MergeColorExt(Color,    Pixels[x,    y],    Density)
            else
            begin
                for    x:=    Left to    k    do
                    Pixels[x,    y]:= MergeColorExt(Color,    Pixels[x,    y],    Density);
                for    x:=    l    to Right do
                    Pixels[x,    y]:= MergeColorExt(Color,    Pixels[x,    y],    Density);
            end;
        end;
    end;
end;

procedure    FrameDitheredPortrait(Canvas:    TCanvas; var Rect: TRect;
     Color:    TColor;    Density, Width,    Edge:    Integer);
var
    P1,    P2,    P3,    P4:    TPoint;
    i, j,    k, l,    m, x:    Integer;

begin
    dec(Rect.Bottom);    dec(Rect.Right);
    with Canvas, Rect    do
    begin
        j:=    Bottom - Top;
        for    i:=    1    to Width do
        begin
            P1.x:= Left    +    Edge - i;
            P1.y:= Top + i - 1;
            P2.x:= Right - Edge    +    i;
            for    x:=    P1.x to    P2.x do
                 Pixels[x, P1.y]:= MergeColorExt(Color,    Pixels[x,    P1.y], Density);
        end;
        m:=    i;
        for    i:=    m    to Edge    +    Width    div    3    do
        begin
            if i <=    Edge then
            begin
                P1.x:= Left    +    Edge - i;
                P2.x:= Right - Edge    +    i;
                P3.x:= P1.x    +    Width    +    Width    div    3;
                P4.x:= P2.x    -    Width    -    Width    div    3;
            end
            else
            begin
                P1.x:= Left;
                P2.x:= Right;
                P3.x:= P1.x    +    Width    +    Width    div    3    -    (i - Edge);
                P4.x:= P2.x    -    Width    -    Width    div    3    +    (i - Edge);
            end;
            P1.y:= Top + i - 1;
            for    x:=    P1.x to    P3.x do
                 Pixels[x, P1.y]:= MergeColorExt(Color,    Pixels[x,    P1.y], Density);
            for    x:=    P4.x to    P2.x do
                 Pixels[x, P1.y]:= MergeColorExt(Color,    Pixels[x,    P1.y], Density);
        end;
        m:=    i;
        for    i:=    m    to j - Edge    -    (Width)    div    3    +    1    do
        begin
            P1.x:= Left;
            P2.x:= Right;
            P3.x:= Left    +    Width    -    1;
            P4.x:= P2.x    -    Width    +    1;
            P1.y:= Top + i - 1;
            for    x:=    P1.x to    P3.x do
                 Pixels[x, P1.y]:= MergeColorExt(Color,    Pixels[x,    P1.y], Density);
            for    x:=    P4.x to    P2.x do
                 Pixels[x, P1.y]:= MergeColorExt(Color,    Pixels[x,    P1.y], Density);
        end;
        m:=    i;
        k:=    0;
        for    i:=    m    to j - Width + 1 do
        begin
            l:=    i    -    m;
            begin
                if i <=    j    -    Edge + 1 then
                begin
                    P1.x:= Left;
                    P2.x:= Right;
                    P3.x:= P1.x    +    Width    +    l;
                    P4.x:= P2.x    -    Width    -    l    ;
                end
                else
                begin
                    P1.x:= Left    +    k;
                    P2.x:= Right - k;
                    P3.x:= P1.x    +    Width    +    Width    div    3;
                    P4.x:= P2.x    -    Width    -    Width    div    3;
                    inc(k);
                end;
                P1.y:= Top + i - 1;
                for    x:=    P1.x to    P3.x do
                    Pixels[x,    P1.y]:=    MergeColorExt(Color, Pixels[x, P1.y],    Density);
                for    x:=    P4.x to    P2.x do
                    Pixels[x,    P1.y]:=    MergeColorExt(Color, Pixels[x, P1.y],    Density);
            end;
        end;
        m:=    i;
        for    i:=    m    to j + 1 do
        begin
            P1.x:= Left    +    k;
            P2.x:= Right - k;
            inc(k);
            P1.y:= Top + i - 1;
            for    x:=    P1.x to    P2.x do
                 Pixels[x, P1.y]:= MergeColorExt(Color,    Pixels[x,    P1.y], Density);
        end;
    end;
end;

{     TktMBevel    }

constructor     TktMBevel.Create(AOwner:    TComponent);
begin
    inherited    Create(AOwner);
        FBevelInner:=    bstRaised;
        FBevelOuter:=    bstLowered;
        FBevelWidth:=    1;
        FBorderWidth:= 0;
        FColor:= clBtnFace;
        FColorDensity:=    100;
        FColorFixed:=    True;
        FColorHighlight:=    clBtnHighlight;
        FColorShadow:= clBtnShadow;
        FDensityDepended:= True;
        FShadowDensity:= 50;
        FEdgeSize:=    15;
        Height:= 50;
        FShadowColor:= clGray;
        FShadowDensity:= 60;
        FShadowed:=    False;
        FShadowOffsetX:= 3;
        FShadowOffsetY:= 3;
        FShadowStyle:= ssDithered;
        FShape:= bspRect;
        FTransparence:=    trNone;
        TempDensity:=    50;
        Width:=    75;
end;

destructor TktMBevel.Destroy;
begin
    inherited    Destroy;
end;

procedure    TktMBevel.SetBevelInner(Value: TBevelStyle);
begin
    if Value <>    FBevelInner    then
    begin
        FBevelInner:=    Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetBevelOuter(Value: TBevelStyle);
begin
    if Value <>    FBevelOuter    then
    begin
        FBevelOuter:=    Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetBevelWidth(Value: TBevelWidth);
begin
    if Value <>    FBevelWidth    then
    begin
        FBevelWidth:=    Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetBorderWidth(Value:    TBorderWidth);
begin
    if Value <>    FBorderWidth then
    begin
        FBorderWidth:= Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetColor(Value:    TColor);
begin
    if FColor    <> Value then    FColor:= Value;
    if FColorFixed then
    begin
        if FColor    =    clBtnFace    then
        begin
            FColorHighlight:=    clBtnHighlight;
            FColorShadow:= clBtnShadow;
        end
        else
        begin
            FColorHighlight:=    MergeColorExt(FColor,clWhite,33);
            FColorShadow:= MergeColorExt(FColor,clBlack,66);
        end;
    end;
    Invalidate;
end;

procedure    TktMBevel.SetColorDensity(Value: TDensity);
begin
    if FColorDensity <>    Value    then
    begin
        FColorDensity:=    Value;
        if FTransparence = trSemi    then TempDensity:= Value;
        if    FDensityDepended then    FShadowDensity:= Round(FColorDensity * 60    /    100);
        Invalidate;
    end;
end;

procedure    TktMBevel.SetColorHighlight(Value: TColor);
begin
    if not FColorFixed then
    begin
        if Value <>    FColorHighlight    then
        begin
            FColorHighlight:=    Value;
            Invalidate;
        end;
    end;
end;

procedure    TktMBevel.SetColorShadow(Value:    TColor);
begin
    if not FColorFixed then
    begin
        if Value <>    FColorShadow then
        begin
            FColorShadow:= Value;
            Invalidate;
        end;
    end;
end;

procedure    TktMBevel.SetColorFixed(Value: Boolean);
begin
    if Value <>    FColorFixed    then FColorFixed:= Value;
    if FColorFixed then    SetColor(FColor)
        else Invalidate;
end;

procedure    TktMBevel.SetDensityDepended(Value:    Boolean);
var    d: TDensity;
begin
    if Value <>    FDensityDepended then
    begin
        FDensityDepended:= Value;
        d:=    Round(FColorDensity    *    60 / 100);
        if (FDensityDepended = True) and (FShadowDensity <>    d) then
        begin
            FShadowDensity:= d;
            if FShadowStyle    =    ssDithered then    Invalidate;
        end;
    end;
end;

procedure    TktMBevel.SetEdgeSize(Value: Integer);
begin
    if Value <>    FEdgeSize    then
    begin
        FEdgeSize:=    Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetShadowColor(Value:    TColor);
begin
    if Value <>    FShadowColor then
    begin
        FShadowColor:= Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetShadowDensity(Value:    TDensity);
begin
    if not FDensityDepended    then
    begin
        if Value <>    FShadowDensity then
        begin
            FShadowDensity:= Value;
            Invalidate;
        end;
    end;
end;

procedure    TktMBevel.SetShadowed(Value: Boolean);
begin
    if (Value    <> FShadowed)    and    (FTransparence <>    trTransparent) then
    begin
        FShadowed:=    Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetShadowOffsetX(Value:    Integer);
begin
    if Value <>    FShadowOffsetX then
    begin
        FShadowOffsetX:= Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetShadowOffsetY(Value:    Integer);
begin
    if Value <>    FShadowOffsetY then
    begin
        FShadowOffsetY:= Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetShadowStyle(Value:    TShadowStyle);
begin
    if Value <>    FShadowStyle then
    begin
        FShadowStyle:= Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetShape(Value:    TBevelShape);
begin
    if Value <>    FShape then
    begin
        FShape:= Value;
        Invalidate;
    end;
end;

procedure    TktMBevel.SetTransparence(Value: TTransparence);
begin
    if Value <>    FTransparence    then
    begin
        FTransparence:=    Value;
        case FTransparence of
            trTransparent    :    begin
                                                FShadowed:=    False;
                                                SetColorDensity(0);
                                            end;
            trNone                :    SetColorDensity(100);
            trSemi                :    SetColorDensity(TempDensity);
        end;
    end;
end;

procedure    TktMBevel.Paint;
var
    Rc,    RectA: TRect;
    s, s1, s2, ox, oy: Integer;
    P1,    P2,    P3,    P4,    P5:    TPoint;

    procedure    CalcShadow;
    begin
        case FShape    of
            bspTopLine     : begin
                                                P1.x:= max(ox, 0);
                                                P1.y:= max(oy, 0);
                                                P2.x:= min(Rc.Right, Rc.Right    +    ox);
                                                P2.y:= P1.y    +    s    -    1;
                                            end;
            bspBottomLine    :    begin
                                                P1.x:= max(ox, 0);
                                                P2.y:= min(Rc.Bottom + oy    -    1, Rc.Bottom - 1);
                                                P2.x:= min(Rc.Right, Rc.Right    +    ox);
                                                P1.y:= P2.y    -    s    +    1;
                                            end;
            bspLeftLine        :    begin
                                                P1.x:= max(ox, 0);
                                                P1.y:= max(oy, 0);
                                                P2.x:= P1.x    +    s    -    1;
                                                P2.y:= min(Rc.Bottom - 1,    Rc.Bottom    +    oy - 1);
                                            end;
            bspRightLine : begin
                                                P2.x:= min(Rc.Right    -    1, Rc.Right    +    ox - 1);
                                                P1.y:= max(oy, 0);
                                                P1.x:= P2.x    -    s    +    1;
                                                P2.y:= min(Rc.Bottom + oy    -    1, Rc.Bottom - 1);
                                            end;
            bspPortrait,
            bspRect                :    begin
                                                P1.x:= max(ox, 0);
                                                P1.y:= max(oy, 0);
                                                P2.x:= min(Rc.Right, Rc.Right    +    ox);
                                                P2.y:= min(Rc.Bottom,    Rc.Bottom    +    oy);
                                            end;
        end;
        P3.x:= P2.x;
        P3.y:= P1.y;
        P4.x:= P1.x;
        P4.y:= P2.y;
        P5:= P1;
        RectA:=    rect(P1.x, P1.y, P2.x, P2.y);
    end;

    procedure    PaintDithered;
    begin
        with Canvas    do
        begin
            Pen.Mode:= pmCopy;
            case Shape of
                bspBottomLine,
                bspLeftLine,
                bspRightLine,
                bspTopLine        :    DitheredRect(Canvas, RectA,    FShadowColor,    FShadowDensity);
                bspRect                :    FrameDitheredRect(Canvas,    RectA, FShadowColor, FShadowDensity, s);
                bspPortrait        :    FrameDitheredPortrait(Canvas,    RectA, FShadowColor, FShadowDensity,
                                                    s, FEdgeSize);
            end;
        end;
    end;

    procedure    PaintShadow;
    var
        i: Integer;
    begin
        with Canvas    do
        begin
            Pen.Width:=    1;
            Pen.Color:=    FShadowColor;
            case FShadowStyle    of
                ssBlack                :    Pen.Mode:= pmBlack;
                ssCopy                :    Pen.Mode:= pmCopy;
                ssDithered        :    begin
                                                    if CheckBackGround(Canvas, RectA)    then
                                                    begin
                                                        PaintDithered;
                                                        Exit;
                                                    end
                                                    else
                                                    begin
                                                        Pen.Mode:= pmCopy;
                                                        Pen.Color:=    MergeColorExt(FShadowColor,
                                                                    Pixels[RectA.Left, RectA.Top],FShadowDensity);
                                                    end;
                                                end;
                ssMask                :    Pen.Mode:= pmMask;
                ssMaskNotPen    :    Pen.Mode:= pmMaskNotPen;
                ssMerge                :    Pen.Mode:= pmMerge;
                ssMergeNotPen    :    Pen.Mode:= pmMergeNotPen;
                ssNot                    :    Pen.Mode:= pmNot;
                ssNotAND            :    Pen.Mode:= pmMaskPenNot;
                ssNotCopy            :    Pen.Mode:= pmNotCopy;
                ssNotMask            :    Pen.Mode:= pmNotMask;
                ssNotMerge        :    Pen.Mode:= pmNotMerge;
                ssNotOR                :    Pen.Mode:= pmMergePenNot;
                ssNotXOR            :    Pen.Mode:= pmNotXor;
                ssTransparent    :    Pen.Mode:= pmNop;
                ssWhite                :    Pen.Mode:= pmWhite;
                ssXOR                    :    Pen.Mode:= pmXor;
            end;
            case FShape    of
                bspRect                :    begin
                                                    for    i:=    1    to s do
                                                    begin
                                                        dec(P2.x);
                                                        dec(P2.y);
                                                        P3.x:= P2.x;
                                                        P4.y:= P2.y;
                                                        PolyLine([P1,    P3,    P2,    P4,    P1]);
                                                        inc(P1.x);
                                                        inc(P1.y);
                                                        P3.y:= P1.y;
                                                        P4.x:= P1.x;
                                                    end;
                                                end;
                bspPortrait        :    Frame3DPortrait(Canvas,    RectA, Pen.Color, Pen.Color,
                                                    s, FEdgeSize);
                bspBottomLine,
                bspLeftLine,
                bspRightLine,
                bspTopLine     : EffectRect(Canvas,    RectA, Pen);
            end;
            Pen.Mode:= pmCopy;
            Pen.Style:=    psSolid;
        end;
    end;

    procedure    CalcBevelOuter;
    begin
        case FShape    of
            bspTopLine     : begin
                                                P1.x:= max(-ox,    0);
                                                P1.y:= max(-oy,    0);
                                                P2.x:= min(Rc.Right, Rc.Right    -    ox);
                                                P2.y:= P1.y    +    s;
                                            end;
            bspBottomLine    :    begin
                                                P1.x:= max(-ox,    0);
                                                P2.y:= min(Rc.Bottom,    Rc.Bottom    -    oy);
                                                P2.x:= min(Rc.Right, Rc.Right    -    ox);
                                                P1.y:= P2.y    -    s;
                                            end;
            bspLeftLine        :    begin
                                                P1.x:= max(-ox,    0);
                                                P1.y:= max(-oy,    0);
                                                P2.x:= P1.x    +    s;
                                                P2.y:= min(Rc.Bottom,    Rc.Bottom    -    oy);
                                            end;
            bspRightLine : begin
                                                P2.x:= min(Rc.Right, Rc.Right    -    ox);
                                                P1.y:= max(-oy,    0);
                                                P1.x:= P2.x    -    s;
                                                P2.y:= min(Rc.Bottom,    Rc.Bottom    -    oy);
                                            end;
            bspRect, bspPortrait:    begin
                                                            P1.x:= max(-ox,    0);
                                                            P1.y:= max(-oy,    0);
                                                            P2.x:= min(Rc.Right, Rc.Right    -    ox);
                                                            P2.y:= min(Rc.Bottom,    Rc.Bottom    -    oy);
                                                        end;
        end;
        RectA:=    rect(P1.x, P1.y, P2.x, P2.y);
    end;

    procedure    PaintBevelOuter;
    begin
        with Canvas, RectA do
        begin
            if FShape    =    bspPortrait    then
            begin
                case FBevelOuter of
                    bstLowered:    Frame3DPortrait(Canvas,    RectA, FColorShadow, FColorHighlight,
                                                FBevelWidth, FEdgeSize);
                    bstRaised    :    Frame3DPortrait(Canvas,    RectA, FColorHighlight,    FColorShadow,
                                                FBevelWidth, FEdgeSize);
                end;
            end
            else
            case FBevelOuter of
                bstLowered:    Frame3D(Canvas,    RectA, FColorShadow, FColorHighlight,    FBevelWidth);
                bstRaised    :    Frame3D(Canvas,    RectA, FColorHighlight,    FColorShadow,    FBevelWidth);
            end;
        end;
    end;

    procedure    CalcBorder;
    var    v: Integer;
    begin
        if FBevelOuter <>    bstNone    then
        begin
            case FShape    of
                bspTopLine     : begin
                                                    P1.x:= max(FBevelWidth - ox, FBevelWidth);
                                                    P1.y:= max(FBevelWidth - oy, FBevelWidth);
                                                    P2.x:= min(Rc.Right    -    FBevelWidth    -    1, Rc.Right    -    ox
                                                                     - FBevelWidth - 1);
                                                    P2.y:= P1.y    +    FBorderwidth - 1;
                                                end;
                bspBottomLine    :    begin
                                                    P1.x:= max(FBevelWidth - ox, FBevelWidth);
                                                    P2.y:= min(Rc.Bottom - 1 - FBevelWidth,    Rc.Bottom    -    1
                                                                        -    oy - FBevelWidth);
                                                    P2.x:= min(Rc.Right    -    1    -    FBevelWidth, Rc.Right     - 1
                                                                        -    ox - FBevelWidth);
                                                    P1.y:= P2.y    -    FBorderwidth + 1;
                                                end;
                bspLeftLine        :    begin
                                                    P1.x:= max(FBevelWidth - ox, FBevelWidth);
                                                    P1.y:= max(FBevelWidth - oy, FBevelWidth);
                                                    P2.x:= P1.x    +    FBorderWidth - 1;
                                                    P2.y:= min(Rc.Bottom - FBevelWidth - 1,    Rc.Bottom    -    oy
                                                                 - FBevelWidth - 1);
                                                end;
                bspRightLine : begin
                                                    P2.x:= min(Rc.Right    -    FBevelWidth    -    1, Rc.Right    -    ox
                                                                 - FBevelWidth - 1);
                                                    P1.y:= max(FBevelWidth - oy, FBevelWidth);
                                                    P1.x:= P2.x    -    FBorderWidth + 1;
                                                    P2.y:= min(Rc.Bottom - FBevelWidth - 1,    Rc.Bottom    -    oy
                                                                 - FBevelWidth - 1);
                                                end;
                bspRect, bspPortrait:    begin
                                                                P1.x:= max(FBevelWidth - ox, FBevelWidth);
                                                                P1.y:= max(FBevelWidth - oy, FBevelWidth);
                                                                P2.x:= min(Rc.Right    -    FBevelWidth, Rc.Right    -    ox
                                                                                 - FBevelWidth);
                                                                P2.y:= min(Rc.Bottom - FBevelWidth,    Rc.Bottom    -    oy
                                                                                 - FBevelWidth);
                                                            end;
            end;
        end
        else
        begin
            case FShape    of
                bspTopLine     : begin
                                                    P1.x:= max(- ox, 0);
                                                    P1.y:= max(- oy, 0);
                                                    P2.x:= min(Rc.Right    -    1, Rc.Right    -    1    -    ox);
                                                    P2.y:= P1.y    +    FBorderwidth - 1;
                                                end;
                bspBottomLine    :    begin
                                                    P1.x:= max(- ox, 0);
                                                    P2.y:= min(Rc.Bottom - 1,    Rc.Bottom    -    1    -    oy);
                                                    P2.x:= min(Rc.Right    -    1, Rc.Right    -    1    -    ox);
                                                    P1.y:= P2.y    -    FBorderwidth + 1;
                                                end;
                bspLeftLine        :    begin
                                                    P1.x:= max(- ox, 0);
                                                    P1.y:= max(- oy, 0);
                                                    P2.x:= P1.x    +    FBorderWidth - 1;
                                                    P2.y:= min(Rc.Bottom - 1,    Rc.Bottom    -    1    -    oy);
                                                end;
                bspRightLine : begin
                                                    P2.x:= min(Rc.Right, Rc.Right    -    ox);
                                                    P1.y:= max(- oy, 0);
                                                    P1.x:= P2.x    -    FBorderWidth + 1;
                                                    P2.y:= min(Rc.Bottom - 1,    Rc.Bottom    -    1    -    oy);
                                                end;
                bspRect, bspPortrait:    begin
                                                                P1.x:= max(-ox,    0);
                                                                P1.y:= max(-oy,    0);
                                                                P2.x:= min(Rc.Right, Rc.Right    -    ox);
                                                                P2.y:= min(Rc.Bottom,    Rc.Bottom    -    oy);
                                                            end;
            end;
        end;
        RectA:=    rect(P1.x, P1.y, P2.x, P2.y);
    end;

    procedure    PaintDitheredBorder;
    begin
        case FShape    of
            bspPortrait        :    if FBevelOuter <>    bstNone    then
                                                FrameDitheredPortrait(Canvas,    RectA, FColor, FColorDensity,
                                                    FBorderWidth,    FEdgeSize    -    (FBevelWidth)    div    2)
                                            else
                                                FrameDitheredPortrait(Canvas,    RectA, FColor, FColorDensity,
                                                    FBorderWidth,    FEdgeSize);
            bspRect                :    FrameDitheredRect(Canvas,    RectA, FColor, FColorDensity,
                                                FBorderWidth);
            bspBottomLine,
            bspLeftLine,
            bspRightLine,
            bspTopLine     : DitheredRect(Canvas,    RectA, FColor, FColorDensity);
        end;
    end;

    procedure    PaintFilledBorder(Color: TColor);
    var
        i: Integer;
    begin
        with Canvas    do
        case FShape    of
            bspPortrait        :    Frame3DPortrait(Canvas,    RectA, Color,    Color, FBorderWidth,
                                                FEdgeSize    -    FBevelWidth    div    2    -    1);
            bspRect                :    begin
                                                Brush.Color:=    Color;
                                                for    i:=    1    to FBorderWidth    do
                                                begin
                                                    FrameRect(RectA);
                                                    inc(P1.x);
                                                    inc(P1.y);
                                                    dec(P2.x);
                                                    dec(P2.y);
                                                    RectA:=    rect(P1.x, P1.y, P2.x, P2.y);
                                                end;
                                            end;
            bspBottomLine,
            bspLeftLine,
            bspRightLine,
            bspTopLine        :    begin
                                                Pen.Width:=    1;
                                                Pen.Color:=    Color;
                                                Pen.Mode:= pmCopy;
                                                EffectRect(Canvas, RectA,    Pen);
                                            end;
        end;
    end;

    procedure    PaintBorder;
    begin
        with Canvas, RectA do
        begin
            if (FTransparence    =    trSemi)    or (FColorDensity    <    100) then
            begin
                if FShadowed or    CheckBackGround(Canvas,    RectA) then    PaintDitheredBorder
                else
                    PaintFilledBorder(MergeColorExt(FColor,    Pixels[RectA.Left, RectA.Top],
                        FColorDensity));
            end
            else PaintFilledBorder(FColor);
        end;
    end;

    procedure    CalcBevelInner;
    begin
            P1.x:= max(s1    -    ox,    s1);
            P1.y:= max(s1    -    oy,    s1);
            P2.x:= min(Rc.Right    -    s1,    Rc.Right - ox    -    s1);
            P2.y:= min(Rc.Bottom - s1, Rc.Bottom - oy    -    s1);
            RectA:=    rect(P1.x, P1.y, P2.x, P2.y);
    end;

    procedure    PaintBevelInner;
    var    E: Integer;
    begin
        with Canvas, RectA do
        begin
            if Shape = bspPortrait then
            begin
                if FBorderWidth    >    0    then
                begin
                    if FBevelOuter <>    bstNone    then
                        E:=    FEdgeSize    -    (FBevelWidth + 2)    div    2    -    (FBorderWidth    +    2) div 2
                    else
                        E:=    FEdgeSize    -    1    -    (FBorderWidth    +    2) div 2;
                end
                else
                begin
                    if FBevelOuter <>    bstNone    then
                        E:=    FEdgeSize    -    (FBevelWidth + 2)    div    2
                    else
                        E:=    FEdgeSize;
                end;
                case FBevelInner of
                    bstLowered:    Frame3DPortrait(Canvas,    RectA, FColorShadow, FColorHighlight,
                                                FBevelWidth, E);
                    bstRaised    :    Frame3DPortrait(Canvas,    RectA, FColorHighlight,    FColorShadow,
                                                FBevelWidth, E);
                end;
            end
            else
            case FBevelInner of
                bstLowered:    Frame3D(Canvas,    RectA, FColorShadow, FColorHighlight,    FBevelWidth);
                bstRaised    :    Frame3D(Canvas,    RectA, FColorHighlight,    FColorShadow,    FBevelWidth);
            end;
        end;
    end;

    procedure    BevelRect;
    begin
        if (FBevelInner    <> bstNone)    and    ((FShape = bspRect)    or
                (FShape    =    bspPortrait))    then s2:=    FBevelWidth
            else s2:=    0;
        if FBevelOuter = bstNone then    s1:= FBorderWidth
            else
            case FShape    of
                bspRect,bspPortrait    :    s1:= FBevelWidth + FBorderWidth;
                bspBottomLine, bspLeftLine,    bspRightLine,    bspTopLine:
                                s1:= 2*FBevelWidth + FBorderWidth;
            end;
        s:=    s1 + s2;
        if not FShadowed then
        begin
            ox:= 0;
            oy:= 0;
        end
        else
        begin
            if s > 0 then
            begin
                ox:= FShadowOffsetX;
                oy:= FShadowOffsetY;
                CalcShadow;
                PaintShadow;
            end;
        end;
    if (FBorderWidth > 0)    and    (FTransparence <>    trTransparent) then
        begin
            CalcBorder;
            PaintBorder;
        end;
        if FBevelOuter <>    bstNone    then
        begin
            CalcBevelOuter;
            PaintBevelOuter;
        end;
        if (FBevelInner    <> bstNone)
            and    ((FShape = bspRect)    or (FShape = bspPortrait)) then
        begin
            CalcBevelInner;
            PaintBevelInner;
        end;
    end;

begin
    Rc:= GetClientRect;
    BevelRect;
end;

{    TktMultiBevel    }

constructor    TktMultiBevel.Create(AOwner: TComponent);
begin
    inherited    Create(AOwner);
end;

{    TktBevelButton    }

constructor    TktBevelButton.Create(AOwner:    TComponent);
begin
    inherited    Create(AOwner);
    ControlStyle:= [csCaptureMouse,    csClickEvents, csFramed];
    FBevelOuter:=    bstNone;
    Height:= 35;
    Width:=    90;
end;

procedure    TktBevelButton.Paint;
var
    RectA, Rc: TRect;
    P1,    P2:    TPoint;
    ox,    oy:    Integer;
begin
    inherited    Paint;
    if csDesigning in    ComponentState then
    begin
        Rc:= GetClientRect;
        if not FShadowed then
        begin
            P1.x:= Rc.Left;
            P1.y:= Rc.Top;
            P2.x:= Rc.Right;
            P2.y:= Rc.Bottom;
        end
        else
        begin
            ox:= FShadowOffsetX;
            oy:= FShadowOffsetY;
            P1.x:= max(-ox,    0);
            P1.y:= max(-oy,    0);
            P2.x:= min(Rc.Right, Rc.Right    -    ox);
            P2.y:= min(Rc.Bottom,    Rc.Bottom    -    oy);
        end;
        RectA:=    Rect(P1.x, P1.y, P2.x, P2.y);
        Frame3D(Canvas,    RectA, clBlack,    clBlack, 1);
     end;
end;

procedure    TktBevelButton.MouseDown(Button: TMouseButton; Shift:    TShiftState;
                X, Y:    Integer);
begin
    SetBevelOuter(bstLowered);
    inherited    MouseDown(Button,    Shift, X,    Y);
    if Assigned(FOnMouseDown)    then FOnMouseDown(Self);
end;

procedure    TktBevelButton.MouseUp(Button: TMouseButton; Shift:    TShiftState;
                X, Y:    Integer);
begin
    SetBevelOuter(bstRaised);
    inherited    MouseUp(Button,    Shift, X,    Y);;
    if Assigned(FOnMouseUp)    then FOnMouseUp(Self);
end;

procedure    TktBevelButton.CMMouseEnter(var    msg:TMessage);
begin
    inherited;
    SetBevelOuter(bstRaised);
    if Assigned(FOnEnter)    then FOnEnter(Self);
end;

procedure    TktBevelButton.CMMouseLeave(var    msg: TMessage);
begin
    inherited;
    SetBevelOuter(bstNone);
    if Assigned(FOnExit) then    FOnExit(Self);
end;

end.