unit K3DLabel;

interface

{*********************************************************************
  薦瀝老 : 2000斥 2巋 絹蠢朝
  恐 薦瀝沁唱? : 粱歹 犬厘等 VCL闌 啊瘤絆 祈府竅霸 橇肺弊伐闌 父甸絆
                 酵絹輯 肚 RealGrid甫 葷儈竅絆 付瀾俊甸菌欄唱 促弗 霓
                 器懲飄啊 酒漿款 扁瓷撈 樂絹輯 眠啊沁促.
  穿啊 : 辮蠟吝
  歹竅絆酵籃富 : 絹蠢氓俊輯 夯巴鞍籃單 穿焙瘤 葛福擺促. 歷磊俊霸
                 固救竅促. 撈巴籃 郴啊 父電巴撈 酒聰促. 割啊瘤 扁瓷闌 眠啊沁闌
                 揮撈促.
  眠啊郴儈 :

  -------------------------------------------------------------------
}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TCaptionStyle = (csLowered, csRaised, csNone);
  TBoxtype      = (bxLowered, bxRaised, bxNone);

  TK3DLabel = class(TLabel)

  private
    { Private declarations }
    fShadowColor : TColor;
    fCaptionStyle: TCaptionStyle;
    fBoxWidth    : Integer;
    fBoxdraw     : Boolean;
    fBoxtype     : TBoxtype;

    procedure SetShadowColor(Value: TColor);
    procedure SetCaptionStyle(Value: TCaptionStyle);
    procedure SetBoxWidth(Value: Integer);
    procedure SetBoxdraw(Value : Boolean);
    procedure SetBoxtype(Value : Tboxtype);

  protected
    { Protected declarations }
    procedure Paint; override;

  public
    { Public declarations }

  published
    { Published declarations }
    property CaptionStyle: TCaptionStyle read FCaptionStyle write SetCaptionStyle default csLowered;
    property ShadowColor: TColor read FShadowColor write SetShadowColor default clWhite;
    property BoxWidth   : Integer Read fBoxWidth Write SetBoxWidth Default 1;
    property Boxdraw    : Boolean Read fBoxdraw  Write SetBoxdraw  Default True;
    property Boxtype    : Tboxtype Read fBoxtype Write SetBoxtype  Default bxLowered;
    constructor Create(AOwner: TComponent); override;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Etc', [TK3DLabel]);
end;


constructor TK3DLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoSize  := False;
  Height    := 21;
  Width     := 90;
  Alignment := taLeftJustify;
  Font.Name := '奔覆';
  Font.Size := 10;
  Font.Color := clBlack;
  Font.Style := [fsBold];
  fShadowColor := clWhite;
  fBoxdraw  := True;
  fBoxWidth := 1;
  Color := clSilver;
  Boxtype := bxRaised;
  CaptionStyle := csLowered;
  ShowHint := True;
  WordWrap := True;
  Layout := tlCenter;
end;

//3d 扼駭闌 弊赴促.
procedure TK3DLabel.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  R: TRect;
  Text: array[0..255] of Char;
  Flags: Word;
  m_Colr: TColor;
  m_Diff: Integer;
  i: Byte;
Begin
  with Canvas do
       begin
       if not Transparent then // 閡捧疙撈扼擱
          begin
          Brush.Color := Color;
          Brush.Style := bsSolid;
          FillRect(ClientRect);
          end;
       Brush.Style := bsClear;
       R := ClientRect;
       end;

  // DrawText API竊薦肺 逞敗林扁 困茄 藹闌 父電促.
  Flags := Alignments[Alignment] or DT_VCENTER or DT_SINGLELINE;
  if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;

  // 臂揪甫 歷厘且 滾欺甫 皋肺府俊 積己茄促.
  GetTextBuf(Text, SizeOf(Text));

  // 鞏磊啊 樂綽 瘤甫 眉農茄促.
  if (Flags and DT_CALCRECT <> 0) and ((Text[0] = #0) or ShowAccelChar and (Text[0] = '&') and (Text[1] = #0)) then
     StrCopy(Text, ' ');

  // 泅犁狼 迄飄 禍惑闌 歷厘秦滴絆 弊覆磊禍闌 剛歷 弊府扁 困竅咯 官槽促.
  m_Colr := Font.Color;
  Canvas.Font := Font;
  if CaptionStyle <> csNone then
     begin
     // 弊覆磊甫 弊赴促.
     Canvas.Font.Color := FShadowColor;
     if CaptionStyle = csLowered then OffsetRect(R, 1, 1) else OffsetRect(R, -1, -1);

     DrawText(Canvas.Handle, Text, StrLen(Text), R, Flags);

     // 迄飄啊 農促擱 開堡闌 弊赴促.
     if Font.Size > 17 then
        begin
        m_Diff := 1;
        Canvas.Font.Color := clDkGray;
        if CaptionStyle = csLowered then OffsetRect(R, -2, -2) else OffsetRect(R, 2, 2);

        DrawText(Canvas.Handle, Text, StrLen(Text), R, Flags);
        end
     else m_Diff := -1;

     if CaptionStyle = csLowered then OffsetRect(R, m_Diff, m_Diff) else OffsetRect(R, -m_Diff, -m_Diff);
     end;

  // 促矯 盔貳狼 禍欄肺 汗蓖矯挪促.
  if not Enabled then Canvas.Font.Color := clDkGray else Canvas.Font.Color := m_Colr;

  DrawText(Canvas.Handle, Text, StrLen(Text), R, Flags);

  // 瀾苞 劇欄肺 葷阿屈闌 弊赴促.
  If fBoxdraw = True Then
     With Canvas do
          Begin
          Pen.Width := 1;
          for i := 1 to fBoxWidth do
              begin
              m_Diff := i-1;
              Case fBoxtype Of
                   bxLowered : Pen.Color := clBtnShadow;
                   bxRaised  : Pen.Color := clWhite;
                   bxNone    : Pen.Color := clBlack;
                   End;

              MoveTo(Width-m_Diff-1, m_Diff);
              LineTo(m_Diff, m_Diff);
              LineTo(m_Diff, Height-m_Diff);

              Case fBoxtype Of
                   bxLowered : Pen.Color := clWhite;
                   bxRaised  : Pen.Color := clBtnShadow;
                   bxNone    : Pen.Color := clBlack;
                   End;

              MoveTo(Width-i, i);
              LineTo(Width-i, Height-i);
              LineTo(m_Diff,  Height-i);
              end;
          end;

end;

//歸弊扼款靛 禍惑
procedure TK3DLabel.SetShadowColor(Value: TColor);
begin
  if FShadowColor <> Value then
     begin
     FShadowColor := Value;
     Invalidate;
     end;
end;

//臂磊狼 表撈 煉例
procedure TK3DLabel.SetCaptionStyle(Value: TCaptionStyle); { 眠啊 }
begin
  FCaptionStyle := Value;
  Invalidate;
end;

//冠膠狼 農扁
procedure TK3DLabel.SetBoxWidth(Value: Integer); { 眠啊 }
begin
  fBoxWidth := Value;
  Invalidate;
end;

//冠膠甫 弊副瘤 救弊凡瘤 汲瀝
procedure TK3DLabel.SetBoxdraw(Value: Boolean); { 眠啊 }
begin
  fBoxdraw := Value;
  Invalidate;
end;

procedure TK3DLabel.SetBoxtype(Value: TBoxtype); { 眠啊 }
begin
  fBoxtype := Value;
  Invalidate;
end;

end.