Druckerausgabe falsch skaliert

[DGL-luke]

Hallo, irgendwo ist wahrscheinlich ein dummer Fehler... aber ich bin dabei, mehrere Bilder in Kacheln über eine Druckseite zu ziehen.
Die Bilder werden allerdings viel zu klein.

Irgendwo hab ich wahrscheinlich ein paar Berechnungen verbockt, seht euch einfach den Code an und sagt mir, ob ihr was entdecken könnt.
(Im Moment ist auch klar, dass die Bilder ohne RÜcksicht auf Verluste skaliert werden)

Initialisierung des Druckers und Bezug der Abmaßungen:

Delphi-Quellcode:

procedure TForm2.BPrinterCheckClick(Sender: TObject);
var pw,ph,     //page
    apw,aph,   //available page
    offx,offy, //border offsets
    numx,numy, //number of icons
    dimx,dimy: //dimensions of icons
    Integer;
begin
  Printer.PrinterIndex := CBPrinters.ItemIndex;

  SetMapMode(Printer.Handle, MM_LOMETRIC);
  pw   := GetDeviceCaps(Printer.Handle,HORZSIZE) *10;
  ph   := GetDeviceCaps(Printer.Handle,VERTSIZE) *10;
  offx := GetDeviceCaps(Printer.Handle,PHYSICALOFFSETX);
  offy := GetDeviceCaps(Printer.Handle,PHYSICALOFFSETY);

  apw := pw - 2*offx;
  aph := ph - 2*offy;

  numx := SENumX.Value; //Anzahl Bilder X
  numy := SENumY.Value; //Anzahl Bilder Y

  //dimension = space div number
  dimx := apw div numx;
  dimy := aph div numy;

  //storing it for later
  prec.pw   := pw;
  prec.ph   := ph;
  prec.apw  := apw;
  prec.aph  := aph;
  prec.numX := numx;
  prec.numY := numy;
  prec.dimX := dimx;
  prec.dimY := dimy;
  prec.offx := offx;
  prec.offy := offy;

  LPageSize.Caption     := inttostr(pw) + ' x ' + inttostr(ph) + ' mm';
  LRealPageSize.Caption := inttostr(apw) + ' x ' + inttostr(aph) +
    ' mm (Ränder: ' + inttostr(offx) + ';' + inttostr(offy) + ' mm)';
  LDimIcon.Caption := inttostr(dimx) + ' x ' + inttostr(dimy) + ' mm';
end;

Druckschleife:

Delphi-Quellcode:

procedure TForm2.BPrintClick(Sender: TObject);
var temp: TBitmap32;
    tmpb: TBitmap;
    i,row,col,iconheight: Integer;
    dst,src,txt: TRect;
    txtheight,x,y: Integer;
begin
  if (MessageDlg('Wirklich drucken?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
    begin
      printer.BeginDoc;

      row := 0;
      col := 0;
      temp := TBitMap32.Create;
      temp.Width  := prec.dimX;
      temp.Height := prec.dimY;
      tmpb := TBitmap.Create;
      tmpb.Width := prec.dimX;
      tmpb.Height := prec.dimY;

      temp.Canvas.Font.Size := 30;

      txtheight := Abs(SELines.Value * temp.Canvas.TextHeight('gf'));

      for i := 0 to BList.Bitmaps.Count -1 do
        begin
          temp.Clear(clwhite);

          src := rect(0,0,BList.Bitmap[i].Width,BList.Bitmap[i].Height);
          dst := rect(0,0,temp.Width,temp.Height - txtHeight);
          txt := rect(0,temp.Height - txtHeight,temp.Width,temp.Height);

          temp.StretchFilter := sflanczos;
          temp.Draw(dst,src,BList.Bitmap[i]);

          temp.Textout(txt,DT_CENTER+DT_WORDBREAK+DT_PATH_ELLIPSIS+DT_NOPREFIX,
                       ImageNames[i]);

          if CBFlip.Checked then temp.FlipVert;

          tmpb.Assign(temp);

          x := prec.dimX * col + prec.offx;
          y := prec.dimY * row + prec.offy;

          printer.Canvas.Draw(x,y,tmpb);

          Inc(col);
          if col = prec.numX then
            begin
              col := 0;
              Inc(row);
              if row = prec.numY then
                begin
                  row := 0;
                  printer.NewPage;
                end;
            end;
        end;
      printer.EndDoc;
    end;
end;

[DGL-luke]

Es fehlt zwar noch eine gute Stunde, aber ich komm einfach nicht weiter, ich find meinen Fehler nicht...

*push*

[marabu]

Hi Lukas,

du könntest dir selbst helfen: zeichne mal ein paar Passmarken, gib anstelle der Bilder Rechtecke aus und - wenn es sein muss - protokolliere die jeweiligen Abmessungen in einem Memo.

Freundliche Grüße vom marabu

[DGL-luke]

ICH RIESENRINDVIEH!

Es hat nur ein SetMapMode(printer.Handle, MM_LOWMETRIC);

gefehlt...



EDIT: Aber danke, marabu. Ohne deine Antwort wär mir der Geistesblitz wohl nicht gekommen.

[DGL-luke]

So, das mit diesem Thread verbundene Projekt ist jetzt im RC-Status, nur noch ein bisschen UI-Schliff, wenn ich von meinem Auftraggeber das OK bekomm, hat die Freeware-Sparte bald einen Eintrag mehr.