home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d123456 / SIMONS.ZIP / Units / SRLabel.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-10-22  |  23.6 KB  |  869 lines
  1. unit SRLabel;
  2.  
  3. { TSRLabel (C)opyright 2001 Version 1.14
  4.   Autor : Simon Reinhardt
  5.   eMail : reinhardt@picsoft.de
  6.   Internet : http://www.picsoft.de
  7.  
  8.   Diese Komponente ist eine Label-Komponente mit Schatteneffekt und
  9.   Internet-Link-Funktion. Sie ist abgeleitet von TGraphicControl und
  10.   sie ist Public Domain, das Urheberrecht liegt aber beim Autor.
  11.  
  12.   Vielen Dank an Robert Rossmair fⁿr die rrColors-Unit! }
  13.  
  14. interface
  15.  
  16. {$I SRDefine.inc}
  17.  
  18. uses {$IFDEF SR_Win32} Windows, {$ELSE} WinTypes, WinProcs, Menus, SysUtils, {$ENDIF}
  19.   Messages, Classes, Controls, Graphics, ExtCtrls, StdCtrls, Forms;
  20.  
  21. type
  22.   THighLightPos = (hpTopLeft, hpTopRight);
  23.   TLinkType = (ltEMail, ltNews, ltNone, ltWWW);
  24.   {$IFNDEF SR_Delphi3_Up}
  25.   TTextLayout = (tlBottom, tlCenter, tlTop);
  26.   {$ENDIF}
  27.  
  28.   TSRLabel = class(TGraphicControl)
  29.   private
  30.     FAlignment         : TAlignment;
  31.     FAutoSize          : boolean;
  32.     FBevelStyle        : TPanelBevel;
  33.     FBevelWidth,
  34.     FBorderWidth       : word;
  35.     FFocusControl      : TWinControl;
  36.     FHighlightColor    : TColor;
  37.     FHighlightOffset   : word;
  38.     FHighlightOnEnter  : boolean;
  39.     FHighlightPos      : THighlightPos;
  40.     FLayout            : TTextLayout;
  41.     FFramed,
  42.     FLinkActive        : boolean;
  43.     FLinkedAdress      : string;
  44.     FLinkType          : TLinkType;
  45.     FMouseOnControl    : boolean;
  46.     FOldCursor         : TCursor;
  47.     FShadowColor       : TColor;
  48.     FShadowOffset      : word;
  49.     FShortenFilenames  : boolean;
  50.     FShowAccelChar,
  51.     FShowHighlight,
  52.     FShowShadow,
  53.     FUnderlineOnEnter : boolean;
  54.     FWordWrap         : boolean;
  55.  
  56.     FOnClick,
  57.     FOnExecuteLink,
  58.     FOnMouseEnter,
  59.     FOnMouseExit     : TNotifyEvent;
  60.  
  61.     procedure AdjustBounds;
  62.     procedure DrawTextComp(AText:string; var ARect:TRect; AFormat:Word);
  63.     procedure GetTextAndTextRect(var AText:string;var ARect:TRect);
  64.     function GetTextRect(ARect: TRect): TRect;
  65.     function GetTransparent: Boolean;
  66.     procedure PaintBevel(ARect: TRect);
  67.     procedure PaintText(ARect: TRect; AFlags: Word);
  68.     procedure SetAlignment(Value: TAlignment);
  69.     procedure SetBevelStyle(Value: TPanelBevel);
  70.     procedure SetBevelWidth(Value: word);
  71.     procedure SetBorderWidth(Value: word);
  72.     procedure SetFramed(Value: boolean);
  73.     {$IFDEF SR_Delphi2_Up}
  74.     procedure SetFocusControl(Value: TWinControl);
  75.     {$ENDIF}
  76.     procedure SetHighlightColor(Value: TColor);
  77.     procedure SetHighlightOffset(Value: word);
  78.     procedure SetHighlightOnEnter(Value: boolean);
  79.     procedure SetHighlightPos(Value: THighlightPos);
  80.     procedure SetLayout(Value: TTextLayout);
  81.     procedure SetShadowColor(Value: TColor);
  82.     procedure SetShadowOffset(Value: word);
  83.     procedure SetShortenFilenames(Value: Boolean);
  84.     procedure SetShowAccelChar(Value: Boolean);
  85.     procedure SetShowHighlight(Value: Boolean);
  86.     procedure SetShowShadow(Value: Boolean);
  87.     procedure SetTransparent(Value: Boolean);
  88.     procedure SetUnderlineOnEnter(Value: boolean);
  89.     procedure SetWordWrap(Value: Boolean);
  90.  
  91.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  92.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  93.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  94.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  95.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  96.  
  97.   protected
  98.     procedure Click; override;
  99.     procedure ExecuteLink; dynamic;
  100.     function GetLabelText: string; virtual;
  101.     procedure Loaded; override;
  102.     procedure Notification(AComponent: TComponent;
  103.       Operation: TOperation); override;
  104.     procedure Paint; override;
  105.     procedure SetAutoSize(Value: Boolean); virtual;
  106.  
  107.   public
  108.     constructor Create(AOwner: TComponent); override;
  109.     property Canvas;
  110.  
  111.   published
  112.     property Align;
  113.     property Alignment: TAlignment read FAlignment write SetAlignment
  114.       default taLeftJustify;
  115.     {$IFDEF SR_Delphi5_Up}
  116.     property Anchors;
  117.     {$ENDIF}
  118.     property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
  119.     property BevelStyle: TPanelBevel read FBevelStyle write SetBevelStyle;
  120.     property BevelWidth: word read FBevelWidth write SetBevelWidth;
  121.     property BorderWidth: word read FBorderWidth write SetBorderWidth;
  122.     property Caption;
  123.     property Color;
  124.     {$IFDEF SR_Delphi4_Up}
  125.     property Constraints;
  126.     {$ENDIF}
  127.     property Cursor;
  128.     {$IFDEF SR_Delphi4_Up}
  129.     property DragKind;
  130.     {$ENDIF}
  131.     property DragCursor;
  132.     property DragMode;
  133.     property Enabled;
  134.     {$IFDEF SR_Delphi2_Up}
  135.     property FocusControl: TWinControl read FFocusControl write SetFocusControl;
  136.     {$ELSE}
  137.     property FocusControl: TWinControl read FFocusControl write FFocusControl;
  138.     {$ENDIF}
  139.     property Font;
  140.     property Framed: Boolean read FFramed write SetFramed;
  141.     property HighlightColor: TColor read FHighlightColor write SetHighlightColor default clBtnHighlight;
  142.     property HighlightOffset: word read FHighlightOffset write SetHighlightOffset default 1;
  143.     property HighlightOnEnter: Boolean read FHighlightOnEnter write SetHighlightOnEnter default True;
  144.     property HighlightPos: THighlightPos read FHighlightPos write SetHighlightPos default hpTopLeft;
  145.     property Layout: TTextLayout read FLayout write SetLayout default tlTop;
  146.     property LinkActive: boolean read FLinkActive write FLinkActive;
  147.     property LinkedAdress: string read FLinkedAdress write FLinkedAdress;
  148.     property LinkType: TLinkType read FLinkType write FLinkType;
  149.     property ParentColor;
  150.     property ParentFont;
  151.     property ParentShowHint;
  152.     property PopupMenu;
  153.     property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
  154.     property ShadowOffset: word read FShadowOffset write SetShadowOffset default 1;
  155.     property ShortenFilenames: Boolean read FShortenFilenames write SetShortenFilenames;
  156.     property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
  157.     property ShowHighlight: Boolean read FShowHighlight write SetShowHighlight;
  158.     property ShowHint;
  159.     property ShowShadow: Boolean read FShowShadow write SetShowShadow;
  160.     property Transparent: Boolean read GetTransparent write SetTransparent default False;
  161.     property UnderlineOnEnter: Boolean read FUnderlineOnEnter write SetUnderlineOnEnter default True;
  162.     property Visible;
  163.     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  164.  
  165.     property OnClick: TNotifyEvent read FOnClick write FOnClick;
  166.     {$IFDEF SR_Delphi5_Up}
  167.     property OnContextPopup;
  168.     {$ENDIF}
  169.     property OnDblClick;
  170.     property OnDragDrop;
  171.     property OnDragOver;
  172.     property OnEndDrag;
  173.     {$IFDEF SR_Delphi4_Up}
  174.     property OnEndDock;
  175.     {$ENDIF}
  176.     property OnExecuteLink: TNotifyEvent read FOnExecuteLink write FOnExecuteLink;
  177.     property OnMouseDown;
  178.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  179.     property OnMouseExit: TNotifyEvent read FOnMouseExit  write FOnMouseExit;
  180.     property OnMouseMove;
  181.     property OnMouseUp;
  182.     {$IFDEF SR_Delphi4_Up}
  183.     property OnStartDock;
  184.     {$ENDIF}
  185.     {$IFDEF SR_Delphi2_Up}
  186.     property OnStartDrag;
  187.     {$ENDIF}
  188.   end;
  189.  
  190. procedure Register;
  191.  
  192. implementation
  193.  
  194. {$IFDEF SR_Delphi2_Up}
  195. {$R *.D32}
  196. {$R *.R32}
  197. uses ShellAPI, FileCtrl, rrColors;
  198. {$ELSE}
  199. {$R *.D16}
  200. {$R *.R16}
  201. uses ShellAPI, FileCtrl;
  202. {$ENDIF}
  203.  
  204. const
  205.   HLFactor    = 0.65;
  206.   HLContrast  = 5;
  207.   ShContrast  = 4;
  208.   crLinkPoint = TCursor(-30);
  209.  
  210. {$IFDEF SR_Delphi1}
  211. function ChangeBrightness(Color:TColor;Percentage:longint):TColor;
  212. var RGBColor       : longint;
  213.     Red,Green,Blue : byte;
  214.     NewR,NewG,NewB : longint;
  215.     Overflow       : longint;
  216. begin
  217.   RGBColor:=ColorToRGB(Color);
  218.   Overflow:=0;
  219.   {Rot}
  220.   Red:=GetRValue(RGBColor);
  221.   NewR:=Red+(Percentage*Red div 100);
  222.   if NewR>255 then begin
  223.     Overflow:=NewR-255;
  224.     NewG:=Overflow;
  225.     NewB:=Overflow;
  226.   end
  227.   else begin
  228.     NewG:=0;
  229.     NewB:=0;
  230.   end;
  231.   {Grⁿn}
  232.   Green:=GetGValue(RGBColor);
  233.   NewG:=NewG+Green+(Percentage*Green div 100);
  234.   if NewG>255 then begin
  235.     Overflow:=NewG-255;
  236.     NewR:=NewR+Overflow;
  237.     NewB:=Overflow;
  238.   end;
  239.   {Blau}
  240.   Blue:=GetBValue(RGBColor);
  241.   NewB:=NewB+Blue+(Percentage*Blue div 100);
  242.   if NewB>255 then begin
  243.     Overflow:=NewB-255;
  244.     if NewG<=255 then
  245.       NewR:=NewR+Overflow;
  246.   end;
  247.   if NewR>255 then
  248.     NewR:=255;
  249.   if NewG>255 then
  250.     NewG:=255;
  251.   if NewB>255 then
  252.     NewB:=255;
  253.   if NewR<0 then
  254.     NewR:=0;
  255.   if NewG<0 then
  256.     NewG:=0;
  257.   if NewB<0 then
  258.     NewB:=0;
  259.   Result:=NewR+(NewG shl 8)+(NewB shl 16);
  260. end;
  261. {$ENDIF}
  262.  
  263. function CalcHighlightColor(AColor:TColor):TColor;
  264. var ShColor : TColor;
  265. begin
  266.   {$IFDEF SR_Delphi1}
  267.   Result:=ChangeBrightness(AColor,round(HLFactor*100));
  268.   {$ELSE}
  269.   Get3DColors(AColor,Result,ShColor,HLFactor,1);
  270.   {$ENDIF}
  271. end;
  272.  
  273. procedure AssignBevelColors(FaceColor:TColor;var HighlightColor,ShadowColor:TColor;HLContrast,ShContrast:integer);
  274. begin
  275.   {$IFDEF SR_Delphi1}
  276.   HighlightColor:=ChangeBrightness(FaceColor,100 div 10*HLContrast);
  277.   ShadowColor:=ChangeBrightness(FaceColor,-100 div 10*ShContrast);
  278.   {$ELSE}
  279.   Get3DColors(FaceColor,HighlightColor,ShadowColor,(10-HLContrast)/10,(10-ShContrast)/10);
  280.   {$ENDIF}
  281. end;
  282.  
  283.  
  284. constructor TSRLabel.Create(AOwner: TComponent);
  285. begin
  286.   inherited Create(AOwner);
  287.   Screen.Cursors[crLinkPoint]:=LoadCursor(HInstance, 'CRSRLINKPOINT');
  288.   {$IFDEF SR_Delphi2_Up}
  289.   ControlStyle:=ControlStyle+[csOpaque, csReplicatable];
  290.   FAutoSize:=True;
  291.   {$ELSE}
  292.   ControlStyle:=ControlStyle+[csOpaque];
  293.   FAutoSize:=False;
  294.   {$ENDIF}
  295.   Width:=65;
  296.   Height:=17;
  297.  
  298.   FBevelStyle:=bvNone;
  299.   FBevelWidth:=1;
  300.   FBorderWidth:=0;
  301.   FFramed:=false;
  302.   FHighlightColor:=clBtnHighlight;
  303.   FHighlightOffset:=1;
  304.   FHighlightOnEnter:=true;
  305.   FHighlightPos:=hpTopLeft;
  306.   FLayout:=tlTop;
  307.   FLinkType:=ltWWW;
  308.   FLinkedAdress:='http://www.picsoft.de';
  309.   FLinkActive:=false;
  310.   FOldCursor:=Cursor;
  311.   FShadowColor:=clBtnShadow;
  312.   FShadowOffset:=1;
  313.   FShortenFilenames:=false;
  314.   FShowAccelChar:=True;
  315.   FShowHighlight:=False;
  316.   FShowShadow:=False;
  317.   FUnderlineOnEnter:=true;
  318. end;
  319.  
  320. procedure TSRLabel.AdjustBounds;
  321. var X     : Integer;
  322.     ARect : TRect;
  323. begin
  324.   if not (csReading in ComponentState) and FAutoSize then begin
  325.     ARect:=GetTextRect(ClientRect);
  326.     if FFramed then
  327.       InflateRect(ARect, 1, 1);
  328.     if FBevelStyle<>bvNone then
  329.       InflateRect(ARect, FBevelWidth*2, FBevelWidth*2);
  330.     if FBorderWidth>0 then
  331.       InflateRect(ARect, FBorderWidth*2, FBorderWidth*2);
  332.     if FShowHighlight then begin
  333.       ARect.Right:=ARect.Right+FHighlightOffset;
  334.       ARect.Bottom:=ARect.Bottom+FHighlightOffset;
  335.     end;
  336.     if FShowShadow then begin
  337.       ARect.Right:=ARect.Right+FShadowOffset;
  338.       ARect.Bottom:=ARect.Bottom+FShadowOffset;
  339.     end;
  340.     if FAlignment=taRightJustify then
  341.       X:=Left+Width-(ARect.Right-ARect.Left)
  342.     else
  343.       X:=Left;
  344.     SetBounds(X, Top, ARect.Right, ARect.Bottom);
  345.   end;
  346. end;
  347.  
  348. procedure TSRLabel.Click;
  349. var URL   : string;
  350. {$IFDEF SR_Delphi1}
  351.     CText : PChar;
  352. {$ENDIF}
  353. begin
  354.   if Assigned(FOnClick) then
  355.     FOnClick(Self);
  356.   if Enabled and FLinkActive and (FLinkType<>ltNone) and (FLinkedAdress<>'') then begin
  357.     case FLinkType of
  358.       ltEMail : URL:='mailto:'+FLinkedAdress;
  359.       ltNews  : URL:='news:'+FLinkedAdress;
  360.       else URL:=FLinkedAdress;
  361.     end;
  362.     ExecuteLink;
  363.     {$IFDEF SR_Delphi1}
  364.     CText:=StrAlloc(255);
  365.     StrPCopy(CText, URL);
  366.     ShellExecute(0, 'open', CText, nil, nil, SW_ShowNormal);
  367.     StrDispose(CText);
  368.     {$ELSE}
  369.     ShellExecute(0, 'open', PChar(URL), nil, nil, SW_ShowNormal);
  370.     {$ENDIF}
  371.   end;
  372. end;
  373.  
  374. procedure TSRLabel.CMDialogChar(var Message: TCMDialogChar);
  375. begin
  376.   if (FFocusControl <> nil) and Enabled and ShowAccelChar and
  377.    IsAccel(Message.CharCode, Caption) then
  378.     with FFocusControl do
  379.       if CanFocus then begin
  380.         SetFocus;
  381.         Message.Result:=1;
  382.       end;
  383. end;
  384.  
  385. procedure TSRLabel.CMFontChanged(var Message: TMessage);
  386. begin
  387.   inherited;
  388.   AdjustBounds;
  389. end;
  390.  
  391. procedure TSRLabel.CMMouseEnter(var Message: TMessage);
  392. begin
  393.   inherited;
  394.   if not FMouseOnControl and FLinkActive and Enabled then begin
  395.     FMouseOnControl:=true;
  396.     FOldCursor:=Cursor;
  397.     Cursor:=crLinkPoint;
  398.     Invalidate;
  399.   end;
  400.   if assigned(FOnMouseEnter) then
  401.     FOnMouseEnter(self);
  402. end;
  403.  
  404. procedure TSRLabel.CMMouseLeave(var Message: TMessage);
  405. begin
  406.   inherited;
  407.   if FMouseOnControl and FLinkActive and Enabled then begin
  408.     FMouseOnControl:=false;
  409.     Cursor:=FOldCursor;
  410.     Invalidate;
  411.   end;
  412.   if assigned(FOnMouseExit) then
  413.     FOnMouseExit(Self);
  414. end;
  415.  
  416. procedure TSRLabel.CMTextChanged(var Message: TMessage);
  417. begin
  418.   AdjustBounds;
  419.   Invalidate;
  420. end;
  421.  
  422. procedure TSRLabel.DrawTextComp(AText:string; var ARect:TRect; AFormat:Word);
  423. {$IFDEF SR_Delphi1}
  424. var CText : PChar;
  425. {$ENDIF}
  426. begin
  427.   {$IFDEF SR_Delphi1}
  428.   CText:=StrAlloc(255);
  429.   StrPCopy(CText, AText);
  430.   DrawText(Canvas.Handle, CText, StrLen(CText), ARect, AFormat);
  431.   StrDispose(CText);
  432.   {$ELSE}
  433.   DrawText(Canvas.Handle, PChar(AText), Length(AText), ARect, AFormat);
  434.   {$ENDIF}
  435. end;
  436.  
  437. procedure TSRLabel.ExecuteLink;
  438. begin
  439.   if Assigned(FOnExecuteLink) then
  440.     FOnExecuteLink(Self);
  441. end;
  442.  
  443. function TSRLabel.GetLabelText: string;
  444. begin
  445.   if FShortenFilenames then begin
  446.     Result:=MinimizeName(Caption, Canvas, ClientWidth-10);
  447.   end
  448.   else
  449.     Result:=Caption;
  450. end;
  451.  
  452. procedure TSRLabel.GetTextAndTextRect(var AText:string;var ARect:TRect);
  453. const WordWraps : array[Boolean] of Word = (0, DT_WORDBREAK);
  454. var DC        : HDC;
  455.     OldHandle : THandle;
  456.     OutText   : string;
  457. begin
  458.   AText:=GetLabelText;
  459.   OutText:=AText;
  460.   if (OutText='') or (FShowAccelChar and (OutText[1]='&') and (OutText[2]=#0)) then
  461.     OutText:=OutText+' ';
  462.   OldHandle:=Canvas.Handle;
  463.   DC:=GetDC(0);
  464.   Canvas.Handle:=DC;
  465.   Canvas.Font:=Font;
  466.   DrawTextComp(OutText, ARect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
  467.   Canvas.Handle:=OldHandle;
  468.   ReleaseDC(0, DC);
  469. end;
  470.  
  471. function TSRLabel.GetTextRect(ARect: TRect): TRect;
  472. const WordWraps : array[Boolean] of Word = (0, DT_WORDBREAK);
  473. var AText     : string;
  474.     DC        : HDC;
  475.     OldHandle : THandle;
  476. begin
  477.   Result:=ARect;
  478.   AText:=GetLabelText;
  479.   if (AText='') or (FShowAccelChar and (AText[1]='&') and (AText[2]=#0)) then
  480.     AText:=AText+' ';
  481.   OldHandle:=Canvas.Handle;
  482.   DC:=GetDC(0);
  483.   Canvas.Handle:=DC;
  484.   Canvas.Font:=Font;
  485.   DrawTextComp(AText, Result, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
  486.   Canvas.Handle:=OldHandle;
  487.   ReleaseDC(0, DC);
  488. end;
  489.  
  490. function TSRLabel.GetTransparent: Boolean;
  491. begin
  492.   Result:=not (csOpaque in ControlStyle);
  493. end;
  494.  
  495. procedure TSRLabel.Loaded;
  496. begin
  497.   inherited Loaded;
  498.   AdjustBounds;
  499. end;
  500.  
  501. procedure TSRLabel.Notification(AComponent: TComponent;
  502.   Operation: TOperation);
  503. begin
  504.   inherited Notification(AComponent, Operation);
  505.   if (Operation=opRemove) and (AComponent=FFocusControl) then
  506.     FFocusControl:=nil;
  507. end;
  508.  
  509. procedure TSRLabel.PaintBevel(ARect: TRect);
  510. var ShColor,
  511.     HLColor : TColor;
  512.     i       : integer;
  513. begin
  514.   AssignBevelColors(Color, HLColor, ShColor, HLContrast, ShContrast);
  515.   with Canvas do begin
  516.     if FFramed then 
  517.       InflateRect(ARect, -1, -1);
  518.     if FBevelStyle=bvRaised then
  519.       Pen.Color:=HLColor
  520.     else
  521.       Pen.Color:=ShColor;
  522.     for i:=1 to FBevelWidth do begin
  523.       MoveTo(ARect.Right-i, ARect.Top+i-1);
  524.       LineTo(ARect.Left+i-1, ARect.Top+i-1);
  525.       LineTo(ARect.Left+i-1, ARect.Bottom-i);
  526.     end;
  527.     if FBevelStyle=bvRaised then
  528.       Pen.Color:=ShColor
  529.     else
  530.       Pen.Color:=HLColor;
  531.     for i:=1 to FBevelWidth do begin
  532.       MoveTo(ARect.Left+i-1, ARect.Bottom-i);
  533.       LineTo(ARect.Right-i, ARect.Bottom-i);
  534.       LineTo(ARect.Right-i, ARect.Top+i-1);
  535.     end;
  536.   end;
  537. end;
  538.  
  539. procedure TSRLabel.PaintText(ARect: TRect; AFlags: Word);
  540. var AText      : string;
  541.     TextHeight,
  542.     TextWidth  : integer;
  543.     TextRect,
  544.     OutRect    : TRect;
  545. begin
  546.   if not FShowAccelChar then
  547.     AFlags:=AFlags or DT_NOPREFIX;
  548.   Canvas.Font:=Font;
  549.   TextRect:=ARect;
  550.   GetTextAndTextRect(AText, TextRect);
  551.   TextHeight:=TextRect.Bottom-TextRect.Top;
  552.   TextWidth:=TextRect.Right-TextRect.Left;
  553.  
  554.   { horizontale und vertikale Offsets berechnen }
  555.   OutRect:=TextRect;
  556.   if FBevelStyle<>bvNone then begin
  557.     if FLayout=tlCenter then
  558.       OffsetRect(OutRect, FBevelWidth, 0)
  559.     else
  560.       OffsetRect(OutRect, FBevelWidth, FBevelWidth);
  561.   end;
  562.   if FFramed then begin
  563.     if FLayout=tlCenter then
  564.       OffsetRect(OutRect, 1, 0)
  565.     else
  566.       OffsetRect(OutRect, 1, 1);
  567.   end;
  568.   if FAlignment=taLeftJustify then
  569.     OffsetRect(OutRect, FBorderWidth, 0);
  570.   if FAlignment=taCenter then
  571.     OffsetRect(OutRect, (Width-TextWidth) div 2, 0);
  572.   if FAlignment=taRightJustify then
  573.     OffsetRect(OutRect, Width-TextWidth-2-FBorderWidth, 0);
  574.   if FLayout=tlTop then
  575.     OffsetRect(OutRect, 0, FBorderWidth);
  576.   if FLayout=tlCenter then
  577.     OffsetRect(OutRect, 0, ((Height-TextHeight) div 2));
  578.   if FLayout=tlBottom then
  579.     OffsetRect(OutRect, 0, Height-TextHeight-FBorderWidth);
  580.   if FShowHighlight then begin
  581.     if FHighlightPos=hpTopLeft then
  582.       OffsetRect(OutRect, FHighlightOffset, 0)
  583.     else
  584.       if Alignment=taRightJustify then
  585.         OffsetRect(OutRect, -FHighlightOffset, 0);
  586.     if FLayout=tlTop then
  587.       OffsetRect(OutRect, 0, FHighlightOffset);
  588.   end;
  589.   if FShowShadow then begin
  590.     if FHighlightPos=hpTopRight then
  591.       OffsetRect(OutRect, FShadowOffset, 0)
  592.     else
  593.       if Alignment=taRightJustify then
  594.         OffsetRect(OutRect, -FShadowOffset, 0);
  595.     if FLayout=tlBottom then
  596.       OffsetRect(OutRect, 0, -FShadowOffset);
  597.   end;
  598.  
  599.   if not Enabled then begin
  600.     OffsetRect(OutRect, 1, 1);
  601.     Canvas.Font.Color:=clBtnHighlight;
  602.     DrawTextComp(AText, OutRect, AFlags);
  603.     OffsetRect(OutRect, -1, -1);
  604.     Canvas.Font.Color:=clBtnShadow;
  605.     DrawTextComp(AText, OutRect, AFlags);
  606.   end
  607.   else begin
  608.  
  609.     { Highlight-Text ausgeben }
  610.     if FShowHighlight then begin
  611.       Canvas.Font.Color:=FHighlightColor;
  612.       TextRect:=OutRect;
  613.       { horizontaler Offset }
  614.       if FHighlightPos=hpTopLeft then
  615.         OffsetRect(TextRect, -FHighlightOffset, -FHighlightOffset)
  616.       else
  617.         OffsetRect(TextRect, FHighlightOffset, -FHighlightOffset);
  618.       DrawTextComp(AText, TextRect, AFlags);
  619.     end;
  620.  
  621.     { Shadow-Text ausgeben }
  622.     if FShowShadow then begin
  623.       Canvas.Font.Color:=FShadowColor;
  624.       TextRect:=OutRect;
  625.       { horizontaler Offset }
  626.       if FHighlightPos=hpTopLeft then
  627.         OffsetRect(TextRect, FShadowOffset, FShadowOffset)
  628.       else
  629.         OffsetRect(TextRect, -FShadowOffset, FShadowOffset);
  630.       DrawTextComp(AText, TextRect, AFlags);
  631.     end;
  632.  
  633.     { Haupttext ausgeben }
  634.     Canvas.Font.Color:=Font.Color;
  635.     if FLinkActive and FMouseOnControl and Enabled then begin
  636.       if FHighlightOnEnter then
  637.         Canvas.Font.Color:=CalcHighlightColor(Font.Color);
  638.       if FUnderlineOnEnter then
  639.         Canvas.Font.Style:=Font.Style+[fsUnderline];
  640.     end;
  641.     DrawTextComp(AText, OutRect, AFlags);
  642.  
  643.   end;
  644. end;
  645.  
  646. procedure TSRLabel.Paint;
  647. const
  648.   Alignments: array[TAlignment] of Word =
  649.    (DT_LEFT, DT_RIGHT, DT_CENTER);
  650.   WordWraps: array[Boolean] of Word =
  651.    (0, DT_WORDBREAK);
  652. var DrawStyle : Integer;
  653. begin
  654.   with Canvas do begin
  655.  
  656.     { Hintergrund }
  657.     if not Transparent then begin
  658.       Brush.Color:=Self.Color;
  659.       Brush.Style:=bsSolid;
  660.       FillRect(ClientRect);
  661.     end;
  662.  
  663.     { Text }
  664.     Brush.Style:=bsClear;
  665.     DrawStyle:=DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment];
  666.     PaintText(ClientRect, DrawStyle);
  667.  
  668.     { Rahmen }
  669.     if FFramed then begin
  670.       Brush.Color:=clWindowFrame;
  671.       FrameRect(ClientRect);
  672.     end;
  673.     if FBevelStyle<>bvNone then
  674.       PaintBevel(ClientRect);
  675.   end;
  676. end;
  677.  
  678. procedure TSRLabel.SetAlignment(Value: TAlignment);
  679. begin
  680.   if FAlignment<>Value then begin
  681.     FAlignment:=Value;
  682.     Invalidate;
  683.   end;
  684. end;
  685.  
  686. procedure TSRLabel.SetAutoSize(Value: Boolean);
  687. begin
  688.   if FAutoSize<>Value then begin
  689.     FAutoSize:=Value;
  690.     AdjustBounds;
  691.   end;
  692. end;
  693.  
  694. procedure TSRLabel.SetBevelStyle(Value: TPanelBevel);
  695. begin
  696.   if FBevelStyle<>Value then begin
  697.     FBevelStyle:=Value;
  698.     Invalidate;
  699.   end;
  700. end;
  701.  
  702. procedure TSRLabel.SetBevelWidth(Value: word);
  703. begin
  704.   if FBevelWidth<>Value then begin
  705.     FBevelWidth:=Value;
  706.     AdjustBounds;
  707.     Invalidate;
  708.   end;
  709. end;
  710.  
  711. procedure TSRLabel.SetBorderWidth(Value: word);
  712. begin
  713.   if FBorderWidth<>Value then begin
  714.     FBorderWidth:=Value;
  715.     AdjustBounds;
  716.     Invalidate;
  717.   end;
  718. end;
  719.  
  720. {$IFDEF SR_Delphi2_Up}
  721. procedure TSRLabel.SetFocusControl(Value: TWinControl);
  722. begin
  723.   FFocusControl:=Value;
  724.   if Value<>nil then
  725.     Value.FreeNotification(Self);
  726. end;
  727. {$ENDIF}
  728.  
  729. procedure TSRLabel.SetFramed(Value: boolean);
  730. begin
  731.   if FFramed<>Value then begin
  732.     FFramed:=Value;
  733.     AdjustBounds;
  734.     Invalidate;
  735.   end;
  736. end;
  737.  
  738. procedure TSRLabel.SetHighlightColor(Value: TColor);
  739. begin
  740.   if FHighlightColor<>Value then begin
  741.     FHighlightColor:=Value;
  742.     Invalidate;
  743.   end;
  744. end;
  745.  
  746. procedure TSRLabel.SetHighlightOffset(Value: word);
  747. begin
  748.   if FHighlightOffset<>Value then begin
  749.     FHighlightOffset:=Value;
  750.     if FShowHighlight then begin
  751.       AdjustBounds;
  752.       Invalidate;
  753.     end;
  754.   end;
  755. end;
  756.  
  757. procedure TSRLabel.SetHighlightOnEnter(Value: boolean);
  758. begin
  759.   if FHighlightOnEnter<>Value then begin
  760.     FHighlightOnEnter:=Value;
  761.     if FMouseOnControl then
  762.       Invalidate;
  763.   end;
  764. end;
  765.  
  766. procedure TSRLabel.SetHighlightPos(Value: THighlightPos);
  767. begin
  768.   if FHighlightPos<>Value then begin
  769.     FHighlightPos:=Value;
  770.     Invalidate;
  771.   end;
  772. end;
  773.  
  774. procedure TSRLabel.SetLayout(Value: TTextLayout);
  775. begin
  776.   if FLayout<>Value then begin
  777.     FLayout:=Value;
  778.     Invalidate;
  779.   end;
  780. end;
  781.  
  782. procedure TSRLabel.SetShadowColor(Value: TColor);
  783. begin
  784.   if FShadowColor<>Value then begin
  785.     FShadowColor:=Value;
  786.     Invalidate;
  787.   end;
  788. end;
  789.  
  790. procedure TSRLabel.SetShadowOffset(Value: word);
  791. begin
  792.   if FShadowOffset<>Value then begin
  793.     FShadowOffset:=Value;
  794.     if FShowShadow then begin
  795.       AdjustBounds;
  796.       Invalidate;
  797.     end;
  798.   end;
  799. end;
  800.  
  801. procedure TSRLabel.SetShortenFilenames(Value: Boolean);
  802. begin
  803.   if FShortenFilenames<>Value then begin
  804.     FShortenFilenames:=Value;
  805.     Invalidate;
  806.   end;
  807. end;
  808.  
  809. procedure TSRLabel.SetShowAccelChar(Value: Boolean);
  810. begin
  811.   if FShowAccelChar<>Value then begin
  812.     FShowAccelChar:=Value;
  813.     Invalidate;
  814.   end;
  815. end;
  816.  
  817. procedure TSRLabel.SetShowHighlight(Value: Boolean);
  818. begin
  819.   if FShowHighlight<>Value then begin
  820.     FShowHighlight:=Value;
  821.     AdjustBounds;
  822.     Invalidate;
  823.   end;
  824. end;
  825.  
  826. procedure TSRLabel.SetShowShadow(Value: Boolean);
  827. begin
  828.   if FShowShadow<>Value then begin
  829.     FShowShadow:=Value;
  830.     AdjustBounds;
  831.     Invalidate;
  832.   end;
  833. end;
  834.  
  835. procedure TSRLabel.SetTransparent(Value: Boolean);
  836. begin
  837.   if Transparent<>Value then begin
  838.     if Value then
  839.       ControlStyle:=ControlStyle-[csOpaque]
  840.     else
  841.       ControlStyle:=ControlStyle+[csOpaque];
  842.     Invalidate;
  843.   end;
  844. end;
  845.  
  846. procedure TSRLabel.SetUnderlineOnEnter(Value: boolean);
  847. begin
  848.   if FUnderlineOnEnter<>Value then begin
  849.     FUnderlineOnEnter:=Value;
  850.     if FMouseOnControl then
  851.       Invalidate;
  852.   end;
  853. end;
  854.  
  855. procedure TSRLabel.SetWordWrap(Value: Boolean);
  856. begin
  857.   if FWordWrap<>Value then begin
  858.     FWordWrap:=Value;
  859.     AdjustBounds;
  860.     Invalidate;
  861.   end;
  862. end;
  863.  
  864. procedure Register;
  865. begin
  866.   RegisterComponents('Simon', [TSRLabel]);
  867. end;
  868.  
  869. end.