Trouver une ressource (Nouvelle version du moteur, plus rapide & pertinent, essayez le !)
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
CANVAS EN MILLIMÈTRE
Information sur la source
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
- 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.
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.
Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
Télécharger le zip
Historique
- 02 février 2008 19:33:59 :
- ajout d'un exemple dans un zip
Sources de la même categorie
Commentaires
Discussions en rapport avec ce code source
|
|