Label-Komponente um 90 Grad drehung

[Bummi]

So ein Teil ist ja auch schnell selbst geschrieben, egal ob von TPanel oder von TGraphicControl angeleitet. Ein kleiner Rumpf zum fertigbasteln ...

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TMyPanel=Class(TPanel)
  private
    FAngle: Double;
    FCenter: TPoint;
    procedure SetAngle(const Value: Double);
    procedure SetCenter(const Value: TPoint);
  published
    protected
    Property Canvas;
    Procedure Paint;override;
    published Property Angle:Double Read FAngle Write SetAngle;
    Property Center:TPoint read FCenter Write SetCenter;
  End;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
uses Math;
{$R *.dfm}

{ TMyPanel }
Procedure SetCanvasZoomAndRotation(ACanvas:TCanvas;Zoom:Double;Angle:Double;CenterpointX,CenterpointY:Double);
var
    form : tagXFORM;
    Winkel:Double;

begin
      Winkel := DegToRad(Angle);
      SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
      SetMapMode(ACanvas.Handle,MM_ANISOTROPIC);
      form.eM11 := Zoom * cos( Winkel);
      form.eM12 := Zoom *Sin( Winkel)  ;
      form.eM21 := Zoom * (-sin( Winkel));
      form.eM22 := Zoom * cos( Winkel) ;
      form.eDx := CenterpointX;
      form.eDy := CenterpointY;
      SetWorldTransform(ACanvas.Handle,form);
end;


procedure TMyPanel.Paint;
begin
  //inherited;
{
   Color := cllime;
   ParentColor := false;
   if not ParentColor then
      begin
       Canvas.Brush.Color := Color;
       Canvas.FillRect(BoundsRect);
      end;
}
   SetCanvasZoomAndRotation(Canvas,1,Angle,FCenter.X,FCenter.Y);
   Canvas.Brush.Style := bsClear;
   Canvas.Font.Assign(Font);
   Canvas.TextOut(0,0,Caption);
end;

procedure TMyPanel.SetAngle(const Value: Double);
begin
  FAngle := Value;
  invalidate;
end;

procedure TMyPanel.SetCenter(const Value: TPoint);
begin
  FCenter := Value;
  invalidate;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  With TMyPanel.Create(self) do
    begin
      DoubleBuffered := true;
      Parent := Self;
      Font.Size := 12;
      Left := 0;
      Top := 0;
      Height := 100;
      Width := 100;
      Caption := 'Test';
      Angle := -90;
      Center := Point(Width div 2,Height div 2);
      for I := -90 to 0 do
         begin
           Angle := i;
           sleep(20);
           Application.ProcessMessages;
         end;

    end;
end;

end.