Wednesday, January 3, 2018

Export Image To PDF with Delphi (Tip for 10 )


Visit my Youtube channnels :  Electro_Magic ; Practical Tips  ; Delphi practical school

This is example how one can export image from Delphi application to PDF file, using open source library SynPDF.


In the following video full procedure is described



Library can be downloaded from :
https://github.com/synopse/SynPDF

Following is full source code :
Edited 10.01.2018 : added code for the Form after main code.
(code style formatted by http://hilite.me/ )





unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg,SynPdf, ShellAPI;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Panel2: TPanel;
    ColorDialog1: TColorDialog;
    Panel3: TPanel;
    Button5: TButton;
    Button6: TButton;
    OpenDialog1: TOpenDialog;

    Panel4: TPanel;
    Button7: TButton;
    CheckBox1: TCheckBox;
    SaveDialog1: TSaveDialog;    procedure Button5Click(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
  public
   State:Integer;
   DrawColor:TColor;
   PenW:Integer;
  end;

var
  frmMain: TfrmMain;
  Drawing:Boolean;
  StartX,StartY,EndX,EndY:Integer;

implementation

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
begin
State:=1;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
begin
State:=2;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
begin
State:=3;
end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin
State:=4;
end;

procedure TfrmMain.Button5Click(Sender: TObject);
begin
if OpenDialog1.Execute() then
begin
Image1.Picture.LoadFromFile(OpenDialog1.FileName);
Image1.Width:=ClientWidth;
Image1.Height:=ClientHeight-60;
Image1.Picture.Bitmap.Width:=Image1.Width;
Image1.Picture.Bitmap.Height:=Image1.Height;
end;
end;

procedure TfrmMain.Button6Click(Sender: TObject);
begin
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Rectangle(0,0,Image1.Width-1,Image1.Height-1);
end;

procedure TfrmMain.Button7Click(Sender: TObject);
var
lPDF:TPdfDocument;
lPage:TPdfPage;
Jpegimage:TJPEGImage;
pdfimage:TPdfImage;
begin
if SaveDialog1.Execute() then
begin
lPDF:=TPdfDocument.Create;
try
  lPDF.DefaultPaperSize:=psA4;
  lPDF.DefaultPageLandscape:=CheckBox1.Checked;
  lPage:=lPDF.AddPage;
   Jpegimage:=TJPEGImage.Create;
   Jpegimage.Assign(Image1.Picture.Graphic);
   pdfimage:=TPdfImage.Create(lPDF,Jpegimage,true);
   lPDF.AddXObject('Image1',pdfimage);
   lPDF.Canvas.DrawXObject(0,lPage.PageHeight-Jpegimage.Height,Jpegimage.Width,Jpegimage.Height,'Image1');
   lPDF.SaveToFile(SaveDialog1.FileName+'.pdf');
   ShellExecute(Handle,'open',PChar(SaveDialog1.FileName+'.pdf'),nil,
   nil,SW_SHOWNORMAL);
finally
lPDF.Free;
end;
end;
end;

procedure TfrmMain.Edit1Change(Sender: TObject);
begin
PenW:=StrToInt(Edit1.Text);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
with Image1.Canvas do begin
  Pen.Color:=clWhite;
  Brush.Color:=clWhite;
  Rect(0,0,Image1.Width-1,Image1.Height-1);
  State:=1;
  DrawColor:=clBlack;
  PenW:=2;
end;
end;

procedure TfrmMain.FormResize(Sender: TObject);
begin
Image1.Width:=ClientWidth;
Image1.Height:=ClientHeight-60;
Image1.Picture.Bitmap.Width:=Image1.Width;
Image1.Picture.Bitmap.Height:=Image1.Height;
end;

procedure TfrmMain.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Drawing:=True;
StartX:=X; StartY:=Y;
EndX:=X; EndY:=Y;

if (State=1) or (State=2) then
begin
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Pen.Width:=PenW;
end;

if State=4 then begin
Image1.Canvas.Pen.Color:=DrawColor;
Image1.Canvas.Pen.Width:=PenW;
Image1.Canvas.PenPos:=Point(X,Y);
end;

end;

procedure TfrmMain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var
  PenColor:TColor;
begin
if Drawing=true then
begin
if State=1 then  begin      //start drawing line
 with Image1.Canvas do begin
   Pen.Mode:=pmXor;
   MoveTo(StartX,StartY);
   LineTo(EndX,EndY);
   Pen.Mode:=pmXor;
   MoveTo(StartX,StartY);
   LineTo(x,y);
 end;
 EndX:=X; EndY:=Y;
end;

if State=2 then begin    // start drawing rectangular
with Image1.Canvas do begin
  Pen.Mode:=pmXOR;
  MoveTo(StartX,StartY);
  LineTo(StartX,EndY);
  LineTo(EndX,EndY);
  LineTo(EndX,StartY);
  LineTo(StartX,StartY);
  Pen.Mode:=pmXOR;
  MoveTo(StartX,StartY);
  LineTo(StartX,y);
  LineTo(x,y);
  LineTo(x,StartY);
  LineTo(StartX,StartY);
end;
EndX:=X; EndY:=Y;
end;

if State=3 then begin    // start drawing ellipse
with Image1.Canvas do begin
PenColor:=Pen.Color;
Pen.Color:=Brush.Color;
Ellipse(StartX,StartY,EndX,EndY);
Pen.Color:=PenColor;
Ellipse(StartX,StartY,X,Y);
end;
EndX:=X; EndY:=Y;
end;

if State=4 then begin    // start drawing freehand
with Image1.Canvas do begin
LineTo(X,Y);
end;

end;

end;
end;

procedure TfrmMain.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if State=1 then  begin      //end drawing line
 with Image1.Canvas do begin
   Pen.Mode:=pmXOR;
   MoveTo(StartX,StartY);
   LineTo(EndX,EndY);
   Pen.Color:=DrawColor;
   Pen.Mode:=pmCopy;
   MoveTo(StartX,StartY);
   LineTo(EndX,EndY);
 end;
 end;

 if State=2 then begin    // end drawing rectangular
with Image1.Canvas do begin
      Pen.Mode:=pmXOR;
      MoveTo(StartX,StartY);
      LineTo(StartX,EndY);
      LineTo(EndX,EndY);
      LineTo(EndX,StartY);
      LineTo(StartX,StartY);
      Pen.Color:=DrawColor;
      Brush.Color:=clWhite;
      Pen.Mode:=pmCopy;
      MoveTo(StartX,StartY);
      LineTo(StartX,EndY);
      LineTo(EndX,EndY);
      LineTo(EndX,StartY);
      LineTo(StartX,StartY);
  end;
end;

Drawing:=False;
end;

procedure TfrmMain.Panel2Click(Sender: TObject);
begin
if ColorDialog1.Execute() then
begin
Panel2.Color:=ColorDialog1.Color;
DrawColor:=ColorDialog1.Color;
Panel2.Repaint;

end;
end;

end.


Form code (copy to text editor and save as .DFM file ) :

object frmMain: TfrmMain
  Left = 256
  Top = 162
  Caption = 'Paint'
  ClientHeight = 451
  ClientWidth = 784
  Color = clBtnFace
  DoubleBuffered = True
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesigned
  OnCreate = FormCreate
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 185
    Top = 0
    Width = 599
    Height = 451
    Align = alClient
    Stretch = True
    OnMouseDown = Image1MouseDown
    OnMouseMove = Image1MouseMove
    OnMouseUp = Image1MouseUp
    ExplicitLeft = 291
    ExplicitTop = 114
    ExplicitWidth = 105
    ExplicitHeight = 105
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 185
    Height = 451
    Align = alLeft
    TabOrder = 0
    object Label1: TLabel
      AlignWithMargins = True
      Left = 4
      Top = 128
      Width = 177
      Height = 13
      Align = alTop
      Caption = ' Line width'
      ExplicitWidth = 51
    end
    object Button1: TButton
      AlignWithMargins = True
      Left = 4
      Top = 4
      Width = 177
      Height = 25
      Align = alTop
      Caption = 'Line'
      TabOrder = 0
      OnClick = Button1Click
    end
    object Button2: TButton
      AlignWithMargins = True
      Left = 4
      Top = 35
      Width = 177
      Height = 25
      Align = alTop
      Caption = 'Rect'
      TabOrder = 1
      OnClick = Button2Click
    end
    object Button3: TButton
      AlignWithMargins = True
      Left = 4
      Top = 66
      Width = 177
      Height = 25
      Align = alTop
      Caption = 'Ellipse'
      TabOrder = 2
      OnClick = Button3Click
    end
    object Button4: TButton
      AlignWithMargins = True
      Left = 4
      Top = 97
      Width = 177
      Height = 25
      Align = alTop
      Caption = 'Freehand'
      TabOrder = 3
      OnClick = Button4Click
    end
    object Edit1: TEdit
      Left = 1
      Top = 141
      Width = 183
      Height = 21
      Align = alTop
      NumbersOnly = True
      TabOrder = 4
      Text = '2'
      OnChange = Edit1Change
    end
    object Panel2: TPanel
      Left = 1
      Top = 162
      Width = 183
      Height = 41
      Align = alTop
      Caption = 'Color'
      ParentBackground = False
      TabOrder = 5
      OnClick = Panel2Click
    end
    object Panel3: TPanel
      Left = 1
      Top = 258
      Width = 183
      Height = 192
      Align = alBottom
      TabOrder = 6
      object Button5: TButton
        AlignWithMargins = True
        Left = 4
        Top = 4
        Width = 175
        Height = 25
        Align = alTop
        Caption = 'Open bitmap'
        TabOrder = 0
        OnClick = Button5Click
      end
      object Button6: TButton
        Left = 1
        Top = 166
        Width = 181
        Height = 25
        Align = alBottom
        Caption = 'Clear all'
        TabOrder = 1
        OnClick = Button6Click
      end
      object Panel4: TPanel
        Left = 1
        Top = 111
        Width = 181
        Height = 55
        Align = alBottom
        TabOrder = 2
        object Button7: TButton
          Left = 1
          Top = 1
          Width = 179
          Height = 25
          Align = alTop
          Caption = 'Export to PDF'
          TabOrder = 0
          OnClick = Button7Click
          ExplicitLeft = 60
          ExplicitTop = 27
          ExplicitWidth = 75
        end
        object CheckBox1: TCheckBox
          AlignWithMargins = True
          Left = 4
          Top = 34
          Width = 173
          Height = 17
          Align = alBottom
          Caption = 'Landscape'
          TabOrder = 1
          ExplicitLeft = 63
          ExplicitTop = 42
          ExplicitWidth = 97
        end
      end
    end
  end
  object ColorDialog1: TColorDialog
    Left = 39
    Top = 213
  end
  object OpenDialog1: TOpenDialog
    Filter = 'Bitmap|*.bmp'
    Left = 108
    Top = 213
  end
  object SaveDialog1: TSaveDialog
    FileName = 'test'
    Filter = 'PDF File|*.pdf'
    InitialDir = '...'
    Left = 75
    Top = 315
  end
end

0 comments:

Post a Comment

Popular Posts

Recent Posts

Unordered List

Text Widget

Pages

Search This Blog

Powered by Blogger.

Contributors

Text Widget