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
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