Målfast udprintning af vingeprofil

Har lave et program der beregner vindmøllevinger af NACA vingeprofil typer.
Men det er meget lang tid side der er arbejdet på dette, så jeg kan ikke helt overskue problemet.

Se billede af vingeprofilet:
www.sunwind.dk/vingeprofil.jpg

Problemformulering:

Når jeg så efter udprintning måler på (papiret) vingeprofilet, så måles der 152 mm
hvor programmet siger 134,4 mm.
Denne forskel har du en løsning på dette?
Resultatet skulle efter udprintning gerne være 134,4 mm.

Program koderne:

  type
    TVingePkt = record
    x:  Real;
    y:  Real;
  end;
  TVingeKoord = record
    Pkt1: TVingePkt;
    Pkt2: TVingePkt;
  end;

  TfrmProfil = class(TForm)
    btnExit: TButton;
    Image1: TImage;
    btnTegn: TButton;
    seZoom: TSpinEdit;
    btnGemJpeg: TButton;
    PrintDialog1: TPrintDialog;
    Label1: TLabel;
    seVinkel: TSpinEdit;
    Label2: TLabel;
    btnClear: TButton;
    btnPrint: TButton;
    SavePictureDialog1: TSavePictureDialog;
    PrinterSetupDialog1: TPrinterSetupDialog;
    Label4: TLabel;
    procedure btnTegnClick(Sender: TObject);
    procedure seZoomChange(Sender: TObject);
    procedure seVinkelChange(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure SaetKryds( center: TVingePkt; bredde: Integer);
    procedure FormResize(Sender: TObject);
    procedure btnGemJpegClick(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }

  end;

var
  frmProfil: TfrmProfil;
  V: Real;
  zoom:integer;

implementation

uses Unit1,Unit3,Unit5;

{$R *.dfm}

function VingePkt( x, y: Real): TVingePkt;
begin
  Result.x := x;
  Result.y := y;
end;

function RotatePkt(pkt: TVingePkt; v, cx,cy: Real): TVingePkt;
const
  toPi = 2*Pi;
begin
  v := v / 360; // ingen grund til at beregne den 4 gange.
  Result.x := (pkt.x-cx)*cos(v*toPi) - (pkt.y-cy)*sin(v*toPi) + cx;
  Result.y := (pkt.y-cy)*cos(v*toPi) + (pkt.x-cx)*sin(v*toPi) + cy;
end;

// Tegner en linie på canvas fra pkt1 til pkt2.
procedure DrawLine( pkt1, pkt2: TVingePkt);
begin
  with frmProfil.Image1.Canvas do
  begin
    MoveTo( Round(pkt1.x), Round(pkt1.y));
    LineTo( Round(pkt2.x), Round(pkt2.y));

  end;
end;

// Tegn et kryds i Image1
procedure TfrmProfil.SaetKryds( center: TVingePkt; bredde: Integer);
var
  topLeft,
  topRight,
  botLeft,
  botRight: TVingePkt;
  gemtFarve:  TColor;
begin
  // skal bruge en halv
  // bredde fra center til hver side.
  bredde := bredde div 2;

  // Beregn hjoernepunkter, som var det
  // et kvadrat der skulle tegnes uden om center.
  topLeft.x := center.x - bredde;
  botLeft.x := topLeft.x;
  topLeft.y := center.y - bredde;
  topRight.y := topLeft.y;
  botRight.x := center.x + bredde;
  topRight.x := botRight.x;
  botRight.y := center.y + bredde;
  botLeft.y := botRight.y;

  // Roter krydset sammen med profilen.
  topLeft := RotatePkt( topLeft, frmProfil.seVinkel.Value, center.x, center.y);
  topRight := RotatePkt( topRight, frmProfil.seVinkel.Value, center.x, center.y);
  botLeft := RotatePkt( botLeft, frmProfil.seVinkel.Value, center.x, center.y);
  botRight := RotatePkt( botRight, frmProfil.seVinkel.Value, center.x, center.y);

  // gem den farve der normalt tegnes med.
  gemtFarve := frmProfil.Image1.Canvas.Pen.Color;
  // skift farve til roed.
  Image1.Canvas.Pen.Color := clRed;
  // tegn diagonal fra øverste ventre hjørne
  // til nederste højre.
  DrawLine( topLeft, botRight);
  // tegn digonal fra nederste venstre hjørne
  // til øverste højre hjørne.
  DrawLine( botLeft, topRight);
  // skift farve til det der normalt tegnes med.
  Image1.Canvas.Pen.Color := gemtFarve;
end;


procedure TfrmProfil.btnTegnClick(Sender: TObject);
var
  koord:  array[0..18] of TVingeKoord;
  cx,midY: Real;
  count: Integer;

begin

  fmProfilValg.StandartTekstNaca4415;
  midY := Image1.Height /1.5; // Midten af Image1

  cx := Round( Naca4415X[ High( Naca4415X) - 1 ] * zoom / 4);
  // zoom := Round( Image1.Width / X[High(X)])-1;
  // beregn "absolutte" koordinater (uden rotation).

  // tegn et kryds i (cx,midY).

  // Hvis du vil have krydset i en fast str. uanset profilets
  // str. skal du ikke gange med zoom...

  // beregn "absolutte" koordinater (uden rotation).
  koord[0].Pkt1 := VingePkt(0,midY);
  koord[0].Pkt2 := VingePkt(0,midY);
  for count := 1 to 18 do
  begin
    koord[count].Pkt1.x := Naca4415X[count]*zoom;
    koord[count].Pkt1.y := midY - Naca4415op[count]*zoom;
    koord[count].Pkt2.x := koord[count].Pkt1.x;
    koord[count].Pkt2.y := midY - Naca4415ned[count]*zoom;
  end;
  // rotér koordinater
  // vinklen bliver laest fra SpinEdit2. cy er midY. cx er midX,
  // (cx,cy) er centrum for rotation.
  for count := 0 to 18 do
  begin
    koord[count].Pkt1 := RotatePkt( koord[count].Pkt1, seVinkel.Value, cx, midY);
    koord[count].Pkt2 := RotatePkt( koord[count].Pkt2, seVinkel.Value, cx, midY);
  end;
  // tegn på canvas.
  for count := 0 to 17 do
  begin
    DrawLine( koord[count].Pkt1, koord[count+1].Pkt1);
    DrawLine( koord[count].Pkt2, koord[count+1].Pkt2);
    // Tegn 1/4 punktet
    end;
    // Hvis du vil have et større kryds, kan du ændre 2-tallet.
    SaetKryds( VingePkt( cx, midY), 2*zoom);
    // zoom := Round( Image1.Width / X[High(X)])-1;
    If (seZoom.Value = 0) then
        seZoom.Value:=7;
end;

procedure TfrmProfil.seZoomChange(Sender: TObject);
begin
zoom:= seZoom.Value;

if fmProfilValg.RadioButton1.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNaca4415;
  end else
if fmProfilValg.RadioButton2.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstFX72MS150B;
  end else
if fmProfilValg.RadioButton3.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNaca4412;
  end else
if fmProfilValg.RadioButton4.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNaca4412;
  end else
if fmProfilValg.RadioButton5.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNaca4421;
  end else
if fmProfilValg.RadioButton6.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNaca23012;
  end

end;

procedure TfrmProfil.seVinkelChange(Sender: TObject);
begin

V:= seVinkel.Value;

if fmProfilValg.RadioButton1.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNaca4415;
  end else
if fmProfilValg.RadioButton2.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstFX72MS150B;
  end else
if fmProfilValg.RadioButton3.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNACA4412;
  end else
if fmProfilValg.RadioButton4.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNACA4418;
  end else
if fmProfilValg.RadioButton5.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNACA4421;
  end else
if fmProfilValg.RadioButton6.Checked then  begin
  frmProfil.btnClear.Click;
  frmProfil.btnTegn.Click;
  fmProfilValg.StandartTekstNACA23012;
  end
end;

procedure TfrmProfil.btnClearClick(Sender: TObject);
var
  r:  TRect;  // Firkanten der definerer image-vinduet.
begin
  with Image1 do
  begin
    Picture := nil; // Fjern det billede der er der.
    // prøv at finde firkanten med windows-funktionen
    if not Windows.GetClientRect(Handle, r) then
      // ellers bare brug width / height af image.
      r := Rect( 0, 0, Width, Height);
    Canvas.FillRect( r); // fyld imagevinduet med hvid.
  end;
end;

procedure TfrmProfil.FormResize(Sender: TObject);
begin
  btnClear.Click; // Clear image1
  btnTegn.Click; // Gentegn profilen.
end;

procedure TfrmProfil.btnGemJpegClick(Sender: TObject);
var
  jpgFile: TJpegImage;
begin
  // Hvis der ikke er tegnet i Image1, saa...
  // hmmm... ved ikke om det virker ??
  if Image1.Picture.Bitmap = nil then
  begin
    ShowMessage( 'Der er ikke noget at gemme !');
    Exit;
  end;

  // Vis gem-dialog. Afslut hvis bruger trykker "annuller".
  if not SavePictureDialog1.Execute then Exit;

  // brug altid try...finally obj.free
  // efter var := obj.Create.
  // Så er du sikker på at det bliver frigivet, selvom noget skulle
  // gå galt undervejs !

  // Opret et JPG-billede.
  jpgFile := TJpegImage.Create;
  try
    // hvor meget skal der komprimeres.
    jpgFile.CompressionQuality := 85;
    // tildel bitmap fra image1.
    jpgFile.Assign( Image1.Picture.Bitmap);
    // lav bitmap om til jpeg format.
    jpgFile.JPEGNeeded;
    // comprimer billedet.
    jpgFile.Compress;
    // gem den på disk.
    jpgFile.SaveToFile( SavePictureDialog1.FileName);
  finally
    jpgFile.Free;
  end;
end;

procedure TfrmProfil.btnPrintClick(Sender: TObject);
var
  ScaleX, ScaleY: Integer;
  R: TRect;
begin
  if PrinterSetupDialog1.Execute then
  begin
    Printer.BeginDoc;  // **
    fmProfilValg.StandartTekstNaca4415;
  with Printer do
    try
      ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
      ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
      R := Rect(0, 0, Image1.Picture.Width * ScaleX,
      Image1.Picture.Height * ScaleY);
      Canvas.StretchDraw(R, Image1.Picture.Graphic);  // **
    finally
    EndDoc;  // **
  end;
end;

Med venlig hilsen
Monie Jacobsen