1{target:win} 2// 3// AggPas 2.4 RM3 Demo application 4// Milan Marusinec alias Milano (c) 2006 - 2008 5// Note: Press F1 key on run to see more info about this demo 6// 7program 8 find_compilers_win ; 9 10uses 11 SysUtils ,Windows , 12 13 agg_basics , 14 agg_platform_support , 15 16 agg_color , 17 agg_pixfmt , 18 agg_pixfmt_rgb , 19 20 agg_ctrl , 21 agg_cbox_ctrl , 22 agg_rbox_ctrl , 23 24 agg_rendering_buffer , 25 agg_renderer_base , 26 agg_renderer_scanline , 27 agg_rasterizer_scanline_aa , 28 agg_scanline , 29 agg_scanline_u , 30 agg_render_scanlines , 31 32 agg_gsv_text , 33 agg_conv_stroke , 34 file_utils_ ; 35 36{$I agg_mode.inc } 37{$I- } 38type 39 src_key = record 40 key , 41 val : string[99 ]; 42 43 end; 44 45const 46 flip_y = true; 47 48 g_appl = 'AggPas'; 49 g_full = 'AggPas 2.4 RM3 vector graphics library'; 50 51 g_agg_paths = 'src;src\ctrl;src\platform\win;src\util;src\svg;gpc;expat-wrap'; 52 g_inc_paths = 'src'; 53 g_out_paths = '_debug'; 54 55 g_delphi_config = '-CG -B -H- -W-'; 56 g_fpc_config = '-Mdelphi -Twin32 -WG -Sg -Se3 -CX -XX -Xs -B -Op3 -v0i'; 57 58 g_max = 20; 59 g_max_demos = 100; 60 61 key_max = 99; 62 63var 64 g_lock ,g_image : boolean; 65 66 g_found ,g_num_demos : unsigned; 67 68 g_search_results : array[0..g_max - 1 ] of shortstring; 69 70 g_demos : array[0..g_max_demos - 1 ] of string[99 ]; 71 72 key_array : array[0..key_max - 1 ] of src_key; 73 key_count , 74 key_lastx : unsigned; 75 key_scanx : shortstring; 76 77type 78 the_application_ptr = ^the_application; 79 80 dialog_ptr = ^dialog; 81 82 func_action = function(appl : the_application_ptr; sender : dialog_ptr ) : boolean; 83 84 user_action_ptr = ^user_action; 85 user_action = record 86 func : func_action; 87 ctrl : rbox_ctrl; 88 89 end; 90 91 user_choice = record 92 ctrl : cbox_ctrl; 93 attr : shortstring; 94 95 end; 96 97 dlg_status_e = (ds_none ,ds_define ,ds_ready ,ds_waiting_input ,ds_running ); 98 99 dialog = object 100 m_appl : the_application_ptr; 101 m_info : PChar; 102 m_text : char_ptr; 103 m_tx_x , 104 m_tx_y : double; 105 m_aloc , 106 m_size : unsigned; 107 m_clri , 108 m_clrt : aggclr; 109 110 m_status : dlg_status_e; 111 112 m_actions : array[0..4 ] of user_action; 113 m_choices : array[0..25 ] of user_choice; 114 115 m_num_actions , 116 m_num_choices : unsigned; 117 118 m_cur_action : user_action_ptr; 119 120 m_waiting : func_action; 121 122 constructor Construct(appl : the_application_ptr; info : PChar; clr : aggclr_ptr = NIL ); 123 destructor Destruct; 124 125 procedure set_waiting(act : func_action ); 126 127 procedure add_action(name : PChar; act : func_action; x1 ,y1 ,x2 ,y2 : double ); 128 procedure add_choice(name ,attr : PChar; x ,y : double; status : boolean = false ); 129 130 procedure change_text(text : PChar; x ,y : double; clr : aggclr_ptr = NIL ); 131 procedure append_text(text : PChar ); 132 133 function add_controls : boolean; 134 procedure set_next_status(status : dlg_status_e = ds_none ); 135 136 function find_cur_action : boolean; 137 function call_cur_action : boolean; 138 procedure call_waiting; 139 140 end; 141 142 the_application = object(platform_support ) 143 m_dlg_welcome , 144 m_dlg_set_drives , 145 m_dlg_searching , 146 m_dlg_not_found , 147 m_dlg_found_some : dialog; 148 149 m_cur_dlg : dialog_ptr; 150 151 m_ras : rasterizer_scanline_aa; 152 m_sl : scanline_u8; 153 154 m_Thread : THandle; 155 m_ApplID : LongWord; 156 m_DoQuit : boolean; 157 m_ShLast , 158 m_DoShow : shortstring; 159 160 constructor Construct(format_ : pix_format_e; flip_y_ : boolean ); 161 destructor Destruct; 162 163 procedure draw_text(x ,y : double; msg : PChar; clr : aggclr_ptr = NIL ); 164 165 procedure on_init; virtual; 166 procedure on_draw; virtual; 167 168 procedure on_ctrl_change; virtual; 169 procedure on_idle; virtual; 170 171 procedure on_key(x ,y : int; key ,flags : unsigned ); virtual; 172 173 end; 174 175{ NEXTKEY } 176function NextKey(var val : shortstring ) : boolean; 177begin 178 result:=false; 179 180 while key_lastx < key_count do 181 begin 182 inc(key_lastx ); 183 184 if cmp_str(key_array[key_lastx - 1 ].key ) = key_scanx then 185 begin 186 val:=key_array[key_lastx - 1 ].val; 187 188 result:=true; 189 190 break; 191 192 end; 193 194 end; 195 196end; 197 198{ FIRSTKEY } 199function FirstKey(key : shortstring; var val : shortstring ) : boolean; 200begin 201 key_lastx:=0; 202 key_scanx:=cmp_str(key ); 203 204 result:=NextKey(val ); 205 206end; 207 208{ LOADKEYS } 209procedure LoadKeys(buff : char_ptr; size : int ); 210type 211 e_scan = (expect_lp ,load_key ,load_val ,next_ln ,expect_crlf ); 212 213var 214 scan : e_scan; 215 key , 216 val : shortstring; 217 218procedure add_key; 219begin 220 if key_count < key_max then 221 begin 222 key_array[key_count ].key:=key; 223 key_array[key_count ].val:=val; 224 225 inc(key_count ); 226 227 end; 228 229 key:=''; 230 val:=''; 231 232end; 233 234begin 235 key_count:=0; 236 237 scan:=expect_lp; 238 key :=''; 239 val :=''; 240 241 while size > 0 do 242 begin 243 case scan of 244 expect_lp : 245 case buff^ of 246 '{' : 247 scan:=load_key; 248 249 else 250 break; 251 252 end; 253 254 load_key : 255 case buff^ of 256 #13 ,#10 : 257 break; 258 259 ':' : 260 scan:=load_val; 261 262 '}' : 263 begin 264 add_key; 265 266 scan:=next_ln; 267 268 end; 269 270 else 271 key:=key + buff^; 272 273 end; 274 275 load_val : 276 case buff^ of 277 #13 ,#10 : 278 break; 279 280 '}' : 281 begin 282 add_key; 283 284 scan:=next_ln; 285 286 end; 287 288 else 289 val:=val + buff^; 290 291 end; 292 293 next_ln : 294 case buff^ of 295 #13 ,#10 : 296 scan:=expect_crlf; 297 298 ' ' : 299 else 300 break; 301 302 end; 303 304 expect_crlf : 305 case buff^ of 306 '{' : 307 scan:=load_key; 308 309 #13 ,#10 : 310 else 311 break; 312 313 end; 314 315 end; 316 317 dec(size ); 318 inc(ptrcomp(buff ) ); 319 320 end; 321 322end; 323 324{ CONSTRUCT } 325constructor dialog.Construct; 326begin 327 m_clri.ConstrDbl(0 ,0 ,0 ); 328 m_clrt.ConstrDbl(0 ,0 ,0 ); 329 330 m_appl:=appl; 331 m_info:=info; 332 m_text:=NIL; 333 m_tx_x:=0; 334 m_tx_y:=0; 335 m_aloc:=0; 336 m_size:=0; 337 338 if clr <> NIL then 339 m_clri:=clr^; 340 341 m_status:=ds_define; 342 343 m_num_actions:=0; 344 m_num_choices:=0; 345 346 m_cur_action:=NIL; 347 m_waiting :=NIL; 348 349end; 350 351{ DESTRUCT } 352destructor dialog.Destruct; 353var 354 i : unsigned; 355 356begin 357 if m_text <> NIL then 358 agg_freemem(pointer(m_text ) ,m_aloc ); 359 360 if m_num_actions > 0 then 361 for i:=0 to m_num_actions - 1 do 362 m_actions[i ].ctrl.Destruct; 363 364 if m_num_choices > 0 then 365 for i:=0 to m_num_choices - 1 do 366 m_choices[i ].ctrl.Destruct; 367 368end; 369 370{ SET_WAITING } 371procedure dialog.set_waiting; 372begin 373 m_waiting:=@act; 374 375end; 376 377{ ADD_ACTION } 378procedure dialog.add_action; 379begin 380 case m_status of 381 ds_define ,ds_ready : 382 if m_num_actions < 5 then 383 begin 384 m_actions[m_num_actions ].ctrl.Construct(x1 ,y1 ,x2 ,y2 ,not flip_y ); 385 m_actions[m_num_actions ].ctrl.add_item (name ); 386 387 m_actions[m_num_actions ].func:=@act; 388 389 inc(m_num_actions ); 390 391 set_next_status(ds_ready ); 392 393 end; 394 395 end; 396 397end; 398 399{ ADD_CHOICE } 400procedure dialog.add_choice; 401begin 402 case m_status of 403 ds_define ,ds_ready : 404 if m_num_choices < 26 then 405 begin 406 m_choices[m_num_choices ].ctrl.Construct(x ,y ,name ,not flip_y ); 407 m_choices[m_num_choices ].ctrl.status_ (status ); 408 409 m_choices[m_num_choices ].attr:=StrPas(attr ) + #0; 410 411 inc(m_num_choices ); 412 413 end; 414 415 end; 416 417end; 418 419{ CHANGE_TEXT } 420procedure dialog.change_text; 421begin 422 if StrLen(text ) + 1 > m_aloc then 423 begin 424 agg_freemem(pointer(m_text ) ,m_aloc ); 425 426 m_aloc:=StrLen(text ) + 1; 427 428 agg_getmem(pointer(m_text ) ,m_aloc ); 429 430 end; 431 432 move(text[0 ] ,m_text^ ,StrLen(text ) + 1 ); 433 434 m_size:=StrLen(text ); 435 m_tx_x:=x; 436 m_tx_y:=y; 437 438 if clr <> NIL then 439 m_clrt:=clr^; 440 441end; 442 443{ APPEND_TEXT } 444procedure dialog.append_text; 445var 446 new_text : char_ptr; 447 new_aloc : unsigned; 448 449begin 450 if StrLen(text ) + m_size + 1 > m_aloc then 451 begin 452 new_aloc:=StrLen(text ) + m_size + 1; 453 454 agg_getmem(pointer(new_text ) ,new_aloc ); 455 456 move(m_text^ ,new_text^ ,m_size ); 457 458 agg_freemem(pointer(m_text ) ,m_aloc ); 459 460 m_aloc:=new_aloc; 461 m_text:=new_text; 462 463 end; 464 465 move(text[0 ] ,char_ptr(ptrcomp(m_text ) + m_size )^ ,StrLen(text ) + 1 ); 466 467 inc(m_size ,StrLen(text ) ); 468 469end; 470 471{ ADD_CONTROLS } 472function dialog.add_controls; 473var 474 i : unsigned; 475 476begin 477 result:=false; 478 479 case m_status of 480 ds_ready : 481 begin 482 m_appl.m_ctrls.Destruct; 483 m_appl.m_ctrls.Construct; 484 485 if m_num_actions > 0 then 486 for i:=0 to m_num_actions - 1 do 487 m_appl.add_ctrl(@m_actions[i ].ctrl ); 488 489 if m_num_choices > 0 then 490 for i:=0 to m_num_choices - 1 do 491 m_appl.add_ctrl(@m_choices[i ] ); 492 493 set_next_status; 494 495 result:=true; 496 497 end; 498 499 end; 500 501end; 502 503{ SET_NEXT_STATUS } 504procedure dialog.set_next_status; 505begin 506 if status <> ds_none then 507 m_status:=status 508 else 509 case m_status of 510 ds_define : 511 m_status:=ds_ready; 512 513 ds_ready : 514 m_status:=ds_waiting_input; 515 516 ds_waiting_input : 517 m_status:=ds_running; 518 519 end; 520 521end; 522 523{ FIND_CUR_ACTION } 524function dialog.find_cur_action; 525var 526 i : unsigned; 527 528begin 529 result:=false; 530 531 case m_status of 532 ds_waiting_input : 533 if m_num_actions > 0 then 534 for i:=0 to m_num_actions - 1 do 535 if m_actions[i ].ctrl._cur_item = 0 then 536 begin 537 m_cur_action:=@m_actions[i ]; 538 539 result:=true; 540 541 exit; 542 543 end; 544 545 end; 546 547end; 548 549{ CALL_CUR_ACTION } 550// result of true means, that this was the last call 551function dialog.call_cur_action; 552begin 553 result:=false; 554 555 case m_status of 556 ds_running : 557 if m_cur_action <> NIL then 558 result:=m_cur_action.func(m_appl ,@self ); 559 560 end; 561 562end; 563 564{ CALL_WAITING } 565procedure dialog.call_waiting; 566begin 567 if @m_waiting <> NIL then 568 m_waiting(m_appl ,@self ); 569 570end; 571 572{ create_delphi } 573procedure create_delphi(batch_file ,comp_path ,project : shortstring ); 574var 575 command : AnsiString; 576 577 suffix ,file_path ,file_name ,file_ext : shortstring; 578 579 df : text; 580 581begin 582// Compose the units path string 583 spread_name(comp_path ,file_path ,file_name ,file_ext ); 584 585 command:=dir_str(file_path ); 586 587 spread_name(command ,file_path ,suffix ,file_ext ); 588 589 suffix:=file_path + 'lib'; 590 591// Compose the command string 592 command:='"' + comp_path + 'dcc32.exe" '; 593 command:=command + '-U"' + suffix + '";'; 594 command:=command + g_agg_paths + ' '; 595 command:=command + '-I' + g_inc_paths + ' '; 596 command:=command + '-N' + g_out_paths + ' '; 597 command:=command + g_delphi_config + ' '; 598 command:=command + project; 599 600// Create the file 601 AssignFile(df ,batch_file ); 602 rewrite (df ); 603 writeln (df ,command ); 604 close (df ); 605 606end; 607 608{ create_fpc } 609procedure create_fpc(batch_file ,comp_path ,project : shortstring ); 610var 611 command : AnsiString; 612 613 suffix ,file_path ,file_name ,file_ext : shortstring; 614 615 df : text; 616 617begin 618// Compose the units path string 619 spread_name(comp_path ,file_path ,file_name ,file_ext ); 620 621 command:=dir_str(file_path ); 622 623 spread_name(command ,file_path ,suffix ,file_ext ); 624 625 command:=dir_str(file_path ); 626 627 spread_name(command ,file_path ,file_name ,file_ext ); 628 629 suffix:=file_path + 'units\' + suffix; 630 631// Compose the command string 632 command:='"' + comp_path + 'ppc386.exe" '; 633 command:=command + '-FD"' + suffix + '" '; 634 command:=command + '-Fu' + g_agg_paths + ' '; 635 command:=command + '-Fi' + g_inc_paths + ' '; 636 command:=command + '-FU' + g_out_paths + ' '; 637 command:=command + g_fpc_config + ' '; 638 command:=command + project; 639 640// Create the file 641 AssignFile(df ,batch_file ); 642 rewrite (df ); 643 writeln (df ,command ); 644 close (df ); 645 646end; 647 648{ create_batch_files } 649procedure create_batch_files(project : shortstring; var del ,fpc : unsigned ); 650var 651 i ,del_cnt ,fpc_cnt : unsigned; 652 653 batch ,batch_path ,comp_path ,file_path ,comp_name ,file_name ,file_ext : shortstring; 654 655 df : text; 656 657begin 658 spread_name(ParamStr(0 ) ,batch_path ,file_name ,file_ext ); 659 660 del_cnt:=1; 661 fpc_cnt:=1; 662 663 for i:=0 to g_found - 1 do 664 begin 665 spread_name(g_search_results[i ] ,comp_path ,comp_name ,file_ext ); 666 spread_name(project ,file_path ,file_name ,file_ext ); 667 668 if cmp_str(comp_name ) = cmp_str('dcc32' ) then 669 begin 670 // Make batch for Delphi 671 if del_cnt = 1 then 672 batch:='' 673 else 674 str(del_cnt ,batch ); 675 676 batch:='delphi' + batch + '-' + file_name; 677 batch:=fold_name(batch_path ,batch ,'*.bat' ); 678 679 create_delphi(batch ,comp_path ,project ); 680 681 // Make file 682 if del_cnt = 1 then 683 file_ext:='' 684 else 685 str(del_cnt ,file_ext ); 686 687 file_ext :='delphi' + file_ext + '_make_all'; 688 file_name:=fold_name(batch_path ,file_ext ,'*.bat' ); 689 690 AssignFile(df ,file_name ); 691 692 if del = 0 then 693 rewrite(df ) 694 else 695 append(df ); 696 697 file_ext:='call "' + batch + '"'; 698 699 writeln(df ,file_ext ); 700 close (df ); 701 702 inc(del_cnt ); 703 704 end 705 else 706 begin 707 // Make batch for FreePascal 708 if fpc_cnt = 1 then 709 batch:='' 710 else 711 str(fpc_cnt ,batch ); 712 713 batch:='fpc' + batch + '-' + file_name; 714 batch:=fold_name(batch_path ,batch ,'*.bat' ); 715 716 create_fpc(batch ,comp_path ,project ); 717 718 // Make file 719 if fpc_cnt = 1 then 720 file_ext:='' 721 else 722 str(fpc_cnt ,file_ext ); 723 724 file_ext :='fpc' + file_ext + '_make_all'; 725 file_name:=fold_name(batch_path ,file_ext ,'*.bat' ); 726 727 AssignFile(df ,file_name ); 728 729 if fpc = 0 then 730 rewrite(df ) 731 else 732 append(df ); 733 734 file_ext:='call "' + batch + '"'; 735 736 writeln(df ,file_ext ); 737 close (df ); 738 739 inc(fpc_cnt ); 740 741 end; 742 743 end; 744 745 inc(del ,del_cnt - 1 ); 746 inc(fpc ,fpc_cnt - 1 ); 747 748end; 749 750{ action_configure } 751function action_configure(appl : the_application_ptr; sender : dialog_ptr ) : boolean; 752var 753 i : unsigned; 754 755 text : shortstring; 756 rgba : aggclr; 757 758 del ,fpc : unsigned; 759 760begin 761 rgba.ConstrDbl(0 ,0.5 ,0 ); 762 763 appl.m_dlg_searching.change_text('Creating appropriate batch files ...' ,10 ,320 ,@rgba ); 764 appl.force_redraw; 765 766// Setup the final text 767 rgba.ConstrDbl(0 ,0.5 ,0 ); 768 769 appl.m_dlg_found_some.change_text('' ,10 ,385 ,@rgba ); 770 771 for i:=0 to g_found - 1 do 772 begin 773 str(i + 1 ,text ); 774 775 text:='(' + text + ') ' + g_search_results[i ] + #13#0; 776 777 appl.m_dlg_found_some.append_text(@text[1 ] ); 778 779 end; 780 781// Create the batch files 782 if g_num_demos > 0 then 783 begin 784 appl.m_dlg_found_some.append_text( 785 #13 + 786 'Appropriate batch files for compiling the ' + g_appl + ' demos were created'#13 + 787 'in the directory, from which this helper utility was run.' ); 788 789 del:=0; 790 fpc:=0; 791 792 for i:=0 to g_num_demos - 1 do 793 create_batch_files(g_demos[i ] ,del ,fpc ); 794 795 if del > 0 then 796 appl.m_dlg_found_some.append_text( 797 #13#13 + 798 'Note: For the Delphi compiler, which was found on your system,'#13 + 799 'helper utility assumes, that the system libraries needed for'#13 + 800 'successful compilation are located in the parallel directory'#13 + 801 '"..\lib" of the particular Delphi compiler path.' ); 802 803 if fpc > 0 then 804 appl.m_dlg_found_some.append_text( 805 #13#13 + 806 'Note: For the Free Pascal compiler, which was found on your system,'#13 + 807 'helper utility assumes, that the system libraries needed for'#13 + 808 'successful compilation are located in the parallel directory'#13 + 809 '"..\units\i386-win32" of the particular Free Pascal compiler path.' ); 810 811 end 812 else 813 appl.m_dlg_found_some.append_text( 814 #13 + 815 'NO batch files for compiling the ' + g_appl + ' demos'#13 + 816 'were created in the directory, from which this helper'#13 + 817 'utility was run, because no *.dpr projects were found.' ); 818 819// Refresh 820 appl.force_redraw; 821 822end; 823 824{ action_set_drives } 825function action_set_drives(appl : the_application_ptr; sender : dialog_ptr ) : boolean; 826var 827 letter , 828 path , 829 drive : shortstring; 830 831 drive_type ,i ,count : unsigned; 832 833begin 834// Scan for drives in the system 835 letter:='C'; 836 count :=0; 837 838 for i:=1 to 24 do 839 begin 840 path :=letter + ':\'#0; 841 drive:=''; 842 843 drive_type:=GetDriveType(@path[1 ] ); 844 845 case drive_type of 846 DRIVE_FIXED : drive:='fixed harddrive'; 847 DRIVE_REMOVABLE : drive:='removable drive'; 848 DRIVE_REMOTE : drive:='network or remote drive'; 849 DRIVE_CDROM : drive:='CD-ROM drive'; 850 DRIVE_RAMDISK : drive:='RAM disk'; 851 852 end; 853 854 if drive <> '' then 855 begin 856 drive:=' ' + StrPas(@path[1 ] ) + ' (' + drive + ')' + #0; 857 858 appl.m_dlg_set_drives.add_choice(@drive[1 ] ,@path[1 ] ,30 ,360 - count * 30 ,count = 0 ); 859 860 inc(count ); 861 862 end; 863 864 inc(byte(letter[1 ] ) ); 865 866 end; 867 868 appl.m_cur_dlg:=@appl.m_dlg_set_drives; 869 870// OK Done 871 result:=true; 872 873end; 874 875{ action_while_search } 876function action_while_search(appl : the_application_ptr; sender : dialog_ptr ) : boolean; 877var 878 text : shortstring; 879 rgba : aggclr; 880 881begin 882 while g_lock do; 883 884 g_lock:=true; 885 886 if appl.m_ShLast <> appl.m_DoShow then 887 begin 888 str(g_found ,text ); 889 890 text:= 891 ' ' + appl.m_DoShow + #13#13 + 892 'Compilers found: ' + text + #0; 893 894 //rgba.ConstrDbl(0 ,0 ,0.5 ); 895 896 appl.m_dlg_searching.change_text(@text[1 ] ,10 ,320 ); 897 appl.force_redraw; 898 899 appl.m_ShLast:=appl.m_DoShow; 900 901 end; 902 903 g_lock:=false; 904 905end; 906 907{ process_file } 908function process_file(file_name : shortstring ) : boolean; 909begin 910 if g_found < g_max then 911 begin 912 g_search_results[g_found ]:=file_name; 913 914 inc(g_found ); 915 916 end; 917 918end; 919 920{ scan_files } 921function scan_files(files : shortstring; appl : the_application_ptr ) : boolean; 922var 923 SR : TSearchRec; 924 err : integer; 925 926 find ,file_path ,file_name ,file_ext : shortstring; 927 928begin 929 result:=false; 930 931{ Scan dirs and go further } 932 spread_name(files ,file_path ,file_name ,file_ext ); 933 934 while g_lock do; 935 936 g_lock:=true; 937 938 appl.m_DoShow:=file_path; 939 940 g_lock:=false; 941 942 err:=SysUtils.FindFirst(str_dir(file_path ) + '*' ,faDirectory ,SR ); 943 944 while err = 0 do 945 begin 946 if appl.m_DoQuit then 947 begin 948 SysUtils.FindClose(SR ); 949 950 exit; 951 952 end; 953 954 if (SR.Name <> '.' ) and 955 (SR.Name <> '..' ) and 956 (SR.Attr and faDirectory = faDirectory ) then 957 begin 958 spread_name(files ,file_path ,file_name ,file_ext ); 959 960 if not scan_files(fold_name(str_dir(file_path ) + SR.Name + '\' ,file_name ,file_ext ) ,appl ) then 961 exit; 962 963 end; 964 965 err:=SysUtils.FindNext(SR ); 966 967 end; 968 969 SysUtils.FindClose(SR ); 970 971{ Scan files for Delphi compiler } 972 find:=fold_name(file_path ,'dcc32' ,'*.exe' ); 973 974 err:=SysUtils.FindFirst(find ,faArchive ,SR ); 975 976 while err = 0 do 977 begin 978 if appl.m_DoQuit then 979 begin 980 SysUtils.FindClose(SR ); 981 982 exit; 983 984 end; 985 986 process_file(fold_name(files ,SR.Name ,SR.Name ) ); 987 988 err:=SysUtils.FindNext(SR ); 989 990 end; 991 992 SysUtils.FindClose(SR ); 993 994{ Scan files for FPC compiler } 995 find:=fold_name(file_path ,'ppc386' ,'*.exe' ); 996 997 err:=SysUtils.FindFirst(find ,faArchive ,SR ); 998 999 while err = 0 do 1000 begin 1001 if appl.m_DoQuit then 1002 begin 1003 SysUtils.FindClose(SR ); 1004 1005 exit; 1006 1007 end; 1008 1009 process_file(fold_name(files ,SR.Name ,SR.Name ) ); 1010 1011 err:=SysUtils.FindNext(SR ); 1012 1013 end; 1014 1015 SysUtils.FindClose(SR ); 1016 1017{ OK } 1018 scan_files:=true; 1019 1020end; 1021 1022{ FnSearch } 1023procedure FnSearch(appl : the_application_ptr ); 1024var 1025 i : unsigned; 1026 1027begin 1028 appl.m_ShLast:=''; 1029 appl.m_DoShow:=''; 1030 1031 g_found:=0; 1032 1033// OK, Go through selected drives and issue search 1034 appl.m_dlg_searching.set_waiting(@action_while_search ); 1035 1036 if appl.m_dlg_set_drives.m_num_choices > 0 then 1037 for i:=0 to appl.m_dlg_set_drives.m_num_choices - 1 do 1038 if appl.m_dlg_set_drives.m_choices[i ].ctrl._status then 1039 if not scan_files(appl.m_dlg_set_drives.m_choices[i ].attr ,appl ) then 1040 break; 1041 1042 appl.m_dlg_searching.set_waiting(NIL ); 1043 1044// Were we forced to quit ? 1045 if appl.m_DoQuit then 1046 NoP; 1047 1048// Depending on the search result activate the next user dialog 1049 if g_found > 0 then 1050 begin 1051 action_configure(appl ,NIL ); 1052 1053 appl.m_cur_dlg:=@appl.m_dlg_found_some; 1054 1055 end 1056 else 1057 appl.m_cur_dlg:=@appl.m_dlg_not_found; 1058 1059end; 1060 1061{ ThSearch } 1062function ThSearch(Parameter : pointer ): integer; 1063begin 1064{ Synchronize } 1065 while the_application_ptr(Parameter ).m_Thread = 0 do; 1066 1067{ Call Thread } 1068 FnSearch(Parameter ); 1069 1070{ Exit } 1071 the_application_ptr(Parameter ).m_Thread:=0; 1072 the_application_ptr(Parameter ).m_ApplID:=0; 1073 1074{ Done } 1075 EndThread(0 ); 1076 1077end; 1078 1079{ action_begin_search } 1080function action_begin_search(appl : the_application_ptr; sender : dialog_ptr ) : boolean; 1081var 1082 i : unsigned; 1083 1084begin 1085 result:=false; 1086 1087// Check, if we have drives to search 1088 if appl.m_dlg_set_drives.m_num_choices > 0 then 1089 for i:=0 to appl.m_dlg_set_drives.m_num_choices - 1 do 1090 if appl.m_dlg_set_drives.m_choices[i ].ctrl._status then 1091 begin 1092 result:=true; 1093 1094 break; 1095 1096 end; 1097 1098 if not result then 1099 begin 1100 appl.m_dlg_set_drives.m_actions[0 ].ctrl.cur_item_(-1 ); 1101 appl.m_dlg_set_drives.set_next_status(ds_waiting_input ); 1102 appl.force_redraw; 1103 1104 exit; 1105 1106 end; 1107 1108// Go on to search dialog 1109 appl.m_cur_dlg:=@appl.m_dlg_searching; 1110 1111// Start Up the search thread 1112 appl.m_Thread:=BeginThread(NIL ,65536 ,ThSearch ,appl ,0 ,appl.m_ApplID ); 1113 1114end; 1115 1116{ action_stop_search } 1117function action_stop_search(appl : the_application_ptr; sender : dialog_ptr ) : boolean; 1118begin 1119 appl.m_DoQuit:=true; 1120 1121end; 1122 1123{ action_exit } 1124function action_exit(appl : the_application_ptr; sender : dialog_ptr ) : boolean; 1125begin 1126 appl.quit; 1127 1128end; 1129 1130{ CONSTRUCT } 1131constructor the_application.Construct; 1132var 1133 rgba : aggclr; 1134 1135begin 1136 inherited Construct(format_ ,flip_y_ ); 1137 1138 m_sl.Construct; 1139 m_ras.Construct; 1140 1141 m_cur_dlg:=NIL; 1142 1143 m_Thread:=0; 1144 m_ApplID:=0; 1145 m_DoQuit:=false; 1146 m_ShLast:=''; 1147 m_DoShow:=''; 1148 1149// Welcome dialog 1150 m_dlg_welcome.Construct( 1151 @self , 1152 'Welcome to the ' + g_full + '.'#13 + 1153 ''#13 + 1154 'This helper utility will scan your system to search'#13 + 1155 'for all available Object Pascal compilers.'#13 + 1156 ''#13 + 1157 'It will also create appropriate batch files with current'#13 + 1158 'paths and options needed to compile properly all'#13 + 1159 'the ' + g_appl + ' demos.'#13+ 1160 ''#13 + 1161 'Currently Delphi and Free Pascal compilers are supported.' ); 1162 1163 m_dlg_welcome.add_action('Continue' ,@action_set_drives ,480 ,15 ,580 ,45 ); 1164 1165// Set drives to search on dialog 1166 m_dlg_set_drives.Construct( 1167 @self , 1168 'Please select, on which drives of your system should'#13 + 1169 'this helper utility perform search for Object Pascal compilers:' ); 1170 1171 m_dlg_set_drives.add_action('Continue' ,@action_begin_search ,480 ,15 ,580 ,45 ); 1172 1173// Wait, searching dialog 1174 m_dlg_searching.Construct( 1175 @self , 1176 'Please wait ...'#13 + 1177 ''#13 + 1178 'Helper utility is searching for Object Pascal compilers'#13 + 1179 'on the drives, you have selected.' ); 1180 1181 m_dlg_searching.add_action('Stop searching' ,@action_stop_search ,440 ,15 ,580 ,45 ); 1182 1183// Found nothing dialog 1184 rgba.ConstrInt(255 ,0 ,0 ); 1185 1186 m_dlg_not_found.Construct( 1187 @self , 1188 'I am sorry, but NO Object Pascal compilers were found'#13 + 1189 'on your system.'#13 + 1190 ''#13 + 1191 'Please install Delphi or FreePascal'#13+ 1192 'and then rerun this utility.'#13#13+ 1193 'http://www.borland.com'#13#13 + 1194 '- or - '#13#13 + 1195 'http://www.freepascal.org' , 1196 @rgba ); 1197 1198 m_dlg_not_found.add_action('Exit' ,@action_exit ,500 ,15 ,580 ,45 ); 1199 1200// Compilers found dialog 1201 rgba.ConstrDbl(0 ,0.5 ,0 ); 1202 1203 m_dlg_found_some.Construct( 1204 @self , 1205 'Following Object Pascal compilers were found your system:' , 1206 @rgba ); 1207 1208 m_dlg_found_some.add_action('Exit' ,@action_exit ,500 ,15 ,580 ,45 ); 1209 1210end; 1211 1212{ DESTRUCT } 1213destructor the_application.Destruct; 1214begin 1215 while m_Thread <> 0 do 1216 m_DoQuit:=true; 1217 1218 inherited Destruct; 1219 1220 m_sl.Destruct; 1221 m_ras.Destruct; 1222 1223 m_dlg_welcome.Destruct; 1224 m_dlg_set_drives.Destruct; 1225 m_dlg_searching.Destruct; 1226 m_dlg_not_found.Destruct; 1227 m_dlg_found_some.Destruct; 1228 1229end; 1230 1231{ DRAW_TEXT } 1232procedure the_application.draw_text; 1233var 1234 pixf : pixel_formats; 1235 rgba : aggclr; 1236 1237 rb : renderer_base; 1238 rs : renderer_scanline_aa_solid; 1239 1240 t : gsv_text; 1241 pt : conv_stroke; 1242 1243begin 1244 pixfmt_bgr24(pixf ,rbuf_window ); 1245 1246 rb.Construct(@pixf ); 1247 rs.Construct(@rb ); 1248 1249 t.Construct; 1250 t.size_ (9.5 ); 1251 t.line_space_(10 ); 1252 1253 pt.Construct(@t ); 1254 pt.width_ (1.2 ); 1255 1256 t.start_point_(x ,y ); 1257 t.text_ (msg ); 1258 1259 if clr <> NIL then 1260 rs.color_(clr ) 1261 else 1262 begin 1263 rgba.ConstrDbl(0 ,0 ,0 ); 1264 rs.color_ (@rgba ); 1265 1266 end; 1267 1268 m_ras.add_path (@pt ); 1269 render_scanlines(@m_ras ,@m_sl ,@rs ); 1270 1271 t.Destruct; 1272 pt.Destruct; 1273 1274end; 1275 1276{ ON_INIT } 1277procedure the_application.on_init; 1278var 1279 SR : TSearchRec; 1280 err : integer; 1281 1282 find ,file_path ,file_name ,file_ext : shortstring; 1283 1284 cf : file; 1285 bf : pointer; 1286 sz : integer; 1287 1288 target ,get : shortstring; 1289 1290begin 1291 wait_mode_(false ); 1292 1293// Load the list of current projects 1294 g_num_demos:=0; 1295 1296 spread_name(ParamStr(0 ) ,file_path ,file_name ,file_ext ); 1297 1298 find:=fold_name(file_path ,'*' ,'*.dpr' ); 1299 err :=SysUtils.FindFirst(find ,faArchive ,SR ); 1300 1301 while err = 0 do 1302 begin 1303 // Load keys from the source file 1304 key_count:=0; 1305 1306 get:=fold_name(file_path ,SR.Name ,SR.Name ); 1307 1308 AssignFile(cf ,SR.Name ); 1309 reset (cf ,1 ); 1310 1311 if IOResult = 0 then 1312 begin 1313 sz:=System.FileSize(cf ); 1314 1315 if agg_getmem(bf ,sz ) then 1316 begin 1317 blockread (cf ,bf^ ,sz ); 1318 LoadKeys (bf ,sz ); 1319 agg_freemem(bf ,sz ); 1320 1321 end; 1322 1323 close(cf ); 1324 1325 end; 1326 1327 target:='win'; 1328 1329 FirstKey('target' ,target ); 1330 1331 // Add To List 1332 if (cmp_str(target ) <> cmp_str('win' ) ) or 1333 FirstKey('skip' ,get ) then 1334 1335 else 1336 if g_num_demos < g_max_demos then 1337 begin 1338 g_demos[g_num_demos ]:=fold_name('' ,SR.Name ,SR.Name ); 1339 1340 inc(g_num_demos ); 1341 1342 end; 1343 1344 err:=SysUtils.FindNext(SR ); 1345 1346 end; 1347 1348 SysUtils.FindClose(SR ); 1349 1350end; 1351 1352{ ON_DRAW } 1353procedure the_application.on_draw; 1354var 1355 pixf : pixel_formats; 1356 rgba : aggclr; 1357 1358 rb : renderer_base; 1359 rs : renderer_scanline_aa_solid; 1360 1361 i ,plus : unsigned; 1362 1363begin 1364// Initialize structures 1365 pixfmt_bgr24(pixf ,rbuf_window ); 1366 1367 rb.Construct(@pixf ); 1368 rs.Construct(@rb ); 1369 1370 rgba.ConstrDbl(1 ,1 ,1 ); 1371 rb.clear (@rgba ); 1372 1373// Render Dialog 1374 if m_cur_dlg <> NIL then 1375 case m_cur_dlg.m_status of 1376 ds_waiting_input ,ds_running : 1377 begin 1378 // Render logo if has one 1379 plus:=0; 1380 1381 if (m_cur_dlg = @m_dlg_welcome ) and 1382 g_image then 1383 begin 1384 rb.copy_from(rbuf_img(1 ) ,NIL ,6 ,330 ); 1385 1386 plus:=rbuf_img(1 )._height + 20; 1387 1388 end; 1389 1390 // Render base text 1391 draw_text(10 ,420 - plus ,m_cur_dlg.m_info ,@m_cur_dlg.m_clri ); 1392 1393 // Render dynamic text 1394 if m_cur_dlg.m_text <> NIL then 1395 draw_text( 1396 m_cur_dlg.m_tx_x , 1397 m_cur_dlg.m_tx_y , 1398 PChar(m_cur_dlg.m_text ) , 1399 @m_cur_dlg.m_clrt ); 1400 1401 // Render choices 1402 if m_cur_dlg.m_num_choices > 0 then 1403 for i:=0 to m_cur_dlg.m_num_choices - 1 do 1404 render_ctrl(@m_ras ,@m_sl ,@rs ,@m_cur_dlg.m_choices[i ] ); 1405 1406 // Render actions 1407 if m_cur_dlg.m_num_actions > 0 then 1408 for i:=0 to m_cur_dlg.m_num_actions - 1 do 1409 render_ctrl(@m_ras ,@m_sl ,@rs ,@m_cur_dlg.m_actions[i ].ctrl ); 1410 1411 end; 1412 1413 end; 1414 1415end; 1416 1417{ ON_CTRL_CHANGE } 1418procedure the_application.on_ctrl_change; 1419begin 1420 if m_cur_dlg <> NIL then 1421 case m_cur_dlg.m_status of 1422 ds_waiting_input : 1423 if m_cur_dlg.find_cur_action then 1424 m_cur_dlg.set_next_status; 1425 1426 end; 1427 1428end; 1429 1430{ ON_IDLE } 1431procedure the_application.on_idle; 1432begin 1433 if m_cur_dlg = NIL then 1434 begin 1435 m_cur_dlg:=@m_dlg_welcome; 1436 1437 if m_cur_dlg.m_status <> ds_ready then 1438 m_cur_dlg:=NIL; 1439 1440 end 1441 else 1442 case m_cur_dlg.m_status of 1443 ds_ready : 1444 if m_cur_dlg.add_controls then 1445 force_redraw; 1446 1447 ds_waiting_input : 1448 m_cur_dlg.call_waiting; 1449 1450 ds_running : 1451 if m_cur_dlg.call_cur_action then 1452 NoP; 1453 1454 end; 1455 1456end; 1457 1458{ ON_KEY } 1459procedure the_application.on_key; 1460begin 1461 if key = key_f1 then 1462 message_( 1463 'This is just an AggPas library helper utility which has nothing to do'#13 + 1464 'with demonstrating any of graphical possibilities of AGG.'#13#13 + 1465 'Author of this pascal port (Milano) recomends to proceed with this utility'#13 + 1466 'on your system right after unpacking the archive, because it will'#13 + 1467 'scan your computer for all available Object Pascal compilers and'#13 + 1468 'it will create the up-to-date working batch files for fompiling the library demos.'#13#13 + 1469 'In the welcome screen of this utility, there is a logo for the AGG library,'#13 + 1470 'which was designed and proposed by Milano. It has the meaning of spiral primitive'#13 + 1471 'upon the interactive polygon control, which should mean in "translation" that'#13 + 1472 '"With AGG the possibilities are endless (the spiral) and custom adjustments'#13 + 1473 'are easy possible. (interactive polygon)".' + 1474 #13#13'Note: F2 key saves current "screenshot" file in this demo''s directory. ' ); 1475 1476end; 1477 1478VAR 1479 app : the_application; 1480 1481BEGIN 1482 g_lock :=false; 1483 g_image:=false; 1484 1485 app.Construct(pix_format_bgr24 ,flip_y ); 1486 app.caption_ (g_appl + ' Startup utility (F1-Help)' ); 1487 1488 if app.load_img(1 ,'aggpas_logo' ) then 1489 g_image:=true; 1490 1491 if app.init(600 ,450 ,0 ) then 1492 app.run; 1493 1494 app.Destruct; 1495 1496END.