[Lazarus-es] Error en funci?n while

Mar Nov 24 00:04:39 CET 2009

1 Millón de gracias, no conocía la existencia de Reset.

Ahora tengo otro problema mucho más sencillo para ustedes y es el siguiente.

Yo quiero mostrar un formulario y de ese llamo la función que en caso que me 
devuelva false me muestre otro formulario pero encima de este y si me lo 
muestra pero me oculta el que lo está llamando.

Lo tengo así:

procedure Tfrmsplash.AfterConstruction();
var
  fileini: String;
begin
  inherited AfterConstruction();
  {$IFDEF UNIX}
    fileini := GetEnvironmentVariable ('HOME') + '/mprima.ini';
  {$ELSE}
    fileini := ExtractFilePath (Application.Exename) + 'mprima.ini';
  {$ENDIF}
  if datos () then
    begin
       // aquí realizo una serie de operaciones
    end
  else
    begin
      Application.CreateForm(Tfrmorigen, frmorigen);
      frmorigen.ShowModal; // aquí es donde quiero que lo muestre sin 
ocultar a quien lo llamó
    end;
end;

Saludos reiterados y perdóneme tantas preguntas
=========
¦¦ ISMAEL ¦¦
=========
PD: No tengo acceso a Internet

----- Mensaje original ----- 
De: "Juan Carlos" <juancarlos en cubalub.cupet.cu>
Para: "Spanish version of Lazarus List" 
<lazarus-es en lists.lazarus.freepascal.org>
Enviado: lunes, 23 de noviembre de 2009 04:08
Asunto: Re: [Lazarus-es] Error en funci?n while

Hola Ismael.

Utilizas la estructuta cíclica while para recorrer el archivo y vas leyendo
cada línea con el procedimiento ReadLn. El procedimiento Append que usas
abre el archivo y lo prepara para adicionar información. Me parese que debes
sustituir Append y en su lugar utilizar Reset que abre el archivo y lo deja
listo para realizar la lectura.

Saludos a todos, Juan Carlos.

----- Original Message ----- 
From: "Ismael L. Donis Garc?a" <ismael en citricos.co.cu>
To: "Spanish version of Lazarus List"
<lazarus-es en lists.lazarus.freepascal.org>
Sent: Monday, November 23, 2009 10:10 AM
Subject: Re: [Lazarus-es] Error en funci?n while

El showmessage lo puse para ver el error en que linea era, porque no sabía
en que linea lo daba.

Y por ello pude detectar que era en la linea:

while (not bolhenc) and (not eof(oldfileini)) do

aunque se refleja en la linea:

bolhenc := true;

Yo antes le tenía puesto break y con break puesto se refleja en la línea del
break, pero realente ocurre cuando entra a la linea del while

Cuando lo probé con break era el while de la siguiente forma:

while not eof(oldfileini) do

Y de las 2 formas da el error: Unknown Run-Time error: 104

Osea la función de puebas las puedes tomar de la siguiente forma y probarlas
desde un boton, aunque realmento yo las necesito que se ejecute cuando se
muestre el formulario.

procedure TForm1.Button1Click(Sender: TObject);
  var
    fileini: String;
begin
  {$IFDEF UNIX}
    fileini := GetEnvironmentVariable ('HOME') + '/mprima.ini';
  {$ELSE}
    fileini := ExtractFilePath (Application.Exename) + 'mprima.ini';
  {$ENDIF}
  if datos () then
      Showmessage ('El archivo ya existía') // Esto es solo para probar si
funciona realmente aquí va otra cosa
  else
    Showmessage ('El archivo fue creado'); // Esto es solo para probar si
funciona realmente aquí va otra cosa
end;

function TForm1.datos(): Boolean;
  var
    fileini: String;
    logfile: TFileStream;
begin
  {$IFDEF UNIX}
    fileini := GetEnvironmentVariable ('HOME') + '/mprima.ini';
  {$ELSE}
    fileini := ExtractFilePath (Application.Exename) + 'mprima.ini';
  {$ENDIF}
  if FileExists (fileini) then
    if IniExistHead(fileini, 'Datos') = false then
      result := false
    else
      result := true
  else
    begin
      logfile := TFileStream.Create (fileini, fmCreate or fmOpenReadWrite);
      logfile.free;
      result := false;
    end;
end;

function TForm1.IniExistHead(fileini: string; head: string): boolean;
  var
    bolhenc: boolean;
    strlinea, strhead: string;
    oldfileini: TextFile;
begin
  bolhenc := false;
  AssignFile (oldfileini, fileini);
  Append (oldfileini); // abre un archivo existente
  while (not bolhenc) and (not eof(oldfileini)) do
    begin
      readln(oldfileini, strlinea);
      strlinea := trim(strlinea);
      if strlinea <> '' then
        if leftstr(strlinea, 1) <> ';' then
          if strlinea = strhead then
            begin
              bolhenc := true; // al documentar la proxima linea el error se
da aquí
              //break; // si descomento esta linea me da error aqui
            end;
    end;
  closefile(oldfileini);
  result := bolhenc;
end;

Saludos
=========
¦¦ ISMAEL ¦¦
=========
----- Mensaje original ----- 
De: "JoshyFun" <joshyfun en gmail.com>
Para: "Spanish version of Lazarus List"
<lazarus-es en lists.lazarus.freepascal.org>
Enviado: lunes, 23 de noviembre de 2009 10:42
Asunto: Re: [Lazarus-es] Error en funci?n while

Hello Ismael,

Monday, November 23, 2009, 5:51:40 PM, you wrote:

ILDGa> He estado todo este fin de semana atascado en un error que me da la
función
ILDGa> while, he tratado por todas las vías que conozco y no he podido
solucionar
ILDGa> el problema.
ILDGa> Al ejecutar la función while en una función que a la ves es llamada
por otra
ILDGa> función y que esta otra función es llamada por un evento, me ocurre
el
ILDGa> error.

Lo primero sería decir cuál es el error que te da ;)

Veo que llamas al procedimiento desde "FormShow" el cual se invoca
cada vez que muestras el formulario, y como tienes ShowMessage, cada
vez que aceptas el showmessage debería invocarse un nuevo "FormShow".
Vamos que hacer cosas en el FormShow no es buena idea normalmente. Si
quieres que algo suceda una vez se ha cargado el form tiene el evento
"manual" AfterConstruction:

procedure AfterConstruction(); override;

procedure AfterConstruction();
begin
  showmessage('Esto sólo pasa una vez, cuando se ha creado el form por
  completo');
end;

Puede ser que ese sea el error o no, pero sin saber cual es el error,
mal asunto.

-- 
Best regards,
 JoshyFun

_______________________________________________
Lazarus-es mailing list
Lazarus-es en lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus-es

_______________________________________________
Lazarus-es mailing list
Lazarus-es en lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus-es

__________ Information from ESET NOD32 Antivirus, version of virus signature
database 4630 (20091123) __________

The message was checked by ESET NOD32 Antivirus.

http://www.eset.com

_______________________________________________
Lazarus-es mailing list
Lazarus-es en lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus-es