Podzielę się, podzielę :)
Więc...
Kopiuj
//Procedurka konwertuje jpg na pdf
procedure Tfrmdm.jpgToPdf(PicturePath: string);
var
pdfDoc: TPdfDocument;
JpegImage: TJpegImage;
pdfImage: TPdfImage;
begin
pdfDoc := TPdfDocument.Create(nil);
pdfDoc.FileName := ExtractFilePath(Application.ExeName)+'Dokumenty\' + ExtractFileName(PicturePath) + '.pdf'; // ścieżka gdzie ma powstać plik PDF
pdfDoc.BeginDoc; // stwórz pusty dokument
// funkcja sprawdza rozmiar obrazka ze stroną A4
// jeżeli szerokość obrazka jest większa niż wysokość strony to znaczy, że mamy stronę poziomą
if GetPicSize('Width', ExtractFilePath(Application.ExeName)+'Dokumenty\' + ExtractFileName(PicturePath) + '.jpeg') > GetPicSize('Height', ExtractFilePath(Application.ExeName)+'Dokumenty\' + ExtractFileName(PicturePath) + '.jpeg') then
pdfDoc.Page[0].Orientation := poPageLandScape;
//
ResizeImage(ExtractFilePath(Application.ExeName)+'Dokumenty\' + ExtractFileName(PicturePath) + '.jpeg', pdfDoc.PageWidth);
JpegImage := TJpegImage.Create;
JpegImage.LoadFromFile(ExtractFilePath(Application.ExeName)+'Dokumenty\' + ExtractFileName(PicturePath) + '.jpeg');
pdfImage := TPdfImage.Create(jpegimage, itcJpeg,pdfDoc);
pdfDoc.AddImage(jpegimage, itcJpeg);
pdfDoc.Canvas.Draw(0, 0,jpegimage);
pdfDoc.EndDoc;
pdfDoc.Free;
end;
// pobierz rozmiar obrazka jpg
Kopiuj
function GetPicSize(Size, FilePath: string): integer;
var
Bitmap: TBitmap;
JPEGImage: TJPEGImage;
begin
Result := 0;
if (FilePath = '') then // No FileName so nothing
Result := 0 //to load - return False...
else
begin
try // Start of try except
JPEGImage := TJPEGImage.Create; // Create the JPEG image... try // now
Bitmap := TBitmap.Create;
try // to load the file but
JPEGImage.LoadFromFile(FilePath);
// might fail...with an Exception.
Bitmap.Assign(JPEGImage);
if Size = 'Width' then
Result := Bitmap.Width
else
Result := Bitmap.Height;
// Assign the image to our bitmap.Result := True;
// Got it so return True.
finally
JPEGImage.Free; // ...must get rid of the JPEG image. finally
Bitmap.Free;
end; {try}
except
Result := 0; // never Loaded, so return False.
end; {try}
end; {if}
end;
Kopiuj
// aby zmienić rozmiar JPG najpierw należy zamienić go na bitmapę
function ResizeImage(FileName: string; MaxWidth: Integer): Boolean;
var
OldBitmap: TBitmap;
NewBitmap: TBitmap;
aWidth: Integer;
begin
Result := False;
OldBitmap := TBitmap.Create;
try
if LoadJPEGPictureFile(OldBitmap, ExtractFilePath(FileName),
ExtractFileName(FileName)) then
begin
aWidth := OldBitmap.Width;
if (OldBitmap.Width > MaxWidth) then
begin
aWidth := MaxWidth;
NewBitmap := TBitmap.Create;
try
NewBitmap.Width := MaxWidth;
NewBitmap.Height := MulDiv(MaxWidth, OldBitmap.Height, OldBitmap.Width);
SmoothResize(OldBitmap, NewBitmap);
RenameFile(FileName, ChangeFileExt(FileName, '.$$$'));
if SaveJPEGPictureFile(NewBitmap, ExtractFilePath(FileName),
ExtractFileName(FileName), 100) then
DeleteFile(ChangeFileExt(FileName, '.$$$'))
else
RenameFile(ChangeFileExt(FileName, '.$$$'), FileName);
finally
NewBitmap.Free;
end; {try}
Result := True;
end; {if}
end; {if}
finally
OldBitmap.Free;
end; {try}
end;
Kopiuj
// funkcja odpowiada przy konwersji za uzupełnienie pixeli obrazka na takie,
// które najbardziej pasują do sąsiadujących
procedure SmoothResize(Src, Dst: TBitmap);
var
x, y: Integer;
xP, yP: Integer;
xP2, yP2: Integer;
SrcLine1, SrcLine2: pRGBArray;
t3: Integer;
z, z2, iz2: Integer;
DstLine: pRGBArray;
DstGap: Integer;
w1, w2, w3, w4: Integer;
begin
Src.PixelFormat := pf24Bit;
Dst.PixelFormat := pf24Bit;
if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then
Dst.Assign(Src)
else
begin
DstLine := Dst.ScanLine[0];
DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine);
xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
yP := 0;
for y := 0 to pred(Dst.Height) do
begin
xP := 0;
SrcLine1 := Src.ScanLine[yP shr 16];
if (yP shr 16 < pred(Src.Height)) then
SrcLine2 := Src.ScanLine[succ(yP shr 16)]
else
SrcLine2 := Src.ScanLine[yP shr 16];
z2 := succ(yP and $FFFF);
iz2 := succ((not yp) and $FFFF);
for x := 0 to pred(Dst.Width) do
begin
t3 := xP shr 16;
z := xP and $FFFF;
w2 := MulDiv(z, iz2, $10000);
w1 := iz2 - w2;
w4 := MulDiv(z, z2, $10000);
w3 := z2 - w4;
DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +
SrcLine1[t3 + 1].rgbtRed * w2 +
SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;
DstLine[x].rgbtGreen :=
(SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +
SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +
SrcLine1[t3 + 1].rgbtBlue * w2 +
SrcLine2[t3].rgbtBlue * w3 +
SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
Inc(xP, xP2);
end; {for}
Inc(yP, yP2);
DstLine := pRGBArray(Integer(DstLine) + DstGap);
end; {for}
end; {if}
end; {SmoothResize}
Może komuś się przyda.