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+