k3dlabel.pas

Korea, a data table control 韩国数据表控件 必备

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.