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