CANVAS EN MILLIMÈTRE

Commentaire de cantador le 02/02/2008 18:54:18

salut barbichette,
un petit exemple de ce qu'on peut envoyer à l'imprimante afin de montrer en quoi cette classe peut s'avérer utile.
Dans un autre style, j'aime bcp tes anims..

Commentaire de MAURICIO le 04/02/2008 14:47:13

Salut Barbichette,

ça fait longtemps que l 'on a pas de tes nouvelles?!

Par contre, ça fait plaisir cette source, j' y ai déjà pensé, comme quoi ... Ça va me faire gagner du temps.

Par contre, je rejoins les autres, une petite source aurait été mieux!

@florenth: GDI+ ??? tu peux m' en dire plus? demo? etc .. ?

A+

Commentaire de MAURICIO le 28/02/2008 17:33:50

Salut Barbichette,

je suis en pleine étude de ta unit,
que fait au juste la fonction InvConvertX ?

Merci d' avance ...

Commentaire de MAURICIO le 29/02/2008 12:55:39

Salut Barbichette,

j' ai fini d' écrire ma propre unit qui est pompée à 99% sur la tienne.
J' ai juste changé TMMCanvas par TDMMCanvas: DMM veut dire 10ème de milimètre et changé le nom des propriétés/fonctions.

J' ai aussi crée :
property  DMMPixels[X, Y: Integer]: TColor read DMMGetPixel write DMMSetPixel;

Bon, je te poste ma Unit, ce sera plus simple (je vais pas faire un code sur une source copiée à 99%):

unit Tc_DmmCanvas;

interface

uses windows,graphics;

type
  TDMMCanvas=class(Tcanvas)
  private
    function  DMMGetPixel(X, Y: Integer): TColor;
    procedure DMMSetPixel(X, Y: Integer; Value: TColor);
    function  DMMGetFontHeight: Integer;
    procedure DMMSetFontHeight(Value: Integer);
  protected
  public
    constructor Create;
    destructor Destroy; override;

    // Fonctions de conversion en 10ème de milimètres :
    function  PxToDmm_X(x:integer): integer;
    function  PxToDmm_Y(y:integer): integer;
    
    // Fonctions de conversion en pixels :
    function  DmmToPx_X(x:integer): integer;
    function  DmmToPx_Y(y:integer): integer;
    function  DmmToPx_Point(pt:TPoint): TPoint;
    function  DmmToPx_Rect(rect:trect): TRect;

    // Fonctions de dessin en 10ème de milimètres :
    procedure DMMArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure DMMBrushCopy(Const Dest: TRect; Bitmap: TBitmap; Const Source: TRect; Color: TColor);
    procedure DMMChord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure DMMCopyRect(Const Dest: TRect; Canvas: TCanvas;Const Source: TRect);
    procedure DMMDraw(X, Y: Integer; Graphic: TGraphic);
    procedure DMMDrawFocusRect(const Rect: TRect);
    procedure DMMEllipse(X1, Y1, X2, Y2: Integer); overload;
    procedure DMMEllipse(const Rect: TRect); overload;
    procedure DMMFillRect(const Rect: TRect);
    procedure DMMFloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);
    procedure DMMFrameRect(const Rect: TRect);
    procedure DMMLineTo(X, Y: Integer);
    procedure DMMMoveTo(X, Y: Integer);
    procedure DMMPie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure DMMPolygon(const Points: array of TPoint);
    procedure DMMPolyline(const Points: array of TPoint);
    procedure DMMPolyBezier(const Points: array of TPoint);
    procedure DMMPolyBezierTo(const Points: array of TPoint);
    procedure DMMRectangle(X1, Y1, X2, Y2: Integer); overload;
    procedure DMMRectangle(const Rect: TRect); overload;
    procedure DMMRoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
    procedure DMMStretchDraw(const Rect: TRect; Graphic: TGraphic);
    function  DMMTextExtent(const Text: string): TSize;    // Largeur et hauteur en DMM du texte dans la police actuelle
    function  DMMTextHeight(const Text: string): Integer;
    procedure DMMTextOut(X, Y: Integer; const Text: string);
    procedure DMMTextRect(Rect: TRect; X, Y: Integer; const Text: string);
    function  DMMTextWidth(const Text: string): Integer;
    property  DMMFontHeight: Integer read DMMGetFontHeight write DMMSetFontHeight;
    property  DMMPixels[X, Y: Integer]: TColor read DMMGetPixel write DMMSetPixel;
  published

  end;



implementation


constructor TDMMCanvas.Create;
begin
  inherited Create;
end;

destructor TDMMCanvas.Destroy;
begin
  inherited Destroy;
end;

// Convertir en 10ème de milimètres ...
function TDMMCanvas.PxToDmm_X(x: integer):integer;
begin
  result := GetDeviceCaps(Handle, LOGPIXELSX);
  result := x * 254 div result;
end;

// Convertir en 10ème de milimètres ...
function TDMMCanvas.PxToDmm_Y(y: integer):integer;
begin
  result := GetDeviceCaps(Handle, LOGPIXELSY);
  result := y * 254 div result;
end;

// Convertir en pixels ...
function TDMMCanvas.DmmToPx_X(x: integer):integer;
begin
  result := GetDeviceCaps(Handle, LOGPIXELSX);  // Récupérer le nombre de points par pouce du Canvas ...
  result := x * result div 254;
end;

// Convertir en pixels ...
function TDMMCanvas.DmmToPx_Y(y: integer):integer;
begin
  result := GetDeviceCaps(Handle, LOGPIXELSY);
  result := y * result div 254;
end;

// Convertir en pixels :
function TDMMCanvas.DmmToPx_Point(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 TDMMCanvas.DmmToPx_Rect(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;

procedure TDMMCanvas.DMMArc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  x1 := DmmToPx_X(x1);  y1 := DmmToPx_Y(y1);
  x2 := DmmToPx_X(x2);  y2 := DmmToPx_Y(y2);
  x3 := DmmToPx_X(x3);  y3 := DmmToPx_Y(y3);
  x4 := DmmToPx_X(x4);  y4 := DmmToPx_Y(y4);
  Arc( X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;

procedure TDMMCanvas.DMMBrushCopy(Const Dest: TRect; Bitmap: TBitmap; Const Source: TRect; Color: TColor);
begin
  BrushCopy(DmmToPx_Rect(dest), Bitmap, DmmToPx_Rect(source), Color);
end;

procedure TDMMCanvas.DMMChord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  x1 := DmmToPx_X(x1);  y1 := DmmToPx_Y(y1);
  x2 := DmmToPx_X(x2);  y2 := DmmToPx_Y(y2);
  x3 := DmmToPx_X(x3);  y3 := DmmToPx_Y(y3);
  x4 := DmmToPx_X(x4);  y4 := DmmToPx_Y(y4);
  Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;

procedure TDMMCanvas.DMMCopyRect(Const Dest: TRect; Canvas: TCanvas;Const Source: TRect);
begin
  CopyRect(DmmToPx_Rect(dest), Canvas, DmmToPx_Rect(source));
end;

procedure TDMMCanvas.DMMDraw(X, Y: Integer; Graphic: TGraphic);
begin
  x := DmmToPx_X(x);  y := DmmToPx_Y(y);
  Draw(X, Y, Graphic);
end;

procedure TDMMCanvas.DMMDrawFocusRect(const Rect: TRect);
begin
  DrawFocusRect(DmmToPx_Rect(Rect));
end;

procedure TDMMCanvas.DMMEllipse(X1, Y1, X2, Y2: Integer);
begin
  x1 := DmmToPx_X(x1);  y1 := DmmToPx_Y(y1);
  x2 := DmmToPx_X(x2);  y2 := DmmToPx_Y(y2);
  Ellipse( X1, Y1, X2, Y2);
end;

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

procedure TDMMCanvas.DMMFillRect(const Rect: TRect);
begin
  FillRect(DmmToPx_Rect(Rect));
end;

procedure TDMMCanvas.DMMFloodFill(X, Y: Integer; Color: TColor;
  FillStyle: TFillStyle);
begin
  x := DmmToPx_X(x);  y := DmmToPx_Y(y);
  FloodFill(X, Y, Color, FillStyle);
end;

procedure TDMMCanvas.DMMFrameRect(const Rect: TRect);
begin
  FrameRect(DmmToPx_Rect(Rect));
end;


procedure TDMMCanvas.DMMLineTo(X, Y: Integer);
begin
  x := DmmToPx_X(x);  y := DmmToPx_Y(y);
  LineTo(X, Y);
end;


procedure TDMMCanvas.DMMMoveTo(X, Y: Integer);
begin
  x := DmmToPx_X(x);  y := DmmToPx_Y(y);
  MoveTo(X, Y);
end;

procedure TDMMCanvas.DMMPie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
begin
  x1 := DmmToPx_X(x1);  y1 := DmmToPx_Y(y1);
  x2 := DmmToPx_X(x2);  y2 := DmmToPx_Y(y2);
  x3 := DmmToPx_X(x3);  y3 := DmmToPx_Y(y3);
  x4 := DmmToPx_X(x4);  y4 := DmmToPx_Y(y4);
  Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4);
end;


procedure TDMMCanvas.DMMPolygon(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] := DmmToPx_Point(points[i]);

  Polygon(pt);
end;

procedure TDMMCanvas.DMMPolyline(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] := DmmToPx_Point(points[i]);

  Polyline(pt);
end;

procedure TDMMCanvas.DMMPolyBezier(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] := DmmToPx_Point(points[i]);
    
  PolyBezier(pt);
end;

procedure TDMMCanvas.DMMPolyBezierTo(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] := DmmToPx_Point(points[i]);

  PolyBezierTo(pt);
end;

procedure TDMMCanvas.DMMRectangle(X1, Y1, X2, Y2: Integer);
begin
  x1 := DmmToPx_X(x1);  y1 := DmmToPx_Y(y1);
  x2 := DmmToPx_X(x2);  y2 := DmmToPx_Y(y2);
  Rectangle(X1, Y1, X2, Y2);
end;

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

procedure TDMMCanvas.DMMRoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
begin
  x1 := DmmToPx_X(x1);  y1 := DmmToPx_Y(y1);
  x2 := DmmToPx_X(x2);  y2 := DmmToPx_Y(y2);
  x3 := DmmToPx_X(x3);  y3 := DmmToPx_Y(y3);
  RoundRect(X1, Y1, X2, Y2, X3, Y3);
end;

procedure TDMMCanvas.DMMStretchDraw(const Rect: TRect; Graphic: TGraphic);
begin
  StretchDraw(DmmToPx_Rect(Rect), Graphic);
end;

procedure TDMMCanvas.DMMTextOut(X, Y: Integer; const Text: String);
begin
  x := DmmToPx_X(x);  y := DmmToPx_Y(y);
  TextOut(X, Y, Text);
end;

procedure TDMMCanvas.DMMTextRect(Rect: TRect; X, Y: Integer; const Text: string);
begin
  x := DmmToPx_X(x);  y := DmmToPx_Y(y);
  TextRect(DmmToPx_Rect(Rect), X, Y, Text);
end;

function TDMMCanvas.DMMTextExtent(const Text: string): TSize;
begin
  result := TextExtent(Text);
  result.cx := PxToDmm_X(result.cx);
  result.cy := PxToDmm_Y(result.cy);
end;

function TDMMCanvas.DMMTextWidth(const Text: string): Integer;
begin
  result := TextExtent(Text).cX;
  result := PxToDmm_X(result);
end;

function TDMMCanvas.DMMTextHeight(const Text: string): Integer;
begin
  Result := TextExtent(Text).cY;
  Result := PxToDmm_Y(result);
end;

function TDMMCanvas.DMMGetPixel(X, Y: Integer): TColor;
begin
  x := DmmToPx_X(x);  y := DmmToPx_Y(y);
  result := pixels[x,y];
end;

procedure TDMMCanvas.DMMSetPixel(X, Y: Integer; Value: TColor);
begin
  x := DmmToPx_X(x);  y := DmmToPx_Y(y);
  pixels[x,y] := value;
end;

function TDMMCanvas.DMMGetFontHeight: Integer;
begin
  result := Font.Height * 254 div Font.PixelsPerInch;
end;

procedure TDMMCanvas.DMMSetFontHeight(Value: Integer);
begin
  Font.Height := Value * Font.PixelsPerInch div 254;
end;

end.

En tout cas je te remercie, tu m' as fais gagné du temps!!!
Bravo encore une fois, j' attends tes prochaines sources avec une certaine impatience ...

A+

Commentaire de Jean-Pierre le 21/09/2009 17:35:35

Salut tout le monde,

Merci aux contributeurs de nous donner ces précieuses ressources.

Voilà, j'ai une chose particulière qui me gratouille...

Sur la démo, si je passe par une impression (BeginDoc, etc.) : la mesure est absolument correcte.

Par contre, si je passe par le TImage afin de mesurer la string, là alors le résultat me donne quelques millimètres de plus.

procedure TForm1.btnTestClick(Sender: TObject);
var
c: TMMCanvas;
s: String;
begin
  c := tmmcanvas(image1.canvas);

  s := 'Ceci est un petit test de la classe TMMCanvas';

  c.font.name  := 'Nyala'; // 'courier new';
  c.font.Size  := 12;
  c.Font.Style := [fsBold];

  ShowMessage(IntToStr(C.MMTextWidth(s)));
end;

Est-il possible d'obtenir la longueur sans passer par une impression ; telle est la question que je me pose.

Merci beaucoup de tenter d'éclaircir ce point précis.

A moins qu'une telle possibilité existe en cette source de Barbichette.

J'espère que je poste au bon endroit, puisque cette question est en étroite relation avec cette page...

Commentaire de Jean-Pierre le 21/09/2009 20:03:11

Barbichette merci, là, je comprends mieux ce qu'il manquait à mon raisonnement.

@+ ;-)

Commentaire de Jean-Pierre le 22/09/2009 19:02:29

Merci Barbichette de ta précision rectificative.

Mais après des tests; là je vais devenir complètement chèvre lol !

Car sur ton zip de démo, la string "Ceci est un petit test de la classe TMMCanvas" (en impression) me donne le result de 742 pixels pour 74 millimètres imprimés.

Or suivant ton indication suivant ton message juste ci-dessus :
(taille en mm=(taille en pixels)*25.4/résolution)

Soit :
...
  SizeMM := (742) * 25.4 / 600;
...

Ça me donne 31 mm en résultat. Oui seulement 31 millimètres pour 742 pixels.

Je précise que j'ai mis en dur pour simplifier les pixels du string = 742
Idem en dur la résolution de mon imprimante = 600
Idem ai affecté : le même nom, taille, size et style de fonte.


Je me demande bien qu'est-ce qui cloche...

@+  ;-)

Commentaire de barbichette le 22/09/2009 19:38:24

ben rien...
742 pixels, avec une résolution de 600 pixels par pouce = 1.236666666
1 pouce=2.54 cm donc 1.236666*2.54 = 3.1 cm (ou 31 mm)
c'est normal....
Enfin pour moi....

Barbichette