]> git.llucax.com Git - z.facultad/75.07/algowars.git/blob - src/forms/FormMain.pas
Se expanden keywords del svn.
[z.facultad/75.07/algowars.git] / src / forms / FormMain.pas
1 {** Formulario principal de la aplicación<br>\r
2     <i>Cambios:</i>\r
3     <PRE>\r
4     29/11/00: Se agregan algunos controles gráficos con indicadores de energía y velocidad.\r
5               No se incluyen en una clase Vista porque son muy pequeños.\r
6     01/12/00: Se modifica levemente la interfaz.\r
7               Se agregan controles para los disparos y metodos pertinentes.\r
8     06/12/00: Se cambian minimamente los menúes, poniendo la parte del manejo\r
9               de escenarios en un submenú del menú Archivo.\r
10     08/12/00: Se termina de implementar la funcionalidad de los menúes\r
11                 Archivo -> Abrir ...\r
12                 Archivo -> Guardar ...\r
13                 Archivo -> Escenario -> Abrir ...\r
14                 Archivo -> Escenario -> Guardar ...\r
15               Se completa el 'destructor', ya que faltaban liberar bastantes\r
16               objetos.\r
17     18/12/00: Se corrige un bug que hacía que en ciertas circunstancias no se\r
18               encuentren el escenario por defecto, agregando la ruta completa.\r
19     </PRE>}\r
20 unit FormMain;\r
21 \r
22 interface\r
23 \r
24 uses\r
25   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,\r
26   ExtCtrls, Menus, StdCtrls,\r
27   Espacio,\r
28   NavePropia,\r
29   NavesEnemigas,\r
30   Meteorito,\r
31   Armas,\r
32   Vectores,\r
33   Vista,\r
34   Tipos;\r
35 \r
36 type\r
37   {** Formulario principal de la aplicación}\r
38   TMainForm = class(TForm)\r
39     aBtnIniciar: TButton;\r
40     aMainMenu: TMainMenu;\r
41     aTimer: TTimer;\r
42     aMenuJuego: TMenuItem;\r
43     aMenuItemConfigurar: TMenuItem;\r
44     aMenuItemSalir: TMenuItem;\r
45     aTimerVista: TTimer;\r
46     aEditEnergia: TEdit;\r
47     aLblEnergia: TLabel;\r
48     N1: TMenuItem;\r
49     aMenuItemNuevoJuego: TMenuItem;\r
50     aMenuItemGuardar: TMenuItem;\r
51     aMenuItemAbrir: TMenuItem;\r
52     aMenuItemAbrirEscenario: TMenuItem;\r
53     aMenuItemGuardarEscenario: TMenuItem;\r
54     N3: TMenuItem;\r
55     aLblVelocidad: TLabel;\r
56     aEditVelocidad: TEdit;\r
57     aLblKMH: TLabel;\r
58     aLblMisiles: TLabel;\r
59     aEditMisiles: TEdit;\r
60     aLblMisilesDir: TLabel;\r
61     aEditMisilesDirigidos: TEdit;\r
62     aLblArma: TLabel;\r
63     aEditArma: TEdit;\r
64     aMenuEscenario: TMenuItem;\r
65     aSaveJuego: TSaveDialog;\r
66     aOpenJuego: TOpenDialog;\r
67     aSaveEscenario: TSaveDialog;\r
68     aOpenEscenario: TOpenDialog;\r
69     aMenuVista: TMenuItem;\r
70     aMenuItemFrontal: TMenuItem;\r
71     aMenuItemDerecha: TMenuItem;\r
72     aMenuItemIzquierda: TMenuItem;\r
73     aMenuItemTrasera: TMenuItem;\r
74     aMenuItemSuperior: TMenuItem;\r
75     aMenuItemInferior: TMenuItem;\r
76     aMenuItemDelArma: TMenuItem;\r
77     N2: TMenuItem;\r
78     aMenuItemCalidad: TMenuItem;\r
79     aMenuItemCambioAutomatico: TMenuItem;\r
80     aMenuItemMapa: TMenuItem;\r
81     procedure aBtnIniciarClick(Sender: TObject);\r
82     procedure aTimerTimer(Sender: TObject);\r
83     procedure aMenuItemConfigurarClick(Sender: TObject);\r
84     procedure FormCreate(Sender: TObject);\r
85     procedure aMenuItemSalirClick(Sender: TObject);\r
86     procedure FormDestroy(Sender: TObject);\r
87     procedure FormKeyDown(Sender: TObject; var Key: Word;\r
88       Shift: TShiftState);\r
89     procedure FormHide(Sender: TObject);\r
90     procedure aTimerVistaTimer(Sender: TObject);\r
91     procedure aMenuItemGuardarClick(Sender: TObject);\r
92     procedure aMenuClick(Sender: TObject);\r
93     procedure aMenuItemAbrirClick(Sender: TObject);\r
94     procedure aMenuItemNuevoJuegoClick(Sender: TObject);\r
95     procedure aMenuItemGuardarEscenarioClick(Sender: TObject);\r
96     procedure aMenuItemAbrirEscenarioClick(Sender: TObject);\r
97     procedure CambiarVistaClick(Sender: TObject);\r
98     procedure aMenuItemCalidadClick(Sender: TObject);\r
99     procedure DesSerializarEscenario( archivo: string );\r
100     procedure SerializarEscenario( archivo: string );\r
101     procedure DesSerializarJuego( archivo: string );\r
102     procedure SerializarJuego( archivo: string );\r
103     procedure aMenuItemCambioAutomaticoClick(Sender: TObject);\r
104   private\r
105     { Private declarations }\r
106     aObjetos:    TList;       // Lista de objetos a utlizar con el espacio\r
107     aEspacio:    cEspacio;    // Espacio a utilizar\r
108     aNavePropia: cNavePropia; // Nave propia a utilizar con el espacio\r
109     aVista:      cVista;      // Vista utilizada para dibujar el modelo en el formulario\r
110     {$IFDEF DebugAlgoWars}\r
111     aDebugFile:  Text;        // Archivo para guardar información de debug\r
112     {$ENDIF}\r
113   public\r
114     { Public declarations }\r
115     {** Obtiene la lista de objetos del formulario}\r
116     function mGetObjetos: TList;\r
117     {** Obtiene la nave propia del formulario}\r
118     function mGetNavePropia: cNavePropia;\r
119   end;\r
120 \r
121 var\r
122   MainForm:    TMainForm;\r
123 \r
124 implementation\r
125 \r
126 uses\r
127   FormConfig,\r
128   ObjetoPersistente,\r
129   SerializacionUtils,\r
130   RegExpr,\r
131   ObjetoVolador,\r
132   Camara;\r
133 \r
134 {$R *.DFM}\r
135 \r
136 const\r
137   DEBUGING: boolean = true; // Constante para indicar si se genera el archivo de debug\r
138 \r
139 procedure TMainForm.aBtnIniciarClick(Sender: TObject);\r
140 begin\r
141   if aEspacio = nil then begin // Todavía no se inicio el juego\r
142     aEspacio := cEspacio.create( aNavePropia, aObjetos, 50 );\r
143     aVista := cVista.create( self, aNavePropia );\r
144     aMenuItemConfigurar.Enabled := false;\r
145     aMenuItemGuardar.Enabled := true;\r
146     aMenuEscenario.Enabled := false;\r
147     aMenuVista.Enabled := true;\r
148   end;\r
149   if aTimer.Enabled = false then begin\r
150     aTimer.enabled := true;\r
151     aTimerVista.enabled := true;\r
152     aBtnIniciar.caption := 'Pausa';\r
153   end else begin\r
154     aTimer.enabled := false;\r
155     aTimerVista.enabled := false;\r
156     aBtnIniciar.caption := 'Continuar';\r
157   end;\r
158 end;\r
159 \r
160 procedure TMainForm.aTimerTimer(Sender: TObject);\r
161 begin\r
162   try // Prueba el codigo\r
163     aEspacio.mActualizar;\r
164   except\r
165     on e: ENavePropiaDestruida do begin         // Si cae en una excepcion de nave propia destruida\r
166       aBtnIniciarClick( self );                 // Detiene la ejecucion\r
167       aBtnIniciar.Enabled := false;             // No permite que se reinicie\r
168       aMenuItemGuardar.Enabled := false;        // No permite guardar el juego\r
169       aMenuVista.Enabled := false;              // No permite manipular la vista\r
170       {$IFDEF DebugAlgoWars}\r
171       writeln( aDebugFile, 'GAME OVER!!!! (' +  // Escribe el archivo de LOG de ser necesario\r
172                            e.Message + ')' );\r
173       {$ENDIF}\r
174       ShowMessage( 'GAME OVER!!!' ); // Muestra un mensaje\r
175     end;\r
176     on e: Exception do begin                       // Si cae en una excepcion desconocida\r
177       aBtnIniciarClick( self );                    // Detiene la ejecucion\r
178       aBtnIniciar.Enabled := false;                // No permite que se reinicie\r
179       aMenuItemGuardar.Enabled := false;           // No permite guardar el juego\r
180       aMenuVista.Enabled := false;                 // No permite manipular la vista\r
181       {$IFDEF DebugAlgoWars}\r
182       writeln( aDebugFile, 'ERROR: ' + e.Message); // Escribe el archivo de LOG de ser necesario\r
183       {$ENDIF}\r
184       ShowMessage( 'ERROR: ' + e.Message );    // Muestra un mensaje\r
185     end;\r
186   end;\r
187 end;\r
188 \r
189 procedure TMainForm.aTimerVistaTimer(Sender: TObject);\r
190 const\r
191   i: int64 = 0;\r
192 begin\r
193   {$IFDEF DebugAlgoWars}\r
194   i := i + 1;\r
195   {$ENDIF}\r
196   // Muestra la energía de la nave\r
197   aEditEnergia.Text := IntToStr( aNavePropia.mGetEnergia );\r
198   // La velocidad esta en las unidades 1m/ms. Sabiendo que 1m = 0,001 km y\r
199   // 1 h = 60 . 60 . 1000 ms, entonces 1 ms = 1 / 3600000 h\r
200   // Entonces velocidad * 0,001 * 3600000 = velocidad * 3600 = km/h\r
201   aEditVelocidad.Text := FloatToStr( aNavePropia.mGetVelModulo * 3600 );\r
202   // Muestra la cantidad de misiles que le quedan a la nave\r
203   aEditMisiles.Text := IntToStr( aNavePropia.mGetMisiles );\r
204   // Muestra la cantidad de misiles dirigidos que le quedan a la nave\r
205   aEditMisilesDirigidos.Text := IntToStr( aNavePropia.mGetMisilesDirigidos );\r
206   // Muestra en el título la cámara actualmente en uso\r
207   Caption := Application.Title + ' @ ' + aVista.mGetCamaraStr;\r
208   // Muestra el arma seleccionada\r
209   case aNavePropia.mGetArmaSelec of\r
210     OV_LASER: begin\r
211       aEditArma.Text := 'Láser';\r
212       if aNavePropia.mPuedeDispararLaser( nil ) then\r
213         aEditArma.Font.Color := clLime\r
214       else\r
215         aEditArma.Font.Color := clRed;\r
216     end;\r
217     OV_MISIL: begin\r
218       aEditArma.Text := 'Misil';\r
219       if aNavePropia.mPuedeDispararMisil( nil ) then\r
220         aEditArma.Font.Color := clLime\r
221       else\r
222         aEditArma.Font.Color := clRed;\r
223     end;\r
224     OV_MISDIR: begin\r
225       aEditArma.Text := 'Misil Dirigido';\r
226       if aNavePropia.mPuedeDispararMisDir( nil ) then\r
227         aEditArma.Font.Color := clLime\r
228       else\r
229         aEditArma.Font.Color := clRed;\r
230     end;\r
231   end;\r
232   try // Prueba el codigo\r
233     aVista.mDibujarVista( aEspacio );\r
234     {$IFDEF DebugAlgoWars}\r
235     // Imprime la informacion del estado del espacio en este instante\r
236     writeln( aDebugFile, aEspacio.mGetDebugInfo( DI_NORMAL ) );\r
237     // Imprime la data de la vista\r
238     writeln( aDebugFile, aVista.mGetDebugInfo( DI_MAXI ) );\r
239     writeln( aDebugFile, #13 + #10 + '====================>  ' + IntToStr( i ) + '  <======================' );\r
240     {$ENDIF}\r
241   except\r
242     on e: ECameramanDestruido do begin // Si cae en una excepcion de camara destruida\r
243       aBtnIniciarClick( self );        // Detiene la ejecucion\r
244       aBtnIniciar.Enabled := false;    // No permite que se reinicie\r
245       {$IFDEF DebugAlgoWars}\r
246       writeln( aDebugFile, 'ERROR!!!! (' +  // Escribe el archivo de LOG de ser necesario\r
247                            e.Message + ')' );\r
248       {$ENDIF}\r
249       ShowMessage( 'ERROR!!!! (' + e.Message + ')' ); // Muestra un mensaje\r
250     end;\r
251     on e: ENavePropiaDestruida do begin         // Si cae en una excepcion de nave propia destruida\r
252       aBtnIniciarClick( self );                 // Detiene la ejecucion\r
253       aBtnIniciar.Enabled := false;             // No permite que se reinicie\r
254       {$IFDEF DebugAlgoWars}\r
255       writeln( aDebugFile, 'GAME OVER!!!! (' +  // Escribe el archivo de LOG de ser necesario\r
256                            e.Message + ')' );\r
257       {$ENDIF}\r
258       ShowMessage( 'GAME OVER!!!' ); // Muestra un mensaje\r
259     end;\r
260     on e: Exception do begin                      // Si cae en una excepcion desconocida\r
261       aBtnIniciarClick( self );                    // Detiene la ejecucion\r
262       aBtnIniciar.Enabled := false;                // No permite que se reinicie\r
263       {$IFDEF DebugAlgoWars}\r
264       writeln( aDebugFile, 'ERROR: ' + e.Message); // Escribe el archivo de LOG de ser necesario\r
265       {$ENDIF}\r
266       ShowMessage( 'ERROR: ' + e.Message );    // Muestra un mensaje\r
267     end;\r
268   end;\r
269 end;\r
270 \r
271 procedure TMainForm.aMenuItemConfigurarClick(Sender: TObject);\r
272 begin\r
273   ConfigForm.ShowModal;\r
274 end;\r
275 \r
276 procedure TMainForm.FormCreate(Sender: TObject);\r
277 var\r
278   fName: string;\r
279 begin\r
280   aEspacio := nil;\r
281   aObjetos := TList.create;\r
282   aNavePropia := cNavePropia.create;\r
283   // Pausa si se minimiza\r
284   Application.OnMinimize := FormHide;\r
285 \r
286   {$IFDEF DebugAlgoWars}\r
287   // Inicializa el archivo de texto para DEBUG\r
288   assignFile( aDebugFile, 'debug.txt' );\r
289   rewrite( aDebugFile );\r
290   {$ENDIF}\r
291 \r
292   // Establecemos el nombre del archivo con la ruta completa\r
293   fName := ExtractFileDir( ParamStr( 0 ) ) + '\comun.eaw';\r
294 \r
295   // Cargamos Algunos datos de ejemplo al principio si existe el archivo\r
296   if FileExists( fName ) then\r
297     try // Prueba que no haya errores\r
298       DesSerializarEscenario( fName );\r
299     except\r
300       on e: ESerializacion do begin\r
301         ShowMessage( 'Hubo un error al recuperar el escenario por defecto "comun.eaw": ' + e.Message );    // Muestra un mensaje\r
302         // Resetea todos los valores ...\r
303         aEspacio.free;\r
304         aObjetos.free;\r
305         aNavePropia.free;\r
306         aEspacio := nil;\r
307         aObjetos := TList.create;\r
308         aNavePropia := cNavePropia.create;\r
309       end;\r
310     end;\r
311 end;\r
312 \r
313 procedure TMainForm.aMenuItemSalirClick(Sender: TObject);\r
314 begin\r
315   Close;\r
316 end;\r
317 \r
318 procedure TMainForm.FormDestroy(Sender: TObject);\r
319 var\r
320   ov: cObjetoVolador;\r
321 begin\r
322   // Si el espacio no esta creado, liberamos la nave propia y los objetos\r
323   if aEspacio = nil then begin\r
324     aNavePropia.free;\r
325     while aObjetos.Count > 0 do begin\r
326       ov := aObjetos.First;\r
327       aObjetos.Remove( ov );\r
328       ov.free;\r
329     end;\r
330     aObjetos.free;\r
331   end else // Si el espacio esta creado ...\r
332     // aObjetos y aNavePropia se liberan cuando se libera el aEspacio\r
333     aEspacio.free;\r
334   aVista.free;\r
335   {$IFDEF DebugAlgoWars}\r
336   // Cierra el archivo para DEBUG\r
337   closeFile( aDebugFile );\r
338   {$ENDIF}\r
339 end;\r
340 \r
341 {** Obtiene la lista de objetos del formulario\r
342     @return Lista de objetos que utilizara el espacio}\r
343 function TMainForm.mGetObjetos: TList;\r
344 begin\r
345   result := aObjetos;\r
346 end;\r
347 \r
348 {** Obtiene la nave propia del formulario\r
349     @return Nave propia que utilizara el espacio}\r
350 function TMainForm.mGetNavePropia: cNavePropia;\r
351 begin\r
352   result := aNavePropia;\r
353 end;\r
354 \r
355 procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;\r
356   Shift: TShiftState);\r
357 begin\r
358   {$IFDEF DebugAlgoWars}\r
359   writeln( aDebugFile, 'Presiono la letra: ', Key );\r
360   {$ENDIF}\r
361   if aTimer.Enabled then\r
362     case Key of\r
363       // 8.7e-3 es 0,5 grados\r
364       73{I}: aNavePropia.mGirarArriba( 8.7e-3 );\r
365       75{K}: aNavePropia.mGirarAbajo( 8.7e-3 );\r
366       74{J}: aNavePropia.mGirarIzquierda( 8.7e-3 );\r
367       76{L}: aNavePropia.mGirarDerecha( 8.7e-3 );\r
368       85{U}: aNavePropia.mRotarDerecha( 8.7e-3 );\r
369       79{O}: aNavePropia.mRotarIzquierda( 8.7e-3 );\r
370       // 0.005 es 18 km/h\r
371       81{Q}: aNavePropia.mAcelerar( 0.005 );\r
372       65{A}: aNavePropia.mDesacelerar( 0.005 );\r
373       // Disparos\r
374       83{S}: begin // Dispara creando la nueva camara del arma si hubo un disparo\r
375                aVista.mCrearCamaraDeArma( aNavePropia.mIntentarDisparo );\r
376                if aMenuItemCambioAutomatico.Checked then begin // Si está activado el cambio automatico...\r
377                  CambiarVistaClick( aMenuItemDelArma ); // Cambia la camara\r
378                end;\r
379              end;\r
380       87{W}: aNavePropia.mSeleccionarArmaSig;\r
381       84{T}: aNavePropia.mCambiarLockeado( aEspacio.mGetObjetos );\r
382       // Vista\r
383       67{C}: aVista.mCamaraSiguiente;\r
384     end;\r
385 end;\r
386 \r
387 procedure TMainForm.FormHide(Sender: TObject);\r
388 begin\r
389   if aBtnIniciar.caption = 'Pausa' then // Esta jugando\r
390     aBtnIniciarClick( self ); // Pausa el juego\r
391 end;\r
392 \r
393 procedure TMainForm.aMenuItemGuardarClick(Sender: TObject);\r
394 begin\r
395   Repaint;\r
396   if aTimer.Enabled = true then // Si esta funcinando,\r
397     aBtnIniciarClick( self );   // lo interrumpe...\r
398   if aSaveJuego.Execute then // Si eligio un archivo...\r
399     SerializarJuego( aSaveJuego.Filename );\r
400 end;\r
401 \r
402 procedure TMainForm.aMenuClick(Sender: TObject);\r
403 begin\r
404   if aTimer.Enabled = true then // Si esta funcinando,\r
405     aBtnIniciarClick( self );   // lo interrumpe...\r
406 end;\r
407 \r
408 procedure TMainForm.aMenuItemAbrirClick(Sender: TObject);\r
409 begin\r
410   Repaint;\r
411   if aTimer.Enabled = true then // Si esta funcinando,\r
412     aBtnIniciarClick( self );   // lo interrumpe...\r
413   if aOpenJuego.Execute then // Si eligio un archivo...\r
414     DesSerializarJuego( aOpenJuego.Filename );\r
415 end;\r
416 \r
417 procedure TMainForm.aMenuItemNuevoJuegoClick(Sender: TObject);\r
418 var\r
419   ov: cObjetoVolador;\r
420 begin\r
421   Repaint;\r
422   if aTimer.Enabled = true then // Si esta funcinando,\r
423     aBtnIniciarClick( self );   // lo interrumpe...\r
424   if MessageDlg( 'Se perderán todos los datos del juego actual ¿Está seguro que desea empezar un juego nuevo?',\r
425                  mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin\r
426   // Si el espacio no esta creado, liberamos la nave propia y los objetos\r
427     if aEspacio = nil then begin\r
428       aNavePropia.free;\r
429       while aObjetos.Count > 0 do begin\r
430         ov := aObjetos.First;\r
431         aObjetos.Remove( ov );\r
432         ov.free;\r
433       end;\r
434       aObjetos.free;\r
435     end else // Si el espacio esta creado ...\r
436       // aObjetos y aNavePropia se liberan cuando se libera el aEspacio\r
437       aEspacio.free;\r
438     aVista.free;\r
439     aEspacio := nil;\r
440     aVista := nil;\r
441     aObjetos := TList.create;\r
442     aNavePropia := cNavePropia.create;\r
443     aBtnIniciar.caption := 'Iniciar';\r
444     aMenuItemConfigurar.Enabled := true;\r
445     aMenuItemGuardar.Enabled := false;\r
446     aMenuEscenario.Enabled := true;\r
447     aBtnIniciar.Enabled := true;         // Se puede iniciar el juego\r
448   end;\r
449 end;\r
450 \r
451 procedure TMainForm.aMenuItemGuardarEscenarioClick(Sender: TObject);\r
452 begin\r
453   Repaint;\r
454   if aTimer.Enabled = true then // Si esta funcinando,\r
455     aBtnIniciarClick( self );   // lo interrumpe...\r
456   if aSaveEscenario.Execute then // Si eligio un archivo...\r
457     SerializarEscenario( aSaveEscenario.Filename );\r
458 end;\r
459 \r
460 procedure TMainForm.aMenuItemAbrirEscenarioClick(Sender: TObject);\r
461 begin\r
462   Repaint;\r
463   if aTimer.Enabled = true then // Si esta funcinando,\r
464     aBtnIniciarClick( self );   // lo interrumpe...\r
465   if aOpenEscenario.Execute then // Si eligio un archivo...\r
466     DesSerializarEscenario( aOpenEscenario.Filename ); // Deserializa el archivo\r
467 end;\r
468 \r
469 procedure TMainForm.CambiarVistaClick(Sender: TObject);\r
470 begin\r
471   if Sender = aMenuItemFrontal then\r
472     aVista.mCambiarCamara( CAMARA_FRONTAL )\r
473   else if Sender = aMenuItemDerecha then\r
474     aVista.mCambiarCamara( CAMARA_LATDER )\r
475   else if Sender = aMenuItemIzquierda then\r
476     aVista.mCambiarCamara( CAMARA_LATIZQ )\r
477   else if Sender = aMenuItemTrasera then\r
478     aVista.mCambiarCamara( CAMARA_TRASERA )\r
479   else if Sender = aMenuItemSuperior then\r
480     aVista.mCambiarCamara( CAMARA_ARRIBA )\r
481   else if Sender = aMenuItemInferior then\r
482     aVista.mCambiarCamara( CAMARA_ABAJO )\r
483   else if Sender = aMenuItemDelArma then\r
484     aVista.mCambiarCamara( CAMARA_ARMA )\r
485   else if Sender = aMenuItemMapa then\r
486     aVista.mCambiarCamara( CAMARA_MAPA )\r
487 end;\r
488 \r
489 procedure TMainForm.aMenuItemCalidadClick(Sender: TObject);\r
490 begin\r
491   aVista.mCambiarCalidad;\r
492   aMenuItemCalidad.Checked := not aMenuItemCalidad.Checked;\r
493 end;\r
494 \r
495 procedure TMainForm.DesSerializarEscenario( archivo: string );\r
496 var\r
497   recuperado,\r
498   str:         string;\r
499   i,\r
500   total:       integer;\r
501   ov:          cObjetoVolador;\r
502   c:           char;\r
503   f:           TextFile;\r
504   r:           TRegExpr;\r
505 begin\r
506     try\r
507       assignFile( f, archivo );   // Asigna el archivo\r
508       reset( f );                             // Abre el archivo\r
509       recuperado := '';\r
510       while not eof( f ) do begin     // Lee el archivo\r
511         read( f, c );                 // caracter por caracter\r
512         recuperado := recuperado + c; // Almacenandolo en un string\r
513       end;\r
514       closeFile( f );                 // Cierra el archivo\r
515     except  // Si hay algun error\r
516       on e: Exception do begin // Muestra un mensaje\r
517         ShowMessage( 'Hubo un error al leer el archivo "' +\r
518                      archivo + '": ' + #13 + #10 +\r
519                      e.Message + #13 + #10 +\r
520                      'Por favor lea la Sección de Errores del Manual del ' +\r
521                      'Usuario para más información'  ); // Muestra un mensaje\r
522       end;\r
523     end;\r
524     r := TRegExpr.create;\r
525     try // ensure memory release\r
526       r.Expression := '<eaw\s+version=(\d+[\.\d+]*)\s*>\s*(.+)\s*</eaw>';\r
527       if r.Exec ( recuperado ) then\r
528         if r.Match[1] = '1.0' then begin // Si el archivo es version 1.0\r
529           str := r.Match[2];\r
530           try // ensure memory release\r
531             r.Expression := '<navepropia>\s*(.+)\s*</navepropia>';\r
532             if r.Exec ( str ) then begin\r
533               aNavePropia.free; // Libera la vieja nave propia\r
534               // Obtiene la nueva navepropia de la serializacion\r
535               aNavePropia := cNavePropia.crearDeSerializado( r.Match[1] );\r
536               try // se fija si hay errores al extraer los datos\r
537                 r.Expression := '<objetos\s+total=(\d+)\s*>\s*(.+)\s*</objetos>'; // contruye la expresion regular a buscar\r
538                 if r.Exec ( str ) then begin // Ejecuta la expresion. Si la encuentra...\r
539                   total := StrToInt( r.Match[1] );\r
540                   str := r.Match[2];\r
541                   // libera los objetos viejos\r
542                   while aObjetos.Count > 0 do begin\r
543                     ov := aObjetos.First;\r
544                     aObjetos.Remove( ov );\r
545                     ov.free;\r
546                   end;\r
547                   for i := 0 to total - 1 do begin\r
548                     // OBJETO N\r
549                     try // se fija si hay errores al extraer los datos\r
550                       r.Expression := '<objeto' + IntToStr( i ) + '\s+class=([\w\d]+)\s*>\s*(.+)\s*</objeto' + IntToStr( i ) + '>'; // contruye la expresion regular a buscar\r
551                       if r.Exec ( str ) then begin // Ejecuta la expresion. Si la encuentra...\r
552                         // lo crea segun su clase y lo agrega a la lista\r
553                         ov := restaurarObjeto( r.Match[1], r.Match[2] );\r
554                         aObjetos.Add( ov );\r
555                         // Elimina duplicados\r
556                         if ov is cMisilDirigido then begin\r
557                           (ov as cMisilDirigido).mGetObjetivo.free; // libera el objetivo duplicado\r
558                           (ov as cMisilDirigido).mSetObjetivo( aNavePropia ); // le asigna como objetivo a la nave propia\r
559                         end;\r
560                       end else // si no encontro la experesion...\r
561                         ShowMessage( 'No se encontro el objeto ' + IntToStr( i ) ); // cae en una excepcion\r
562                     except // Si hubieron errores ...\r
563                       on e: ESerializacion do begin // Si fueron de serializacion...\r
564                         r.Free; // libera memoria\r
565                         ShowMessage( 'Error al deserializar el objeto '\r
566                                      + IntToStr( i ) + ': ' + e.Message ); // muestra mensaje\r
567                       end;\r
568                       on e: ERegExpr do begin // si fueron de expresiones regulares...\r
569                          r.Free; // libera memoria\r
570                          ShowMessage( 'Error al extraer el objeto ' + IntToStr( i ) + ' utilizando expresiones regulares: ' + e.Message ); // cae en una excepcion\r
571                       end;\r
572                     end;\r
573                   end;\r
574                 end else // si no encontro el tag <objetos total=n>\r
575                   ShowMessage( 'No se encontro la cantidad total de objetos' ); // muestra mensaje\r
576               except // Si hubieron errores en el tag <objetos total=n>\r
577                 on e: ERegExpr do begin // si fueron de expresiones regulares...\r
578                   r.Free; // libera memoria\r
579                   ShowMessage( 'Error al extraer la cantidad total de objetos utilizando expresiones regulares: ' + e.Message ); // cae en una excepcion\r
580                 end;\r
581               end;\r
582             end else // si no encontro el tag <navepropia>\r
583                   ShowMessage( 'No se encontro la nave propia' ); // muestra mensaje\r
584           except // si hubieron errores en el tag <navepropia>\r
585             on e: ERegExpr do begin // si fueron de expresiones regulares...\r
586               r.Free;\r
587               ShowMessage( 'Error al recuperar la nave propia utilizando expresiones regulares: ' + e.Message );\r
588             end;\r
589             on e: ESerializacion do begin\r
590               r.Free;\r
591               ShowMessage( 'Error al recuperar la nave propia: ' + e.Message );\r
592             end;\r
593           end\r
594         end else // if r.Match[1] = '1.0' then begin - chequeo de version fallido\r
595           ShowMessage( 'El escenario almacenado es de una versión incorrecta (' +\r
596                        r.Match[1] + ').' )\r
597       else // if r.Exec ( recuperado ) then - si no se encontró un escenario almacenado\r
598         ShowMessage( 'No se encontró un escenario almacenado en el archivo "' +\r
599                      archivo + '".' );\r
600     except // error en el tag <eaw version=n>\r
601       on e: ERegExpr do begin\r
602         r.Free;\r
603         ShowMessage( 'Error al recuperar el escenario utilizando expresiones regulares: ' + e.Message );\r
604       end;\r
605     end; // try - except\r
606 end;\r
607 \r
608 procedure TMainForm.SerializarEscenario( archivo: string );\r
609 var\r
610   serializado: string;\r
611   f:           TextFile;\r
612   ov:          cObjetoVolador;\r
613   i:           integer;\r
614 begin\r
615     try\r
616       assignFile( f, archivo ); // Asigna el archivo\r
617       rewrite( f );                         // Sobreescribe el archivo\r
618       // Serializa la nave propia agregando alguna información sobre el archivo y la versión\r
619       serializado := '<eaw version=1.0><navepropia>' + aNavePropia.mSerializar + '</navepropia>' +\r
620                      '<objetos total=' + IntToStr( aObjetos.Count ) + '>';\r
621       // Serializa los objetos\r
622       for i := 0 to aObjetos.Count - 1 do begin  // recorre la lista\r
623         ov := aObjetos.Items[i]; // obteniendo el primer objeto volador\r
624           // Serializa el objeto actual\r
625           serializado := serializado + '<objeto' + IntToStr( i ) + ' class=' +\r
626                          ov.ClassName + '>' + ov.mSerializar + '</objeto' +\r
627                          IntToStr( i ) + '>';\r
628       end;\r
629       serializado := serializado + '</objetos></eaw>';\r
630       write( f, serializado );              // Escribe en el archivo\r
631       closeFile( f );                       // Cierra el archivo\r
632     except  // Si hay algun error\r
633       on e: Exception do // Muestra un mensaje\r
634         ShowMessage( 'Hubo un error al grabar el archivo "' +\r
635                      archivo + '": ' + #13 + #10 +\r
636                      e.Message + #13 + #10 +\r
637                      'Por favor lea la Sección de Errores del Manual del ' +\r
638                      'Usuario para más información'  ); // Muestra un mensaje\r
639     end;\r
640 end;\r
641 \r
642 procedure TMainForm.DesSerializarJuego( archivo: string );\r
643 var\r
644   recuperado:  string;\r
645   c:           char;\r
646   f:           TextFile;\r
647   r:           TRegExpr;\r
648 begin\r
649     try\r
650       assignFile( f, archivo );   // Asigna el archivo\r
651       reset( f );                             // Abre el archivo\r
652       recuperado := '';\r
653       while not eof( f ) do begin     // Lee el archivo\r
654         read( f, c );                 // caracter por caracter\r
655         recuperado := recuperado + c; // Almacenandolo en un string\r
656       end;\r
657     except  // Si hay algun error\r
658       on e: Exception do begin // Muestra un mensaje\r
659         ShowMessage( 'Hubo un error al leer el archivo "' +\r
660                      archivo + '": ' + #13 + #10 +\r
661                      e.Message + #13 + #10 +\r
662                      'Por favor lea la Sección de Errores del Manual del ' +\r
663                      'Usuario para más información'  ); // Muestra un mensaje\r
664       end;\r
665     end;\r
666     r := TRegExpr.create;\r
667     try // ensure memory release\r
668       r.Expression := '<jaw\s+version=(\d+[\.\d+]*)\s*>\s*(.+)\s*</jaw>';\r
669       if r.Exec ( recuperado ) then\r
670         if r.Match[1] = '1.0' then begin // Si el archivo es version 1.0\r
671           aEspacio.free; // Libera el espacio existente de existir\r
672           aEspacio := nil;\r
673           aEspacio := cEspacio.crearDeSerializado( r.Match[2] );    // Crea el nuevo a partir del guardado\r
674           aNavePropia := aEspacio.mGetNavePropia;       // Asigna la nueva nave propia\r
675           aVista.free;                                  // Libera la vieja vista\r
676           aVista := nil;\r
677           aVista := cVista.create( self, aNavePropia ); // Crea la nueva vista\r
678           aBtnIniciar.Enabled := true;                  // Se puede iniciar el juego\r
679         end else\r
680           ShowMessage( 'El juego almacenado es de una versión incorrecta (' +\r
681                        r.Match[1] + ').' )\r
682       else\r
683         ShowMessage( 'No se encontró un juego almacenado en el archivo "' +\r
684                      archivo + '".' );\r
685     except\r
686       on e: ERegExpr do begin\r
687         r.Free;\r
688         ShowMessage( 'Error al recuperar el juego utilizando expresiones regulares: ' + e.Message );\r
689       end;\r
690       on e: ESerializacion do begin\r
691         r.Free;\r
692         ShowMessage( 'Error al recuperar el juego: ' + e.Message );\r
693       end;\r
694     end;\r
695     closeFile( f );                         // Cierra el archivo\r
696 end;\r
697 \r
698 procedure TMainForm.SerializarJuego( archivo: string );\r
699 var\r
700   serializado: string;\r
701   f:           TextFile;\r
702 begin\r
703     try\r
704       assignFile( f, archivo ); // Asigna el archivo\r
705       rewrite( f );                         // Sobreescribe el archivo\r
706       // Serializa agregando alguna información sobre el archivo y la versión\r
707       serializado := '<jaw version=1.0>' + aEspacio.mSerializar + '</jaw>';\r
708       write( f, serializado );              // Escribe en el archivo\r
709       closeFile( f );                       // Cierra el archivo\r
710     except  // Si hay algun error\r
711       on e: Exception do // Muestra un mensaje\r
712         ShowMessage( 'Hubo un error al grabar el archivo "' +\r
713                      archivo + '": ' + #13 + #10 +\r
714                      e.Message + #13 + #10 +\r
715                      'Por favor lea la Sección de Errores del Manual del ' +\r
716                      'Usuario para más información'  ); // Muestra un mensaje\r
717     end;\r
718 end;\r
719 \r
720 procedure TMainForm.aMenuItemCambioAutomaticoClick(Sender: TObject);\r
721 begin\r
722   aMenuItemCambioAutomatico.Checked := not aMenuItemCambioAutomatico.Checked; \r
723 end;\r
724 \r
725 end.\r