├── .gitattributes ├── F2PDFExample.ico ├── F2PDFExample.lpi ├── F2PDFExample.lpr ├── F2PDFExample.res ├── f2pdfexunit.lfm ├── f2pdfexunit.pas ├── form2pdf.pas ├── images └── lena.bmp ├── licence.txt └── readme.txt /.gitattributes: -------------------------------------------------------------------------------- 1 | html/* linguist-documentation 2 | doc/* linguist-documentation 3 | -------------------------------------------------------------------------------- /F2PDFExample.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/alanphys/Form2PDF/0e5497f9b9e64add31cf45caedc0797a27453055/F2PDFExample.ico -------------------------------------------------------------------------------- /F2PDFExample.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | <Scaled Value="True"/> 12 | <ResourceType Value="res"/> 13 | <UseXPManifest Value="True"/> 14 | <XPManifest> 15 | <DpiAware Value="True"/> 16 | </XPManifest> 17 | <Icon Value="0"/> 18 | </General> 19 | <BuildModes Count="1"> 20 | <Item1 Name="Default" Default="True"/> 21 | </BuildModes> 22 | <PublishOptions> 23 | <Version Value="2"/> 24 | <UseFileFilters Value="True"/> 25 | </PublishOptions> 26 | <RunParams> 27 | <FormatVersion Value="2"/> 28 | </RunParams> 29 | <RequiredPackages Count="4"> 30 | <Item1> 31 | <PackageName Value="DateTimeCtrls"/> 32 | </Item1> 33 | <Item2> 34 | <PackageName Value="LazControls"/> 35 | </Item2> 36 | <Item3> 37 | <PackageName Value="TAChartLazarusPkg"/> 38 | </Item3> 39 | <Item4> 40 | <PackageName Value="LCL"/> 41 | </Item4> 42 | </RequiredPackages> 43 | <Units Count="2"> 44 | <Unit0> 45 | <Filename Value="F2PDFExample.lpr"/> 46 | <IsPartOfProject Value="True"/> 47 | </Unit0> 48 | <Unit1> 49 | <Filename Value="f2pdfexunit.pas"/> 50 | <IsPartOfProject Value="True"/> 51 | <ComponentName Value="F2PDFExForm"/> 52 | <HasResources Value="True"/> 53 | <ResourceBaseClass Value="Form"/> 54 | </Unit1> 55 | </Units> 56 | </ProjectOptions> 57 | <CompilerOptions> 58 | <Version Value="11"/> 59 | <Target> 60 | <Filename Value="F2PDFExample"/> 61 | </Target> 62 | <SearchPaths> 63 | <IncludeFiles Value="$(ProjOutDir);$(FPCSrcDir)/packages/fcl-pdf/src"/> 64 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 65 | </SearchPaths> 66 | <Parsing> 67 | <SyntaxOptions> 68 | <CStyleOperator Value="False"/> 69 | <IncludeAssertionCode Value="True"/> 70 | <AllowLabel Value="False"/> 71 | <CPPInline Value="False"/> 72 | </SyntaxOptions> 73 | </Parsing> 74 | <CodeGeneration> 75 | <Checks> 76 | <IOChecks Value="True"/> 77 | <RangeChecks Value="True"/> 78 | <OverflowChecks Value="True"/> 79 | <StackChecks Value="True"/> 80 | </Checks> 81 | <VerifyObjMethodCallValidity Value="True"/> 82 | </CodeGeneration> 83 | <Linking> 84 | <Debugging> 85 | <DebugInfoType Value="dsDwarf2Set"/> 86 | </Debugging> 87 | <Options> 88 | <Win32> 89 | <GraphicApplication Value="True"/> 90 | </Win32> 91 | </Options> 92 | </Linking> 93 | </CompilerOptions> 94 | <Debugging> 95 | <Exceptions Count="4"> 96 | <Item1> 97 | <Name Value="EAbort"/> 98 | </Item1> 99 | <Item2> 100 | <Name Value="ECodetoolError"/> 101 | </Item2> 102 | <Item3> 103 | <Name Value="EFOpenError"/> 104 | </Item3> 105 | <Item4> 106 | <Name Value="ERangeError"/> 107 | </Item4> 108 | </Exceptions> 109 | </Debugging> 110 | </CONFIG> 111 | -------------------------------------------------------------------------------- /F2PDFExample.lpr: -------------------------------------------------------------------------------- 1 | program F2PDFExample; 2 | {.DEFINE DEBUG} 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, tachartlazaruspkg, lazcontrols, datetimectrls, 11 | f2pdfexunit; 12 | 13 | {$R *.res} 14 | 15 | begin 16 | {Set up -gh output for the Leakview package} 17 | {$IFDEF DEBUG} 18 | if FileExists('heap.trc') then 19 | DeleteFile('heap.trc'); 20 | SetHeapTraceOutput('heap.trc'); 21 | {$ENDIF} 22 | RequireDerivedFormResource:=True; 23 | Application.Scaled:=True; 24 | Application.Initialize; 25 | Application.CreateForm(TF2PDFExForm, F2PDFExForm); 26 | Application.Run; 27 | end. 28 | 29 | -------------------------------------------------------------------------------- /F2PDFExample.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/alanphys/Form2PDF/0e5497f9b9e64add31cf45caedc0797a27453055/F2PDFExample.res -------------------------------------------------------------------------------- /f2pdfexunit.lfm: -------------------------------------------------------------------------------- 1 | object F2PDFExForm: TF2PDFExForm 2 | Left = 371 3 | Height = 430 4 | Top = 231 5 | Width = 593 6 | Caption = 'Form to PDF Example' 7 | ClientHeight = 400 8 | ClientWidth = 593 9 | Menu = MainMenu 10 | OnCreate = FormCreate 11 | LCLVersion = '2.2.2.0' 12 | object PageControl1: TPageControl 13 | Left = 0 14 | Height = 377 15 | Top = 0 16 | Width = 593 17 | ActivePage = TabSheet9 18 | Align = alClient 19 | ParentFont = False 20 | TabIndex = 8 21 | TabOrder = 0 22 | object TabSheet1: TTabSheet 23 | Caption = 'Text 1' 24 | ClientHeight = 342 25 | ClientWidth = 589 26 | ParentFont = False 27 | object Image: TImage 28 | Left = 47 29 | Height = 169 30 | Top = 32 31 | Width = 184 32 | Stretch = True 33 | end 34 | object Shape1: TShape 35 | Left = 47 36 | Height = 1 37 | Top = 280 38 | Width = 201 39 | end 40 | object Shape2: TShape 41 | Left = 49 42 | Height = 1 43 | Top = 344 44 | Width = 201 45 | end 46 | object Label1: TLabel 47 | Left = 56 48 | Height = 18 49 | Top = 304 50 | Width = 173 51 | Caption = 'This is an example PDF form' 52 | ParentColor = False 53 | ParentFont = False 54 | end 55 | object Label12: TLabel 56 | Left = 372 57 | Height = 9 58 | Top = 32 59 | Width = 21 60 | Caption = 'Minute' 61 | Font.Height = 6 62 | ParentColor = False 63 | ParentFont = False 64 | end 65 | object Label13: TLabel 66 | Left = 368 67 | Height = 14 68 | Top = 66 69 | Width = 26 70 | Caption = 'Small' 71 | Font.Color = clRed 72 | Font.Height = 10 73 | ParentColor = False 74 | ParentFont = False 75 | end 76 | object Label14: TLabel 77 | Left = 359 78 | Height = 17 79 | Top = 110 80 | Width = 47 81 | Caption = 'Medium' 82 | Font.Color = clGreen 83 | Font.Height = 12 84 | ParentColor = False 85 | ParentFont = False 86 | end 87 | object Label15: TLabel 88 | Left = 369 89 | Height = 23 90 | Top = 155 91 | Width = 25 92 | Caption = 'Big' 93 | Font.Color = clBlue 94 | Font.Height = 16 95 | ParentColor = False 96 | ParentFont = False 97 | end 98 | object Label16: TLabel 99 | Left = 344 100 | Height = 35 101 | Top = 203 102 | Width = 78 103 | Caption = 'Bigger' 104 | Font.Color = clYellow 105 | Font.Height = 25 106 | ParentColor = False 107 | ParentFont = False 108 | end 109 | object Label17: TLabel 110 | Left = 348 111 | Height = 45 112 | Top = 261 113 | Width = 66 114 | Caption = 'Best' 115 | Font.Color = clNavy 116 | Font.Height = 32 117 | ParentColor = False 118 | ParentFont = False 119 | end 120 | object Edit1: TEdit 121 | Left = 47 122 | Height = 32 123 | Top = 229 124 | Width = 227 125 | ParentFont = False 126 | TabOrder = 0 127 | Text = 'Write your text here' 128 | end 129 | object StaticText1: TStaticText 130 | Left = 461 131 | Height = 45 132 | Top = 16 133 | Width = 66 134 | AutoSize = True 135 | Caption = 'Best' 136 | Font.Height = 32 137 | ParentFont = False 138 | TabOrder = 1 139 | end 140 | object StaticText2: TStaticText 141 | Left = 457 142 | Height = 35 143 | Top = 84 144 | Width = 73 145 | AutoSize = True 146 | Caption = 'Better' 147 | Font.Height = 25 148 | ParentFont = False 149 | TabOrder = 2 150 | end 151 | object StaticText3: TStaticText 152 | Left = 485 153 | Height = 20 154 | Top = 143 155 | Width = 22 156 | AutoSize = True 157 | Caption = 'Big' 158 | Font.Height = 14 159 | ParentFont = False 160 | TabOrder = 3 161 | end 162 | object StaticText4: TStaticText 163 | Left = 472 164 | Height = 17 165 | Top = 191 166 | Width = 47 167 | AutoSize = True 168 | Caption = 'Medium' 169 | Font.Height = 12 170 | ParentFont = False 171 | TabOrder = 4 172 | end 173 | object StaticText5: TStaticText 174 | Left = 482 175 | Height = 14 176 | Top = 236 177 | Width = 26 178 | AutoSize = True 179 | Caption = 'Small' 180 | Font.Height = 10 181 | ParentFont = False 182 | TabOrder = 5 183 | end 184 | object StaticText6: TStaticText 185 | Left = 486 186 | Height = 9 187 | Top = 279 188 | Width = 21 189 | AutoSize = True 190 | Caption = 'Minute' 191 | Font.Height = 6 192 | ParentFont = False 193 | TabOrder = 6 194 | end 195 | end 196 | object TabSheet2: TTabSheet 197 | Caption = 'Shapes 2' 198 | ClientHeight = 342 199 | ClientWidth = 589 200 | ParentFont = False 201 | object Label2: TLabel 202 | Left = 184 203 | Height = 18 204 | Top = 320 205 | Width = 198 206 | Caption = 'Shapes lines and colors example' 207 | ParentColor = False 208 | ParentFont = False 209 | end 210 | object Shape3: TShape 211 | Left = 40 212 | Height = 80 213 | Top = 32 214 | Width = 153 215 | Brush.Color = clRed 216 | end 217 | object Shape4: TShape 218 | Left = 300 219 | Height = 80 220 | Top = 31 221 | Width = 153 222 | Brush.Style = bsClear 223 | Pen.Color = clRed 224 | end 225 | object Shape5: TShape 226 | Left = 329 227 | Height = 80 228 | Top = 85 229 | Width = 153 230 | Brush.Style = bsClear 231 | Pen.Color = clBlue 232 | Pen.Style = psDash 233 | end 234 | object Shape6: TShape 235 | Left = 358 236 | Height = 80 237 | Top = 139 238 | Width = 153 239 | Brush.Style = bsClear 240 | Pen.Color = clGreen 241 | Pen.Style = psDashDot 242 | end 243 | object Shape7: TShape 244 | Left = 387 245 | Height = 80 246 | Top = 193 247 | Width = 153 248 | Brush.Style = bsClear 249 | Pen.Style = psDashDotDot 250 | end 251 | object Shape8: TShape 252 | Left = 416 253 | Height = 80 254 | Top = 247 255 | Width = 153 256 | Brush.Style = bsClear 257 | Pen.Style = psDot 258 | end 259 | object Shape9: TShape 260 | Left = 64 261 | Height = 80 262 | Top = 97 263 | Width = 153 264 | Brush.Color = clBlue 265 | Pen.Width = 2 266 | end 267 | object Shape10: TShape 268 | Left = 88 269 | Height = 80 270 | Top = 162 271 | Width = 153 272 | Brush.Color = clGreen 273 | Pen.Width = 4 274 | end 275 | object Shape11: TShape 276 | Left = 112 277 | Height = 80 278 | Top = 227 279 | Width = 153 280 | Pen.Width = 8 281 | end 282 | end 283 | object TabSheet4: TTabSheet 284 | Caption = 'Shapes 3' 285 | ClientHeight = 342 286 | ClientWidth = 589 287 | ParentFont = False 288 | object Shape15: TShape 289 | Left = 16 290 | Height = 304 291 | Top = 8 292 | Width = 490 293 | Brush.Style = bsClear 294 | Shape = stRoundRect 295 | end 296 | object Shape12: TShape 297 | Left = 64 298 | Height = 134 299 | Top = 42 300 | Width = 194 301 | Shape = stRoundRect 302 | end 303 | object Label18: TLabel 304 | Left = 198 305 | Height = 18 306 | Top = 320 307 | Width = 102 308 | Caption = 'Different Shapes' 309 | ParentColor = False 310 | ParentFont = False 311 | end 312 | object Shape13: TShape 313 | Left = 136 314 | Height = 118 315 | Top = 112 316 | Width = 193 317 | Shape = stEllipse 318 | end 319 | object Shape14: TShape 320 | Left = 272 321 | Height = 120 322 | Top = 160 323 | Width = 120 324 | Shape = stEllipse 325 | end 326 | object Shape16: TShape 327 | Left = 344 328 | Height = 32 329 | Top = 64 330 | Width = 40 331 | Shape = stRoundRect 332 | end 333 | end 334 | object TabSheet3: TTabSheet 335 | Caption = 'GroupBox 4' 336 | ClientHeight = 342 337 | ClientWidth = 589 338 | ParentFont = False 339 | object Label3: TLabel 340 | Left = 288 341 | Height = 18 342 | Top = 339 343 | Width = 147 344 | Caption = 'Grouped items example' 345 | ParentColor = False 346 | ParentFont = False 347 | end 348 | object GroupBox1: TGroupBox 349 | Left = 0 350 | Height = 342 351 | Top = 0 352 | Width = 185 353 | Align = alLeft 354 | Caption = 'GroupBox1' 355 | ClientHeight = 312 356 | ClientWidth = 181 357 | ParentFont = False 358 | TabOrder = 0 359 | object Label4: TLabel 360 | Left = 16 361 | Height = 18 362 | Top = 0 363 | Width = 37 364 | Caption = 'Line 1' 365 | ParentColor = False 366 | ParentFont = False 367 | end 368 | object Label5: TLabel 369 | Left = 16 370 | Height = 18 371 | Top = 40 372 | Width = 37 373 | Caption = 'Line 2' 374 | ParentColor = False 375 | ParentFont = False 376 | end 377 | object Label6: TLabel 378 | Left = 16 379 | Height = 18 380 | Top = 120 381 | Width = 38 382 | Caption = 'Line 4' 383 | ParentColor = False 384 | ParentFont = False 385 | end 386 | object Label7: TLabel 387 | Left = 16 388 | Height = 18 389 | Top = 80 390 | Width = 37 391 | Caption = 'Line 3' 392 | ParentColor = False 393 | ParentFont = False 394 | end 395 | object Label8: TLabel 396 | Left = 16 397 | Height = 18 398 | Top = 160 399 | Width = 37 400 | Caption = 'Line 5' 401 | ParentColor = False 402 | ParentFont = False 403 | end 404 | object Label9: TLabel 405 | Left = 16 406 | Height = 18 407 | Top = 200 408 | Width = 37 409 | Caption = 'Line 6' 410 | ParentColor = False 411 | ParentFont = False 412 | end 413 | object Label10: TLabel 414 | Left = 16 415 | Height = 18 416 | Top = 240 417 | Width = 37 418 | Caption = 'Line 7' 419 | ParentColor = False 420 | ParentFont = False 421 | end 422 | object Label11: TLabel 423 | Left = 16 424 | Height = 18 425 | Top = 296 426 | Width = 37 427 | Caption = 'Line 8' 428 | ParentColor = False 429 | ParentFont = False 430 | end 431 | end 432 | object RadioGroup1: TRadioGroup 433 | Left = 185 434 | Height = 174 435 | Top = 0 436 | Width = 392 437 | AutoFill = True 438 | Caption = 'RadioGroup1' 439 | ChildSizing.LeftRightSpacing = 6 440 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 441 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 442 | ChildSizing.ShrinkHorizontal = crsScaleChilds 443 | ChildSizing.ShrinkVertical = crsScaleChilds 444 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 445 | ChildSizing.ControlsPerLine = 1 446 | ClientHeight = 144 447 | ClientWidth = 388 448 | ParentFont = False 449 | TabOrder = 1 450 | object RadioButton5: TRadioButton 451 | Left = 6 452 | Height = 36 453 | Top = 0 454 | Width = 376 455 | Caption = 'RadioButton5' 456 | ParentFont = False 457 | TabOrder = 0 458 | end 459 | object RadioButton6: TRadioButton 460 | Left = 6 461 | Height = 36 462 | Top = 36 463 | Width = 376 464 | Caption = 'RadioButton6' 465 | ParentFont = False 466 | TabOrder = 1 467 | end 468 | object RadioButton7: TRadioButton 469 | Left = 6 470 | Height = 36 471 | Top = 72 472 | Width = 376 473 | Caption = 'RadioButton7' 474 | ParentFont = False 475 | TabOrder = 2 476 | end 477 | object RadioButton8: TRadioButton 478 | Left = 6 479 | Height = 36 480 | Top = 108 481 | Width = 376 482 | Caption = 'RadioButton8' 483 | ParentFont = False 484 | TabOrder = 3 485 | end 486 | end 487 | object CheckGroup1: TCheckGroup 488 | Left = 185 489 | Height = 152 490 | Top = 176 491 | Width = 393 492 | AutoFill = True 493 | Caption = 'CheckGroup1' 494 | ChildSizing.LeftRightSpacing = 6 495 | ChildSizing.TopBottomSpacing = 6 496 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 497 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 498 | ChildSizing.ShrinkHorizontal = crsScaleChilds 499 | ChildSizing.ShrinkVertical = crsScaleChilds 500 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 501 | ChildSizing.ControlsPerLine = 1 502 | ClientHeight = 122 503 | ClientWidth = 389 504 | ParentFont = False 505 | TabOrder = 2 506 | object CheckBox5: TCheckBox 507 | Left = 6 508 | Height = 37 509 | Top = 6 510 | Width = 377 511 | Caption = 'CheckBox5' 512 | ParentFont = False 513 | TabOrder = 0 514 | end 515 | object CheckBox6: TCheckBox 516 | Left = 6 517 | Height = 37 518 | Top = 43 519 | Width = 377 520 | Caption = 'CheckBox6' 521 | ParentFont = False 522 | TabOrder = 1 523 | end 524 | object CheckBox7: TCheckBox 525 | Left = 6 526 | Height = 36 527 | Top = 80 528 | Width = 377 529 | Caption = 'CheckBox7' 530 | ParentFont = False 531 | TabOrder = 2 532 | end 533 | end 534 | end 535 | object TabSheet5: TTabSheet 536 | Caption = 'CheckBoxes 5' 537 | ClientHeight = 342 538 | ClientWidth = 589 539 | ParentFont = False 540 | object Label19: TLabel 541 | Left = 219 542 | Height = 18 543 | Top = 332 544 | Width = 183 545 | Caption = 'Check and Radio box example' 546 | ParentColor = False 547 | ParentFont = False 548 | end 549 | object Panel1: TPanel 550 | Left = 8 551 | Height = 176 552 | Top = 0 553 | Width = 286 554 | ClientHeight = 176 555 | ClientWidth = 286 556 | Color = clMoneyGreen 557 | ParentColor = False 558 | ParentFont = False 559 | TabOrder = 0 560 | object CheckBox1: TCheckBox 561 | Left = 17 562 | Height = 22 563 | Top = 16 564 | Width = 96 565 | Caption = 'CheckBox1' 566 | Color = clDefault 567 | ParentColor = False 568 | ParentFont = False 569 | TabOrder = 0 570 | end 571 | object CheckBox2: TCheckBox 572 | Left = 17 573 | Height = 22 574 | Top = 57 575 | Width = 96 576 | Caption = 'CheckBox2' 577 | ParentFont = False 578 | TabOrder = 1 579 | end 580 | object CheckBox3: TCheckBox 581 | Left = 17 582 | Height = 22 583 | Top = 98 584 | Width = 96 585 | Caption = 'CheckBox3' 586 | ParentFont = False 587 | TabOrder = 2 588 | end 589 | object CheckBox4: TCheckBox 590 | Left = 17 591 | Height = 22 592 | Top = 139 593 | Width = 97 594 | Caption = 'CheckBox4' 595 | ParentFont = False 596 | TabOrder = 3 597 | end 598 | end 599 | object Panel2: TPanel 600 | Left = 296 601 | Height = 176 602 | Top = 0 603 | Width = 288 604 | ClientHeight = 176 605 | ClientWidth = 288 606 | Color = clSkyBlue 607 | ParentColor = False 608 | ParentFont = False 609 | TabOrder = 1 610 | object RadioButton1: TRadioButton 611 | Left = 37 612 | Height = 22 613 | Top = 23 614 | Width = 112 615 | Caption = 'RadioButton1' 616 | ParentFont = False 617 | TabOrder = 0 618 | end 619 | object RadioButton2: TRadioButton 620 | Left = 37 621 | Height = 22 622 | Top = 58 623 | Width = 112 624 | Caption = 'RadioButton2' 625 | ParentFont = False 626 | TabOrder = 1 627 | end 628 | object RadioButton3: TRadioButton 629 | Left = 37 630 | Height = 22 631 | Top = 93 632 | Width = 112 633 | Caption = 'RadioButton3' 634 | ParentFont = False 635 | TabOrder = 2 636 | end 637 | object RadioButton4: TRadioButton 638 | Left = 37 639 | Height = 22 640 | Top = 128 641 | Width = 113 642 | Caption = 'RadioButton4' 643 | ParentFont = False 644 | TabOrder = 3 645 | end 646 | end 647 | object Panel3: TPanel 648 | Left = 9 649 | Height = 76 650 | Top = 184 651 | Width = 570 652 | Caption = 'Panel3' 653 | ClientHeight = 76 654 | ClientWidth = 570 655 | ParentFont = False 656 | TabOrder = 2 657 | object Label67: TLabel 658 | Left = 0 659 | Height = 18 660 | Top = 0 661 | Width = 51 662 | Caption = 'Text Top' 663 | ParentColor = False 664 | end 665 | object Label68: TLabel 666 | Left = 0 667 | Height = 18 668 | Top = 29 669 | Width = 71 670 | Caption = 'Text Middle' 671 | ParentColor = False 672 | end 673 | object Label69: TLabel 674 | Left = 0 675 | Height = 18 676 | Top = 58 677 | Width = 74 678 | Caption = 'Text Bottom' 679 | ParentColor = False 680 | end 681 | end 682 | end 683 | object TabSheet6: TTabSheet 684 | Caption = 'Memo 6' 685 | ClientHeight = 342 686 | ClientWidth = 589 687 | ParentFont = False 688 | object Memo1: TMemo 689 | Left = 0 690 | Height = 342 691 | Top = 0 692 | Width = 589 693 | Align = alClient 694 | Lines.Strings = ( 695 | 'Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor' 696 | 'incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud' 697 | 'exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure' 698 | 'dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. ' 699 | 'Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit ' 700 | 'anim id est laborum.' 701 | '' 702 | 'Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque' 703 | 'laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi ' 704 | 'architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia ' 705 | 'voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui' 706 | 'ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia' 707 | 'dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora' 708 | 'incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima' 709 | 'veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid' 710 | 'ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea' 711 | 'voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat' 712 | 'quo voluptas nulla pariatur?' 713 | '' 714 | 'At vero eos et accusamus et iusto odio dignissimos ducimus qui blanditiis praesentium ' 715 | 'voluptatum deleniti atque corrupti quos dolores et quas molestias excepturi sint ' 716 | 'occaecati cupiditate non provident, similique sunt in culpa qui officia deserunt mollitia' 717 | 'animi, id est laborum et dolorum fuga. Et harum quidem rerum facilis est et expedita ' 718 | 'distinctio. Nam libero tempore, cum soluta nobis est eligendi optio cumque nihil ' 719 | 'impedit quo minus id quod maxime placeat facere possimus, omnis voluptas assumenda ' 720 | 'est, omnis dolor repellendus. Temporibus autem quibusdam et aut officiis debitis aut ' 721 | 'rerum necessitatibus saepe eveniet ut et voluptates repudiandae sint et molestiae non ' 722 | 'recusandae. Itaque earum rerum hic tenetur a sapiente delectus, ut aut reiciendis ' 723 | 'voluptatibus maiores alias consequatur aut perferendis doloribus asperiores repellat.' 724 | '' 725 | '' 726 | '' 727 | 'Maecenas mauris massa, auctor ut nisl nec, suscipit gravida nisi. Nunc volutpat volutpat augue, vel rutrum massa aliquam eu. Integer non congue lorem. Vestibulum sagittis vel turpis id feugiat. Pellentesque condimentum tempor augue. Integer sodales, nunc a feugiat varius, arcu est pretium mauris, sed lacinia augue odio et mi. Nullam malesuada sagittis ultricies. Nulla semper lobortis feugiat. Pellentesque luctus ut nisl eget ornare. Maecenas sit amet aliquam leo, semper viverra nulla. Etiam quis commodo justo.' 728 | '' 729 | 'Donec fermentum est vitae est semper, in laoreet felis sollicitudin. Duis semper tincidunt ipsum vitae hendrerit. Maecenas id massa sagittis, vulputate leo eget, iaculis tortor. Duis eget auctor ante. Mauris ornare nunc nulla, sed aliquam justo scelerisque fringilla. Mauris et nulla et neque tincidunt pellentesque vel sit amet dui. Pellentesque viverra diam ut sagittis bibendum. Praesent varius magna turpis, non lobortis metus sodales eget. Sed tempor egestas interdum. Pellentesque a placerat neque, vitae rutrum felis. Phasellus et auctor diam. Morbi sit amet sodales ex.' 730 | '' 731 | 'Nullam sed nulla maximus leo semper gravida. Fusce ac sodales arcu, ac faucibus nulla. Phasellus a lacus eget ante tempus venenatis quis at mi. Nunc malesuada dignissim lorem, quis pharetra odio sollicitudin a. Curabitur luctus malesuada nibh eget egestas. Nunc tincidunt rutrum ex ultricies laoreet. Curabitur ut accumsan nisi. Duis rhoncus tempus enim eget malesuada. Ut tristique aliquam pharetra. Cras volutpat maximus ipsum, eu fringilla nisl lobortis sit amet. Quisque ligula nisi, volutpat sit amet orci a, viverra efficitur ante. Cras sollicitudin pulvinar efficitur. Maecenas efficitur, odio vitae ornare sagittis, orci sem condimentum est, vel aliquam eros elit id erat. Mauris id risus rutrum, luctus arcu ut, venenatis magna.' 732 | '' 733 | 'Donec turpis metus, interdum non quam molestie, ultrices porttitor purus. Etiam quis ultrices elit, bibendum cursus mauris. Vestibulum rutrum nibh sit amet ex dignissim dignissim. Sed sit amet turpis in massa congue accumsan vitae ut erat. Vestibulum viverra ante vel quam tempus, id laoreet massa finibus. Suspendisse rhoncus dui quam, vitae rutrum mauris tincidunt non. Duis massa turpis, posuere eget varius non, ultricies in arcu. Aenean imperdiet turpis quis lorem sodales finibus. Praesent posuere tellus et pretium commodo. Phasellus mollis massa molestie tellus tempus, pulvinar gravida velit feugiat. Donec quam ligula, accumsan eget urna quis, tincidunt venenatis mauris. Aliquam gravida efficitur enim quis tempor. Vestibulum in rhoncus risus. Proin ultricies condimentum lobortis.' 734 | '' 735 | 'Proin et rhoncus erat. Donec dignissim dolor lacus, nec dictum libero tempus ornare. Proin sagittis sem eros, posuere rutrum urna facilisis non. Nam aliquam justo facilisis, pretium ante nec, ullamcorper metus. Proin volutpat, sapien ac tristique fermentum, est neque tincidunt tellus, ut porta ipsum purus nec ex. Mauris sed posuere odio. Pellentesque rutrum erat eget dui porta porta. Mauris sit amet consectetur nibh. Vestibulum faucibus ornare orci. Sed luctus purus a erat porta, vel accumsan libero porta. Vivamus porttitor ac neque id auctor. Ut vulputate lectus neque. Pellentesque habitant morbi tristique senectus et netus et malesuada fames ac turpis egestas. Fusce a urna a orci ullamcorper tempus sed at libero. ' 736 | ) 737 | ParentFont = False 738 | ScrollBars = ssAutoVertical 739 | TabOrder = 0 740 | end 741 | end 742 | object TabSheet7: TTabSheet 743 | Caption = 'TeeChart 7' 744 | ClientHeight = 342 745 | ClientWidth = 589 746 | ParentFont = False 747 | object Chart1: TChart 748 | Left = 0 749 | Height = 342 750 | Top = 0 751 | Width = 589 752 | AxisList = < 753 | item 754 | Marks.LabelBrush.Style = bsClear 755 | Minors = <> 756 | Title.LabelFont.Orientation = 900 757 | Title.Visible = True 758 | Title.Caption = 'Dummy results' 759 | Title.LabelBrush.Style = bsClear 760 | end 761 | item 762 | Intervals.Count = 1 763 | Intervals.NiceSteps = '|1.0' 764 | Alignment = calBottom 765 | Marks.LabelBrush.Style = bsClear 766 | Minors = < 767 | item 768 | Grid.Visible = False 769 | Intervals.MinLength = 5 770 | Intervals.Options = [aipUseCount, aipUseMinLength] 771 | Marks.LabelBrush.Style = bsClear 772 | end> 773 | Title.Visible = True 774 | Title.Caption = 'Random list' 775 | Title.LabelBrush.Style = bsClear 776 | end> 777 | Foot.Brush.Color = clBtnFace 778 | Foot.Font.Color = clBlue 779 | Title.Brush.Color = clBtnFace 780 | Title.Font.Color = clBlue 781 | Title.Text.Strings = ( 782 | 'TAChart' 783 | ) 784 | Align = alClient 785 | object Chart1LineSeries1: TLineSeries 786 | Source = RandomChartSource1 787 | end 788 | end 789 | end 790 | object TabSheet8: TTabSheet 791 | Caption = 'StringGrid 8' 792 | ClientHeight = 342 793 | ClientWidth = 589 794 | ParentFont = False 795 | object StringGrid2: TStringGrid 796 | Left = 0 797 | Height = 143 798 | Top = 0 799 | Width = 280 800 | ColCount = 4 801 | FixedCols = 0 802 | FixedRows = 0 803 | ParentFont = False 804 | TabOrder = 0 805 | end 806 | object Label20: TLabel 807 | Left = 72 808 | Height = 18 809 | Top = 160 810 | Width = 122 811 | Caption = 'String Grid example' 812 | ParentColor = False 813 | ParentFont = False 814 | end 815 | object StringGrid1: TStringGrid 816 | Left = 296 817 | Height = 321 818 | Top = 0 819 | Width = 280 820 | Columns = < 821 | item 822 | Title.Caption = 'Col A' 823 | end 824 | item 825 | Title.Caption = 'Col B' 826 | end 827 | item 828 | Title.Caption = 'Col C' 829 | Visible = False 830 | end 831 | item 832 | Title.Caption = 'Col D' 833 | end> 834 | ParentFont = False 835 | TabOrder = 1 836 | end 837 | object DateTimePicker1: TDateTimePicker 838 | Left = 64 839 | Height = 26 840 | Top = 216 841 | Width = 153 842 | CenturyFrom = 1941 843 | MaxDate = 2958465 844 | MinDate = -53780 845 | TabOrder = 2 846 | TrailingSeparator = False 847 | TextForNullDate = 'NULL' 848 | LeadingZeros = True 849 | Kind = dtkDateTime 850 | TimeFormat = tf24 851 | TimeDisplay = tdHMS 852 | DateMode = dmComboBox 853 | Date = 44368 854 | Time = 0.508002152775589 855 | UseDefaultSeparators = True 856 | HideDateTimeParts = [] 857 | MonthNames = 'Long' 858 | end 859 | object Label70: TLabel 860 | Left = 76 861 | Height = 18 862 | Top = 272 863 | Width = 118 864 | Caption = 'Date Time example' 865 | ParentColor = False 866 | end 867 | end 868 | object TabSheet9: TTabSheet 869 | Caption = 'Data 9' 870 | ClientHeight = 342 871 | ClientWidth = 589 872 | ParentFont = False 873 | object ListBox1: TListBox 874 | Left = 37 875 | Height = 91 876 | Top = 29 877 | Width = 100 878 | Items.Strings = ( 879 | 'Item A' 880 | 'Item B' 881 | 'Item C' 882 | 'Item D' 883 | 'Item E' 884 | 'Item F' 885 | 'Item G' 886 | 'Item H' 887 | 'Item I' 888 | 'Item J' 889 | 'Item K' 890 | 'Item L' 891 | 'Item M' 892 | 'Item N' 893 | 'Item N' 894 | 'Item O' 895 | 'Item P' 896 | 'Item Q' 897 | 'Item R' 898 | ) 899 | ItemHeight = 24 900 | ParentFont = False 901 | TabOrder = 0 902 | end 903 | object SpinEdit1: TSpinEdit 904 | Left = 38 905 | Height = 32 906 | Top = 187 907 | Width = 50 908 | Alignment = taCenter 909 | ParentFont = False 910 | TabOrder = 1 911 | Value = 20 912 | end 913 | object FloatSpinEdit1: TFloatSpinEdit 914 | Left = 38 915 | Height = 32 916 | Top = 231 917 | Width = 50 918 | ParentFont = False 919 | TabOrder = 2 920 | Value = 9.81 921 | end 922 | object FloatSpinEdit2: TFloatSpinEdit 923 | Left = 38 924 | Height = 32 925 | Top = 275 926 | Width = 50 927 | Alignment = taRightJustify 928 | ParentFont = False 929 | ParentShowHint = False 930 | ShowHint = True 931 | TabOrder = 3 932 | Value = 3.15 933 | end 934 | object SpinEdit2: TSpinEdit 935 | Left = 38 936 | Height = 32 937 | Top = 143 938 | Width = 50 939 | Alignment = taRightJustify 940 | ParentFont = False 941 | TabOrder = 4 942 | Value = 10 943 | end 944 | object ComboBox1: TComboBox 945 | Left = 166 946 | Height = 32 947 | Top = 16 948 | Width = 156 949 | ItemHeight = 24 950 | Items.Strings = ( 951 | 'Item A' 952 | 'Item B' 953 | 'Item C' 954 | 'Item D' 955 | 'Item E' 956 | 'Item F' 957 | 'Item J' 958 | 'Item K' 959 | 'Item L' 960 | 'Item M' 961 | 'Item N' 962 | 'Item N' 963 | 'Item O' 964 | 'Item P' 965 | 'Item Q' 966 | 'Item R' 967 | ) 968 | ParentFont = False 969 | TabOrder = 5 970 | Text = 'Select Item' 971 | end 972 | object SpinEditEx1: TSpinEditEx 973 | Left = 166 974 | Height = 32 975 | Top = 53 976 | Width = 103 977 | Alignment = taLeftJustify 978 | Color = clDefault 979 | MaxLength = 0 980 | ParentColor = True 981 | ParentFont = False 982 | TabOrder = 6 983 | NullValue = 0 984 | Value = 15 985 | end 986 | object SpinEditEx2: TSpinEditEx 987 | Left = 166 988 | Height = 32 989 | Top = 102 990 | Width = 103 991 | Color = clDefault 992 | MaxLength = 0 993 | ParentColor = True 994 | ParentFont = False 995 | TabOrder = 7 996 | NullValue = 0 997 | Value = 5 998 | end 999 | object FloatSpinEditEx1: TFloatSpinEditEx 1000 | Left = 166 1001 | Height = 32 1002 | Top = 151 1003 | Width = 103 1004 | Alignment = taCenter 1005 | Color = clDefault 1006 | MaxLength = 0 1007 | ParentColor = True 1008 | ParentFont = False 1009 | TabOrder = 8 1010 | Value = 6.67 1011 | end 1012 | object FloatSpinEditEx2: TFloatSpinEditEx 1013 | Left = 166 1014 | Height = 32 1015 | Top = 200 1016 | Width = 103 1017 | Alignment = taCenter 1018 | Color = clDefault 1019 | MaxLength = 0 1020 | ParentColor = True 1021 | ParentFont = False 1022 | TabOrder = 9 1023 | Value = 3.33 1024 | end 1025 | object Label21: TLabel 1026 | Left = 215 1027 | Height = 18 1028 | Top = 322 1029 | Width = 119 1030 | Caption = 'Data Entry Controls' 1031 | ParentColor = False 1032 | ParentFont = False 1033 | end 1034 | object FileNameEdit1: TFileNameEdit 1035 | Left = 137 1036 | Height = 32 1037 | Top = 239 1038 | Width = 423 1039 | FileName = 'FileNameEdit1' 1040 | FilterIndex = 0 1041 | HideDirectories = False 1042 | ButtonWidth = 23 1043 | NumGlyphs = 1 1044 | Alignment = taRightJustify 1045 | Color = clDefault 1046 | MaxLength = 0 1047 | ParentColor = True 1048 | ParentFont = False 1049 | TabOrder = 10 1050 | Text = 'FileNameEdit1' 1051 | end 1052 | object DirectoryEdit1: TDirectoryEdit 1053 | Left = 137 1054 | Height = 32 1055 | Top = 281 1056 | Width = 423 1057 | Directory = 'DirectoryEdit1' 1058 | ShowHidden = False 1059 | ButtonWidth = 23 1060 | NumGlyphs = 1 1061 | Color = clDefault 1062 | MaxLength = 0 1063 | ParentColor = True 1064 | ParentFont = False 1065 | TabOrder = 11 1066 | Text = 'DirectoryEdit1' 1067 | end 1068 | object ValueListEditor1: TValueListEditor 1069 | Left = 352 1070 | Height = 209 1071 | Top = 16 1072 | Width = 216 1073 | FixedCols = 0 1074 | ParentFont = False 1075 | RowCount = 12 1076 | TabOrder = 12 1077 | Strings.Strings = ( 1078 | 'Key 1=10' 1079 | 'Key 2=20' 1080 | 'Key 3=30' 1081 | 'Key 4=40' 1082 | 'Key 5=50' 1083 | 'Key 6=60' 1084 | 'Key 7=70' 1085 | 'Key 8=80' 1086 | 'Key 9=90' 1087 | 'Key 10=100' 1088 | 'Key 11=110' 1089 | ) 1090 | ColWidths = ( 1091 | 64 1092 | 127 1093 | ) 1094 | end 1095 | end 1096 | object TabSheet10: TTabSheet 1097 | Caption = 'Fonts 10' 1098 | ClientHeight = 342 1099 | ClientWidth = 589 1100 | ParentFont = False 1101 | object Label22: TLabel 1102 | Left = 27 1103 | Height = 17 1104 | Top = 20 1105 | Width = 222 1106 | AutoSize = False 1107 | Caption = 'System font' 1108 | ParentColor = False 1109 | ParentFont = False 1110 | end 1111 | object Label23: TLabel 1112 | Left = 27 1113 | Height = 15 1114 | Top = 60 1115 | Width = 222 1116 | AutoSize = False 1117 | Caption = 'Arial' 1118 | Font.Name = 'Arial' 1119 | ParentColor = False 1120 | ParentFont = False 1121 | end 1122 | object Label24: TLabel 1123 | Left = 27 1124 | Height = 15 1125 | Top = 99 1126 | Width = 222 1127 | AutoSize = False 1128 | Caption = 'Arial Italic' 1129 | Font.Name = 'Arial' 1130 | Font.Style = [fsItalic] 1131 | ParentColor = False 1132 | ParentFont = False 1133 | end 1134 | object Label25: TLabel 1135 | Left = 27 1136 | Height = 15 1137 | Top = 137 1138 | Width = 222 1139 | AutoSize = False 1140 | Caption = 'Arial Bold' 1141 | Font.Name = 'Arial' 1142 | Font.Style = [fsBold] 1143 | ParentColor = False 1144 | ParentFont = False 1145 | end 1146 | object Label26: TLabel 1147 | Left = 27 1148 | Height = 15 1149 | Top = 177 1150 | Width = 222 1151 | AutoSize = False 1152 | Caption = 'Times New Roman' 1153 | Font.Name = 'Times New Roman' 1154 | ParentColor = False 1155 | ParentFont = False 1156 | end 1157 | object Label27: TLabel 1158 | Left = 27 1159 | Height = 15 1160 | Top = 216 1161 | Width = 222 1162 | AutoSize = False 1163 | Caption = 'Times New Roman Italic' 1164 | Font.Name = 'Times New Roman' 1165 | Font.Style = [fsItalic] 1166 | ParentColor = False 1167 | ParentFont = False 1168 | end 1169 | object Label28: TLabel 1170 | Left = 27 1171 | Height = 15 1172 | Top = 256 1173 | Width = 222 1174 | AutoSize = False 1175 | Caption = 'Time New Roman Bold' 1176 | Font.Name = 'Times New Roman' 1177 | Font.Style = [fsBold] 1178 | ParentColor = False 1179 | ParentFont = False 1180 | end 1181 | object Label29: TLabel 1182 | Left = 287 1183 | Height = 17 1184 | Top = 22 1185 | Width = 222 1186 | AutoSize = False 1187 | Caption = 'Standard sans serif font' 1188 | Font.Name = 'Sans Serif' 1189 | ParentColor = False 1190 | ParentFont = False 1191 | end 1192 | object Label30: TLabel 1193 | Left = 287 1194 | Height = 17 1195 | Top = 62 1196 | Width = 222 1197 | AutoSize = False 1198 | Caption = 'Standard sans serif font italic' 1199 | Font.Name = 'Sans Serif' 1200 | Font.Style = [fsItalic] 1201 | ParentColor = False 1202 | ParentFont = False 1203 | end 1204 | object Label31: TLabel 1205 | Left = 287 1206 | Height = 17 1207 | Top = 101 1208 | Width = 222 1209 | AutoSize = False 1210 | Caption = 'Standard sans serif font Bold' 1211 | Font.Name = 'Sans Serif' 1212 | Font.Style = [fsBold] 1213 | ParentColor = False 1214 | ParentFont = False 1215 | end 1216 | object Label32: TLabel 1217 | Left = 287 1218 | Height = 17 1219 | Top = 139 1220 | Width = 222 1221 | AutoSize = False 1222 | Caption = 'Standard serif font' 1223 | Font.Name = 'Serif' 1224 | ParentColor = False 1225 | ParentFont = False 1226 | end 1227 | object Label33: TLabel 1228 | Left = 287 1229 | Height = 17 1230 | Top = 179 1231 | Width = 222 1232 | AutoSize = False 1233 | Caption = 'Standard serif font Italic' 1234 | Font.Name = 'Serif' 1235 | Font.Style = [fsItalic] 1236 | ParentColor = False 1237 | ParentFont = False 1238 | end 1239 | object Label34: TLabel 1240 | Left = 287 1241 | Height = 17 1242 | Top = 218 1243 | Width = 222 1244 | AutoSize = False 1245 | Caption = 'Standard serif font Bold' 1246 | Font.Name = 'Serif' 1247 | Font.Style = [fsBold] 1248 | ParentColor = False 1249 | ParentFont = False 1250 | end 1251 | object Label35: TLabel 1252 | Left = 287 1253 | Height = 17 1254 | Top = 258 1255 | Width = 222 1256 | AutoSize = False 1257 | Caption = 'Some strange font' 1258 | ParentColor = False 1259 | ParentFont = False 1260 | end 1261 | object Label36: TLabel 1262 | Left = 243 1263 | Height = 18 1264 | Top = 307 1265 | Width = 109 1266 | Caption = 'Fonts left justified' 1267 | ParentColor = False 1268 | ParentFont = False 1269 | end 1270 | end 1271 | object TabSheet11: TTabSheet 1272 | Caption = 'Fonts 11' 1273 | ClientHeight = 342 1274 | ClientWidth = 589 1275 | ParentFont = False 1276 | object Label37: TLabel 1277 | Left = 24 1278 | Height = 16 1279 | Top = 34 1280 | Width = 222 1281 | Alignment = taRightJustify 1282 | AutoSize = False 1283 | Caption = 'System font' 1284 | ParentColor = False 1285 | ParentFont = False 1286 | end 1287 | object Label38: TLabel 1288 | Left = 24 1289 | Height = 14 1290 | Top = 71 1291 | Width = 222 1292 | Alignment = taRightJustify 1293 | AutoSize = False 1294 | Caption = 'Arial' 1295 | Font.Name = 'Arial' 1296 | ParentColor = False 1297 | ParentFont = False 1298 | end 1299 | object Label39: TLabel 1300 | Left = 24 1301 | Height = 14 1302 | Top = 105 1303 | Width = 222 1304 | Alignment = taRightJustify 1305 | AutoSize = False 1306 | Caption = 'Arial Italic' 1307 | Font.Name = 'Arial' 1308 | Font.Style = [fsItalic] 1309 | ParentColor = False 1310 | ParentFont = False 1311 | end 1312 | object Label40: TLabel 1313 | Left = 24 1314 | Height = 14 1315 | Top = 140 1316 | Width = 222 1317 | Alignment = taRightJustify 1318 | AutoSize = False 1319 | Caption = 'Arial Bold' 1320 | Font.Name = 'Arial' 1321 | Font.Style = [fsBold] 1322 | ParentColor = False 1323 | ParentFont = False 1324 | end 1325 | object Label41: TLabel 1326 | Left = 24 1327 | Height = 14 1328 | Top = 175 1329 | Width = 222 1330 | Alignment = taRightJustify 1331 | AutoSize = False 1332 | Caption = 'Times New Roman' 1333 | Font.Name = 'Times New Roman' 1334 | ParentColor = False 1335 | ParentFont = False 1336 | end 1337 | object Label42: TLabel 1338 | Left = 24 1339 | Height = 14 1340 | Top = 209 1341 | Width = 222 1342 | Alignment = taRightJustify 1343 | AutoSize = False 1344 | Caption = 'Times New Roman Italic' 1345 | Font.Name = 'Times New Roman' 1346 | Font.Style = [fsItalic] 1347 | ParentColor = False 1348 | ParentFont = False 1349 | end 1350 | object Label43: TLabel 1351 | Left = 315 1352 | Height = 17 1353 | Top = 34 1354 | Width = 222 1355 | Alignment = taRightJustify 1356 | AutoSize = False 1357 | Caption = 'Standard San Serif Font' 1358 | Font.Name = 'Sans Serif' 1359 | ParentColor = False 1360 | ParentFont = False 1361 | end 1362 | object Label44: TLabel 1363 | Left = 315 1364 | Height = 17 1365 | Top = 71 1366 | Width = 222 1367 | Alignment = taRightJustify 1368 | AutoSize = False 1369 | Caption = 'Standard Sans Serif Font Italic' 1370 | Font.Name = 'Sans Serif' 1371 | Font.Style = [fsItalic] 1372 | ParentColor = False 1373 | ParentFont = False 1374 | end 1375 | object Label45: TLabel 1376 | Left = 315 1377 | Height = 17 1378 | Top = 105 1379 | Width = 222 1380 | Alignment = taRightJustify 1381 | AutoSize = False 1382 | Caption = 'Standard Sans Serif Font Bold' 1383 | Font.Name = 'Sans Serif' 1384 | Font.Style = [fsBold] 1385 | ParentColor = False 1386 | ParentFont = False 1387 | end 1388 | object Label46: TLabel 1389 | Left = 315 1390 | Height = 17 1391 | Top = 140 1392 | Width = 222 1393 | Alignment = taRightJustify 1394 | AutoSize = False 1395 | Caption = 'Standard Serif Font' 1396 | Font.Name = 'Serif' 1397 | ParentColor = False 1398 | ParentFont = False 1399 | end 1400 | object Label47: TLabel 1401 | Left = 315 1402 | Height = 17 1403 | Top = 175 1404 | Width = 222 1405 | Alignment = taRightJustify 1406 | AutoSize = False 1407 | Caption = 'Standard Serif Font Italic' 1408 | Font.Name = 'Serif' 1409 | Font.Style = [fsItalic] 1410 | ParentColor = False 1411 | ParentFont = False 1412 | end 1413 | object Label48: TLabel 1414 | Left = 315 1415 | Height = 17 1416 | Top = 209 1417 | Width = 222 1418 | Alignment = taRightJustify 1419 | AutoSize = False 1420 | Caption = 'Standard Serif Font Bold' 1421 | Font.Name = 'Serif' 1422 | Font.Style = [fsBold] 1423 | ParentColor = False 1424 | ParentFont = False 1425 | end 1426 | object Label51: TLabel 1427 | Left = 24 1428 | Height = 14 1429 | Top = 244 1430 | Width = 222 1431 | Alignment = taRightJustify 1432 | AutoSize = False 1433 | Caption = 'Times New Roman Bold' 1434 | Font.Name = 'Times New Roman' 1435 | Font.Style = [fsBold] 1436 | ParentColor = False 1437 | ParentFont = False 1438 | end 1439 | object Label52: TLabel 1440 | Left = 315 1441 | Height = 17 1442 | Top = 244 1443 | Width = 222 1444 | Alignment = taRightJustify 1445 | AutoSize = False 1446 | Caption = 'Some strange font' 1447 | ParentColor = False 1448 | ParentFont = False 1449 | end 1450 | object Label53: TLabel 1451 | Left = 259 1452 | Height = 18 1453 | Top = 299 1454 | Width = 119 1455 | Caption = 'Fonts right justified' 1456 | ParentColor = False 1457 | ParentFont = False 1458 | end 1459 | end 1460 | object TabSheet12: TTabSheet 1461 | Caption = 'Font 12' 1462 | ClientHeight = 342 1463 | ClientWidth = 589 1464 | ParentFont = False 1465 | object Label49: TLabel 1466 | Left = 24 1467 | Height = 16 1468 | Top = 34 1469 | Width = 222 1470 | Alignment = taCenter 1471 | AutoSize = False 1472 | Caption = 'System font' 1473 | ParentColor = False 1474 | ParentFont = False 1475 | end 1476 | object Label50: TLabel 1477 | Left = 24 1478 | Height = 14 1479 | Top = 71 1480 | Width = 222 1481 | Alignment = taCenter 1482 | AutoSize = False 1483 | Caption = 'Arial' 1484 | Font.Name = 'Arial' 1485 | ParentColor = False 1486 | ParentFont = False 1487 | end 1488 | object Label54: TLabel 1489 | Left = 24 1490 | Height = 14 1491 | Top = 105 1492 | Width = 222 1493 | Alignment = taCenter 1494 | AutoSize = False 1495 | Caption = 'Arial Italic' 1496 | Font.Name = 'Arial' 1497 | Font.Style = [fsItalic] 1498 | ParentColor = False 1499 | ParentFont = False 1500 | end 1501 | object Label55: TLabel 1502 | Left = 24 1503 | Height = 14 1504 | Top = 175 1505 | Width = 222 1506 | Alignment = taCenter 1507 | AutoSize = False 1508 | Caption = 'Times New Roman' 1509 | Font.Name = 'Times New Roman' 1510 | ParentColor = False 1511 | ParentFont = False 1512 | end 1513 | object Label56: TLabel 1514 | Left = 24 1515 | Height = 14 1516 | Top = 140 1517 | Width = 222 1518 | Alignment = taCenter 1519 | AutoSize = False 1520 | Caption = 'Arial Bold' 1521 | Font.Name = 'Arial' 1522 | Font.Style = [fsBold] 1523 | ParentColor = False 1524 | ParentFont = False 1525 | end 1526 | object Label57: TLabel 1527 | Left = 24 1528 | Height = 14 1529 | Top = 209 1530 | Width = 222 1531 | Alignment = taCenter 1532 | AutoSize = False 1533 | Caption = 'Times New Roman Italic' 1534 | Font.Name = 'Times New Roman' 1535 | Font.Style = [fsItalic] 1536 | ParentColor = False 1537 | ParentFont = False 1538 | end 1539 | object Label58: TLabel 1540 | Left = 24 1541 | Height = 14 1542 | Top = 244 1543 | Width = 222 1544 | Alignment = taCenter 1545 | AutoSize = False 1546 | Caption = 'Times New Roman Bold' 1547 | Font.Name = 'Times New Roman' 1548 | Font.Style = [fsBold] 1549 | ParentColor = False 1550 | ParentFont = False 1551 | end 1552 | object Label59: TLabel 1553 | Left = 315 1554 | Height = 17 1555 | Top = 34 1556 | Width = 222 1557 | Alignment = taCenter 1558 | AutoSize = False 1559 | Caption = 'Standard San Serif Font' 1560 | Font.Name = 'Sans Serif' 1561 | ParentColor = False 1562 | ParentFont = False 1563 | end 1564 | object Label60: TLabel 1565 | Left = 315 1566 | Height = 17 1567 | Top = 71 1568 | Width = 222 1569 | Alignment = taCenter 1570 | AutoSize = False 1571 | Caption = 'Standard Sans Serif Font Italic' 1572 | Font.Name = 'Sans Serif' 1573 | Font.Style = [fsItalic] 1574 | ParentColor = False 1575 | ParentFont = False 1576 | end 1577 | object Label61: TLabel 1578 | Left = 315 1579 | Height = 17 1580 | Top = 105 1581 | Width = 222 1582 | Alignment = taCenter 1583 | AutoSize = False 1584 | Caption = 'Standard Sans Serif Font Bold' 1585 | Font.Name = 'Sans Serif' 1586 | Font.Style = [fsBold] 1587 | ParentColor = False 1588 | ParentFont = False 1589 | end 1590 | object Label62: TLabel 1591 | Left = 315 1592 | Height = 17 1593 | Top = 140 1594 | Width = 222 1595 | Alignment = taCenter 1596 | AutoSize = False 1597 | Caption = 'Standard Serif Font' 1598 | Font.Name = 'Serif' 1599 | ParentColor = False 1600 | ParentFont = False 1601 | end 1602 | object Label63: TLabel 1603 | Left = 315 1604 | Height = 17 1605 | Top = 175 1606 | Width = 222 1607 | Alignment = taCenter 1608 | AutoSize = False 1609 | Caption = 'Standard Serif Font Italic' 1610 | Font.Name = 'Serif' 1611 | Font.Style = [fsItalic] 1612 | ParentColor = False 1613 | ParentFont = False 1614 | end 1615 | object Label64: TLabel 1616 | Left = 315 1617 | Height = 17 1618 | Top = 209 1619 | Width = 222 1620 | Alignment = taCenter 1621 | AutoSize = False 1622 | Caption = 'Standard Serif Font Bold' 1623 | Font.Name = 'Serif' 1624 | Font.Style = [fsBold] 1625 | ParentColor = False 1626 | ParentFont = False 1627 | end 1628 | object Label65: TLabel 1629 | Left = 315 1630 | Height = 17 1631 | Top = 244 1632 | Width = 222 1633 | Alignment = taCenter 1634 | AutoSize = False 1635 | Caption = 'Some strange font' 1636 | ParentColor = False 1637 | ParentFont = False 1638 | end 1639 | object Label66: TLabel 1640 | Left = 259 1641 | Height = 18 1642 | Top = 299 1643 | Width = 91 1644 | Caption = 'Fonts centered' 1645 | ParentColor = False 1646 | ParentFont = False 1647 | end 1648 | end 1649 | end 1650 | object StatusBar: TStatusBar 1651 | Left = 0 1652 | Height = 23 1653 | Top = 377 1654 | Width = 593 1655 | Panels = <> 1656 | ParentFont = False 1657 | end 1658 | object RandomChartSource1: TRandomChartSource 1659 | PointsNumber = 10 1660 | RandomX = True 1661 | RandSeed = 840426996 1662 | XCount = 10 1663 | XMax = 10 1664 | YMax = 10 1665 | Left = 517 1666 | Top = 323 1667 | end 1668 | object MainMenu: TMainMenu 1669 | Left = 16 1670 | Top = 356 1671 | object miPrintAll: TMenuItem 1672 | Caption = '&Print All' 1673 | OnClick = miPrintAllClick 1674 | end 1675 | object miPrintActive: TMenuItem 1676 | Caption = 'Print &Active Page' 1677 | OnClick = miPrintActiveClick 1678 | end 1679 | object miPrintSel: TMenuItem 1680 | Caption = 'Print &Selected' 1681 | OnClick = miPrintSelClick 1682 | end 1683 | end 1684 | end 1685 | -------------------------------------------------------------------------------- /f2pdfexunit.pas: -------------------------------------------------------------------------------- 1 | unit f2pdfexunit; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, 9 | ComCtrls, Grids, Menus, Spin, EditBtn, ValEdit, TAGraph, TASources, TASeries, 10 | SpinEx, DateTimePicker; 11 | 12 | type 13 | 14 | { TF2PDFExForm } 15 | 16 | TF2PDFExForm = class(TForm) 17 | Chart1: TChart; 18 | Chart1LineSeries1: TLineSeries; 19 | CheckBox1: TCheckBox; 20 | CheckBox2: TCheckBox; 21 | CheckBox3: TCheckBox; 22 | CheckBox4: TCheckBox; 23 | CheckBox5: TCheckBox; 24 | CheckBox6: TCheckBox; 25 | CheckBox7: TCheckBox; 26 | CheckGroup1: TCheckGroup; 27 | ComboBox1: TComboBox; 28 | DateTimePicker1: TDateTimePicker; 29 | DirectoryEdit1: TDirectoryEdit; 30 | Edit1: TEdit; 31 | FileNameEdit1: TFileNameEdit; 32 | FloatSpinEdit1: TFloatSpinEdit; 33 | FloatSpinEdit2: TFloatSpinEdit; 34 | FloatSpinEditEx1: TFloatSpinEditEx; 35 | FloatSpinEditEx2: TFloatSpinEditEx; 36 | GroupBox1: TGroupBox; 37 | Image: TImage; 38 | Label1: TLabel; 39 | Label10: TLabel; 40 | Label11: TLabel; 41 | Label12: TLabel; 42 | Label13: TLabel; 43 | Label14: TLabel; 44 | Label15: TLabel; 45 | Label16: TLabel; 46 | Label17: TLabel; 47 | Label18: TLabel; 48 | Label19: TLabel; 49 | Label2: TLabel; 50 | Label20: TLabel; 51 | Label21: TLabel; 52 | Label22: TLabel; 53 | Label23: TLabel; 54 | Label24: TLabel; 55 | Label25: TLabel; 56 | Label26: TLabel; 57 | Label27: TLabel; 58 | Label28: TLabel; 59 | Label29: TLabel; 60 | Label3: TLabel; 61 | Label30: TLabel; 62 | Label31: TLabel; 63 | Label32: TLabel; 64 | Label33: TLabel; 65 | Label34: TLabel; 66 | Label35: TLabel; 67 | Label36: TLabel; 68 | Label37: TLabel; 69 | Label38: TLabel; 70 | Label39: TLabel; 71 | Label4: TLabel; 72 | Label40: TLabel; 73 | Label41: TLabel; 74 | Label42: TLabel; 75 | Label43: TLabel; 76 | Label44: TLabel; 77 | Label45: TLabel; 78 | Label46: TLabel; 79 | Label47: TLabel; 80 | Label48: TLabel; 81 | Label49: TLabel; 82 | Label5: TLabel; 83 | Label50: TLabel; 84 | Label51: TLabel; 85 | Label52: TLabel; 86 | Label53: TLabel; 87 | Label54: TLabel; 88 | Label55: TLabel; 89 | Label56: TLabel; 90 | Label57: TLabel; 91 | Label58: TLabel; 92 | Label59: TLabel; 93 | Label6: TLabel; 94 | Label60: TLabel; 95 | Label61: TLabel; 96 | Label62: TLabel; 97 | Label63: TLabel; 98 | Label64: TLabel; 99 | Label65: TLabel; 100 | Label66: TLabel; 101 | Label67: TLabel; 102 | Label68: TLabel; 103 | Label69: TLabel; 104 | Label7: TLabel; 105 | Label70: TLabel; 106 | Label8: TLabel; 107 | Label9: TLabel; 108 | ListBox1: TListBox; 109 | MainMenu: TMainMenu; 110 | Memo1: TMemo; 111 | miPrintSel: TMenuItem; 112 | miPrintActive: TMenuItem; 113 | miPrintAll: TMenuItem; 114 | PageControl1: TPageControl; 115 | Panel1: TPanel; 116 | Panel2: TPanel; 117 | Panel3: TPanel; 118 | RadioButton1: TRadioButton; 119 | RadioButton2: TRadioButton; 120 | RadioButton3: TRadioButton; 121 | RadioButton4: TRadioButton; 122 | RadioButton5: TRadioButton; 123 | RadioButton6: TRadioButton; 124 | RadioButton7: TRadioButton; 125 | RadioButton8: TRadioButton; 126 | RadioGroup1: TRadioGroup; 127 | RandomChartSource1: TRandomChartSource; 128 | Shape1: TShape; 129 | Shape10: TShape; 130 | Shape11: TShape; 131 | Shape12: TShape; 132 | Shape13: TShape; 133 | Shape14: TShape; 134 | Shape15: TShape; 135 | Shape16: TShape; 136 | Shape2: TShape; 137 | Shape3: TShape; 138 | Shape4: TShape; 139 | Shape5: TShape; 140 | Shape6: TShape; 141 | Shape7: TShape; 142 | Shape8: TShape; 143 | Shape9: TShape; 144 | SpinEdit1: TSpinEdit; 145 | SpinEdit2: TSpinEdit; 146 | SpinEditEx1: TSpinEditEx; 147 | SpinEditEx2: TSpinEditEx; 148 | StaticText1: TStaticText; 149 | StaticText2: TStaticText; 150 | StaticText3: TStaticText; 151 | StaticText4: TStaticText; 152 | StaticText5: TStaticText; 153 | StaticText6: TStaticText; 154 | StatusBar: TStatusBar; 155 | StringGrid2: TStringGrid; 156 | StringGrid1: TStringGrid; 157 | TabSheet1: TTabSheet; 158 | TabSheet10: TTabSheet; 159 | TabSheet11: TTabSheet; 160 | TabSheet12: TTabSheet; 161 | TabSheet2: TTabSheet; 162 | TabSheet3: TTabSheet; 163 | TabSheet4: TTabSheet; 164 | TabSheet5: TTabSheet; 165 | TabSheet6: TTabSheet; 166 | TabSheet7: TTabSheet; 167 | TabSheet8: TTabSheet; 168 | TabSheet9: TTabSheet; 169 | ValueListEditor1: TValueListEditor; 170 | procedure FormCreate(Sender: TObject); 171 | procedure miPrintActiveClick(Sender: TObject); 172 | procedure miPrintAllClick(Sender: TObject); 173 | procedure miPrintSelClick(Sender: TObject); 174 | private 175 | 176 | public 177 | 178 | end; 179 | 180 | var 181 | F2PDFExForm: TF2PDFExForm; 182 | 183 | implementation 184 | 185 | uses form2pdf, StrUtils; 186 | 187 | {$R *.lfm} 188 | 189 | { TF2PDFExForm } 190 | 191 | procedure TF2PDFExForm.FormCreate(Sender: TObject); 192 | var I,J :integer; 193 | begin 194 | Image.Picture.LoadFromFile('images/lena.bmp'); 195 | for I:=0 to StringGrid2.RowCount - 1 do 196 | for J:=0 to StringGrid2.ColCount - 1 do 197 | StringGrid2.Cells[J,I] := IntToStr(I+J*J); 198 | 199 | StringGrid1.RowCount := 25; 200 | for I:=1 to StringGrid1.RowCount - 1 do 201 | begin 202 | StringGrid1.Cells[0,I] := IntToStr(I); 203 | for J:=1 to StringGrid1.ColCount - 1 do 204 | StringGrid1.Cells[J,I] := IntToStr(I+J); 205 | end; 206 | 207 | end; 208 | 209 | procedure TF2PDFExForm.miPrintActiveClick(Sender: TObject); 210 | begin 211 | FormToPDF; 212 | FDoc.SetMargins(0,0,36,36,36,36); 213 | StatusBar.SimpleText := IntToStr(FormToPDF(PageControl1.ActivePage,'test.pdf')) 214 | + ' objects printed' 215 | end; 216 | 217 | procedure TF2PDFExForm.miPrintAllClick(Sender: TObject); 218 | begin 219 | if FormToPDF = 0 then 220 | StatusBar.SimpleText := IntToStr(FormToPDF(F2PDFExForm,'test.pdf')) + ' objects printed' 221 | else 222 | StatusBar.SimpleText := 'Sorry, no fonts available' ; 223 | end; 224 | 225 | 226 | procedure TF2PDFExForm.miPrintSelClick(Sender: TObject); 227 | var sTabs :string; 228 | ObjectCount, 229 | TabIndex :integer; 230 | begin 231 | sTabs := '1,2,3,4,5,6,7,8,9'; 232 | ObjectCount := 0; 233 | if InputQuery('Please select tabs to be printed','Enter the tab numbers delimited by commas', 234 | sTabs) then 235 | try 236 | FormToPDF; 237 | FDoc.SetMargins(0,36,36,36,36,36); 238 | while sTabs <> '' do 239 | begin 240 | TabIndex := StrToInt(Copy2SymbDel(sTabs,',')) - 1; 241 | ObjectCount := ObjectCount + FormToPDF(PageControl1.Pages[TabIndex]); 242 | end; 243 | StatusBar.SimpleText := IntToStr(FormToPDF('test.pdf')) + ' objects printed' 244 | except 245 | StatusBar.SimpleText := 'Sorry, not a valid tab list'; 246 | end; 247 | end; 248 | 249 | 250 | end. 251 | 252 | -------------------------------------------------------------------------------- /form2pdf.pas: -------------------------------------------------------------------------------- 1 | unit form2pdf; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | {Copyright Alan Chamberlain 2021 6 | 7 | This unit renders the text and image components of a form to a PDF using the 8 | fcl-pdf package. The object is not to provide a pixel by pixel representation of 9 | the form, but to record the text and image information. Multiline controls such 10 | as TStringGrid and TMemo are printed out in their entirety. the unit is 11 | modularised so new components can be added easily. Supported components are: 12 | TForm 13 | TLabel 14 | TStaticText 15 | TEdit 16 | TSpinEdit 17 | TFloatSpinEdit 18 | TSpinEditEx 19 | TFloatSpinEditEx 20 | TDirectoryEdit 21 | TFileNameEdit 22 | TComboBox 23 | TListBox 24 | TStringGrid 25 | TValueListEditor 26 | TMemo (does not support word wrapping) 27 | TCheckBox 28 | TRadioButton 29 | TImage 30 | TChart 31 | TShape (rectangle, rounded rect, ellipse) 32 | TPageControl 33 | TTabSheet 34 | TGroupBox 35 | TPanel 36 | TRadioGroup 37 | TCheckGroup 38 | TScrollbox 39 | TDateTime 40 | 41 | To use copy form2pdf.pas into your source directory and include Form2PDF in 42 | your uses clause. Any visual control can be passed as a parent eg. TTabControl. 43 | 44 | Licence: Apache v2.0 45 | 46 | History 47 | 26/6/2020 Initial commit. 48 | 3/7/2020 Fix bottom margin pagination. 49 | 5/07/2020 (TvS):moved initialization of FormToPDF to initalization part of unit 50 | 6/7/2020 changed FormToPDF to function to return error code 51 | added control and filename checks 52 | 8/7/2020 add functionality to append pages to document, FDoc now global 53 | 13/7/2020 load and use system fonts 54 | 15/7/2020 add text alignment for labels 55 | 17/7/2020 add text alignment for spinedits 56 | add Panel caption 57 | 5/8/2020 add hide string grid columns 58 | 6/8/2020 fix string grid fixed cols bug 59 | add consistent margin schema 60 | 17/12/2020 use rounded rect for smoother appearance 61 | fix TStringGrid no columns bug 62 | 18/12/2020 fix TStringGrid extend beyond end of control 63 | 14/6/2021 add TScrollbox 64 | fix groupbox (inc radiogroup and checkgroup) item spacing start 65 | fix add metadata 66 | 17/6/2021 fix off by one on panel and groupbox border 67 | add 2 pixel offset to left margin for panel and groupbox borders 68 | 22/6/2021 add TDateTime 69 | add drawing routines and refactor 70 | tweak arrows for spin and combo boxes 71 | add conditional defines for controls 72 | 28/11/2022 derive TForm2PDFDoc class and add definable margins in FDOC 73 | print TabSheet caption in footer} 74 | 75 | {The user must undefine controls which are not used} 76 | {$DEFINE UseTAChart} 77 | {$DEFINE UseLazCntrls} 78 | {$DEFINE UseDTPicker} 79 | 80 | interface 81 | 82 | uses 83 | Classes, Forms, Graphics, Controls, SysUtils, fppdf; 84 | 85 | type TMargins = record 86 | H, {header margin} 87 | F, {footer margin} 88 | T, {top margin} 89 | B, {bottom margin} 90 | L, {left margin} 91 | R :integer; {right margin} 92 | end; 93 | 94 | TForm2PDFDoc = class(TPDFDocument) 95 | private 96 | fMargins:TMargins; 97 | public 98 | procedure SetMargins(aH,aF,aT,aB,aL,aR:integer); 99 | constructor Create(AOwner : TComponent); 100 | property Margins:TMargins read fMargins write fMargins; 101 | end; 102 | 103 | var FDoc :TForm2PDFDoc; {declare FDOC global so it can be accessed by caller} 104 | 105 | function FormToPDF:integer; {initialise FDoc and check if fonts are available} 106 | function FormToPDF(AControl: TControl):integer; {parse controls and append pages to Fdoc} 107 | function FormToPDF(FileName:string):integer; {use to save FDoc to PDF and reset FDoc} 108 | function FormToPDF(AControl:TControl; FileName:string):integer; {parse controls and save and close Fdoc} 109 | 110 | implementation 111 | 112 | uses StdCtrls, ExtCtrls, ComCtrls, Grids, Spin, EditBtn,ValEdit, 113 | fpparsettf, fpttf, intfgraphics, 114 | {$IFDEF UseTAChart}TAGraph, {$ENDIF} 115 | {$IFDEF UseLazCntrls}SpinEx, {$ENDIF} 116 | {$IFDEF UseDTPicker}DateTimePicker, {$ENDIF} 117 | StrUtils; 118 | 119 | {Set Include files in "Project Options, Paths" to include 120 | /usr/share/fpcsrc/packages/fcl-pdf/src for linux and 121 | C:\lazarus\fpc\3.0.4\source\packages\fcl-pdf\src for windows 122 | otherwise the fontmetrics_stdpdf.inc file will not be found} 123 | {$I fontmetrics_stdpdf.inc } 124 | 125 | procedure RecurseControls(AControl:TControl; FDoc:TPDFDocument; Page:TPDFPage; ftText:integer; Margins:TMargins); forward; 126 | procedure ParseControls(AControl:TControl; FDoc:TPDFDocument; Page:TPDFPage; ftText:integer; Margins:TMargins); forward; 127 | 128 | var FirstPage :boolean; 129 | CustomPaper:TPDFPaper; 130 | 131 | {------------------------------------------------------------------------------ 132 | TForm2PDFDoc 133 | ------------------------------------------------------------------------------} 134 | constructor TForm2PDFDoc.Create(AOwner : TComponent); 135 | begin 136 | inherited Create(AOwner); 137 | SetMargins(36,36,36,36,36,36) 138 | end; 139 | 140 | 141 | procedure TForm2PDFDoc.SetMargins(aH,aF,aT,aB,aL,aR:integer); 142 | begin 143 | if aH < 0 then aH := 0; 144 | fMargins.H := aH; 145 | if aF < 0 then aF := 0; 146 | fMargins.F := aF; 147 | if aT < 0 then aT := 0; 148 | fMargins.T := aT; 149 | if aB < 0 then aB := 0; 150 | fMargins.B := aB; 151 | if aL < 0 then aL := 0; 152 | fMargins.L := aL; 153 | if aR < 0 then aR := 0; 154 | fMargins.R := aR; 155 | end; 156 | 157 | {------------------------------------------------------------------------------ 158 | Page and Document set up 159 | ------------------------------------------------------------------------------} 160 | 161 | function FontsAvailable: Boolean; 162 | begin 163 | Result:= (gTTFontCache.Count > 0); 164 | end; 165 | 166 | 167 | function SetupPage(AControl:TControl; FDoc:TPDFDocument):TPDFPage; 168 | var APage :TPDFPage; 169 | 170 | begin 171 | APage := FDoc.Pages.AddPage; 172 | if FDoc.DefaultPaperType = ptCustom then 173 | APage.Paper := CustomPaper; 174 | APage.PaperType := FDoc.DefaultPaperType; 175 | if APage.Orientation = ppoPortrait then {work around to trigger adjustmatrix} 176 | begin 177 | APage.Orientation := ppoLandscape; 178 | APage.Orientation := ppoPortrait; 179 | end 180 | else 181 | begin 182 | APage.Orientation := ppoPortrait; 183 | APage.Orientation := ppoLandscape; 184 | end; 185 | 186 | FDoc.Sections[0].AddPage(APage); {only created one section} 187 | Result := APage; 188 | end; 189 | 190 | 191 | function ColorToPDF(AColor:TColor):TARGBColor; 192 | {Red and blue values appear to be swapped} 193 | var c: TColor; 194 | begin 195 | c := ColorToRGB(AColor); 196 | Result := Red(c)*$10000 + Green(c)*$100 + Blue(c); 197 | end; 198 | 199 | 200 | function GetPDFPenStyle(APen:TPen):TPDFPenStyle; 201 | {Unfortunately mapping is not 1:1 therefore this clumsy method} 202 | begin 203 | Result := ppsSolid; 204 | case APen.Style of 205 | psDash: Result := ppsDash; 206 | psDot: Result := ppsDot; 207 | psDashDot: Result := ppsDashDot; 208 | psDashDotDot: Result := ppsDashDotDot; 209 | end; {of case} 210 | end; 211 | 212 | 213 | procedure SetControlFont(AControl:TControl; APage:TPDFPage; var IDX,fSize:integer); 214 | var fFamily, {font family} 215 | fName :string; {font name} 216 | fData :TFontData; 217 | lFC :TFPFontCacheItem;{font item} 218 | fBold, 219 | fItalic :boolean; 220 | 221 | begin 222 | fData := GetFontData(AControl.Font.Handle); 223 | fSize := abs(fData.Height); 224 | if fSize = 0 then fSize := 12; {windows returns default control size of 0} 225 | fName := fData.Name; 226 | if Graphics.fsBold in fData.Style then fBold := true else fBold := false; 227 | if Graphics.fsItalic in fData.Style then fItalic := true else fItalic := false; 228 | 229 | lFC := gTTFontCache.Find(fName, fBold, fItalic); 230 | if Assigned(lFC) then 231 | begin {use system fonts} 232 | {we need to further specialise FamilyName otherwise base font is loaded} 233 | fFamily := lFC.FamilyName; 234 | if fBold then fFamily := lFC.FamilyName + '-Bold'; 235 | if fItalic then fFamily := lFC.FamilyName + '-Italic'; 236 | if fBold and fItalic then fFamily := lFC.FamilyName + '-BoldItalic'; 237 | IDX := APage.Document.AddFont(lFC.FileName,fFamily); 238 | end 239 | else {fall back on internal pdf fonts} 240 | begin 241 | if Pos('SANS',UpCase(fname)) > 0 then 242 | begin 243 | if fBold then IDX := APage.Document.AddFont('Helvetica-Bold'); 244 | if fItalic then IDX := APage.Document.AddFont('Helvetica-Oblique'); 245 | if fBold and fItalic then IDX := APage.Document.AddFont('Helvetica-BoldOblique'); 246 | if not fBold and not fItalic then IDX := APage.Document.AddFont('Helvetica'); 247 | end 248 | else 249 | begin 250 | if fBold then IDX := APage.Document.AddFont('Times-Bold'); 251 | if fItalic then IDX := APage.Document.AddFont('Times-Italic'); 252 | if fBold and fItalic then IDX := APage.Document.AddFont('Times-BoldItalic'); 253 | if not fBold and not fItalic then IDX := APage.Document.AddFont('Times-Roman'); 254 | end; 255 | end; 256 | APage.SetColor(ColorToPDF(AControl.Font.Color),false); 257 | APage.SetFont(IDX,fSize); 258 | end; 259 | 260 | 261 | function GetFontTextWidth(AText:string; APage:TPDFPage; IDX,fSize:integer):double; 262 | {string width in points} 263 | var I :integer; 264 | lWidth :double; 265 | lFC :TFPFontCacheItem;{font item} 266 | fName :string; 267 | AFont :TPDFFont; 268 | FontWArr :TPDFFontWidthArray; 269 | fBold, 270 | fItalic :boolean; 271 | begin 272 | lWidth := 0; 273 | if IDX >= 0 then 274 | begin 275 | AFont := APage.Document.Fonts[IDX]; 276 | FName := AFont.Name; 277 | if AFont.IsStdFont then {can't use protected members to get this so have to do it ourselves} 278 | begin 279 | case fName of 280 | 'Courier': FontWArr := FONT_COURIER_FULL; 281 | 'Courier-Bold': FontWArr := FONT_COURIER_FULL; 282 | 'Courier-Oblique': FontWArr := FONT_COURIER_FULL; 283 | 'Courier-BoldOblique': FontWArr := FONT_COURIER_FULL; 284 | 'Helvetica': FontWArr := FONT_HELVETICA_ARIAL; 285 | 'Helvetica-Bold': FontWArr := FONT_HELVETICA_ARIAL_BOLD; 286 | 'Helvetica-Oblique': FontWArr := FONT_HELVETICA_ARIAL_ITALIC; 287 | 'Helvetica-BoldOblique': FontWArr := FONT_HELVETICA_ARIAL_BOLD_ITALIC; 288 | 'Times-Roman': FontWArr := FONT_TIMES; 289 | 'Times-Bold': FontWArr := FONT_TIMES_BOLD; 290 | 'Times-Italic': FontWArr := FONT_TIMES_ITALIC; 291 | 'Times-BoldItalic': FontWArr := FONT_TIMES_BOLD_ITALIC; 292 | 'Symbol': FontWArr := FONT_SYMBOL; 293 | 'ZapfDingbats': FontWArr := FONT_ZAPFDINGBATS; 294 | end; 295 | lWidth := 0; 296 | for I:= 1 to length(AText) do 297 | lWidth := lWidth + FontWArr[ord(Atext[I])]; 298 | lWidth := lWidth*fSize*72/(96*1540); 299 | end 300 | else 301 | begin 302 | if Pos('BOLD',upcase(fName)) > 0 then fBold := true else fBold := false; 303 | if Pos('ITALIC',upcase(fname)) > 0 then fItalic := true else fItalic := false; 304 | fname := Copy2Symb(fname,'-'); 305 | lFC := gTTFontCache.Find(fName, fBold, fItalic); 306 | if Assigned(lFC) then 307 | begin 308 | lWidth := lFC.TextWidth(AText,fSize); {TextWidth gives size in screen pixels} 309 | end 310 | else 311 | lWidth := -1; 312 | end; 313 | end; 314 | Result := lWidth; 315 | end; 316 | 317 | 318 | {------------------------------------------------------------------------------ 319 | Drawing Routines 320 | ------------------------------------------------------------------------------} 321 | 322 | procedure DrawVarBorder(CL,CT,CW,CH:integer; APage:TPDFPage; DX,DY:integer; Margins:TMargins); 323 | {draw rectangle around border} 324 | var DW,DH :integer; {height and width to draw item} 325 | begin 326 | DW := CW; 327 | DH := DY - (Margins.T + CT); 328 | DX := Margins.L + CL; 329 | DY := Margins.T + CT + DH; 330 | APage.DrawRoundedRect(DX,DY,DW,DH,1,1,false,true); 331 | end; 332 | 333 | 334 | procedure DrawFixedBorder(CL,CT,CW,CH:integer; cColor:TColor; APage:TPDFPage; Margins:TMargins); 335 | var DX,DY, {position of item} 336 | DW,DH :integer; {height and width to draw item} 337 | Isfilled :boolean; {is the shape filled} 338 | 339 | begin 340 | IsFilled := false; 341 | {draw rectangle around border} 342 | DW := CW; 343 | DH := CH; 344 | DX := Margins.L + CL; 345 | DY := Margins.T + CT + DH; 346 | if cColor <> clDefault then 347 | begin 348 | APage.SetColor(ColorToPDF(cColor),false); 349 | IsFilled := true; 350 | end; 351 | APage.DrawRoundedRect(DX,DY,DW,DH,1,1,IsFilled,true); 352 | end; 353 | 354 | 355 | procedure DrawUpDownTick(CL,CT,CW,CH:integer; APage:TPDFPage; Margins:TMargins); 356 | {Draws up and down ticks at the right end of the control for spin controls. 357 | CL control position left 358 | CT control position top 359 | CW control text width 360 | CH control text height 361 | APage PDF page to write on 362 | Margins page margins} 363 | 364 | var X1,X2, {position of item} 365 | Y1,Y2 :integer; 366 | begin 367 | {draw up tick} 368 | X1 := Margins.L + CL + CW - CH div 2 + 4; 369 | Y1 := Margins.T + CT + 4; 370 | X2 := X1 + CH div 4 - 4; 371 | Y2 := Y1 + CH div 3 - 2; 372 | APage.DrawLine(X1,Y2,X2,Y1,1,true); 373 | APage.DrawLine(X1 + CH div 4 - 4,Y1,X2 + CH div 4 - 4,Y2,1,true); 374 | 375 | {draw down tick} 376 | Y1 := Margins.T + CT + CH - 5; 377 | Y2 := Y1 - CH div 3 + 2; 378 | APage.DrawLine(X1,Y2,X2,Y1,1,true); 379 | APage.DrawLine(X1 + CH div 4 - 4,Y1,X2 + CH div 4 - 4,Y2,1,true); 380 | end; 381 | 382 | 383 | procedure DrawTextJustified(CL,CT,CW,CH:integer; cText:string; Align:TAlignment; 384 | APage:TPDFPage; Margins:TMargins; IDX,fSize:integer); 385 | {Writes text left, right or centre justified. 386 | CL control position left 387 | CT control position top 388 | CW control text width 389 | CH control text height 390 | cText text to write 391 | Align text justification (taLeftJustify, taCenter, taRightJustify) 392 | APage PDF page to write on 393 | Margins page margins 394 | IDX font index 395 | fsize font size} 396 | 397 | var DX,DY :integer; {position of item} 398 | begin 399 | case Align of 400 | taLeftJustify : DX := Margins.L + CL + 2; 401 | taCenter : DX := Margins.L + CL + Round((CW - GetFontTextWidth(cText,APage,IDX,fSize))/2); 402 | taRightJustify: DX := Margins.L + CL + Round(CW - GetFontTextWidth(cText,APage,IDX,fSize) - 2); 403 | end; {of case} 404 | DY := Margins.T + CT + (CH + fSize) div 2; 405 | APage.WriteText(DX,DY,cText); 406 | end; 407 | 408 | 409 | {------------------------------------------------------------------------------ 410 | Component Procedures 411 | ------------------------------------------------------------------------------} 412 | 413 | procedure Header2PDF(cForm:Tform; APage:TPDFPage; IDX:integer; Margins:TMargins); 414 | var fSize, {font size} 415 | DX,DY, {x and y pos to draw item} 416 | DW :integer; {height and width to draw item} 417 | 418 | begin 419 | SetControlFont(cForm,APage,IDX,fSize); 420 | if Margins.H > fSize then 421 | begin 422 | DW := Round(GetFontTextWidth(cForm.Caption,APage,IDX,fSize)); 423 | DX := (APage.Paper.W - DW) div 2; {fix this to take into account margins} 424 | DY := Margins.T + (Margins.H - fSize) div 2 + fSize; {put caption halfway in header} 425 | APage.SetFont(IDX, fSize); 426 | APage.SetColor(cForm.Font.Color, false); 427 | APage.WriteText(DX,DY,cForm.Caption); 428 | end; 429 | end; 430 | 431 | 432 | {TLabel} 433 | procedure LabelToPDF(cLabel:TLabel; APage:TPDFPage; IDX:integer; Margins:TMargins); 434 | var fSize :integer; {font size} 435 | begin 436 | if cLabel.Visible then 437 | begin 438 | SetControlFont(cLabel,APage,IDX,fSize); 439 | with cLabel do 440 | DrawTextJustified(Left,Top,Width,Height,Caption,Alignment,APage,Margins,IDX,fSize); 441 | end; 442 | end; 443 | 444 | 445 | {TStaticText} 446 | procedure StaticTextToPDF(cLabel:TStaticText; APage:TPDFPage; IDX:integer; Margins:TMargins); 447 | var fSize :integer; {font size} 448 | begin 449 | if cLabel.Visible then 450 | begin 451 | SetControlFont(cLabel,APage,IDX,fsize); 452 | with cLabel do 453 | DrawTextJustified(Left,Top,Width,Height,Caption,Alignment,APage,Margins,IDX,fSize); 454 | end; 455 | end; 456 | 457 | 458 | {TImage} 459 | procedure ImageToPDF(cImage:TImage; ADoc:TPDFDocument; APage:TPDFPage; Margins:TMargins); 460 | var IDX, 461 | DX,DY, {x and y pos to draw item} 462 | DH,DW :integer; {height and width to draw item} 463 | pdfImage :TPDFImageItem; 464 | fpBitmap :TLazIntfImage; 465 | begin 466 | if cImage.Visible then 467 | begin 468 | pdfImage := ADoc.Images.AddImageItem; 469 | IDX := ADoc.Images.Count - 1; 470 | fpBitMap := TLazIntfImage.Create(0,0); 471 | fpBitMap.LoadFromBitmap(cImage.Picture.Bitmap.Handle,cImage.Picture.Bitmap.MaskHandle); 472 | pdfImage.Image := fpBitMap; 473 | pdfImage.OwnsImage := true; 474 | DW := cImage.Width; 475 | DH := cImage.Height; 476 | DX := Margins.L + cImage.Left; 477 | DY := Margins.T + cImage.Top + DH; 478 | APage.DrawImageRawSize(DX,DY,DW,DH,IDX); 479 | end; 480 | end; 481 | 482 | 483 | {$IFDEF UseTAChart} 484 | {TChart} 485 | procedure ChartToPDF(cChart:TChart; ADoc:TPDFDocument; APage:TPDFPage; Margins:TMargins); 486 | {for now copy chart to bitmap. use fpVectorial later?} 487 | var IDX, 488 | DX,DY, {x and y pos to draw item} 489 | DH,DW :integer; {height and width to draw item} 490 | pdfImage :TPDFImageItem; 491 | fpBitmap :TLazIntfImage; 492 | BitMap :TBitMap; 493 | begin 494 | if cChart.Visible then 495 | begin 496 | pdfImage := ADoc.Images.AddImageItem; 497 | IDX := ADoc.Images.Count - 1; 498 | fpBitMap := TLazIntfImage.Create(0,0); 499 | BitMap := cChart.SaveToImage(TBitMap) as TBitMap; 500 | fpBitmap.LoadFromBitmap(BitMap.Handle,BitMap.MaskHandle); 501 | pdfImage.Image := fpBitMap; 502 | pdfImage.OwnsImage := true; 503 | DW := cChart.Width; 504 | DH := cChart.Height; 505 | DX := Margins.L + cChart.Left; 506 | DY := Margins.T + cChart.Top + DH; 507 | APage.DrawImageRawSize(DX,DY,DW,DH,IDX); 508 | BitMap.Free; 509 | end; 510 | end; 511 | {$ENDIF} 512 | 513 | 514 | {TShape} 515 | procedure ShapeToPDF(cShape:TShape; APage:TPDFPage; Margins:TMargins); 516 | {Supported shapes: 517 | Rectangle 518 | Rounded Rect 519 | Ellipse 520 | } 521 | var LW, {line width} 522 | DX,DY, {x and y pos to draw item} 523 | DH,DW :integer; {height and width to draw item} 524 | Isfilled :boolean; {is the shape filled} 525 | 526 | begin 527 | if cShape.Visible then 528 | begin 529 | Isfilled := true; 530 | APage.SetColor(ColorToPDF(cShape.Pen.Color),true); 531 | APage.SetPenStyle(GetPDFPenStyle(cShape.Pen)); 532 | APage.SetColor(ColorToPDF(cShape.Brush.Color),false); 533 | if cShape.Brush.Style = bsClear then Isfilled := false; 534 | DW := cShape.Width; 535 | DH := cShape.Height; 536 | DX := Margins.L + cShape.Left; 537 | DY := Margins.T + cShape.Top + DH; 538 | LW := cShape.Pen.Width; 539 | case cShape.Shape of 540 | stRectangle: APage.DrawRect(DX,DY,DW,DH,LW,Isfilled,true); 541 | stRoundRect: APage.DrawRoundedRect(DX,DY,DW,DH,(DW/20 + DH/20),LW,Isfilled,true); 542 | stEllipse : APage.DrawEllipse(DX,DY,DW,DH,LW,IsFilled,true); 543 | end; {case} 544 | end; 545 | end; 546 | 547 | 548 | {TGroupBox} 549 | procedure GroupBoxToPDF(cGroupBx:TGroupBox; FDoc:TPDFDocument; APage:TPDFPage; IDX:integer; Margins:TMargins); 550 | var I, 551 | fSize, {font size} 552 | DX,DY :integer; {x and y pos to draw item} 553 | begin 554 | if cGroupBx.Visible then 555 | begin 556 | with cGroupBx do DrawFixedBorder(left,Top,Width,Height,Color,APage,Margins); 557 | 558 | {write groupbox caption} 559 | SetControlFont(cGroupBx,APage,IDX,fsize); 560 | DX := Margins.L + cGroupBx.Left + 2; 561 | DY := Margins.T + cGroupBx.Top + fSize + 2; 562 | APage.WriteText(DX,DY,cGroupBx.Caption); 563 | 564 | {draw components} 565 | Margins.L := DX; 566 | Margins.T := DY + 2; 567 | for I:=0 to cGroupBx.ControlCount - 1 do 568 | ParseControls(cGroupBx.Controls[I],FDoc,APage,IDX,Margins); 569 | end; 570 | end; 571 | 572 | 573 | {TPanel} 574 | procedure PanelToPDF(cPanel:TPanel; FDoc:TPDFDocument; APage:TPDFPage; IDX:integer; Margins:TMargins); 575 | var I, 576 | fSize :integer; {font size} 577 | begin 578 | if cPanel.Visible then with cPanel do 579 | begin 580 | DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 581 | 582 | {write groupbox caption} 583 | SetControlFont(cPanel,APage,IDX,fsize); 584 | DrawTextJustified(Left,Top,Width,Height,Caption,Alignment,APage,Margins,IDX,fSize); 585 | 586 | {draw components} 587 | Margins.L := Margins.L + cPanel.Left; 588 | Margins.T := Margins.T + cPanel.Top; 589 | for I:=0 to cPanel.ControlCount - 1 do 590 | ParseControls(cPanel.Controls[I],FDoc,APage,IDX,Margins); 591 | end; 592 | end; 593 | 594 | 595 | {TEdit} 596 | procedure EditToPDF(cEdit:TEdit; APage:TPDFPage; IDX:integer; Margins:TMargins); 597 | var fSize:integer; {font size} 598 | begin 599 | if cEdit.Visible then with cEdit do 600 | begin 601 | DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 602 | 603 | {write edit caption} 604 | SetControlFont(cEdit,APage,IDX,fsize); 605 | DrawTextJustified(Left,Top,Width,Height,Caption,Alignment,APage,Margins,IDX,fSize); 606 | end; 607 | end; 608 | 609 | 610 | {Note: TspinEdit, TFloatSpinEdit, TSpinEditEx and TFloatSpinEditEx are programatically 611 | the same, but if the -CR compiler switch is set we can only typecast to the exact 612 | type. Base class of TSpinEditEx and TFloatSpinEditEx is not specialised so we 613 | cannot typecast to it.} 614 | 615 | {TCustomFloatSpinEdit} 616 | procedure CustomFloatSpinEditToPDF(cSpinEd:TCustomFloatSpinEdit; APage:TPDFPage; IDX:integer; Margins:TMargins); 617 | var fSize, {font size} 618 | DH, {height to draw item} 619 | X1, 620 | Y1,Y2 :integer; 621 | 622 | begin 623 | if cSpinEd.Visible then with cSpinEd do 624 | begin 625 | DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 626 | 627 | {write edit caption} 628 | SetControlFont(cSpinEd,APage,IDX,fsize); 629 | DH := cSpinEd.Height; 630 | DrawTextJustified(Left,Top,Width - DH div 2 - 4,Height,Caption,Alignment, 631 | APage,Margins,IDX,fSize); 632 | 633 | {draw separator line} 634 | X1 := Margins.L + cSpinEd.Left + cSpinEd.Width - DH div 2; 635 | Y1 := Margins.T + cSpinEd.Top; 636 | Y2 := Y1 + DH - 1; 637 | APage.DrawLine(X1,Y1,X1,Y2,1,true); 638 | 639 | DrawUpDownTick(Left,Top,Width,Height, APage, Margins); 640 | end; 641 | end; 642 | 643 | 644 | {TSpinEdit} 645 | procedure SpinEditToPDF(cSpinEd:TSpinEdit; APage:TPDFPage; IDX:integer; Margins:TMargins); 646 | begin 647 | CustomFloatSpinEditToPDF(TCustomFloatSpinEdit(cSpinEd),APage,IDX,Margins) 648 | end; 649 | 650 | 651 | {TFloatSpinEdit} 652 | procedure FloatSpinEditToPDF(cSpinEd:TFloatSpinEdit; APage:TPDFPage; IDX:integer; Margins:TMargins); 653 | begin 654 | CustomFloatSpinEditToPDF(TCustomFloatSpinEdit(cSpinEd),APage,IDX,Margins) 655 | end; 656 | 657 | 658 | {$IFDEF UseLazCntrls} 659 | {TSpinEditEx} 660 | procedure SpinEditExToPDF(cSpinEd:TSpinEditEx; APage:TPDFPage; IDX:integer; Margins:TMargins); 661 | var fSize, {font size} 662 | DH, {height to draw item} 663 | X1, 664 | Y1,Y2 :integer; 665 | 666 | begin 667 | if cSpinEd.Visible then with cSpinEd do 668 | begin 669 | DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 670 | 671 | {write edit caption} 672 | SetControlFont(cSpinEd,APage,IDX,fsize); 673 | DH := cSpinEd.Height; 674 | DrawTextJustified(Left,Top,Width - DH div 2 - 4,Height,Caption,Alignment, 675 | APage,Margins,IDX,fSize); 676 | 677 | {draw separator line} 678 | X1 := Margins.L + cSpinEd.Left + cSpinEd.Width - DH div 2; 679 | Y1 := Margins.T + cSpinEd.Top; 680 | Y2 := Y1 + DH - 1; 681 | APage.DrawLine(X1,Y1,X1,Y2,1,true); 682 | 683 | DrawUpDownTick(Left,Top,Width,Height, APage, Margins); 684 | end; 685 | end; 686 | 687 | 688 | {TFloatSpinEditEx} 689 | procedure FloatSpinEditExToPDF(cSpinEd:TFloatSpinEditEx; APage:TPDFPage; IDX:integer; Margins:TMargins); 690 | var fSize, {font size} 691 | DH, {height to draw item} 692 | X1, 693 | Y1,Y2 :integer; 694 | 695 | begin 696 | if cSpinEd.Visible then with cSpinEd do 697 | begin 698 | DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 699 | 700 | {write edit caption} 701 | SetControlFont(cSpinEd,APage,IDX,fsize); 702 | DH := cSpinEd.Height; 703 | DrawTextJustified(Left,Top,Width - DH div 2 - 4,Height,Caption,Alignment, 704 | APage,Margins,IDX,fSize); 705 | 706 | {draw separator line} 707 | X1 := Margins.L + cSpinEd.Left + cSpinEd.Width - DH div 2; 708 | Y1 := Margins.T + cSpinEd.Top; 709 | Y2 := Y1 + DH - 1; 710 | APage.DrawLine(X1,Y1,X1,Y2,1,true); 711 | 712 | DrawUpDownTick(Left,Top,Width,Height, APage, Margins); 713 | end; 714 | end; 715 | {$ENDIF} 716 | 717 | 718 | {TDirectoryEdit} 719 | procedure DirEditToPDF(cDirEdit:TDirectoryEdit; APage:TPDFPage; IDX:integer; Margins:TMargins); 720 | var fSize :integer; {font size} 721 | begin 722 | if cDirEdit.Visible then with cDirEdit do 723 | begin 724 | DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 725 | SetControlFont(cDirEdit,APage,IDX,fsize); 726 | DrawTextJustified(Left,Top,Width,Height,Caption,Alignment,APage,Margins,IDX,fSize); 727 | end; 728 | end; 729 | 730 | 731 | {TFileNameEdit} 732 | procedure FileEditToPDF(cFileEdit:TFileNameEdit; APage:TPDFPage; IDX:integer; Margins:TMargins); 733 | var fSize :integer; {font size} 734 | begin 735 | if cFileEdit.Visible then with cFileEdit do 736 | begin 737 | DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 738 | SetControlFont(cFileEdit,APage,IDX,fsize); 739 | DrawTextJustified(Left,Top,Width,Height,Caption,Alignment,APage,Margins,IDX,fSize); 740 | end; 741 | end; 742 | 743 | {$IFDEF UseDTPicker} 744 | {TDateTimePicker} 745 | procedure DateTimePickerToPDF(cDTPicker:TDateTimePicker; APage:TPDFPage; IDX:integer; Margins:TMargins); 746 | var fSize, {font size} 747 | DX,DY, {x and y pos to draw item} 748 | DH :integer; {height and width to draw item} 749 | begin 750 | if cDTPicker.Visible then 751 | begin 752 | with cDTPicker do DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 753 | 754 | {write edit caption} 755 | SetControlFont(cDTPicker,APage,IDX,fsize); 756 | DH := cDTPicker.Height; 757 | DX := Margins.L + cDTPicker.Left; 758 | DY := Margins.T + cDTPicker.Top + (DH + fSize) div 2; 759 | case cDTPicker.Kind of 760 | dtkDateTime: APage.WriteText(DX + 2,DY,FormatDateTime('dd/mm/yyyy hh:mm:ss',cDTPicker.DateTime)); 761 | dtkDate : APage.WriteText(DX + 2,DY,FormatDateTime('dd/mm/yyyy',cDTPicker.DateTime)); 762 | dtkTime : APage.WriteText(DX + 2,DY,FormatDateTime('hh:mm:ss',cDTPicker.DateTime)); 763 | end; 764 | end; 765 | end; 766 | {$ENDIF} 767 | 768 | 769 | {TComboBox} 770 | procedure ComboBoxToPDF(cCmboBx:TComboBox; APage:TPDFPage; IDX:integer; Margins:TMargins); 771 | {prints selected text only, not the drop down list} 772 | var fSize, {font size} 773 | DX,DY, {x and y pos to draw item} 774 | DW,DH, {height and width to draw item} 775 | X1,X2, 776 | Y1,Y2 :integer; 777 | 778 | begin 779 | if cCmboBx.Visible then 780 | begin 781 | with cCmboBX do DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 782 | 783 | {write edit caption} 784 | SetControlFont(cCmboBx,APage,IDX,fsize); 785 | DH := cCmboBx.Height; 786 | DW := cCmboBx.Width; 787 | DX := Margins.L + cCmboBx.Left; 788 | DY := Margins.T + cCmboBx.Top + fSize + (DH - fSize) div 2; 789 | APage.WriteText(DX + 2,DY,cCmboBx.Caption); 790 | 791 | {draw down tick} 792 | X1 := DX + DW - DH + 4; 793 | Y1 := Margins.T + cCmboBx.Top + 2*DH div 3; 794 | X2 := X1 + DH div 2 - 4; 795 | Y2 := Y1 - DH div 3 + 2; 796 | APage.DrawLine(X1,Y2,X2,Y1,1,true); 797 | APage.DrawLine(X1 + DH div 2 - 4,Y1,X2 + DH div 2 - 4,Y2,1,true); 798 | end; 799 | end; 800 | 801 | 802 | {TMemo} 803 | procedure MemoToPDF(cMemo:TMemo; FDoc:TPDFDocument; APage:TPDFPage; IDX:integer; Margins:TMargins); 804 | var I, 805 | fSize, {font size} 806 | DX,DY :integer; {x and y pos to draw item} 807 | fp :boolean; {first page of control} 808 | 809 | begin 810 | if cMemo.Visible then 811 | begin 812 | {write text, no line wrapping} 813 | fp := true; 814 | SetControlFont(cMemo,APage,IDX,fsize); 815 | DX := Margins.L + cMemo.Left + 2; 816 | DY := Margins.T + cMemo.Top + fsize + 2; 817 | for I:=0 to cMemo.Lines.Count - 1 do 818 | begin 819 | APage.WriteText(DX,DY,cMemo.Lines[I]); 820 | DY := DY + fSize; 821 | if (DY > APage.Paper.Printable.B) or ((DY > Margins.T + cMemo.Top + cMemo.Height) and fp) then 822 | begin 823 | with cMemo do DrawVarBorder(Left,Top,Width,Height,APage,DX,DY,Margins); 824 | APage := SetupPage(cMemo,FDoc); 825 | SetControlFont(cMemo,APage,IDX,fsize); 826 | DY := Margins.T + fsize + 2; 827 | fp := false; 828 | end; 829 | end; 830 | with cMemo do DrawVarBorder(Left,Top,Width,Height,APage,DX,DY,Margins); 831 | end; 832 | end; 833 | 834 | 835 | {TListBox} 836 | procedure ListBoxToPDF(cLstBx:TListBox; FDoc:TPDFDocument; APage:TPDFPage; IDX:integer; Margins:TMargins); 837 | var I, 838 | fSize, {font size} 839 | DX,DY :integer; {x and y pos to draw item} 840 | fp :boolean; {first page of control} 841 | 842 | begin 843 | if cLstBx.Visible then 844 | begin 845 | fp := true; 846 | SetControlFont(cLstBx,APage,IDX,fsize); 847 | DX := Margins.L + cLstBx.Left + 2; 848 | DY := Margins.T + cLstBx.Top + fsize + 2; 849 | for I:=0 to cLstBx.Items.Count - 1 do 850 | begin 851 | APage.WriteText(DX,DY,cLstBx.Items[I]); 852 | DY := DY + fSize; 853 | if (DY > APage.Paper.Printable.B) or ((DY > Margins.T + cLstBx.Top + cLstBx.Height) and fp) then 854 | begin 855 | with clstBx do DrawVarBorder(Left,Top,Width,Height,APage,DX,DY,Margins); 856 | APage := SetupPage(cLstBx,FDoc); 857 | SetControlFont(cLstBx,APage,IDX,fsize); 858 | DY := Margins.T + cLstBx.Top + fsize + 2; 859 | fp := false; 860 | end; 861 | end; 862 | 863 | with cLstBx do DrawVarBorder(Left,Top,Width,Height,APage,DX,DY,Margins); 864 | end; 865 | end; 866 | 867 | 868 | {TStringGrid} 869 | procedure StringGridToPDF(cStrGrd:TStringGrid; FDoc:TPDFDocument; APage:TPDFPage; IDX:integer; Margins:TMargins); 870 | var I,J, 871 | fSize, {font size} 872 | DX,DY :integer; {x and y pos to draw item} 873 | fp :boolean; {first page of control} 874 | 875 | begin 876 | if cStrGrd.Visible then 877 | begin 878 | fp := true; 879 | SetControlFont(cStrGrd,APage,IDX,fsize); 880 | DX := Margins.L + cStrGrd.Left + 2; 881 | DY := Margins.T + cStrGrd.Top + fsize + 2; 882 | for I:=0 to cStrGrd.RowCount - 1 do 883 | begin 884 | for J:=0 to cStrGrd.FixedCols - 1 do {write fixed cols} 885 | begin 886 | APage.WriteText(DX,DY,cStrGrd.Cells[J,I]); 887 | DX := DX + cStrGrd.ColWidths[J]; 888 | end; 889 | 890 | for J:=cStrGrd.FixedCols to cStrGrd.ColCount - 1 do 891 | if (cStrGrd.Columns.Count > 0) then 892 | begin 893 | if (cStrGrd.Columns[J - cStrGrd.FixedCols].Visible) then 894 | begin 895 | if I < cStrGrd.FixedRows then 896 | APage.WriteText(DX,DY,cStrGrd.Columns[J - cStrGrd.FixedCols].Title.Caption) 897 | else 898 | APage.WriteText(DX,DY,cStrGrd.Cells[J,I]); 899 | DX := DX + cStrGrd.ColWidths[J]; 900 | end; 901 | end 902 | else 903 | begin 904 | APage.WriteText(DX,DY,cStrGrd.Cells[J,I]); 905 | DX := DX + cStrGrd.ColWidths[J]; 906 | end; 907 | 908 | DX := Margins.L + cStrGrd.Left + 2; 909 | DY := DY + cStrGrd.RowHeights[I]; 910 | if (DY > APage.Paper.Printable.B) or 911 | ((DY > Margins.T + cStrGrd.Top + cStrGrd.Height) and fp) then 912 | begin 913 | if fp then DY := Margins.T + cStrGrd.Top + cStrGrd.Height; 914 | with CStrGrd do DrawVarBorder(Left,Top,Width,Height,APage,DX,DY,Margins); 915 | APage := SetupPage(cStrGrd,FDoc); 916 | SetControlFont(cStrGrd,APage,IDX,fsize); 917 | DY := Margins.T + cStrGrd.Top + fsize + 2; 918 | fp := false; 919 | end; 920 | end; 921 | with cStrGrd do DrawVarBorder(Left,Top,Width,Height,APage,DX,DY,Margins); 922 | end; 923 | end; 924 | 925 | 926 | {TValueListEditor} 927 | procedure ValueListToPDF(cValueList:TValueListEditor; FDoc:TPDFDocument; APage:TPDFPage; IDX:integer; Margins:TMargins); 928 | var I,SI, 929 | fSize, {font size} 930 | DX,DY :integer; {x and y pos to draw item} 931 | fp :boolean; {first page of control} 932 | AKey, 933 | AValue :string; 934 | 935 | begin 936 | if cValueList.Visible then 937 | begin 938 | fp := true; 939 | SI := 0; 940 | SetControlFont(cValueList,APage,IDX,fsize); 941 | DX := Margins.L + cValueList.Left + 2; 942 | DY := Margins.T + cValueList.Top + fsize + 2; 943 | 944 | {write column title if there is one} 945 | if cValueList.TitleCaptions.Count > 0 then 946 | begin 947 | APage.WriteText(DX,DY,cValueList.TitleCaptions[0] + ' = ' + cValueList.TitleCaptions[1]); 948 | DY := DY + fSize; 949 | SI := 1; 950 | end; 951 | 952 | {write key value pairs} 953 | for I:=SI to cValueList.RowCount - 1 do 954 | begin 955 | AKey := cValueList.Cells[0,I]; 956 | AValue := cValueList.Cells[1,I]; 957 | APage.WriteText(DX,DY,Akey + ' = ' + AValue); 958 | DY := DY + fSize; 959 | if (DY > APage.Paper.Printable.B) or ((DY > Margins.T + cValueList.Top + cValueList.Height) and fp) then 960 | begin 961 | if fp then DY := Margins.T + cValueList.Top + cValueList.Height; 962 | with cValueList do DrawVarBorder(Left,Top,Width,Height,APage,DX,DY,Margins); 963 | APage := SetupPage(cValueList,FDoc); 964 | SetControlFont(cValueList,APage,IDX,fsize); 965 | DY := Margins.T + cValueList.Top + fsize + 2; 966 | fp := false; 967 | end; 968 | end; 969 | 970 | with cValueList do DrawVarBorder(Left,Top,Width,Height,APage,DX,DY,Margins); 971 | end; 972 | end; 973 | 974 | 975 | {TCheckBox} 976 | procedure CheckBoxToPDF(cCheckBx:TCheckBox; APage:TPDFPage; IDX:integer; Margins:TMargins); 977 | var fSize, {font size} 978 | DX,DY, {x and y pos to draw item} 979 | DW,DH :integer; {height and width to draw item} 980 | begin 981 | if cCheckBx.Visible then 982 | begin 983 | {write caption} 984 | SetControlFont(cCheckBx,APage,IDX,fsize); 985 | DH := cCheckbx.Height; 986 | DX := Margins.L + cCheckBx.Left + Round(fSize*1.2); {shift text right to allow for circle} 987 | DY := Margins.T + cCheckBx.Top + (DH + fsize) div 2; 988 | APage.WriteText(DX,DY,cCheckbx.Caption); 989 | 990 | {draw tick box} 991 | DX := Margins.L + cCheckbx.Left; 992 | DY := DY + 1; 993 | DW := fSize; {want a square box same size as text} 994 | APage.DrawRect(DX,DY,DW,DW,1,false,true); 995 | 996 | {draw cross} 997 | if cCheckBx.Checked then 998 | begin 999 | DX := DX + 2; 1000 | DY := DY - 2; 1001 | DW := DX + fSize - 4; 1002 | DH := DY - fSize + 4; 1003 | APage.DrawLine(DX,DY,DW,DH,1,true); 1004 | APage.DrawLine(DX,DH,DW,DY,1,true); 1005 | end; 1006 | end; 1007 | end; 1008 | 1009 | 1010 | {TRadioButton} 1011 | procedure RadioButToPDF(cRadioBtn:TRadioButton; APage:TPDFPage; IDX:integer; Margins:TMargins); 1012 | var fSize, {font size} 1013 | DX,DY, {x and y pos to draw item} 1014 | DW,DH :integer; {height and width to draw item} 1015 | begin 1016 | if cRadioBtn.Visible then 1017 | begin 1018 | {write caption} 1019 | SetControlFont(cRadioBtn,APage,IDX,fsize); 1020 | DH := cRadioBtn.Height; 1021 | DX := Margins.L + cRadioBtn.Left + Round(fSize*1.2); {shift text right to allow for circle} 1022 | DY := Margins.T + cRadioBtn.Top + (DH + fsize) div 2; 1023 | APage.WriteText(DX,DY,cRadioBtn.Caption); 1024 | 1025 | {draw outer circle} 1026 | DX := Margins.L + cRadioBtn.Left; 1027 | DY := DY + 1; 1028 | DW := fsize; {same size as text} 1029 | APage.DrawEllipse(DX,DY,DW,DW,1,false,true); 1030 | 1031 | {draw inner circle} 1032 | if cRadioBtn.Checked then 1033 | begin 1034 | DX := DX + 4; 1035 | DY := DY - 4; 1036 | DW := DW - 8; 1037 | APage.DrawEllipse(DX,DY,DW,DW,1,true,true); 1038 | end; 1039 | end; 1040 | end; 1041 | 1042 | 1043 | {TRadioGroup} 1044 | procedure RadioGroupToPDF(cRadioGrp:TRadioGroup; FDoc:TPDFDocument; APage:TPDFPage; IDX:integer; Margins:TMargins); 1045 | var I, 1046 | fSize, {font size} 1047 | DX,DY :integer; {x and y pos to draw item} 1048 | begin 1049 | if cRadioGrp.Visible then 1050 | begin 1051 | with cRadioGrp do DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 1052 | 1053 | {write caption} 1054 | SetControlFont(cRadioGrp,APage,IDX,fsize); 1055 | DX := Margins.L + cRadioGrp.Left + 2; 1056 | DY := Margins.T + cRadioGrp.Top + fSize + 2; 1057 | APage.WriteText(DX,DY,cRadioGrp.Caption); 1058 | 1059 | {draw components} 1060 | Margins.L := DX; 1061 | Margins.T := DY + 2; 1062 | for I:=0 to cRadioGrp.ControlCount - 1 do 1063 | ParseControls(cRadioGrp.Controls[I],FDoc,APage,IDX,Margins); 1064 | end; 1065 | end; 1066 | 1067 | 1068 | {TCheckGroup} 1069 | procedure CheckGroupToPDF(cCheckGrp:TCheckGroup; FDoc:TPDFDocument; APage:TPDFPage; IDX:integer; Margins:TMargins); 1070 | var I, 1071 | fSize, {font size} 1072 | DX,DY :integer; {x and y pos to draw item} 1073 | begin 1074 | if cCheckGrp.Visible then 1075 | begin 1076 | with cCheckGrp do DrawFixedBorder(Left,Top,Width,Height,Color,APage,Margins); 1077 | 1078 | {write caption} 1079 | SetControlFont(cCheckGrp,APage,IDX,fsize); 1080 | DX := Margins.L + cCheckGrp.Left + 2; 1081 | DY := Margins.T + cCheckGrp.Top + fSize + 2; 1082 | APage.WriteText(DX,DY,cCheckGrp.Caption); 1083 | 1084 | {draw components} 1085 | Margins.L := DX; 1086 | Margins.T := DY + 2; 1087 | for I:=0 to cCheckGrp.ControlCount - 1 do 1088 | ParseControls(cCheckGrp.Controls[I],FDoc,APage,IDX,Margins); 1089 | end; 1090 | end; 1091 | 1092 | 1093 | procedure TabSheetToPDF(cTabSht:TTabSheet; FDoc:TPDFDocument; APage:TPDFPage; IDX:integer; Margins:TMargins); 1094 | var I, 1095 | fSize, {font size} 1096 | DX,DY, {x and y pos to draw item} 1097 | DW :integer; {height and width to draw item} 1098 | begin 1099 | if cTabSht.TabVisible then 1100 | begin 1101 | if not FirstPage then APage := SetupPage(cTabSht,FDoc) 1102 | else FirstPage := false; 1103 | for I:=0 to cTabSht.ControlCount - 1 do 1104 | ParseControls(cTabSht.Controls[I],FDoc,APage,IDX,Margins); 1105 | SetControlFont(cTabSht,APage,IDX,fsize); 1106 | if Margins.F > fSize then 1107 | begin 1108 | DW := Round(GetFontTextWidth(cTabSht.Caption,APage,IDX,fSize)); 1109 | DX := (APage.Paper.W - DW) div 2; {fix this to take into account margins} 1110 | DY := APage.Paper.H - Margins.B - (Margins.F - fSize) div 2 - fSize; {put caption halfway in footer} 1111 | APage.SetFont(IDX, fSize); 1112 | APage.SetColor(cTabSht.Font.Color, false); 1113 | APage.WriteText(DX,DY,cTabSht.Caption); 1114 | end; 1115 | end; 1116 | end; 1117 | 1118 | 1119 | {------------------------------------------------------------------------------ 1120 | Form parsing functions 1121 | -------------------------------------------------------------------------------} 1122 | 1123 | procedure ParseControls(AControl:TControl; FDoc:TPDFDocument; Page:TPDFPage; ftText:integer; Margins:TMargins); 1124 | {List of simple controls to take action on} 1125 | begin 1126 | if AControl is TLabel then {TLabel} 1127 | LabelToPDF(TLabel(AControl),Page,ftText,Margins); 1128 | 1129 | if AControl is TStaticText then {TStaticText} 1130 | StaticTextToPDF(TStaticText(AControl),Page,ftText,Margins); 1131 | 1132 | if AControl is TEdit then {TEdit} 1133 | EditToPDF(TEdit(AControl),Page,ftText,Margins); 1134 | 1135 | if AControl is TFloatSpinEdit then {TFloatSpinEdit} 1136 | FloatSpinEditToPDF(TFloatSpinEdit(AControl),Page,ftText,Margins); 1137 | 1138 | if AControl is TSpinEdit then {TSpinEdit} 1139 | SpinEditToPDF(TSpinEdit(AControl),Page,ftText,Margins); 1140 | 1141 | {$IFDEF UseLazCntrls} 1142 | if AControl is TSpinEditEx then {TSpinEditEx} 1143 | SpinEditExToPDF(TSpinEditEx(AControl),Page,ftText,Margins); 1144 | 1145 | if AControl is TFloatSpinEditEx then {TFloatSpinEditEx} 1146 | FloatSpinEditExToPDF(TFloatSpinEditEx(AControl),Page,ftText,Margins); 1147 | {$ENDIF} 1148 | 1149 | if AControl is TDirectoryEdit then {TDirectoryEdit} 1150 | DirEditToPDF(TDirectoryEdit(AControl),Page,ftText,Margins); 1151 | 1152 | if AControl is TFileNameEdit then {TFileNameEdit} 1153 | FileEditToPDF(TFileNameEdit(AControl),Page,ftText,Margins); 1154 | 1155 | {$IFDEF UseDTPicker} 1156 | if AControl is TDateTimePicker then {TDateTimePicker} 1157 | DateTimePickerToPDF(TDateTimePicker(AControl),Page,ftText,Margins); 1158 | {$ENDIF} 1159 | 1160 | if AControl is TComboBox then {TComboBox} 1161 | ComboBoxToPDF(TComboBox(AControl),Page,ftText,Margins); 1162 | 1163 | if AControl is TListBox then {TListBox} 1164 | ListBoxToPDF(TListBox(AControl),FDoc,Page,ftText,Margins); 1165 | 1166 | if AControl is TStringGrid then {TStringGrid} 1167 | StringGridToPDF(TStringGrid(AControl),FDoc,Page,ftText,Margins); 1168 | 1169 | if AControl is TValueListEditor then {TValueListEditor} 1170 | ValueListToPDF(TValueListEditor(AControl),FDoc,Page,ftText,Margins); 1171 | 1172 | if AControl is TMemo then {TMemo} 1173 | MemoToPDF(TMemo(AControl),FDoc,Page,ftText,Margins); 1174 | 1175 | if AControl is TCheckBox then {TCheckBox} 1176 | CheckBoxToPDF(TCheckBox(AControl),Page,ftText,Margins); 1177 | 1178 | if AControl is TRadioButton then {TRadioButton} 1179 | RadioButToPDF(TRadioButton(AControl),Page,ftText,Margins); 1180 | 1181 | if AControl is TImage then {TImage} 1182 | ImageToPDF(TImage(AControl),FDoc,Page,Margins); 1183 | 1184 | {$IFDEF UseTAChart} 1185 | if AControl is TChart then {TChart} 1186 | ChartToPDF(TChart(AControl),FDoc,Page,Margins); 1187 | {$ENDIF} 1188 | 1189 | if AControl is TShape then {TShape} 1190 | ShapeToPDF(TShape(AControl),Page,Margins); 1191 | 1192 | if AControl is TPageControl then {TPageControl} 1193 | RecurseControls(AControl,FDoc,Page,ftText,Margins); 1194 | 1195 | if AControl is TTabSheet then {TTabSheet} 1196 | RecurseControls(AControl,FDoc,Page,ftText,Margins); 1197 | 1198 | if AControl is TGroupBox then {TGroupBox} 1199 | RecurseControls(AControl,FDoc,Page,ftText,Margins); 1200 | 1201 | if AControl is TPanel then {TPanel} 1202 | RecurseControls(AControl,FDoc,Page,ftText,Margins); 1203 | 1204 | if AControl is TRadioGroup then {TRadioGroup} 1205 | RecurseControls(AControl,FDoc,Page,ftText,Margins); 1206 | 1207 | if AControl is TCheckGroup then {TCheckGroup} 1208 | RecurseControls(AControl,FDoc,Page,ftText,Margins); 1209 | 1210 | if AControl is TScrollbox then {TScrollbox} 1211 | RecurseControls(AControl,FDoc,Page,ftText,Margins); 1212 | end; 1213 | 1214 | 1215 | procedure RecurseControls(AControl:TControl; FDoc:TPDFDocument; Page:TPDFPage; ftText:integer; Margins:TMargins); 1216 | {Iterate through components and print them to PDF, recurse into nested controls. 1217 | Terrible programming but use exit to emulate case and increase efficiency} 1218 | var cForm :TForm; 1219 | cPageCtrl :TPageControl; 1220 | cScrollbx :TScrollbox; 1221 | I :integer; 1222 | begin 1223 | if AControl is TForm then {TForm} 1224 | begin 1225 | cForm := AControl as TForm; 1226 | {write page titel centered} 1227 | Header2PDF(cForm,Page,ftText,Margins); 1228 | Margins.T := Margins.T + Margins.H; 1229 | for I:=0 to cForm.ControlCount - 1 do 1230 | ParseControls(cForm.Controls[I],FDoc,Page,ftText,Margins); 1231 | exit; 1232 | end; 1233 | if AControl is TPageControl then {TPageControl} 1234 | begin 1235 | cPageCtrl := AControl as TPageControl; 1236 | for I:=0 to cPageCtrl.ControlCount - 1 do 1237 | ParseControls(cPageCtrl.Controls[I],FDoc,Page,ftText,Margins); 1238 | exit; 1239 | end; 1240 | if AControl is TTabSheet then {TTabSheet} 1241 | begin 1242 | TabSheetToPDF(TTabSheet(AControl),FDoc,Page,ftText,Margins); 1243 | exit; 1244 | end; 1245 | if AControl is TScrollbox then 1246 | begin 1247 | cScrollBx := AControl as TScrollbox; 1248 | for I:=0 to cScrollbx.ControlCount - 1 do 1249 | ParseControls(cScrollbx.Controls[I],FDoc,Page,ftText,Margins); 1250 | exit; 1251 | end; 1252 | if AControl is TGroupBox then {TGroupBox} 1253 | begin 1254 | GroupBoxToPDF(TGroupBox(AControl),FDoc,Page,ftText,Margins); 1255 | exit; 1256 | end; 1257 | if AControl is TPanel then {TPanel} 1258 | begin 1259 | PanelToPDF(TPanel(AControl),FDoc,Page,ftText,Margins); 1260 | exit; 1261 | end; 1262 | if AControl is TRadioGroup then {TRadioGroup} 1263 | begin 1264 | RadioGroupToPDF(TRadioGroup(AControl),FDoc,Page,ftText,Margins); 1265 | exit; 1266 | end; 1267 | if AControl is TCheckGroup then {TCheckGroup} 1268 | begin 1269 | CheckGroupToPDF(TCheckGroup(AControl),FDoc,Page,ftText,Margins); 1270 | exit; 1271 | end; 1272 | end; 1273 | 1274 | 1275 | function FormToPDF:integer; 1276 | {Use to check if FormToPDF is available. Resets FDoc.} 1277 | begin 1278 | FreeAndNil(FDoc); 1279 | Result := FormToPDF(nil,''); 1280 | end; 1281 | 1282 | 1283 | function FormToPDF(AControl: TControl):integer; 1284 | {Use to append pages to FDoc} 1285 | begin 1286 | Result := FormToPDF(AControl,''); 1287 | end; 1288 | 1289 | 1290 | function FormToPDF(FileName:string):integer; 1291 | {Use to save FDoc to PDF and reset FDoc} 1292 | begin 1293 | Result := FormToPDF(nil,FileName); 1294 | end; 1295 | 1296 | 1297 | function FormToPDF(AControl: TControl; FileName:string):integer; 1298 | {Note screen origin is top-left, pdf origin is bottom-left. We map the form to 1299 | the page 1:1, but PDF is 72 dpi (Points) and screen is usually 96dpi so the 1300 | form will be enlarged. Returns number of objects printed if successful, error 1301 | code otherwise. Error codes: 1302 | 0 initialisation OK, no objects printed, nil control or empty filename. 1303 | -1 no fonts available. 1304 | -2 could not create document} 1305 | 1306 | var DW,DH, 1307 | ftTitle, {title font index} 1308 | ftText :integer; {text font index} 1309 | Page :TPDFPage; 1310 | Section :TPDFSection; 1311 | Aspect :single; {control aspect ratio} 1312 | Margins :TMargins; 1313 | 1314 | begin 1315 | Result := -1; 1316 | FirstPage := false; 1317 | 1318 | {Checks} 1319 | if FontsAvailable then Result := 0; 1320 | if (Result = 0) then 1321 | begin 1322 | {set margins} 1323 | Margins.T := 36; {1/2 inch} 1324 | Margins.L := 36; {1/2 inch} 1325 | Margins.B := 36; {1/2 inch} 1326 | Margins.R := 36; {1/2 inch} 1327 | Margins.H := 36; {1/2 inch} 1328 | Margins.F := 36; {1/2 inch} 1329 | 1330 | if not Assigned(FDoc) then 1331 | begin 1332 | {Set up document} 1333 | try 1334 | FDoc := TForm2PDFDoc.Create(Nil); 1335 | except 1336 | Result := -2; 1337 | end; 1338 | FDoc.Options := [poPageOriginAtTop,poMetadataEntry]; 1339 | FDoc.FontDirectory := 'fonts'; 1340 | FDoc.DefaultUnitOfMeasure := uomPixels; 1341 | FDoc.StartDocument; 1342 | Section := FDoc.Sections.AddSection; 1343 | end; 1344 | 1345 | {set up fonts} 1346 | {It is very difficult to get the system fonts. For now the user must copy 1347 | any fonts used in the form to the /fonts directory and specify them explicitly} 1348 | {ftTitle := FDoc.Addfont('Helvetica'); 1349 | ftText := FDoc.Addfont('FreeSans.ttf','Regular');} 1350 | 1351 | {if user has not already set info then set defaults} 1352 | if FDoc.Infos.Title = '' then 1353 | FDoc.Infos.Title := Application.Title; 1354 | if FDoc.Infos.Author = '' then 1355 | FDoc.Infos.Author := 'Form2PDF'; 1356 | if FDoc.Infos.Producer = '' then 1357 | FDoc.Infos.Producer := 'fpGUI Toolkit 1.4.1'; 1358 | if FDoc.Infos.ApplicationName = '' then 1359 | FDoc.Infos.ApplicationName := ApplicationName; 1360 | FDoc.Infos.CreationDate := Now; 1361 | 1362 | if Assigned(AControl) then 1363 | begin 1364 | {get form aspect ratio} 1365 | DW := AControl.Width; 1366 | DH := AControl.Height; 1367 | Aspect := DW/DH; 1368 | if Aspect > 1 then 1369 | FDoc.DefaultOrientation := ppoLandscape 1370 | else 1371 | FDoc.DefaultOrientation := ppoPortrait; 1372 | 1373 | {set margins} 1374 | Margins.T := FDoc.Margins.T; 1375 | Margins.L := FDoc.Margins.L; 1376 | Margins.B := FDoc.Margins.B; 1377 | Margins.R := FDoc.Margins.R; 1378 | Margins.H := FDoc.Margins.H; 1379 | Margins.F := FDoc.Margins.F; 1380 | 1381 | {set paper size, smaller than A4 use A4 otherwise use custom as nothing larger} 1382 | CustomPaper.H := DH + Margins.T + Margins.B + Margins.H + Margins.F; 1383 | CustomPaper.W := DW + Margins.L + Margins.R; 1384 | CustomPaper.Printable.T := Margins.T; 1385 | CustomPaper.Printable.L := Margins.L; 1386 | CustomPaper.Printable.R := CustomPaper.W - Margins.R; 1387 | CustomPaper.Printable.B := CustomPaper.H - Margins.B; 1388 | if (DW > 842 - Margins.L - Margins.R) or (DH > 595 - Margins.T - Margins.B) then 1389 | FDoc.DefaultPaperType := ptCustom 1390 | else FDoc.DefaultPaperType := ptA4; 1391 | 1392 | {Add first page} 1393 | Page := SetupPage(AControl,FDoc); 1394 | FirstPage := true; 1395 | 1396 | RecurseControls(AControl,FDoc,Page,ftText,Margins); 1397 | end; 1398 | 1399 | {Save the PDF} 1400 | if FileName <> '' then 1401 | begin 1402 | FDoc.SaveToFile(FileName); 1403 | Result := FDoc.ObjectCount; 1404 | FreeAndNil(FDoc); {assume document is finished and dispose} 1405 | end; 1406 | end; 1407 | end; 1408 | 1409 | 1410 | initialization 1411 | FDoc := nil; 1412 | {add any extra fonts} 1413 | gTTFontCache.ReadStandardFonts; 1414 | {gTTFontCache.SearchPath.Add(ExtractFilePath(Application.ExeName) + 'fonts'); 1415 | gTTFontCache.BuildFontCache;} 1416 | gTTFontCache.DPI := 72; 1417 | 1418 | finalization 1419 | FreeAndNil(FDoc); 1420 | 1421 | end. 1422 | 1423 | -------------------------------------------------------------------------------- /images/lena.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/alanphys/Form2PDF/0e5497f9b9e64add31cf45caedc0797a27453055/images/lena.bmp -------------------------------------------------------------------------------- /licence.txt: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /readme.txt: -------------------------------------------------------------------------------- 1 | Form2PDF (c) AC Chamberlain Copyright 2020-2022 2 | 3 | 1) Introduction 4 | This unit renders (very crudely) the text and image components of a form to a PDF using the fcl-pdf package. The object is not to provide a pixel by pixel representation of the form, but to record the text and image information. Multiline controls such as TStringGrid and TMemo are printed out in their entirety. The unit is modularised so new components can be added easily. Written for Free Pascal and Lazarus. 5 | 6 | 2) Licence 7 | Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at 8 | 9 | http://www.apache.org/licenses/LICENSE-2.0 10 | 11 | Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. 12 | 13 | 3)Supported components are: 14 | TForm 15 | TLabel 16 | TStaticText 17 | TEdit 18 | TSpinEdit 19 | TFloatSpinEdit 20 | TSpinEditEx 21 | TFloatSpinEditEx 22 | TDirectoryEdit 23 | TFileNameEdit 24 | TComboBox 25 | TListBox 26 | TStringGrid 27 | TValueListEditor 28 | TMemo (does not support word wrapping under linux) 29 | TCheckBox 30 | TRadioButton 31 | TImage 32 | TChart 33 | TShape (rectangle, rounded rect, ellipse) 34 | TPageControl 35 | TTabSheet 36 | TGroupBox 37 | TPanel 38 | TRadioGroup 39 | TCheckGroup 40 | TScrollbox 41 | TDateTime 42 | 43 | 4) Usage 44 | To use copy form2pdf.pas into your source directory and include Form2PDF in your uses clause. You will need to add the path to the fcl-pdf source so the standard font metrics file can be included. Any visual control can be passed as a parent eg. TTabSheet or TForm. 45 | 46 | FormToPDF 47 | Initialise FDoc and check if fonts are available. Returns 0 if everything OK, error code otherwise. 48 | 49 | FormToPDF(AControl: TControl) 50 | Parse controls and append pages to Fdoc. Returns number of objects in FDoc, error code otherwise. 51 | 52 | FormToPDF(FileName:string) 53 | Save FDoc to PDF and reset FDoc. Returns number of objects in FDoc, error code otherwise. 54 | 55 | FormToPDF(AControl:TControl; FileName:string) 56 | Parse controls and save and close Fdoc. Returns number of objects in FDoc, error code otherwise. 57 | 58 | 5) History 59 | 26/6/2020 Initial commit. 60 | 3/7/2020 Fix bottom margin pagination. 61 | 5/7/2020 (TvS):moved initialization of FormToPDF to initalization part of unit 62 | 6/7/2020 changed FormToPDF to function to return error code 63 | added control and filename checks 64 | 8/7/2020 add functionality to append pages to document, FDoc now global} 65 | 13/7/2020 load and use system fonts 66 | 15/7/2020 add text alignment for labels 67 | 17/7/2020 add text alignment for spin edits 68 | add Panel caption 69 | 5/8/2020 add hide string grid columns 70 | 6/8/2020 fix string grid fixed cols bug 71 | add consistent margin schema 72 | 17/12/2020 use rounded rect for smoother appearance 73 | fix TStringGrid no columns bug 74 | 18/12/2020 fix TStringGrid extend beyond end of control 75 | 14/6/2021 add TScrollbox 76 | fix groupbox (inc radiogroup and checkgroup) item spacing start 77 | fix add metadata 78 | 17/6/2021 fix off by one on panel and groupbox border 79 | add 2 pixel offset to left margin for panel and groupbox borders 80 | 22/6/2021 add TDateTime 81 | add drawing routines and refactor 82 | tweak arrows for spin and combo boxes 83 | add conditional defines for controls 84 | 28/11/2022 derive TForm2PDFDoc class and add definable margins in FDOC 85 | print TabSheet caption in footer 86 | 87 | 6) To Do 88 | Implement word wrapping on TMemo (seems to be OK for Windows) 89 | --------------------------------------------------------------------------------