unit bmp2pdf;
interface
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
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;
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;
TStringStream(AStream).WriteString('%PDF-1.2'#10);
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);
WriteString('/OpenAction [3 0 R /XYZ -32768 -32768 1 ]'#10);
WriteString('>>'#10);
WriteString('endobj'#10);
end;
Inc(ObjectIndex);
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);
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);
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);
ObjectPosArray[ObjectIndex] :=AStream.Position;
Write_CrossReferenceTable(AStream,ObjectPosArray,ObjectIndex);
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.
|
BMP2PDF.PAS (6k)