Convert Bitmap to PDF

Unit bmp2pdf.pas:

unit bmp2pdf;

interface

{Unit bmp2pdf.pas}

uses
    Windows,Classes, Graphics, SysUtils;

    procedure BMPtoPDF(BMP:TBitmap;SaveName:String);

implementation

type
 pRGBArray = ^TRGBArray;
 TRGBArray = array[0..32768-1] of TRGBTriple;

procedure Write_CrossReferenceTable(AStream: TStream;PosArray : array of Dword;Count:Integer);
Var
   i :Integer;
begin
  With TStringStream(AStream) do
  begin
    WriteString('xref'#10);
    WriteString(Format('0 %d'#10,[Count+1]));
    WriteString('0000000000 65535 f '#10);
    for i:= 0 to Count-1 do
    begin
     WriteString(Format('%0.10d',[PosArray[i]])+' 00000 n '#10);
    end;
  end;
end;

procedure Write_ContentsObject(AStream: TStream;Index : Dword; Width,Height : Integer);
Var
   MemoryStream : TMemoryStream;
begin
  MemoryStream:=TMemoryStream.Create;
  Try
     // Stream
     With TStringStream(MemoryStream) do
     begin
       WriteString('q'#10);
         WriteString(Format('%d 0 0 %d 0 0 cm'#10,[Width,Height]));
         WriteString('/Im0 Do'#10);
       WriteString('Q'#10);
     end;

     MemoryStream.Position:=0;

     // Object
     With TStringStream(AStream) do
     begin
       WriteString(Format('%d 0 obj'#10,[Index]));
       WriteString(Format('<< /Length %d >>'#10,[MemoryStream.Size]));
       WriteString('stream'#10);
       AStream.CopyFrom(MemoryStream,MemoryStream.Size) ;
       WriteString('endstream'#10);
       WriteString('endobj'#10);
     end;
  finally
    MemoryStream.Free;
  end;
end;

procedure GetBitmapData(AStream :TStream;BMP:TBitmap);
var
 tmp :TBitmap;
 Buffer  : Pointer;
 SrcRow,DestRow  : pRGBArray;
 Row,Col,DestCnt : Integer;
begin

 DestCnt:=0;

 tmp := TBitmap.Create;
 tmp.Assign(BMP);
 tmp.PixelFormat:=pf24bit;

 GetMem(Buffer,tmp.Width*tmp.height*3);
 DestRow :=Buffer;

 try   
   for Row:=0 to tmp.Height-1 do
   begin
     SrcRow :=tmp.ScanLine[Row];
     for Col:=0 to tmp.Width-1 do
     begin
       DestRow[DestCnt].rgbtBlue  := SrcRow[Col].rgbtRed;
       DestRow[DestCnt].rgbtGreen := SrcRow[Col].rgbtGreen;
       DestRow[DestCnt].rgbtRed   := SrcRow[Col].rgbtBlue;
       Inc(DestCnt);
     end;
   end;

   AStream.Write(DestRow^,tmp.Width*tmp.Height*3);

  finally
     tmp.Free;
     FreeMem(Buffer);
  end;
end;

procedure BMPtoPDF(BMP:TBitmap;SaveName:String);
Var
  AStream,BitsData  : TStream;
  ObjectIndex  : Integer;
  ObjectPosArray  : array [0..10] of Dword;
begin

  if BMP=nil then
   raise  Exception.Create('Bitmap is nil');

  if SaveName='' then
   raise  Exception.Create('SaveName is nil');

  ObjectIndex :=0;

  AStream  :=TFileStream.Create(SaveName,fmCreate)  ;
  BitsData :=TMemorySTream.Create;
  Try          
     GetBitmapData(BitsData,BMP);
     BitsData.Position:=0;

     // PDF version
     TStringStream(AStream).WriteString('%PDF-1.2'#10);

     // Catalog
     ObjectPosArray[ObjectIndex] :=AStream.Position;
     With TStringStream(AStream) do
     begin
          WriteString(Format('%d 0 obj'#10,[ObjectIndex+1]));
          WriteString('<<'#10);
          WriteString('/Type /Catalog'#10);
          WriteString('/Pages 2 0 R'#10);
          // View Option (100%) 
          WriteString('/OpenAction [3 0 R /XYZ -32768 -32768 1 ]'#10);       
          WriteString('>>'#10);
          WriteString('endobj'#10);
     end;
     Inc(ObjectIndex);
   
     // Parent Pages
     ObjectPosArray[ObjectIndex] :=AStream.Position;
     With TStringStream(AStream) do
     begin
          WriteString(Format('%d 0 obj'#10,[ObjectIndex+1]));
          WriteString('<<'#10);
          WriteString('/Type /Pages'#10);
          WriteString('/Kids [ 3 0 R ]'#10);
          WriteString('/Count 1'#10);
          WriteString('>>'#10);         
          WriteString('endobj'#10);
     end;
     Inc(ObjectIndex);

     // Kids Page
     ObjectPosArray[ObjectIndex] :=AStream.Position;
     With TStringStream(AStream) do
     begin
          WriteString(Format('%d 0 obj'#10,[ObjectIndex+1]));
          WriteString('<<'#10);
          WriteString('/Type /Page'#10);
          WriteString('/Parent 2 0 R'#10);
          WriteString('/Resources'#10);
          WriteString('<<'#10);
          WriteString('/XObject << /Im0 4 0 R >>'#10);
          WriteString('/ProcSet [ /PDF /ImageC ]'#10);
          WriteString('>>'#10);
          WriteString(Format('/MediaBox [ 0 0 %d %d ]'#10, [BMP.Width,BMP.Height]));
          WriteString('/Contents 5 0 R'#10);
          WriteString('>>'#10);
          WriteString('endobj'#10);
     end;
     Inc(ObjectIndex);

     // XObject Resource
     ObjectPosArray[ObjectIndex] :=AStream.Position;   
     With TStringStream(AStream) do
     begin
          WriteString(Format('%d 0 obj'#10,[ObjectIndex+1]));
          WriteString('<<'#10);
          WriteString('/Type /XObject'#10);
          WriteString('/Subtype /Image'#10);
          WriteString('/Name /Im0'#10);
          WriteString(Format('/Width %d'#10,[BMP.Width]));
          WriteString(Format('/Height %d'#10,[BMP.Height]));
          WriteString('/BitsPerComponent 8'#10);
          WriteString('/Filter []'#10);
          WriteString('/ColorSpace /DeviceRGB'#10);
          WriteString(Format('/Length %d >>'#10,[BitsData.Size]));
          WriteString('stream'#10);
          AStream.CopyFrom(BitsData,BitsData.Size);
          WriteString('endstream'#10);
          WriteString('endobj'#10);
     end;
     Inc(ObjectIndex);

     ObjectPosArray[ObjectIndex] :=AStream.Position;
     With TStringStream(AStream) do
     begin
        Write_ContentsObject(AStream,ObjectIndex+1,BMP.Width,BMP.Height);
     end;
     Inc(ObjectIndex);

     // CrossReferenceTable
     ObjectPosArray[ObjectIndex] :=AStream.Position;
     Write_CrossReferenceTable(AStream,ObjectPosArray,ObjectIndex);

     // trailer
     With TStringStream(AStream) do
     begin
         WriteString('trailer'#10);
         WriteString('<<'#10);
         WriteString(Format('/Size %d'#10,[ObjectIndex+1]));
         WriteString('/Root 1 0 R'#10);
         WriteString('>>'#10);
         WriteString('startxref'#10);
         WriteString(Format('%d'#10,[ObjectPosArray[ObjectIndex]]));
         WriteString('%%EOF');
     end;

  finally
    AStream.Free;
    BitsData.Free;
  end;
end;

end.

Beispiel :

uses bmp2pdf

procedure TForm1.Button1Click(Sender: TObject);
var BMP : TBitmap;
begin
  BMP := TBitmap.Create;
  if OpenDialog1.Execute then begin
  try
  BMP.LoadFromFile(OpenDialog1.FileName);
  BMPtoPDF(BMP, OpenDialog1.FileName + '.pdf'); 
  end;
  finally
  BMP.Free;
  end;
end;