PDA

View Full Version : سوال: پرينت تصوير اسكن شده در شيء image



YkA1363
سه شنبه 11 مرداد 1390, 13:42 عصر
سلام به همه دوستان
براي چاپ تصوير اسكن شده داخل شي ء image از دستور زير استفاده مي كنم اما تصوير به طور كامل چاپ نمي شه لطف مي كنين راهنمايي كنيد ايراد كارم كجاست؟

procedure TFrmRecive2.BitBtn23Click(Sender: TObject);

var
ScaleX, ScaleY: Integer;
RR: TRect;
Jpg: TJPEGImage;
begin
with Printer do
begin
BeginDoc;
// Mit BeginDoc wird ein Druckauftrag initiiert.
// The StartDoc function starts a print job.
try
ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
// Informationen über die Aufl?sung
// Retrieves information about the Pixels per Inch of the Printer.
RR := Rect(0, 0, Image1.picture.Width * scaleX, Image1.Picture.Height * ScaleY);
Canvas.StretchDraw(RR, Image1.Picture.Graphic);
// An die Aufl?sung anpassen
// Stretch to fit

finally
EndDoc; //Methode EndDoc beendet den aktuellen Druckauftrag und schlie?t die
// Textdatei-Variable.
// Steht in finally - um auch bei Abbruch des Druckauftrages Papierausgabe
// sicherzustellen
end;
end;
end;

YkA1363
چهارشنبه 12 مرداد 1390, 22:57 عصر
مثل اينكه دوستان سرشون خيلي شلوغه و نتونستن به سووال من جواب بدن به هر حال ممنون.من با كدهاي زير مشكلم رو حل كردم . اميدوارم براي دوستان ديگه هم كه سووالي مشابه من دارن قابل استفاده باشه:
procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
var
Header, Bits: Pointer;
HeaderSize: DWORD;
BitsSize: DWORD;
begin
GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
Header := AllocMem(HeaderSize);
Bits := AllocMem(BitsSize);
try
GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
DestRect.Right, DestRect.Bottom,
0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^),
DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Header, HeaderSize);
FreeMem(Bits, BitsSize);
end;
end;

procedure PrintImage(Image: TImage; ZoomPercent: Integer);

var
relHeight, relWidth: integer;
begin
Screen.Cursor := crHourglass;
Printer.BeginDoc;
with Image.Picture.Bitmap do
begin
if ((Width / Height) > (Printer.PageWidth / Printer.PageHeight)) then
begin
relWidth := Printer.PageWidth;
relHeight := MulDiv(Height, Printer.PageWidth, Width);
end
else
begin
relWidth := MulDiv(Width, Printer.PageHeight, Height);
relHeight := Printer.PageHeight;
end;
relWidth := Round(relWidth * ZoomPercent / 100);
relHeight := Round(relHeight * ZoomPercent / 100);
DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), Image.Picture.Bitmap);
end;
Printer.EndDoc;
Screen.cursor := crDefault;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
PrintImage(Image1, 100);
end;

فقط مشكل اينجا بود كه عكسهاي من به صورت jpg ذخيره شده بودند كه نمي دونم درست يا اشتباه قبل از چاپ با كد زير تبديل به bmp كردمشون و يك فرمان delete هم اضافه كردم تا فايل توليد شده رو حذف كنه.

procedure jpg2bmp(JpgFilePath : string; BmpSavePath : string);
var bmp : TBitmap;
Jpg : TJpegImage;
begin
bmp := TBitmap.Create;
jpg := TJpegImage.Create;
try
jpg.LoadFromFile (jpgfilepath);
bmp.Assign(jpg);
bmp.SaveToFile (BmpSavePath + '.bmp');

finally
jpg.Free;
bmp.Free;
end;

end;:لبخند: