unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    //{ Private declarations }
  public
    //{ Public declarations }
  end;

  ApCreate = function(pFileName:PChar  ): Longint	; stdcall	;
  ApOpen = function(pFileName:PChar  ): Longint	; stdcall	;
  ApClose = procedure(id:Longint ); stdcall ;

  ApAddInfo = function(id:Longint;Title:PChar;Subject:PChar;Author:PChar;Keyword:PChar;Creator:PChar):Longint;stdcall;
  ApSetFunction = function(id:Longint;func_code:Longint;
                             para1:Longint;para2:Longint;para3:PChar ;para4:PChar ): Longint	; stdcall	;
  ApGetFunction = function(id:Longint;func_code:Longint;
                             para1:Longint;para2:Longint;para3:PChar ;para4:PChar ): Longint	; stdcall	;

  ApAddImage = function( id:Longint;filename:PChar): Longint	; stdcall	;
  ApAddImageData = function (id:Longint;data:PChar;width:Longint;height:Longint;color:Longint):Longint;stdcall;


  ApAddText = function(id:Longint;x:Longint;y:Longint;width:Longint;height:Longint;
                      str:PChar;color:Longint;bkcolor:Longint;lFormat:Longint):Longint;stdcall;

  ApAddTextEx= function(id:Longint;x:Longint;y:Longint;str:PChar;color:Longint):Longint;stdcall;

  ApAddTxt = function (id:Longint;filename:PChar;color:Longint;
                        PageWidth:Longint;PageHeight:Longint;AutoNewLine:Longint;AutoWidthAdjust:Longint;
						            LeftMargin:Longint;RightMargin:Longint;TopMargin:Longint;BottomMargin:Longint;
						            TabSize:Longint):Longint;stdcall;
                        
  ApAddLine = function (id:Longint;sx:Longint;sy:Longint;ex:Longint;ey:Longint;width:Longint;color:Longint):Longint;stdcall;

  ApAddRect = function(id:Longint;sx:Longint;sy:Longint;ex:Longint;ey:Longint;
							          side_width:Longint;side_color:Longint;
							          flagFill:Longint;fill_color:Longint):Longint;stdcall;

const

//defined for ApSetFunction
Ap_Set_MultiPage			: Longint =	101;
Ap_Set_ImagePosAndSize: Longint =	104;
Ap_Set_Encrypt 				: Longint =	105;
Ap_Set_Font					  : Longint =	106;
Ap_Set_NewOrClosePage	: Longint =	109;
Ap_Set_BookMark				: Longint =	110;
Ap_Set_ViewerPreferences: Longint =	121;
Ap_Set_Orientation		: Longint =	122;
Ap_Set_Recompress			: Longint =	123;
Ap_Set_Skewcorrect		: Longint =	126;
Ap_Set_JpegQuality		: Longint =	128;

//defined for ApGetFunction
Ap_Get_ImagePageCount		: Longint = 201 ;
Ap_Get_ImageSizeW			  : Longint = 202 ;
Ap_Get_ImageSizeH			  : Longint = 203 ;
Ap_Get_ImageDpiX			  : Longint = 204 ;
Ap_Get_ImageDpiY			  : Longint = 205 ;
Ap_Get_PdfPageCount			: Longint = 206 ;
Ap_Get_PdfCurrentPageSize	: Longint = 209 ;
Ap_Get_StringWidth			  : Longint = 250 ;
Ap_Get_StringHeight			  : Longint = 251 ;
Ap_Get_Recomporess			  : Longint = 210 ;
Ap_Get_ImageBits			    : Longint = 211 ;

//defined for ApAddText
Ap_DT_LEFT			: Longint = 0 ;
Ap_DT_CENTER		: Longint = 1 ;
Ap_DT_RIGHT			: Longint = 2 ;
Ap_DT_WORDBREAK	: Longint = 16;   //0x10 ;
Ap_DT_CALCRECT	: Longint = 1024; //0x400 ;

//defined permission
permission_Print	: Longint = 1 ;
permission_Copy		: Longint = 2 ;
permission_Modify	: Longint = 4 ;



var
  Form1: TForm1;

  g_hapW : HMODULE	;
  pApCreate: ApCreate;
  pApOpen: ApOpen ;
  pApClose: ApClose ;
  pApAddInfo: ApAddInfo;
  pApSetFunction: ApSetFunction ;
  pApGetFunction: ApGetFunction ;
  pApAddImage: ApAddImage ;
  pApAddImageData: ApAddImageData;
  pApAddText: ApAddText ;
  pApAddTextEx: ApAddTextEx;
  pApAddTxt: ApAddTxt;
  pApAddLine: ApAddLine ;
  pApAddRect: ApAddRect;

implementation

{$R *.dfm}


//****************************************************************************

function FreeapWDll() : Boolean;
begin
	if(g_hapW = 0) then begin
		FreeapWDll:=False;
    Exit;
  end;
	FreeLibrary(g_hapW);
	g_hapW:=0;
  Result:=True;
end;
//****************************************************************************

function  LoadapWDll(pDll:pchar) :Boolean ;
var
  path:PAnsiChar ;
  proc :FARPROC ;
label
  Failer;

begin
  path := 'imagetopdf.dll';
  g_hapW :=LoadLibrary(path);
	if(g_hapW=0) then
		goto Failer;

	proc:=GetProcAddress(g_hapW,'ApCreate');
	if(proc=nil)then
		goto Failer;
  pApCreate:=proc ;
	proc:=GetProcAddress(g_hapW,'ApOpen');
	if(proc=nil)then
		goto Failer;
  pApOpen:=proc ;
  proc:=GetProcAddress(g_hapW,'ApClose');
	if(proc=nil)then
		goto Failer;
  pApClose:=proc ;
  proc:=GetProcAddress(g_hapW,'ApAddInfo');
	if(proc=nil)then
		goto Failer;
  pApAddInfo:=proc ;
  proc:=GetProcAddress(g_hapW,'ApSetFunction');
	if(proc=nil)then
		goto Failer;
  pApSetFunction:=proc ;
  proc:=GetProcAddress(g_hapW,'ApGetFunction');
	if(proc=nil)then
		goto Failer;
  pApGetFunction:=proc ;
  proc:=GetProcAddress(g_hapW,'ApAddImage');
	if(proc=nil)then
		goto Failer;
  pApAddImage:=proc ;
  proc:=GetProcAddress(g_hapW,'ApAddImageData');
	if(proc=nil)then
		goto Failer;
  pApAddImageData:=proc ;
  proc:=GetProcAddress(g_hapW,'ApAddText');
	if(proc=nil)then
		goto Failer;
  pApAddText:=proc ;
  proc:=GetProcAddress(g_hapW,'ApAddTextEx');
	if(proc=nil)then
		goto Failer;
  pApAddTextEx:=proc ;
  proc:=GetProcAddress(g_hapW,'ApAddTxt');
	if(proc=nil)then
		goto Failer;
  pApAddTxt:=proc ;
  proc:=GetProcAddress(g_hapW,'ApAddLine');
	if(proc=nil)then
		goto Failer;
  pApAddLine:=proc ;
  proc:=GetProcAddress(g_hapW,'ApAddRect');
	if(proc=nil)then
		goto Failer;
  pApAddRect:=proc ;

  Result:=True;
  Exit;

  Failer:
    FreeapWDll();
    Result:=False;
end;

//----------------------------------------------------------------------------------------

procedure AddImageData(id:Longint );
type

   TMemData = array[0..128*128*3] of Char;
var
  i:Longint;
  j:Longint;
  temp1:Longint;
  temp2:Longint;
  red:Longint;
  green:Longint;
  blue:Longint;
  MemImageWidth:Longint;
  MemImageHeight:Longint;
  color:Longint;
  MemData:TMemData;

begin

	MemImageWidth:=128;
	MemImageHeight:=128;
	color:=24;//can be 1 , 8 or 24

  if id <= 0 then
    Exit;

	for i:=0 to MemImageHeight - 1 do
		for j:=0 to MemImageWidth - 1 do
    begin
    	temp1:=i And 8;
			temp2:=j And 8;
			if  ( temp1 Xor temp2 ) <> 0 then
      begin
				red :=255 ;
				green := 0;
        blue := 0;
      end
			else
      begin
        red := 0;
        green := 0;
        blue := 255;
      end;
      MemData[i * MemImageWidth * 3 + j * 3 + 0] := char(red);
      MemData[i * MemImageWidth * 3 + j * 3 + 1] := char(green);
      MemData[i * MemImageWidth * 3 + j * 3 + 2] := char(blue);
	  end;

    //create page
    pApSetFunction(id,Ap_Set_NewOrClosePage,MemImageWidth,MemImageHeight,NIL,NIL);

    pApAddImageData(id,MemData,MemImageWidth,MemImageHeight,color);

    //close page
    pApSetFunction(id,Ap_Set_NewOrClosePage,0,0,NIL,NIL);

end;

//----------------------------------------------------------------------------------------

//split image file
procedure One2Multiple(pPdf:PChar	; pImage:PChar	);
var
	id,pagecount,beginpage : Longint    ;
	szPDFFile:PChar	;
begin

	//get multipage image page count
	pagecount:=pApGetFunction(0,Ap_Get_ImagePageCount,0,0,pImage,NIL);
	for beginpage:=1 to pagecount do
	begin
    szPDFFile := PChar( pPdf + inttostr(beginpage) + '.pdf');
    id:=pApCreate(szPDFFile);
		if( id >0 )then
		begin
			pApSetFunction(id,Ap_Set_MultiPage,beginpage,1,nil,nil);
			pApAddImage(id,pImage);
			pApClose(id);
		end
	end
end;

//----------------------------------------------------------------------------------------
procedure One2One(pPdf:PChar	; pImage:PChar	) ;
var
	id:Longint;
begin
  id:=pApCreate(pPdf);
	if( id >0 ) then
	begin
		pApAddImage(id,pImage);
		pApClose(id);
	end

end;
//----------------------------------------------------------------------------------------
//merge image file
procedure Multiple2One(pPdf:PChar; pImage:array of PChar; len:Longint);
var

	id,i:  Longint;
begin

	id:=pApCreate(pPdf);
	if( id >0 ) then
	begin
		for i := 0 to len-1 do
		begin
			pApAddImage(id,pImage[i]);	
		end ;
		pApClose(id);
	end
end;


//----------------------------------------------------------------------------------------

procedure AppendPDF(pPdf:PChar; pImage:array of PChar;len:Longint);
var
	 id,i: Longint ;
begin                          

	for i := 0 to len-1 do
  begin
    id:=pApOpen(pPdf);
		if( id >0 )then//Append PDF file
    begin
        pApAddImage(id,pImage[i]);
        pApClose(id);
    end
    else
    begin
        id:=pApCreate(pPdf);
        if( id >0 )then//Create new PDF file
        begin
          pApAddImage(id,pImage[i]);
          pApClose(id);
        end ;
    end;
	end ;
		
end ;
//----------------------------------------------------------------------------------------

procedure Skewcorrect(pPdf:PChar; pImage:PChar);
var
	id:Longint;
begin
  id:=pApCreate(pPdf);
	if( id >0 ) then
	begin
		pApAddImage(id,pImage);

		//set skewcorrect
		pApSetFunction(id,Ap_Set_Skewcorrect,1,0,NIL,nil);

		pApAddImage(id,pImage);		

		pApClose(id);	
	end 

end;
//----------------------------------------------------------------------------------------

procedure RecompressTruecolorFile(pPdf:PChar; pImage:PChar);
var
	id:Longint;
	szPDFFile : pchar;
begin

	// recompress lzw
  szPDFFile := pchar(pPdf + '_lzw.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,3,0,'lzw',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

	// recompress zip
  szPDFFile := pchar(pPdf + '_zip.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,3,0,'zip',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

	// recompress packbits
  szPDFFile := pchar(pPdf + '_packbits.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,3,0,'packbits',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

	// recompress jpeg,quality=100
  szPDFFile := pchar(pPdf + '_jpeg_100.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,3,0,'jpeg',nil);
		pApSetFunction(id,Ap_Set_JpegQuality,100,0,nil,nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

	// recompress jpeg,quality=50
  szPDFFile := pchar(pPdf + '_jpeg_50.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,3,0,'jpeg',nil);
		pApSetFunction(id,Ap_Set_JpegQuality,50,0,nil,nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end;

end ;
//----------------------------------------------------------------------------------------

procedure RecompressGrayFile(pPdf:PChar; pImage:PChar);
var
	id:Longint;
	szPDFFile : pchar;
begin

	// recompress lzw
  szPDFFile := pchar(pPdf + '_lzw.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,2,0,'lzw',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

	// recompress zip
  szPDFFile := pchar(pPdf + '_zip.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,2,0,'zip',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end   ;

	// recompress packbits
  szPDFFile := pchar(pPdf + '_packbits.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,2,0,'packbits',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

	// recompress jpeg, default quality=75
  szPDFFile := pchar(pPdf + '_jpeg.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,2,0,'jpeg',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

end ;
//----------------------------------------------------------------------------------------

procedure RecompressBlackWhiteFile(pPdf:PChar; pImage:PChar);
var
	id:Longint;
	szPDFFile : pchar;
begin

	// recompress lzw
  szPDFFile := pchar(pPdf + '_lzw.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,1,0,'lzw',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end  ;

	// recompress zip
  szPDFFile := pchar(pPdf + '_zip.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,1,0,'zip',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end  ;

	// recompress CCITT Group 3 fax encoding
  szPDFFile := pchar(pPdf + '_g3.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,1,0,'g3',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end;

	// recompress CCITT Group 4 fax encoding
  szPDFFile := pchar(pPdf + '_g4.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin
		pApSetFunction(id,Ap_Set_Recompress,1,0,'g4',nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

end;
//----------------------------------------------------------------------------------------

procedure Recompress(pPdf:PChar; pImage:PChar);
var
	 bits: Longint   ;
begin
	bits:=pApGetFunction(0,Ap_Get_ImageBits,0,0,pImage,nil);
	case (bits) of
	1:
		RecompressBlackWhiteFile(pPdf,pImage);
	8:
		RecompressGrayFile(pPdf,pImage);
	24:
		RecompressTruecolorFile(pPdf,pImage);
	end ;

end ;

//----------------------------------------------------------------------------------------

procedure PageSize(pPdf:PChar; pImage:PChar);
var
	id:Longint;
	fZoom, zw,zh:Single	;
	ImageWidth,ImageHeight,ImageWidth2,ImageHeight2,PageWidth,PageHeight: Longint;
  xdpi,ydpi : Longint;

begin

  id := pApCreate(pPdf);
	if( id >0 ) then
	begin
		//Get image width and height
		pApGetFunction(id,Ap_Get_ImageSizeW,Longint(@ImageWidth),Longint(@ImageHeight),pImage,nil);
		//Get image dpi (Resolution)
		pApGetFunction(id,Ap_Get_ImageDpiX,Longint(@xdpi),Longint(@ydpi),pImage,nil);

		//keep image dpi (resolution)
		ImageWidth2  := Trunc(ImageWidth * (72.0/xdpi));
		ImageHeight2 := Trunc(ImageHeight* (72.0/ydpi));

		pApSetFunction(id,Ap_Set_NewOrClosePage,ImageWidth2,ImageHeight2,nil,nil);
		pApAddImage(id,pImage);

		//page size with image size
		pApSetFunction(id,Ap_Set_NewOrClosePage,ImageWidth,ImageHeight,nil,nil);
		pApAddImage(id,pImage);

		//A4
		pApSetFunction(id,Ap_Set_NewOrClosePage,2,2,nil,nil);
		pApSetFunction(id,Ap_Set_ImagePosAndSize,0,0,PChar(IntToStr(ImageWidth)),PChar(IntToStr(ImageHeight)));
		pApAddImage(id,pImage);

		//custom page size and fit width/height 
		PageWidth:=768;
		PageHeight:=1024;
		pApSetFunction(id,Ap_Set_NewOrClosePage,PageWidth,PageHeight,nil,nil);
		zw := 1.0 * PageWidth/ImageWidth;
		zh := 1.0 * PageHeight/ImageHeight;
    if( zw < zh) then
		  fZoom:=  zw
    else
		  fZoom:=  zh;

		ImageWidth := Trunc(ImageWidth * fZoom);
		ImageHeight:= Trunc(ImageHeight * fZoom);
		pApSetFunction( id,Ap_Set_ImagePosAndSize,Trunc((PageWidth-ImageWidth)/2),Trunc((PageHeight-ImageHeight)/2),
                    PChar(IntToStr(ImageWidth)),PChar(IntToStr(ImageHeight)));
		pApAddImage(id,pImage);

		pApClose(id);
	end 

end;

//----------------------------------------------------------------------------------------

procedure PageLayout(pPdf:PChar; pImage:array of PChar; len:Longint);
var
  id,i,nPos,nPages,index, PageWidth,PageHeight: Longint;

begin
  nPos:=1;
	PageWidth:=768;
	PageHeight:=1024;

  id := pApCreate(pPdf);
	if( id >0 ) then
	begin
		for i := 0 to len-1 do
		begin
			//get pages
			nPages:=pApGetFunction(id,Ap_Get_ImagePageCount,0,0,pImage[i],nil);
			//
			for index := 1 to nPages do
			begin
				case (nPos mod 4) of
				1:  begin
						//new page
						pApSetFunction(id,Ap_Set_NewOrClosePage,PageWidth,PageHeight,nil,nil);
						//set image posion
						pApSetFunction( id,Ap_Set_ImagePosAndSize,0,0,
                            PChar(IntToStr(PageWidth div 2)),PChar(IntToStr(PageHeight div 2)) );
						pApSetFunction(id,Ap_Set_MultiPage,index,1,nil,nil);
						pApAddImage(id,pImage[i]);
            end;
				2:  begin
						pApSetFunction( id,Ap_Set_ImagePosAndSize,PageWidth div 2,0,
                            PChar(IntToStr(PageWidth div 2)),PChar(IntToStr(PageHeight div 2)) );
						pApSetFunction( id,Ap_Set_MultiPage,index,1,nil,nil);
						pApAddImage(id,pImage[i]);
            end;
				3:  begin
						pApSetFunction( id,Ap_Set_ImagePosAndSize,0,PageHeight div 2,
                            PChar(IntToStr(PageWidth div 2)),PChar(IntToStr(PageHeight div 2)) );
						pApSetFunction(id,Ap_Set_MultiPage,index,1,nil,nil);
						pApAddImage(id,pImage[i]);
            end;
				0:  begin
						pApSetFunction( id,Ap_Set_ImagePosAndSize,PageWidth div 2,PageHeight div 2,
                            PChar(IntToStr(PageWidth div 2)),PChar(IntToStr(PageHeight div 2)) );
						pApSetFunction(id,Ap_Set_MultiPage,index,1,nil,nil);
						pApAddImage(id,pImage[i]);
						//close page
						pApSetFunction(id,Ap_Set_NewOrClosePage,0,0,nil,nil);
            end;
				end;
				nPos := nPos + 1;
			end;
		end;
		pApClose(id);
	end; 

end;
//----------------------------------------------------------------------------------------

procedure PageOrientation(pPdf:PChar; pImage:PChar);
var
  id,nOrientation : Longint;
	szPDFFile : pchar;

begin

	nOrientation:=90;
  szPDFFile := pchar(pPdf + '_90.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin	
		pApSetFunction(id,Ap_Set_Orientation,nOrientation,0,nil,nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

	nOrientation:=180;
  szPDFFile := pchar(pPdf + '_180.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin	
		pApSetFunction(id,Ap_Set_Orientation,nOrientation,0,nil,nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end ;

	nOrientation:=270;
  szPDFFile := pchar(pPdf + '_270.pdf');
  id := pApCreate(szPDFFile);
	if( id > 0 ) then
	begin	
		pApSetFunction(id,Ap_Set_Orientation,nOrientation,0,nil,nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end 

end;
//----------------------------------------------------------------------------------------

procedure Watermark(pPdf:PChar; pImage:array of PChar;len:Longint) ;
var
  id,nPages,index ,i,ImageWidth,ImageHeight,nPosX,nPosY: Longint;

begin

  id := pApCreate(pPdf);
	if( id >0 ) then
	begin
		for i := 0 to len-1 do
		begin
			nPages:=pApGetFunction(id,Ap_Get_ImagePageCount,0,0,pImage[i],nil);
			for index:=1 to nPages do
			begin
				//get image width and height
				pApGetFunction(id,Ap_Get_ImageSizeW,Longint(@ImageWidth),Longint(@ImageHeight),
                       pImage[i],PChar(IntToStr(index)));
				//new page
				pApSetFunction(id,Ap_Set_NewOrClosePage,ImageWidth,ImageHeight,nil,nil);
				//set image pos
				pApSetFunction(id,Ap_Set_ImagePosAndSize,0,0,
                      PChar(IntToStr(ImageWidth)),PChar(IntToStr(ImageHeight)));
			
				pApSetFunction(id,Ap_Set_MultiPage,index,1,nil,nil);
				pApAddImage(id,pImage[i]);
				
				//set system font and size
				pApSetFunction(id,Ap_Set_Font,1,32,'Arial',nil);
				//add text
				nPosX:=10;
				nPosY:=ImageHeight div 2;
				pApAddTextEx(id,nPosX,nPosY,'(c)Copyright XXXXXXXXXX',RGB(255,0,0));

				//close page
				pApSetFunction(id,Ap_Set_NewOrClosePage,0,0,nil,nil);
			end ;
		end ;
		pApClose(id);
	end;
	
end ;

//----------------------------------------------------------------------------------------
procedure PDFsecurity(pPdf:PChar; pImage:PChar);
var
	id:Longint;

begin
  id := pApCreate(pPdf);
	if( id >0 ) then
	begin
		pApSetFunction(id,Ap_Set_Encrypt,128,permission_Print+permission_Copy+permission_Modify,'owner','user');
		pApAddImage(id,pImage);
		pApClose(id);
	end 

end  ;
//----------------------------------------------------------------------------------------

procedure PDFInfo(pPdf:PChar; pImage:PChar);
var
	id:Longint;
begin
  id := pApCreate(pPdf);

	if( id >0 ) then
	begin
		pApAddInfo(id,'Title','Subject','Author','Keywords','Creator');
		pApAddImage(id,pImage);
		pApClose(id);
	end 
	
end ;
//----------------------------------------------------------------------------------------


procedure Bookmark(pPdf:PChar; pImage:PChar);
var
	id,beginpage,pagecount:Longint;
  szBookmark: pchar;
begin
  id := pApCreate(pPdf);

	if( id >0 ) then
	begin
		//get multi page image page count
		pagecount:=pApGetFunction(id,Ap_Get_ImagePageCount,0,0,pImage,nil);
		for beginpage:=1 to pagecount do
    begin
			//add bookmark
      szBookmark := pchar('bookmark ' + inttostr(beginpage));
			pApSetFunction(id,Ap_Set_BookMark,0,0,szBookmark,nil);
			//Add page
			pApSetFunction(id,Ap_Set_MultiPage,beginpage,1,nil,nil);
			pApAddImage(id,pImage);
		end ;
		pApClose(id);
	end;
end    ;

//----------------------------------------------------------------------------------------

procedure ViewerPreferences(pPdf:PChar; pImage:PChar);
var
	id:Longint;

begin
  id := pApCreate(pPdf);
	if( id >0 ) then
	begin
		pApSetFunction(id,Ap_Set_ViewerPreferences,4+4096,2,nil,nil);
		pApAddImage(id,pImage);
		pApClose(id);
	end 
	
end   ;

//----------------------------------------------------------------------------------------


procedure TextAndGraphics(pPdf:PChar) ;
var
	id,width,height:Longint;
	strings :  pchar;
begin

  strings := 'this is a text! this is a text! this is a text! this is a text!';
  id := pApCreate(pPdf);
	if( id >0 ) then
	begin
		//create a page for a3
		pApSetFunction(id,Ap_Set_NewOrClosePage,1,1,nil,nil);
		//set system font and size
		pApSetFunction(id,Ap_Set_Font,1,32,'Arial',nil);
		//add text
		pApAddTextEx(id,300,300,'this is a text!',RGB(0,255,255));

		//set system font and size
		pApSetFunction(id,Ap_Set_Font,1,32,'Helvetica',nil);
		//add text
		pApAddTextEx(id,300,400,'this is a text!',RGB(0,255,255));

		//set adobe font and size
		pApSetFunction(id,Ap_Set_Font,203,32,nil,nil);
		//add text with rectangle
		width :=400;
		height:=200;
		pApAddText(id,100,50,width,height,strings,RGB(0,0,255),RGB(255,0,255),Ap_DT_WORDBREAK or Ap_DT_CENTER);

		//set system font and size
		pApSetFunction(id,Ap_Set_Font,1,32,'Verdana',nil);
		//add text
		pApAddTextEx(id,300,500,'this is a text!',RGB(0,255,255));

		//create a page for b5
		pApSetFunction(id,Ap_Set_NewOrClosePage,4,4,nil,nil);
		//add graphic
		pApAddLine  (id,10,10,100,200,5,RGB(0,0,255));
		pApAddRect(id,20,210,300,400,3,RGB(0,255,0),1,RGB(255,0,255));
		//close page
		pApSetFunction(id,Ap_Set_NewOrClosePage,0,0,nil,nil);

		//add a txt file
		pApSetFunction(id,Ap_Set_Font,200,16,nil,nil);
		pApAddTxt(id,'test.txt',0,0,0,1,1,64,64,64,64,4);

		//add memory image 
		AddImageData(id);

		pApClose(id);
	end 

end ;





procedure TForm1.Button1Click(Sender: TObject);
var
	szMultiPage : PChar;
	szBlackWhite : PChar;
	szGray : PChar;
	szTrueColor : PChar;
	szSkewcorrect : PChar;
  szJpg  : PChar;
  szBmp  : PChar;
  szGif  : PChar;
  szEmf  : PChar;
  szWmf  : PChar;
  szDcx  : PChar;
  szPcx  : PChar;
  szPsd  : PChar;
	input : array[0..20] of PChar;
    
begin

  szMultiPage := 'MultiPage.tif';
	szBlackWhite := 'BlackWhite.tif';
	szGray := 'Gray.tif';
	szTrueColor := 'TrueColor.tif';
	szSkewcorrect := 'Skewcorrect.tif';
  szJpg := 'test.jpg';
  szBmp := 'test.bmp';
  szGif := 'test.gif';
  szEmf := 'test.emf';
  szWmf := 'test.wmf';
  szDcx := 'test.dcx';
  szPcx := 'test.pcx';
  szPsd := 'test.psd';

	input[0] := szBlackWhite;
	input[1] := szGray;
	input[2] := szTrueColor;
	input[3] := szMultiPage;
  input[4] := szJpg;
  input[5] := szBmp;
  input[6] := szGif;
  input[7] := szEmf;
  input[8] := szWmf;
  input[9] := szDcx;
  input[10] := szPcx;
  input[11] := szPsd;

	if( LoadApWDll('imagetopdf.dll') = False) then
		exit;

	One2Multiple('One2Multiple1',szMultiPage);
	One2Multiple('One2Multiple2',szDcx);

	One2One('One2One1.pdf',szMultiPage);
	One2One('One2One2.pdf',szDcx);

	Multiple2One('Multiple2One.pdf',input,12);

	AppendPDF('Append.pdf',input,2);

	//re-compress image files to PDFs
	Recompress('BlackWhite',szBlackWhite);
	Recompress('Gray',szGray);
	Recompress('TrueColor',szTrueColor);

	Skewcorrect('Skewcorrect.pdf',szSkewcorrect);

	PageSize('PageSize.pdf',szTrueColor);

	PageLayout('PageLayout.pdf',input,12);

	PageOrientation('PageOrientation',szMultiPage);

	Watermark('Watermark.pdf',input,12);

	PDFsecurity('Security.pdf',szTrueColor);

	PDFInfo('Information.pdf',szTrueColor);

	Bookmark('Bookmark.pdf',szMultiPage);

	ViewerPreferences('ViewerPreferences.pdf',szTrueColor);

	TextAndGraphics('TextAndGraphics.pdf');

	FreeApWDll();
  
end;

end.
