home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmLabel.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  23KB  |  756 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmLabel
  5. Purpose  : This label has extra functionality for UI eye-candy.
  6. Date     : 07-09-1998
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. ================================================================================}
  10.  
  11. unit rmLabel;
  12.  
  13. interface
  14.  
  15. {$I CompilerDefines.INC}
  16.  
  17. uses Messages, Windows, SysUtils, Classes, Controls, forms, Graphics, extctrls, dialogs;
  18.  
  19. type
  20.   TrmBorderStyle = (rmbsNone, rmbsSingle, rmbsSunken, rmbsRaised, rmbsSunkenEdge, rmbsRaisedEdge);
  21.   TrmTextStyle = (rmtsNormal, rmtsRaised, rmtsLowered, rmtsShadow);
  22.   TrmTextLayout = (rmtlTop, rmtlCenter, rmtlBottom);
  23.   TrmGradientLayout = (rmglTopDown, rmglLeftRight);
  24.  
  25.   TrmCustomLabel = class;
  26.  
  27.   TrmLMouseOptions = class(TPersistent)
  28.   private
  29.     { Private declarations }
  30.     fenabled: boolean;
  31.     FOwner: TrmCustomLabel;
  32.     FEnterColor: TColor;
  33.     FEnterBorderStyle: TrmBorderStyle;
  34.     FEnterTextStyle: TrmTextStyle;
  35.   protected
  36.     { Protected declarations }
  37.     procedure SetEnterColor(Value: TColor);
  38.     procedure SetEnterBorderStyle(Value: TrmBorderStyle);
  39.     procedure SetEnterTextStyle(Value: TrmTextStyle);
  40.   public
  41.     { Public declarations }
  42.     constructor Create(AOwner: TrmCustomLabel); virtual;
  43.   published
  44.     { Published declarations }
  45.     property EnterColor: TColor read FEnterColor write SetEnterColor default clWindowText;
  46.     property EnterBorder: TrmBorderStyle read fEnterBorderStyle write SetEnterBorderStyle default rmbsNone;
  47.     property EnterTextStyle: TrmTextStyle read FEnterTextStyle write SetEnterTextStyle default rmtsNormal;
  48.     property Enabled: boolean read fEnabled write fenabled default false;
  49.   end; { TCompanyText }
  50.  
  51.   TrmCustomLabel = class(TGraphicControl)
  52.   private
  53.     fOnMouseEnter: TNotifyEvent;
  54.     fOnMouseLeave: TNotifyEvent;
  55.     fMouseOptions: TrmLMouseOptions;
  56.     FFocusControl: TWinControl;
  57.     FAlignment: TAlignment;
  58.     FAutoSize: Boolean;
  59.     fdoublebuffered: boolean;
  60.     fbuffer: TBitmap;
  61.     fThickBorder: boolean;
  62.     FLayout: TrmTextLayout;
  63.     FWordWrap: Boolean;
  64.     FShowAccelChar: Boolean;
  65.     fGradTLColor, fGradBRColor: TColor;
  66.     fShadowColor: TColor;
  67.     fShadowdepth: integer;
  68.     fGradDir: TrmGradientLayout;
  69.     fBorderStyle: TrmBorderStyle;
  70.     fUseGradient: Boolean;
  71.     ftextstyle: TrmTextStyle;
  72.     fnormalcolor: tcolor;
  73.     fnormaltext: TrmTextStyle;
  74.     fnormalborder: TrmBorderstyle;
  75.     {$IFNDEF BD6}
  76.     procedure AdjustBounds;
  77.     {$ENDIF}
  78.     function DrawBorder(canvas: TCanvas): trect;
  79.     procedure DoDrawText(canvas: TCanvas; var Rect: TRect; Flags: Word);
  80.     function GetTransparent: Boolean;
  81.     function GetBorderWidth: integer;
  82.     procedure SetAlignment(Value: TAlignment);
  83.     procedure SetFocusControl(Value: TWinControl);
  84.     procedure SetShowAccelChar(Value: Boolean);
  85.     procedure SetTransparent(Value: Boolean);
  86.     procedure SetLayout(Value: TrmTextLayout);
  87.     procedure SetWordWrap(Value: Boolean);
  88.     procedure SetBorderStyle(Value: TrmBorderStyle);
  89.     procedure SetThickBorder(Value: Boolean);
  90.     procedure SetTextStyle(Value: TrmTextStyle);
  91.     procedure SetGradient(Value: Boolean);
  92.     procedure SetTLColor(value: TColor);
  93.     procedure SetBRColor(value: TColor);
  94.     procedure SetGradientDirection(value: TrmGradientLayout);
  95.     procedure GradientFill(canvas: TCanvas; R: TRect);
  96.     procedure setshadowcolor(value: tcolor);
  97.     procedure setshadowdepth(value: integer);
  98.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  99.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  100.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  101.     procedure CMMouseEnter(var Message: TCMEnter); message CM_MouseEnter;
  102.     procedure CMMouseLeave(var Message: TCMExit); message CM_MouseLeave;
  103.   protected
  104.     procedure Draw3DText(canvas: TCanvas; var Rect: TRect; Flags: Word; Raised: boolean);
  105.     function GetLabelText: string; virtual;
  106.     procedure Loaded; override;
  107.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  108.     procedure Paint; override;
  109.     {$IFNDEF BD6}
  110.     procedure SetAutoSize(Value: Boolean); virtual;
  111.     {$ENDIF}
  112.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  113.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  114.     property DoubleBuffered: Boolean read fdoublebuffered write fdoublebuffered default true;
  115.     property FocusControl: TWinControl read FFocusControl write SetFocusControl;
  116.     property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
  117.     property Transparent: Boolean read GetTransparent write SetTransparent default False;
  118.     property Layout: TrmTextLayout read FLayout write SetLayout default rmtlTop;
  119.     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  120.     property BorderStyle: TrmBorderStyle read fBorderStyle write SetBorderStyle default rmbsNone;
  121.     property UseGradient: Boolean read fuseGradient write SetGradient default false;
  122.     property TextStyle: TrmTextStyle read ftextstyle write settextstyle default rmtsNormal;
  123.     property GradientTLColor: TColor read fGradTLColor write SetTLColor default clbtnshadow;
  124.     property GradientBRColor: TColor read fGradBRColor write SetBRColor default clbtnface;
  125.     property GradientDirection: TrmGradientLayout read fGradDir write SetGradientDirection default rmglLeftRight;
  126.     property MouseOptions: TrmLMouseOptions read fmouseoptions write fmouseoptions stored true;
  127.     property ThickBorder: Boolean read fthickborder write setthickborder default false;
  128.     property Borderwidth: integer read GetBorderWidth;
  129.     property ShadowColor: tcolor read fshadowcolor write setShadowColor default clbtnshadow;
  130.     property ShadowDepth: integer read fshadowdepth write setshadowdepth default 4;
  131.     property OnMouseEnter: TNotifyEvent read fOnMouseEnter write fOnMouseEnter;
  132.     property OnMouseLeave: TNotifyEvent read fOnMouseLeave write fOnMouseLeave;
  133.   public
  134.     constructor Create(AOwner: TComponent); override;
  135.     destructor destroy; override;
  136.     property Canvas;
  137.   end;
  138.  
  139.   TrmLabel = class(TrmCustomLabel)
  140.   public
  141.     property Borderwidth;
  142.   published
  143.     property Align;
  144.     property Alignment;
  145.     property AutoSize;
  146.     property DoubleBuffered;
  147.     property Caption;
  148.     property Color;
  149.     property DragCursor;
  150.     property DragMode;
  151.     property Enabled;
  152.     property FocusControl;
  153.     property Font;
  154.     property ParentColor;
  155.     property ParentFont;
  156.     property ParentShowHint;
  157.     property PopupMenu;
  158.     property ShowAccelChar;
  159.     property ShowHint;
  160.     property Transparent;
  161.     property Layout;
  162.     property Visible;
  163.     property WordWrap;
  164.     property BorderStyle;
  165.     property UseGradient;
  166.     property TextStyle;
  167.     property ThickBorder;
  168.     property GradientTLColor;
  169.     property GradientBRColor;
  170.     property GradientDirection;
  171.     property shadowcolor;
  172.     property shadowdepth;
  173.     property MouseOptions;
  174.     property OnClick;
  175.     property OnDblClick;
  176.     property OnDragDrop;
  177.     property OnDragOver;
  178.     property OnEndDrag;
  179.     property OnMouseDown;
  180.     property OnMouseMove;
  181.     property OnMouseUp;
  182.     property OnStartDrag;
  183.     property OnMouseEnter;
  184.     property OnMouseLeave;
  185.   end;
  186.  
  187. implementation
  188.  
  189. uses rmLibrary;
  190.  
  191. { TrmLMouseOptions }
  192.  
  193. constructor TrmLMouseOptions.Create(AOwner: TrmCustomLabel);
  194. begin
  195.   inherited create;
  196.   FOwner := aowner;
  197.   fenabled := false;
  198.   fEnterColor := clWindowText;
  199.   fEnterBorderStyle := rmbsNone;
  200.   fEnterTextStyle := rmtsNormal;
  201. end;
  202.  
  203. procedure TrmLMouseOptions.SetEnterColor(Value: TColor);
  204. begin
  205.   fEnterColor := value;
  206.   fowner.Invalidate;
  207. end;
  208.  
  209. procedure TrmLMouseOptions.SetEnterBorderStyle(Value: TrmBorderStyle);
  210. begin
  211.   fEnterBorderStyle := value;
  212.   fowner.Invalidate;
  213. end;
  214.  
  215. procedure TrmLMouseOptions.SetEnterTextStyle(Value: TrmTextStyle);
  216. begin
  217.   fEnterTextStyle := value;
  218.   fowner.Invalidate;
  219. end;
  220.  
  221. { TrmCustomLabel }
  222.  
  223. constructor TrmCustomLabel.Create(AOwner: TComponent);
  224. begin
  225.   inherited Create(AOwner);
  226.   ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  227.   fMouseOptions := TrmLMouseOptions.create(self);
  228.   fdoublebuffered := true;
  229.   fbuffer := tbitmap.create;
  230.   Width := 65;
  231.   Height := 17;
  232.   fshadowdepth := 4;
  233.   fshadowcolor := clbtnshadow;
  234.   FAutoSize := True;
  235.   FShowAccelChar := True;
  236.   fGradTLColor := clbtnshadow;
  237.   fGradBRColor := clbtnface;
  238.   fGradDir := rmglLeftRight;
  239.   fBorderStyle := rmbsNone;
  240.   fUseGradient := false;
  241.   ftextstyle := rmtsNormal;
  242. end;
  243.  
  244. destructor TrmCustomLabel.destroy;
  245. begin
  246.   fmouseoptions.free;
  247.   fbuffer.free;
  248.   inherited;
  249. end;
  250.  
  251. function TrmCustomLabel.GetLabelText: string;
  252. begin
  253.   Result := Caption;
  254. end;
  255.  
  256. procedure TrmCustomLabel.Draw3DText(canvas: TCanvas; var Rect: TRect; Flags: Word; Raised: boolean);
  257. var
  258.   top, bottom: tcolor;
  259. begin
  260.   if raised then
  261.   begin
  262.     top := clBtnShadow;
  263.     bottom := clBtnHighlight;
  264.   end
  265.   else
  266.   begin
  267.     top := clBtnHighlight;
  268.     bottom := clBtnShadow;
  269.   end;
  270.   OffsetRect(Rect, 1, 1);
  271.  
  272.   Canvas.Font.Color := top;
  273.   DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  274.   OffsetRect(Rect, -2, -2);
  275.   Canvas.Font.Color := bottom;
  276.   DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  277.   OffsetRect(Rect, 1, 1);
  278.   Canvas.Font.color := font.color;
  279.   DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  280.   inflaterect(rect, 1, 1);
  281.   rect.right := rect.right + 1;
  282.   rect.bottom := rect.bottom + 1;
  283. end;
  284.  
  285. procedure TrmCustomLabel.DoDrawText(canvas: TCanvas; var Rect: TRect; Flags: Word);
  286. var
  287.   Text: string;
  288. begin
  289.   Text := GetLabelText;
  290.   if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and
  291.     (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
  292.   if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
  293.   Canvas.Font := Font;
  294.   if not Enabled then
  295.   begin
  296.     OffsetRect(Rect, 1, 1);
  297.     Canvas.Font.Color := clBtnHighlight;
  298.     DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  299.     OffsetRect(Rect, -1, -1);
  300.     Canvas.Font.Color := clBtnShadow;
  301.     DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  302.   end
  303.   else
  304.     case TextStyle of
  305.       rmtsNormal: DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  306.       rmtsRaised: Draw3DText(canvas, rect, flags, true);
  307.       rmtsLowered: Draw3DText(canvas, rect, flags, false);
  308.       rmtsShadow:
  309.         begin
  310.           OffsetRect(Rect, fshadowdepth, fshadowdepth);
  311.           Canvas.Font.Color := fshadowcolor;
  312.           DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  313.           OffsetRect(Rect, -fshadowdepth, -fshadowdepth);
  314.           Canvas.Font.Color := font.color;
  315.           DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);
  316.           inflaterect(rect, fshadowdepth, fshadowdepth);
  317.         end;
  318.     end;
  319. end;
  320.  
  321. procedure TrmCustomLabel.Paint;
  322. const
  323.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  324.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  325. var
  326.   WR, CalcRect: TRect;
  327.   DrawStyle: Integer;
  328.   bmp: TBitmap;
  329.   Workcanvas: TCanvas;
  330. begin
  331.   bmp := nil;
  332.   if fdoublebuffered then
  333.   begin
  334.     bmp := tbitmap.create;
  335.     bmp.width := width;
  336.     bmp.height := height;
  337.     workcanvas := bmp.canvas
  338.   end
  339.   else
  340.     workcanvas := canvas;
  341.   with WorkCanvas do
  342.   begin
  343.     WR := DrawBorder(WorkCanvas);
  344.     if not Transparent then
  345.     begin
  346.       if UseGradient then GradientFill(WorkCanvas, wr)
  347.       else
  348.       begin
  349.         Brush.Color := Self.Color;
  350.         Brush.Style := bsSolid;
  351.         FillRect(WR);
  352.       end;
  353.     end
  354.     else
  355.     begin
  356.       if fdoublebuffered then
  357.       begin
  358.         if font.color = clblack then
  359.           bmp.transparentcolor := clred
  360.         else
  361.           font.color := clblue;
  362.         bmp.transparent := true;
  363.         Brush.color := bmp.transparentcolor;
  364.         Brush.Style := bsSolid;
  365.         fillRect(WR);
  366.       end;
  367.     end;
  368.     Brush.Style := bsClear;
  369.     DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
  370.     { Calculate vertical layout }
  371.     if FLayout <> rmtlTop then
  372.         begin
  373.       CalcRect := WR;
  374.       DoDrawText(WorkCanvas, CalcRect, DrawStyle or DT_CALCRECT);
  375.       if FLayout = rmtlBottom then OffsetRect(WR, 0, Height - CalcRect.Bottom)
  376.       else OffsetRect(WR, 0, (Height - CalcRect.Bottom) div 2);
  377.     end;
  378.     DoDrawText(WorkCanvas, WR, DrawStyle);
  379.   end;
  380.   if (fdoublebuffered) and assigned(bmp) then
  381.   begin
  382.     canvas.Draw(0, 0, bmp);
  383.     bmp.free;
  384.   end;
  385. end;
  386.  
  387. procedure TrmCustomLabel.Loaded;
  388. begin
  389.   inherited Loaded;
  390.   {$ifndef BD6}
  391.   AdjustBounds;
  392.   {$endif}
  393. end;
  394.  
  395. {$IFNDEF BD6}
  396. procedure TrmCustomLabel.AdjustBounds;
  397. const
  398.   WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
  399. var
  400.   DC: HDC;
  401.   X: Integer;
  402.   WR: TRect;
  403. begin
  404.   if not (csReading in ComponentState) and FAutoSize then
  405.   begin
  406.     wr := clientrect;
  407.     DC := GetDC(0);
  408.     Canvas.Handle := DC;
  409.     DoDrawText(canvas, wr, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
  410.     Canvas.Handle := 0;
  411.     ReleaseDC(0, DC);
  412.     X := Left;
  413.     if FAlignment = taRightJustify then Inc(X, Width - (wr.Right + BorderWidth));
  414.     if (align in [altop, albottom, alclient]) then wr.right := width;
  415.     if (align in [alRight, alLeft, alclient]) then wr.bottom := height;
  416.     if (height <= wr.Bottom + borderwidth) or (width <= wr.Right + borderwidth) then
  417.       SetBounds(X, Top, wr.Right + borderwidth, wr.Bottom + borderwidth);
  418.   end;
  419. end;
  420. {$ENDIF}
  421.  
  422. procedure TrmCustomLabel.SetAlignment(Value: TAlignment);
  423. begin
  424.   if FAlignment <> Value then
  425.   begin
  426.     FAlignment := Value;
  427.     Invalidate;
  428.   end;
  429. end;
  430.  
  431. {$IFNDEF BD6}
  432. procedure TrmCustomLabel.SetAutoSize(Value: Boolean);
  433. begin
  434.   if FAutoSize <> Value then
  435.   begin
  436.     FAutoSize := Value;
  437.     AdjustBounds;
  438.   end;
  439. end;
  440. {$ENDIF}
  441.  
  442. function TrmCustomLabel.GetTransparent: Boolean;
  443. begin
  444.   Result := not (csOpaque in ControlStyle);
  445. end;
  446.  
  447. procedure TrmCustomLabel.SetFocusControl(Value: TWinControl);
  448. begin
  449.   FFocusControl := Value;
  450.   if Value <> nil then Value.FreeNotification(Self);
  451. end;
  452.  
  453. procedure TrmCustomLabel.SetShowAccelChar(Value: Boolean);
  454. begin
  455.   if FShowAccelChar <> Value then
  456.   begin
  457.     FShowAccelChar := Value;
  458.     Invalidate;
  459.   end;
  460. end;
  461.  
  462. procedure TrmCustomLabel.SetTransparent(Value: Boolean);
  463. begin
  464.   if Transparent <> Value then
  465.   begin
  466.     if Value then
  467.       ControlStyle := ControlStyle - [csOpaque] else
  468.       ControlStyle := ControlStyle + [csOpaque];
  469.     Invalidate;
  470.   end;
  471. end;
  472.  
  473. procedure TrmCustomLabel.SetLayout(Value: TrmTextLayout);
  474. begin
  475.   if FLayout <> Value then
  476.   begin
  477.     FLayout := Value;
  478.     Invalidate;
  479.   end;
  480. end;
  481.  
  482. procedure TrmCustomLabel.SetWordWrap(Value: Boolean);
  483. begin
  484.   if FWordWrap <> Value then
  485.   begin
  486.     FWordWrap := Value;
  487.     {$ifndef BD6}
  488.     AdjustBounds;
  489.     {$endif}
  490.     Invalidate;
  491.   end;
  492. end;
  493.  
  494. procedure TrmCustomLabel.Notification(AComponent: TComponent;
  495.   Operation: TOperation);
  496. begin
  497.   inherited Notification(AComponent, Operation);
  498.   if (Operation = opRemove) and (AComponent = FFocusControl) then
  499.     FFocusControl := nil;
  500. end;
  501.  
  502. procedure TrmCustomLabel.CMTextChanged(var Message: TMessage);
  503. begin
  504.   Invalidate;
  505.   {$ifndef BD6}
  506.   AdjustBounds;
  507.   {$endif}
  508. end;
  509.  
  510. procedure TrmCustomLabel.CMFontChanged(var Message: TMessage);
  511. begin
  512.   inherited;
  513.   {$ifndef BD6}
  514.   AdjustBounds;
  515.   {$endif}
  516. end;
  517.  
  518. procedure TrmCustomLabel.CMDialogChar(var Message: TCMDialogChar);
  519. begin
  520.   if (FFocusControl <> nil) and Enabled and ShowAccelChar and
  521.     IsAccel(Message.CharCode, Caption) then
  522.     with FFocusControl do
  523.       if CanFocus then
  524.       begin
  525.         SetFocus;
  526.         Message.Result := 1;
  527.       end;
  528. end;
  529.  
  530. procedure TrmCustomLabel.SetBorderStyle(Value: TrmBorderStyle);
  531. begin
  532.   if fBorderStyle <> value then fBorderStyle := value;
  533.   {$ifndef BD6}
  534.   Adjustbounds;
  535.   {$endif}
  536.   invalidate;
  537. end;
  538.  
  539. procedure TrmCustomLabel.SetTextStyle(Value: TrmTextStyle);
  540. begin
  541.   if ftextstyle <> value then ftextstyle := value;
  542.   {$ifndef BD6}
  543.   AdjustBounds;
  544.   {$endif}
  545.   invalidate;
  546. end;
  547.  
  548. procedure TrmCustomLabel.SetGradient(Value: Boolean);
  549. begin
  550.   if fUseGradient <> value then fUseGradient := value;
  551.   invalidate;
  552. end;
  553.  
  554. procedure TrmCustomLabel.SetTLColor(value: TColor);
  555. begin
  556.   if fGradTLColor <> value then fGradTLColor := value;
  557.   invalidate;
  558. end;
  559.  
  560. procedure TrmCustomLabel.SetBRColor(value: TColor);
  561. begin
  562.   if fGradBRColor <> value then fGradBRColor := value;
  563.   invalidate;
  564. end;
  565.  
  566. procedure TrmCustomLabel.SetGradientDirection(value: TrmGradientLayout);
  567. begin
  568.   if fGradDir <> value then fGradDir := value;
  569.   invalidate;
  570. end;
  571.  
  572. function TrmCustomLabel.DrawBorder(canvas: TCanvas): trect;
  573. var
  574.   Innertopcolor, Innerbottomcolor, Outertopcolor, Outerbottomcolor: TColor;
  575.   wr: TRect;
  576. begin
  577.   wr := GetClientRect;
  578.   result := wr;
  579.   if BorderStyle = rmbsnone then exit;
  580.   InnerTopColor := clBlack;
  581.   InnerBottomColor := clblack;
  582.   OuterTopColor := clblack;
  583.   OuterBottomColor := clblack;
  584.   case borderstyle of
  585.     rmbsSunken:
  586.       begin
  587.         InnerTopColor := cl3ddkshadow;
  588.         InnerBottomColor := cl3dlight;
  589.         OuterTopColor := clBtnShadow;
  590.         OuterBottomColor := clBtnhighlight;
  591.       end;
  592.     rmbsRaised:
  593.       begin
  594.         InnerTopColor := clBtnhighlight;
  595.         InnerBottomColor := clBtnShadow;
  596.         if thickborder then
  597.         begin
  598.           OuterTopColor := cl3dlight;
  599.           OuterBottomColor := cl3ddkshadow;
  600.         end
  601.         else
  602.         begin
  603.           OuterTopColor := InnerTopColor;
  604.           OuterBottomColor := InnerBottomColor;
  605.         end
  606.       end;
  607.     rmbsRaisedEdge:
  608.       begin
  609.         InnerTopColor := clBtnShadow;
  610.         InnerBottomColor := clBtnhighlight;
  611.         OuterTopColor := clBtnhighlight;
  612.         OuterBottomColor := clBtnShadow;
  613.       end;
  614.     rmbsSunkenEdge:
  615.       begin
  616.         InnerTopColor := clBtnhighlight;
  617.         InnerBottomColor := clBtnShadow;
  618.         OuterTopColor := clBtnShadow;
  619.         OuterBottomColor := clBtnhighlight;
  620.       end;
  621.   end;
  622.   frame3d(canvas, wr, Outertopcolor, Outerbottomcolor, 1);
  623.   if (ThickBorder) or (borderstyle in [rmbsSunkenEdge, rmbsRaisedEdge]) then
  624.     frame3d(canvas, wr, Innertopcolor, Innerbottomcolor, 1);
  625.   result := wr;
  626. end;
  627.  
  628. procedure TrmCustomLabel.GradientFill(canvas: TCanvas; R: TRect);
  629. const
  630.   fNumColors = 63;
  631. var
  632.   BeginRGBValue: array[0..2] of Byte;
  633.   RGBDifference: array[0..2] of integer;
  634.   ColorBand: TRect;
  635.   I: Integer;
  636.   Red: Byte;
  637.   Green: Byte;
  638.   Blue: Byte;
  639.   Brush, OldBrush: HBrush;
  640. begin
  641.   BeginRGBValue[0] := GetRValue(ColorToRGB(fGradTLColor));
  642.   BeginRGBValue[1] := GetGValue(ColorToRGB(fGradTLColor));
  643.   BeginRGBValue[2] := GetBValue(ColorToRGB(fGradTLColor));
  644.  
  645.   RGBDifference[0] := GetRValue(ColorToRGB(fGradBRColor)) - BeginRGBValue[0];
  646.   RGBDifference[1] := GetGValue(ColorToRGB(fGradBRColor)) - BeginRGBValue[1];
  647.   RGBDifference[2] := GetBValue(ColorToRGB(fGradBRColor)) - BeginRGBValue[2];
  648.  
  649.   { Calculate the color band's top and bottom coordinates }
  650.   { for Left To Right fills }
  651.   if Gradientdirection = rmglLeftRight then
  652.   begin
  653.     ColorBand.Top := R.Top;
  654.     ColorBand.Bottom := R.Bottom;
  655.   end
  656.   else
  657.   begin
  658.     ColorBand.Left := R.Left;
  659.     ColorBand.Right := R.Right;
  660.   end;
  661.   { Perform the fill }
  662.   for I := 0 to FNumColors - 1 do
  663.   begin { iterate through the color bands }
  664.     if Gradientdirection = rmglLeftRight then
  665.     begin
  666.       { Calculate the color band's left and right coordinates }
  667.       ColorBand.Left := R.Left + MulDiv(I, R.Right - R.Left, FNumColors);
  668.       ColorBand.Right := R.Left + MulDiv(I + 1, R.Right - R.Left, FNumColors);
  669.     end
  670.     else
  671.     begin
  672.       ColorBand.Top := R.Top + MulDiv(I, R.Bottom - R.Top, FNumColors);
  673.       ColorBand.Bottom := R.Top + MulDiv(I + 1, R.Bottom - R.Top, FNumColors);
  674.     end;
  675.  
  676.     { Calculate the color band's color }
  677.     Red := BeginRGBValue[0] + MulDiv(I, RGBDifference[0], FNumColors - 1);
  678.     Green := BeginRGBValue[1] + MulDiv(I, RGBDifference[1], FNumColors - 1);
  679.     Blue := BeginRGBValue[2] + MulDiv(I, RGBDifference[2], FNumColors - 1);
  680.  
  681.     { Create a brush with the appropriate color for this band }
  682.     Brush := CreateSolidBrush(RGB(Red, Green, Blue));
  683.     { Select that brush into the temporary DC. }
  684.     OldBrush := SelectObject(Canvas.handle, Brush);
  685.     try
  686.       { Fill the rectangle using the selected brush -- PatBlt is faster than FillRect }
  687.       PatBlt(Canvas.handle, ColorBand.Left, ColorBand.Top, ColorBand.Right - ColorBand.Left, ColorBand.Bottom - ColorBand.Top, PATCOPY);
  688.     finally
  689.       { Clean up the brush }
  690.       SelectObject(Canvas.handle, OldBrush);
  691.       DeleteObject(Brush);
  692.     end;
  693.   end; { iterate through the color bands }
  694. end; { GradientFill }
  695.  
  696. procedure TrmCustomLabel.CMMouseEnter(var Message: TCMEnter);
  697. begin
  698.   inherited;
  699.   if fmouseoptions.enabled then
  700.   begin
  701.     fnormalborder := borderstyle;
  702.     fnormalcolor := font.color;
  703.     fnormaltext := textstyle;
  704.     fborderstyle := fmouseoptions.EnterBorder;
  705.     ftextstyle := fmouseoptions.EnterTextStyle;
  706.     font.color := fmouseoptions.EnterColor;
  707.   end;
  708.   if assigned(fOnMouseEnter) then fOnMouseEnter(self);
  709. end;
  710.  
  711. procedure TrmCustomLabel.CMMouseLeave(var Message: TCMExit);
  712. begin
  713.   inherited;
  714.   if fmouseoptions.enabled then
  715.   begin
  716.     fborderstyle := fnormalborder;
  717.     ftextstyle := fnormaltext;
  718.     font.color := fNormalColor;
  719.   end;
  720.   if assigned(fOnMouseLeave) then fOnMouseLeave(self);
  721. end;
  722.  
  723. procedure TrmCustomLabel.SetThickBorder(Value: Boolean);
  724. begin
  725.   if fthickborder <> value then fthickborder := value;
  726.   invalidate;
  727. end;
  728.  
  729. function TrmCustomLabel.GetBorderWidth: integer;
  730. begin
  731.   result := 0;
  732.   case borderstyle of
  733.     rmbsRaisedEdge,
  734.       rmbsSunkenEdge: result := 2;
  735.     rmbsSingle,
  736.       rmbsRaised,
  737.       rmbsSunken: result := 1;
  738.   end;
  739.   if (ThickBorder) and (result = 1) then result := 2;
  740. end;
  741.  
  742. procedure TrmCustomLabel.SetShadowColor(value: tcolor);
  743. begin
  744.   fshadowcolor := value;
  745.   invalidate;
  746. end;
  747.  
  748. procedure TrmCustomLabel.SetShadowDepth(value: integer);
  749. begin
  750.   fshadowdepth := value;
  751.   invalidate;
  752. end;
  753.  
  754. end.
  755.  
  756.