home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / rotatel / rotatel.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  3.4 KB  |  128 lines
  1. unit Rotatel;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   StdCtrls, Menus;
  8.  
  9. type
  10.   TRotateLabel = class(TCustomLabel)
  11.   private
  12.     fAngle: longint;
  13.     fDegToRad, fCosAngle, fSinAngle: double;
  14.     procedure SetAngle(Value: longint);
  15.   protected
  16.     procedure Paint; override;
  17.   public
  18.     constructor Create(AOwner: TComponent); override;
  19.   published
  20.     property Angle: longint read fAngle write SetAngle default 0;
  21.     {property Align;}
  22.     {property Alignment;}
  23.     {property AutoSize;}
  24.     property Caption;
  25.     property Color;
  26.     property DragCursor;
  27.     property DragMode;
  28.     property Enabled;
  29.     property FocusControl;
  30.     property Font;
  31.     property ParentColor;
  32.     property ParentFont;
  33.     property ParentShowHint;
  34.     property PopupMenu;
  35.     property ShowAccelChar;
  36.     property ShowHint;
  37.     property Transparent default true;
  38.     property Visible;
  39.     {property WordWrap; }
  40.     property OnClick;
  41.     property OnDblClick;
  42.     property OnDragDrop;
  43.     property OnDragOver;
  44.     property OnEndDrag;
  45.     property OnMouseDown;
  46.     property OnMouseMove;
  47.     property OnMouseUp;
  48.   end;
  49.  
  50. procedure Register;
  51.  
  52. implementation
  53.  
  54. procedure Register;
  55. begin
  56.   RegisterComponents('Samples', [TRotateLabel]);
  57. end;
  58.  
  59. constructor TRotateLabel.Create(AOwner: TComponent);
  60. begin
  61.   inherited Create(AOwner);
  62.   fAngle := 0;
  63.   fDegToRad := PI / 180;
  64.   fCosAngle := 1; {cos(fAngle * fDegToRad)}
  65.   fSinAngle := 0; {sin(fAngle * fDegToRad)}
  66.   Transparent := true;
  67.   AutoSize := false;
  68. end;
  69.  
  70. procedure TRotateLabel.SetAngle(Value: longint);
  71. begin
  72.   if fAngle <> Value then
  73.   begin
  74.     fAngle := Value;
  75.     fCosAngle := cos(fAngle * fDegToRad);
  76.     fSinAngle := sin(fAngle * fDegToRad);
  77.     Invalidate;
  78.   end;
  79. end;
  80.  
  81. procedure TRotateLabel.Paint;
  82. var
  83.   LogRec: TLOGFONT;
  84.   OldFont,
  85.   NewFont: HFONT;
  86.   midX, midY, H, W, X, Y: integer;
  87.   P1, P2, P3, P4: TPoint;
  88. begin
  89.   with Canvas do
  90.   begin
  91.     Font := Self.Font;
  92.     Width := TextWidth(Caption + '   ');
  93.     Height := Width;
  94.     midX := Width div 2;
  95.     midY := Height div 2;
  96.     Brush.Style := bsClear;
  97.     GetObject(Font.Handle, SizeOf(LogRec), @LogRec);
  98.     LogRec.lfEscapement := fAngle*10;
  99.     LogRec.lfOutPrecision := OUT_TT_ONLY_PRECIS;
  100.     NewFont := CreateFontIndirect(LogRec);
  101.     OldFont := SelectObject(Canvas.Handle,NewFont);
  102.     W := TextWidth(Caption);
  103.     H := TextHeight(Caption);
  104.     X := midX - trunc(W/2*fCosAngle) - trunc(H/2*fSinAngle);
  105.     Y := midY + trunc(W/2*fSinAngle) - trunc(H/2*fCosAngle);
  106.     if not Transparent then
  107.     begin
  108.       W := W+7; H := H+5;
  109.       P1.X := midX - trunc(W/2*fCosAngle) - trunc(H/2*fSinAngle);
  110.       P1.Y := midY + trunc(W/2*fSinAngle) - trunc(H/2*fCosAngle);
  111.       P2.X := midX + trunc(W/2*fCosAngle) - trunc(H/2*fSinAngle);
  112.       P2.Y := midY - trunc(W/2*fSinAngle) - trunc(H/2*fCosAngle);
  113.       P3.X := midX + trunc(W/2*fCosAngle) + trunc(H/2*fSinAngle);
  114.       P3.Y := midY - trunc(W/2*fSinAngle) + trunc(H/2*fCosAngle);
  115.       P4.X := midX - trunc(W/2*fCosAngle) + trunc(H/2*fSinAngle);
  116.       P4.Y := midY + trunc(W/2*fSinAngle) + trunc(H/2*fCosAngle);
  117.       Brush.Color := Self.Color;
  118.       Brush.Style := bsSolid;
  119.       Polygon([P1, P2, P3, P4]);
  120.     end;
  121.     TextOut(X, Y, Caption);
  122.     NewFont := SelectObject(Canvas.Handle,OldFont);
  123.     DeleteObject(NewFont);
  124.   end;
  125. end;
  126.  
  127. end.
  128.