home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / LABELS / LABEL3D / LABEL3D.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  3.7 KB  |  141 lines
  1. {************************************}
  2. {***       3D Label Component     ***}
  3. {************************************}
  4. {***            Max 1.5k          ***}
  5. {*** Novosibirsk State University ***}
  6. {************************************}
  7.  
  8. unit Label3d;
  9.  
  10. interface
  11.  
  12. uses
  13.   SysUtils, WinTypes, WinProcs, Classes, Graphics, StdCtrls;
  14.  
  15. type
  16.     TTextStyle = (tsNone, tsRaized, tsRecessed, tsShadow);
  17.  
  18.   TLabel3d = class (TLabel)
  19.   private
  20.      FTextStyle                : TTextStyle;
  21.      FShadowColor            : TColor;
  22.      FShadowDepth            : Integer;
  23.      procedure SetTextStyle( Value : TTextStyle );
  24.      procedure SetShadowColor( Value : TColor );
  25.      procedure SetShadowDepth( Value : Integer );
  26.      procedure Draw3DText( R : TRect; Flags : Word );
  27.   protected
  28.      procedure Paint; override;
  29.   public
  30.      constructor Create( AOwner : TComponent ); override;
  31.   published
  32.      property ShadowColor : TColor read FShadowColor write SetShadowColor
  33.          default clBtnShadow;
  34.      property ShadowDepth : Integer read FShadowDepth write SetShadowDepth
  35.          default 2;
  36.      property TextStyle : TTextStyle read FTextStyle write SetTextStyle
  37.          default tsRecessed;
  38.   end;
  39.  
  40. const
  41.   TextAlignments : array [TAlignment] of Word = (dt_Left, dt_Right, dt_Center);
  42.  
  43. procedure Register;
  44.  
  45. implementation
  46.  
  47. constructor TLabel3d.Create( AOwner : TComponent );
  48. begin
  49.     inherited Create(AOwner);
  50.   FTextStyle := tsRecessed;
  51.   FShadowDepth := 2;
  52.   FShadowColor := clBtnShadow;
  53. end;
  54.  
  55. procedure TLabel3d.SetShadowColor(Value : TColor);
  56. begin
  57.     if Value <> FShadowColor then begin
  58.      FShadowColor := Value;
  59.      Invalidate;
  60.   end;
  61. end;
  62.  
  63. procedure TLabel3d.SetShadowDepth(Value : Integer);
  64. begin
  65.     if Value <> FShadowDepth then begin
  66.      FShadowDepth := Value;
  67.      Invalidate;
  68.   end;
  69. end;
  70.  
  71. procedure TLabel3d.SetTextStyle(Value : TTextStyle);
  72. begin
  73.     if Value <> FTextStyle then begin
  74.      FTextStyle := Value;
  75.      Invalidate;
  76.   end;
  77. end;
  78.  
  79. procedure TLabel3d.Draw3DText(R : TRect; Flags : Word);
  80. var
  81.     CaptionStz         : array [0..255] of Char;
  82.   TempRct            : TRect;
  83.   ULColor            : TColor;
  84.   LRColor            : TColor;
  85. begin
  86.     with Canvas do begin
  87.      StrPCopy(CaptionStz, Caption);
  88.      if WordWrap then Flags := Flags or dt_WordBreak;
  89.      if not ShowAccelChar then Flags := Flags or dt_NoPrefix;
  90.      Font := Self.Font;
  91.      if FTextStyle in [tsRecessed, tsRaized] then begin
  92.         case FTextStyle of
  93.            tsRaized : begin
  94.               ULColor := clBtnHighlight;
  95.               LRColor := clBtnShadow;
  96.            end;
  97.            tsRecessed : begin
  98.               ULColor := clBtnShadow;
  99.               LRColor := clBtnHighlight;
  100.            end;
  101.         end;
  102.         TempRct := R;
  103.         OffsetRect(TempRct, 1, 1);
  104.         Font.Color := LRColor;
  105.         DrawText(Handle, CaptionStz, -1, TempRct, Flags);
  106.         TempRct := R;
  107.         OffsetRect(TempRct, -1, -1);
  108.         Font.Color := ULColor;
  109.         DrawText(Handle, CaptionStz, -1, TempRct, Flags);
  110.      end else if FTextStyle = tsShadow then begin
  111.         TempRct := R;
  112.         OffsetRect(TempRct, FShadowDepth, FShadowDepth);
  113.         Font.Color := FShadowColor;
  114.         DrawText(Handle, CaptionStz, -1, TempRct, Flags);
  115.      end;
  116.      Font.Color := Self.Font.Color;
  117.      if not Enabled then Font.Color := clGrayText;
  118.      DrawText(Handle, CaptionStz, -1, R, Flags);
  119.   end;
  120. end;
  121.  
  122. procedure TLabel3d.Paint;
  123. begin
  124.   with Canvas do begin
  125.      if not Transparent then begin
  126.         Brush.Color := Self.Color;
  127.         Brush.Style := bsSolid;
  128.         FillRect(ClientRect);
  129.      end;
  130.      Brush.Style := bsClear;
  131.      Draw3DText(ClientRect, dt_ExpandTabs or TextAlignments[Alignment]);
  132.   end;
  133. end;
  134.  
  135. procedure Register;
  136. begin
  137.   RegisterComponents('3D', [TLabel3d]);
  138. end;
  139.  
  140. end.
  141.