← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/aggpas/find_compilers_win.dpr

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/aggpas/find_compilers_win.dpr
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
 
//
7
 
program
8
 
 find_compilers_win ;
9
 
 
10
 
uses
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- }
38
 
type
39
 
 src_key = record
40
 
   key ,
41
 
   val : string[99 ];
42
 
 
43
 
  end;
44
 
 
45
 
const
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
 
 
63
 
var
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
 
 
77
 
type
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 }
176
 
function NextKey(var val : shortstring ) : boolean;
177
 
begin
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
 
 
196
 
end;
197
 
 
198
 
{ FIRSTKEY }
199
 
function FirstKey(key : shortstring; var val : shortstring ) : boolean;
200
 
begin
201
 
 key_lastx:=0;
202
 
 key_scanx:=cmp_str(key );
203
 
 
204
 
 result:=NextKey(val );
205
 
 
206
 
end;
207
 
 
208
 
{ LOADKEYS }
209
 
procedure LoadKeys(buff : char_ptr; size : int );
210
 
type
211
 
 e_scan = (expect_lp ,load_key ,load_val ,next_ln ,expect_crlf );
212
 
 
213
 
var
214
 
 scan : e_scan;
215
 
 key  ,
216
 
 val  : shortstring;
217
 
 
218
 
procedure add_key;
219
 
begin
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
 
 
232
 
end;
233
 
 
234
 
begin
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
 
 
322
 
end;
323
 
 
324
 
{ CONSTRUCT }
325
 
constructor dialog.Construct;
326
 
begin
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
 
 
349
 
end;
350
 
 
351
 
{ DESTRUCT }
352
 
destructor dialog.Destruct;
353
 
var
354
 
 i : unsigned;
355
 
 
356
 
begin
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
 
 
368
 
end;
369
 
 
370
 
{ SET_WAITING }
371
 
procedure dialog.set_waiting;
372
 
begin
373
 
 m_waiting:=@act;
374
 
 
375
 
end;
376
 
 
377
 
{ ADD_ACTION }
378
 
procedure dialog.add_action;
379
 
begin
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
 
 
397
 
end;
398
 
 
399
 
{ ADD_CHOICE }
400
 
procedure dialog.add_choice;
401
 
begin
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
 
 
417
 
end;
418
 
 
419
 
{ CHANGE_TEXT }
420
 
procedure dialog.change_text;
421
 
begin
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
 
 
441
 
end;
442
 
 
443
 
{ APPEND_TEXT }
444
 
procedure dialog.append_text;
445
 
var
446
 
 new_text : char_ptr;
447
 
 new_aloc : unsigned;
448
 
 
449
 
begin
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
 
 
469
 
end;
470
 
 
471
 
{ ADD_CONTROLS }
472
 
function dialog.add_controls;
473
 
var
474
 
 i : unsigned;
475
 
 
476
 
begin
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
 
 
501
 
end;
502
 
 
503
 
{ SET_NEXT_STATUS }
504
 
procedure dialog.set_next_status;
505
 
begin
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
 
 
521
 
end;
522
 
 
523
 
{ FIND_CUR_ACTION }
524
 
function dialog.find_cur_action;
525
 
var
526
 
 i : unsigned;
527
 
 
528
 
begin
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
 
 
547
 
end;
548
 
 
549
 
{ CALL_CUR_ACTION }
550
 
// result of true means, that this was the last call
551
 
function dialog.call_cur_action;
552
 
begin
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
 
 
562
 
end;
563
 
 
564
 
{ CALL_WAITING }
565
 
procedure dialog.call_waiting;
566
 
begin
567
 
 if @m_waiting <> NIL then
568
 
  m_waiting(m_appl ,@self );
569
 
 
570
 
end;
571
 
 
572
 
{ create_delphi }
573
 
procedure create_delphi(batch_file ,comp_path ,project : shortstring );
574
 
var
575
 
 command : AnsiString;
576
 
 
577
 
 suffix ,file_path ,file_name ,file_ext : shortstring;
578
 
 
579
 
 df : text;
580
 
 
581
 
begin
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
 
 
606
 
end;
607
 
 
608
 
{ create_fpc }
609
 
procedure create_fpc(batch_file ,comp_path ,project : shortstring );
610
 
var
611
 
 command : AnsiString;
612
 
 
613
 
 suffix ,file_path ,file_name ,file_ext : shortstring;
614
 
 
615
 
 df : text;
616
 
 
617
 
begin
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
 
 
646
 
end;
647
 
 
648
 
{ create_batch_files }
649
 
procedure create_batch_files(project : shortstring; var del ,fpc : unsigned );
650
 
var
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
 
 
657
 
begin
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
 
 
748
 
end;
749
 
 
750
 
{ action_configure }
751
 
function action_configure(appl : the_application_ptr; sender : dialog_ptr ) : boolean;
752
 
var
753
 
 i : unsigned;
754
 
 
755
 
 text : shortstring;
756
 
 rgba : aggclr;
757
 
 
758
 
 del ,fpc : unsigned;
759
 
 
760
 
begin
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
 
 
822
 
end;
823
 
 
824
 
{ action_set_drives }
825
 
function action_set_drives(appl : the_application_ptr; sender : dialog_ptr ) : boolean;
826
 
var
827
 
 letter ,
828
 
 path   ,
829
 
 drive  : shortstring;
830
 
 
831
 
 drive_type ,i ,count : unsigned;
832
 
 
833
 
begin
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
 
 
873
 
end;
874
 
 
875
 
{ action_while_search }
876
 
function action_while_search(appl : the_application_ptr; sender : dialog_ptr ) : boolean;
877
 
var
878
 
 text : shortstring;
879
 
 rgba : aggclr;
880
 
 
881
 
begin
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
 
 
905
 
end;
906
 
 
907
 
{ process_file }
908
 
function process_file(file_name : shortstring ) : boolean;
909
 
begin
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
 
 
918
 
end;
919
 
 
920
 
{ scan_files }
921
 
function scan_files(files : shortstring; appl : the_application_ptr ) : boolean;
922
 
var
923
 
 SR  : TSearchRec;
924
 
 err : integer;
925
 
 
926
 
 find ,file_path ,file_name ,file_ext : shortstring;
927
 
 
928
 
begin
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
 
 
1020
 
end;
1021
 
 
1022
 
{ FnSearch }
1023
 
procedure FnSearch(appl : the_application_ptr );
1024
 
var
1025
 
 i : unsigned;
1026
 
 
1027
 
begin
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
 
 
1059
 
end;
1060
 
 
1061
 
{ ThSearch }
1062
 
function ThSearch(Parameter : pointer ): integer;
1063
 
begin
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
 
 
1077
 
end;
1078
 
 
1079
 
{ action_begin_search }
1080
 
function action_begin_search(appl : the_application_ptr; sender : dialog_ptr ) : boolean;
1081
 
var
1082
 
 i : unsigned;
1083
 
 
1084
 
begin
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
 
 
1114
 
end;
1115
 
 
1116
 
{ action_stop_search }
1117
 
function action_stop_search(appl : the_application_ptr; sender : dialog_ptr ) : boolean;
1118
 
begin
1119
 
 appl.m_DoQuit:=true;
1120
 
 
1121
 
end;
1122
 
 
1123
 
{ action_exit }
1124
 
function action_exit(appl : the_application_ptr; sender : dialog_ptr ) : boolean;
1125
 
begin
1126
 
 appl.quit;
1127
 
 
1128
 
end;
1129
 
 
1130
 
{ CONSTRUCT }
1131
 
constructor the_application.Construct;
1132
 
var
1133
 
 rgba : aggclr;
1134
 
 
1135
 
begin
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
 
 
1210
 
end;
1211
 
 
1212
 
{ DESTRUCT }
1213
 
destructor the_application.Destruct;
1214
 
begin
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
 
 
1229
 
end;
1230
 
 
1231
 
{ DRAW_TEXT }
1232
 
procedure the_application.draw_text;
1233
 
var
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
 
 
1243
 
begin
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
 
 
1274
 
end;
1275
 
 
1276
 
{ ON_INIT }
1277
 
procedure the_application.on_init;
1278
 
var
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
 
 
1290
 
begin
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
 
 
1350
 
end;
1351
 
 
1352
 
{ ON_DRAW }
1353
 
procedure the_application.on_draw;
1354
 
var
1355
 
 pixf : pixel_formats;
1356
 
 rgba : aggclr;
1357
 
 
1358
 
 rb : renderer_base;
1359
 
 rs : renderer_scanline_aa_solid;
1360
 
 
1361
 
 i ,plus : unsigned;
1362
 
 
1363
 
begin
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
 
 
1415
 
end;
1416
 
 
1417
 
{ ON_CTRL_CHANGE }
1418
 
procedure the_application.on_ctrl_change;
1419
 
begin
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
 
 
1428
 
end;
1429
 
 
1430
 
{ ON_IDLE }
1431
 
procedure the_application.on_idle;
1432
 
begin
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
 
 
1456
 
end;
1457
 
 
1458
 
{ ON_KEY }
1459
 
procedure the_application.on_key;
1460
 
begin
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
 
 
1476
 
end;
1477
 
 
1478
 
VAR
1479
 
 app : the_application;
1480
 
 
1481
 
BEGIN
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
 
 
1496
 
END.
 
 
b'\\ No newline at end of file'