Canvas en millimètre

Télécharger le projet
Commenter

Description

Ben voilà, rien de bien révolutionnaire.
C'est une classe dérivé de TCanvas qui prend comme paramètre dans les procédures de dessins des valeurs en 1/10 de millimètre.
Donc TMMCanvas.rectangle(0,0,1000,1000) trace un carré de 10cm de côté.
Pour une utilisation simple, il suffit de transtyper un canvas en tmmcanvas.
Par exemple :
tmmcanvas(form1.canvas).ellypse(0,0,200,200); trace un cercle de 2cm de diamètre sur le canvas d'une fenêtre.

Très pratique pour le canvas de l'objet Printer. Ainsi, on trace en mm sur l'imprimante.

Source / Exemple : 


unit UMMCanvas;

interface

uses windows,graphics;

type
 TMMCanvas=class(Tcanvas)
  private
    function ConvertX(x:integer):integer;
    function ConvertY(y:integer):integer;
    function InvConvertX(x:integer):integer;
    function InvConvertY(y:integer):integer;
    function ConvertPoint(pt:TPoint):TPoint;
    function ConvertRect(rect:trect):TRect;
    function GetPixel(X, Y: Integer): TColor;
    procedure SetPixel(X, Y: Integer; Value: TColor);
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure MMArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure MMBrushCopy(Const Dest: TRect; Bitmap: TBitmap; Const Source: TRect; Color: TColor);
    procedure MMChord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure MMCopyRect(Const Dest: TRect; Canvas: TCanvas;Const Source: TRect);
    procedure MMDraw(X, Y: Integer; Graphic: TGraphic);
    procedure MMDrawFocusRect(const Rect: TRect);
    procedure MMEllipse(X1, Y1, X2, Y2: Integer); overload;
    procedure MMEllipse(const Rect: TRect); overload;
    procedure MMFillRect(const Rect: TRect);
    procedure MMFloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);
    procedure MMFrameRect(const Rect: TRect);

    procedure MMLineTo(X, Y: Integer);

    procedure MMMoveTo(X, Y: Integer);
    procedure MMPie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure MMPolygon(const Points: array of TPoint);
    procedure MMPolyline(const Points: array of TPoint);
    procedure MMPolyBezier(const Points: array of TPoint);
    procedure MMPolyBezierTo(const Points: array of TPoint);
    procedure MMRectangle(X1, Y1, X2, Y2: Integer); overload;
    procedure MMRectangle(const Rect: TRect); overload;
    procedure MMRoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
    procedure MMStretchDraw(const Rect: TRect; Graphic: TGraphic);
    function MMTextExtent(const Text: string): TSize;
    function MMTextHeight(const Text: string): Integer;
    procedure MMTextOut(X, Y: Integer; const Text: string);
    procedure MMTextRect(Rect: TRect; X, Y: Integer; const Text: string);
    function MMTextWidth(const Text: string): Integer;
    property MMPixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
  published

  end;

implementation

function TMMCanvas.ConvertX(x:integer):integer;
begin
 result:=GetDeviceCaps(Handle, LOGPIXELSX);
 result:=x*result div 254;
end;

function TMMCanvas.ConvertY(y:integer):integer;
begin
 result:=GetDeviceCaps(Handle, LOGPIXELSY);
 result:=y*result div 254;
end;

function TMMCanvas.InvConvertX(x:integer):integer;
begin
 result:=GetDeviceCaps(Handle, LOGPIXELSX);
 result:=x*254 div result;
end;

function TMMCanvas.InvConvertY(y:integer):integer;
begin
 result:=GetDeviceCaps(Handle, LOGPIXELSY);
 result:=y*254 div result;
end;

function TMMCanvas.ConvertPoint(pt:TPoint):TPoint;
begin
 result.x:=GetDeviceCaps(Handle, LOGPIXELSX);
 result.y:=GetDeviceCaps(Handle, LOGPIXELSY);
 result.x:=pt.x*result.x div 254;
 result.y:=pt.y*result.y div 254;
end;

function TMMCanvas.ConvertRect(rect:trect):TRect;
var
 lpx,lpy:integer;
begin
 lpx:=GetDeviceCaps(Handle, LOGPIXELSX);
 lpy:=GetDeviceCaps(Handle, LOGPIXELSY);
 result.Left:=rect.Left*lpx div 254;
 result.Top:=rect.Top*lpy div 254;
 result.right:=rect.right*lpx div 254;
 result.bottom:=rect.bottom*lpy div 254;
end;

constructor TMMCanvas.Create;
begin
  inherited Create;
end;

destructor TMMCanvas.Destroy;
begin
  inherited Destroy;
end;

procedure TMMCanvas.MMArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
 x1:=convertx(x1);  y1:=converty(y1);
 x2:=convertx(x2);  y2:=converty(y2);
 x3:=convertx(x3);  y3:=converty(y3);
 x4:=convertx(x4);  y4:=converty(y4);
 Arc( X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;

procedure TMMCanvas.MMBrushCopy(Const Dest: TRect; Bitmap: TBitmap; Const Source: TRect; Color: TColor);
begin
 BrushCopy(convertrect(dest), Bitmap, convertrect(source), Color);
end;

procedure TMMCanvas.MMChord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
 x1:=convertx(x1);  y1:=converty(y1);
 x2:=convertx(x2);  y2:=converty(y2);
 x3:=convertx(x3);  y3:=converty(y3);
 x4:=convertx(x4);  y4:=converty(y4);
 Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;

procedure TMMCanvas.MMCopyRect(Const Dest: TRect; Canvas: TCanvas;Const Source: TRect);
begin
 CopyRect(convertrect(dest), Canvas, convertrect(source));
end;

procedure TMMCanvas.MMDraw(X, Y: Integer; Graphic: TGraphic);
begin
  x:=convertx(x);  y:=converty(y);
  Draw(X, Y, Graphic);
end;

procedure TMMCanvas.MMDrawFocusRect(const Rect: TRect);
begin
 DrawFocusRect(convertrect(Rect));
end;

procedure TMMCanvas.MMEllipse(X1, Y1, X2, Y2: Integer);
begin
 x1:=convertx(x1);  y1:=converty(y1);
 x2:=convertx(x2);  y2:=converty(y2);
 Ellipse( X1, Y1, X2, Y2);
end;

procedure TMMCanvas.MMEllipse(const Rect: TRect);
begin
 MMEllipse(rect.Left, rect.Top, rect.Right, rect.Bottom);
end;

procedure TMMCanvas.MMFillRect(const Rect: TRect);
begin
 FillRect(convertRect(Rect));
end;

procedure TMMCanvas.MMFloodFill(X, Y: Integer; Color: TColor;
  FillStyle: TFillStyle);
begin
 x:=convertx(x);  y:=converty(y);
 FloodFill(X, Y, Color, FillStyle);
end;

procedure TMMCanvas.MMFrameRect(const Rect: TRect);
begin
 FrameRect(convertRect(Rect));
end;

procedure TMMCanvas.MMLineTo(X, Y: Integer);
begin
 x:=convertx(x);  y:=converty(y);
 LineTo(X, Y);
end;

procedure TMMCanvas.MMMoveTo(X, Y: Integer);
begin
 x:=convertx(x);  y:=converty(y);
 MoveTo(X, Y);
end;

procedure TMMCanvas.MMPie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
 x1:=convertx(x1);  y1:=converty(y1);
 x2:=convertx(x2);  y2:=converty(y2);
 x3:=convertx(x3);  y3:=converty(y3);
 x4:=convertx(x4);  y4:=converty(y4);
 Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;

procedure TMMCanvas.MMPolygon(const Points: array of TPoint);
var
 i:integer;
 pt:array of tpoint;
begin
 setlength(pt,high(points)+1);
 for i:=0 to high(points) do pt[i]:=convertpoint(points[i]);
 Polygon(pt);
end;

procedure TMMCanvas.MMPolyline(const Points: array of TPoint);
var
 i:integer;
 pt:array of tpoint;
begin
 setlength(pt,high(points)+1);
 for i:=0 to high(points) do pt[i]:=convertpoint(points[i]);
 Polyline(pt);
end;

procedure TMMCanvas.MMPolyBezier(const Points: array of TPoint);
var
 i:integer;
 pt:array of tpoint;
begin
 setlength(pt,high(points)+1);
 for i:=0 to high(points) do pt[i]:=convertpoint(points[i]);
 PolyBezier(pt);
end;

procedure TMMCanvas.MMPolyBezierTo(const Points: array of TPoint);
var
 i:integer;
 pt:array of tpoint;
begin
 setlength(pt,high(points)+1);
 for i:=0 to high(points) do pt[i]:=convertpoint(points[i]);
 PolyBezierTo(pt);
end;

procedure TMMCanvas.MMRectangle(X1, Y1, X2, Y2: Integer);
begin
 x1:=convertx(x1);  y1:=converty(y1);
 x2:=convertx(x2);  y2:=converty(y2);
 Rectangle(X1, Y1, X2, Y2);
end;

procedure TMMCanvas.MMRectangle(const Rect: TRect);
begin
 MMRectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
end;

procedure TMMCanvas.MMRoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
 x1:=convertx(x1);  y1:=converty(y1);
 x2:=convertx(x2);  y2:=converty(y2);
 x3:=convertx(x3);  y3:=converty(y3);
 RoundRect(X1, Y1, X2, Y2, X3, Y3);
end;

procedure TMMCanvas.MMStretchDraw(const Rect: TRect; Graphic: TGraphic);
begin
 StretchDraw(convertRect(Rect),Graphic);
end;

procedure TMMCanvas.MMTextOut(X, Y: Integer; const Text: String);
begin
 x:=convertx(x);  y:=converty(y);
 TextOut( X, Y,Text);
end;

procedure TMMCanvas.MMTextRect(Rect: TRect; X, Y: Integer; const Text: string);
begin
 x:=convertx(x);  y:=converty(y);
 TextRect(convertRect(Rect), X, Y, Text);
end;

function TMMCanvas.MMTextExtent(const Text: string): TSize;
begin
 result:=TextExtent(Text);
 result.cx:=invconvertx(result.cx);
 result.cy:=invconverty(result.cy);
end;

function TMMCanvas.MMTextWidth(const Text: string): Integer;
begin
  Result := TextExtent(Text).cX;
  result:=invconvertx(result);
end;

function TMMCanvas.MMTextHeight(const Text: string): Integer;
begin
  Result := TextExtent(Text).cY;
 result:=invconverty(result);
end;

function TMMCanvas.GetPixel(X, Y: Integer): TColor;
begin
  x:=convertx(x);  y:=converty(y);
  result:=pixels[x,y];
end;

procedure TMMCanvas.SetPixel(X, Y: Integer; Value: TColor);
begin
  x:=convertx(x);  y:=converty(y);
  pixels[x,y]:=value;
end;

end.

Conclusion :


Je joint un petit programme de test qui fait pas grand chose en dehors de dessiner trois gribouillons soit dans un TImage, soit sur une imprimante.
Un carré de 10cm de côté, une ellipse de 1*2cm et un bout de texte de 1cm de hauteur.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_barbichette)