this slowpoke moves

Draw Animated Bezier Fonts

Unit ExCanvasTools.pas
unit ExCanvasTools;

interface
uses
  Windows, SysUtils,  Classes, Graphics;

  Function Grad2Rad(w:Double):Double;
  Function StringReverse(Const s:String):String;
  Procedure PaintGraphic(ACanvas:TCanvas;x,y:Integer;AGraphic:TGraphic;Faktor,Winkel:Double;PosIsCenter:Boolean=false);
  Procedure PaintText(ACanvas:TCanvas;Const s:String;x,y:Double;Faktor,Winkel:Double;PosIsCenter:Boolean=false);
  Procedure ResetCanvas(ACanvas:TCanvas);
  procedure SetCanvasZoomAndRotation(ACanvas: TCanvas;Zoom:Double;Angle:Double;CenterpointX,CenterpointY:Double);
  Procedure PaintRingText(ACanvas:TCanvas;Const s:String;Centerx,Centery:Integer;StartWinkel:Double;Radius:Double;Abstand:Double;Linkslaeufig:Boolean=false;Mirror:Boolean=false);

implementation

Function Grad2Rad(w:Double):Double;
  begin
     Result := w  / 360 * PI *2;
  end;

Function StringReverse(Const s:String):String;
var
 i:Integer;
begin
  SetLength(Result,Length(s));
  for I := 1 to Length(s) do
  Result[Length(s)-i + 1] := s[i];
end;


Procedure PaintRingText(ACanvas:TCanvas;Const s:String;Centerx,Centery:Integer;StartWinkel:Double;Radius:Double;Abstand:Double;Linkslaeufig:Boolean=false;Mirror:Boolean=false);
TYPE
  TDistArray=Array of Double;
var
 CurrWinkel:Double;
 DistArray:TDistArray;
 i:Integer;
 x,y:Double;
 AddRot:Double;
 Vorz:Integer;
 TheStr:String;
 bs:TBrushStyle;
begin
  if Linkslaeufig then
    begin
    TheStr := Stringreverse(s);
    AddRot := 180;
    end
   else
    begin
    TheStr := s;
    AddRot := 0;
    end;

  if Mirror then Vorz := -1 else Vorz := 1;
  SetLength(DistArray,length(TheStr) + 1);
  for i := 1 to Length(TheStr) do
    begin
    DistArray[i] := ACanvas.textwidth(TheStr[i]);
    if DistArray[i] > DistArray[0] then DistArray[0] := DistArray[i];
    end;
  for i := 1 to Length(TheStr) do  DistArray[i] := SQRT(SQRT(DistArray[i] / DistArray[0]));
  CurrWinkel := StartWinkel;
  bs := aCanvas.Brush.Style;
  for i := 1 to Length(TheStr) do
      begin
        x := Round(Cos(Grad2Rad(CurrWinkel )) * Radius + Centerx);
        y := Round(Sin(Grad2Rad(CurrWinkel )) * Radius + Centery);
        PaintText(ACanvas,TheStr[i],x,y,1,CurrWinkel + 90 + AddRot,true);
        CurrWinkel := CurrWinkel +  Vorz * (Abstand * DistArray[i]);
      end;
  aCanvas.Brush.Style := bs;
end;


Procedure PaintText(ACanvas:TCanvas;Const s:String;x,y:Double;Faktor,Winkel:Double;PosIsCenter:Boolean=false);
var
  px,py:Integer;
begin
     SetCanvasZoomAndRotation(ACanvas , Faktor, Winkel, x,y);
     if PosIsCenter then
        begin
          px := Round( ACanvas.TextWidth(s) / 2 );
          py := Round( ACanvas.TextHeight(s) / 2 );
        end
     else
        begin
          px := 0;
          py := 0;
        end;

     ACanvas.TextOut(-px ,-py ,s);
     ResetCanvas(ACanvas);
end;

Procedure PaintGraphic(ACanvas:TCanvas;x,y:Integer;AGraphic:TGraphic;Faktor,Winkel:Double;PosIsCenter:Boolean=false);
var
  px,py:Integer;
begin
     if PosIsCenter then
        begin
          px := Round( AGraphic.Width / 2 );
          py := Round( AGraphic.Height / 2 );
        end
     else
        begin
          px := 0;
          py := 0;
        end;
     SetCanvasZoomAndRotation(ACanvas , Faktor, Winkel, x , y  );
     ACanvas.Draw(-px ,-py ,AGraphic);
     ResetCanvas(ACanvas);
end;

Procedure ResetCanvas(ACanvas:TCanvas);
begin
   SetCanvasZoomAndRotation(ACanvas , 1, 0, 0,0);
end;

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

begin
      Winkel := Grad2Rad(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;

end.
Unit1 :
uses ExCanvasTools, Math

private
  { Private-Deklarationen }
  FStartWinkel, FStartWinkelAdd, FRadius, Fabstand:Double;
  Rinc : Integer;
  
//

procedure TForm1.FormCreate(Sender: TObject);
begin
    FRadius := 100;
    Fabstand := FRadius / 5;
    Rinc := 3;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Font.Color := clBlue;
  PaintRingText(Canvas,'Hello World Right',
                Width div 2,
                Height div 2,
                FStartWinkel,
                FRadius,
                Fabstand,false);

  Canvas.Font.Color := clRed;
  PaintRingText(Canvas,'Hello World Left',
                Width div 2,
                Height div 2,
                - FStartWinkel + 180,
                FRadius + 30,
                Fabstand,true);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
    FRadius := FRadius + Rinc;
    FStartWinkelAdd := FStartWinkelAdd + 2;
    Canvas.Brush.Style := bsClear;
    Canvas.Font.Size := Round(FRadius*FRadius / 4000) + 6;
    if (FRadius > 300) or (FRadius < 100)  then  Rinc := -Rinc;
    Fabstand := Sqrt(310 - FRadius) * 1.5;
    FStartwinkel := FRadius - 100 + FStartWinkelAdd;
    Invalidate;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate