Problema con la Label en este código

[Pedrote]

procedure TForm1.Button3Click(Sender: TObject);
var
  HttpResult: boolean;
  manufacturers_es, manufacturers, media, Res, URLData: String ;
  respuesta: TStringList;
begin
  if test then
  begin
    if ConnDBEjActual then
    begin
      // Limpiamos el label
      Label1.Caption := '';
      if MessageDlg('Advertencia', AdvMsg, mtConfirmation, [mbYes, mbNo] ,0) = mrYes then
      begin
        Label1.Caption := 'En proceso .... espere';
        // Desactivamos el resto de operaciones que puede realizar el usuario
        Button1.Enabled := False;
        Button2.Enabled := False;
        // Exportamos los datos en xml
        SQLQuery1.SQL.Text := 'SELECT ' +
                              'ROW_NUMBER() OVER(ORDER BY codigo) AS virtuemart_manufacturer_id, ' +
                              'LTRIM(RTRIM(NOMBRE)) AS mf_name, ' +
                              ''''' AS mf_email, ' +
                              ''''' AS mf_desc, ' +
                              ''''' AS mf_url ' +
                              'FROM ['+ MSSQLConnection1.DatabaseName +'].[dbo].[marcas] '+
                              'FOR XML RAW';
        SQLQuery1.Open;
        while not SQLQuery1.EOF do
        begin
          manufacturers_es := manufacturers_es+ SQLQuery1.Fields[0].AsString;
          SQLQuery1.Next;
        end;
        SQLQuery1.Close;
        SQLQuery1.SQL.Text := 'SELECT ' +
                              ''''' AS virtuemart_manufacturer_id, ' +
                              //'ROW_NUMBER() OVER(ORDER BY codigo) AS virtuemart_manufacturer_id, ' +
                              ''''' AS virtuemart_manufacturercategories_id, ' +
                              ''''' AS hits, ' +
                              '''1'' AS published, ' +
                              ''''' AS created_on, ' +
                              ''''' AS created_by, ' +
                              ''''' AS modified_on, ' +
                              ''''' AS modified_by, ' +
                              ''''' AS locked_on, ' +
                              ''''' AS locked_by ' +
                              'FROM ['+ MSSQLConnection1.DatabaseName +'].[dbo].[marcas] '+
                              'FOR XML RAW';
        SQLQuery1.Open;
        while not SQLQuery1.EOF do
        begin
          manufacturers := manufacturers + SQLQuery1.Fields[0].AsString;
          SQLQuery1.Next;
        end;
        SQLQuery1.Close;
        SQLQuery1.SQL.Text := 'SELECT ' +
                              // Obtenemos el nombre de fichero
                              'CASE ' +
                              'WHEN REVERSE(SUBSTRING(REVERSE(foto), 0, CHARINDEX(''\'', REVERSE(foto), 1))) != '''' THEN ' +
                                    '''images/stories/virtuemart/manufacturer/'' +' +
                                    'RTRIM(REVERSE(SUBSTRING(REVERSE(foto), 0, CHARINDEX(''\'', REVERSE(foto), 1)))) ' +
                              'ELSE ' +
                                    ''''' ' +
                              'END ' +
                              'AS file_url, ' +
                              'codigo AS slug ' +
                              'FROM ['+ MSSQLConnection1.DatabaseName +'].[dbo].[marcas] '+
                              'ORDER BY codigo ' +
                              'FOR XML RAW';
        SQLQuery1.Open;
        while not SQLQuery1.EOF do
        begin
          media := media + SQLQuery1.Fields[0].AsString;
          SQLQuery1.Next;
        end;
        SQLQuery1.Close;
        MSSQLConnection1.Connected := False;
        // QUIZÁS HAYA QUE REVISAR SI EL SERVIDOR SIGUE EN PIE (NO IMPLEMENTADO)
        // Mandamos los datos en formato xml al servidor
        HTTP := THTTPSend.Create;
        respuesta := TStringList.Create;
        URLData := 'a=marcas&';
        URLData := URLData + '&k=' + id + '&';
        URLData := URLData + '&p=' + App + '&';
        URLData := URLData + '&v=' + IntToStr(Version) + '&';
        URLData := URLData + '&f=' + MD5Print(MD5File(ParamStr(0))) + '&';
        URLData := URLData + 't1=' +  manufacturers + '&';
        URLData := URLData + '&ft1=' + MD5Print(MD5String(manufacturers)) + '&';
        URLData := URLData + '&t2=' + manufacturers_es + '&';
        URLData := URLData + '&ft2=' + MD5Print(MD5String(manufacturers_es)) + '&';
        URLData := URLData + '&t3=' + media + '&';
        URLData := URLData + '&ft3=' + MD5Print(MD5String(media)) + '&';
        HTTP.Document.Write(Pointer(URLData)^, Length(URLData));
        HTTP.MimeType := 'application/x-www-form-urlencoded';
        HttpResult := HTTP.HTTPMethod('POST', UrlSrv);
        //ShowMessage(URLData);
        if HttpResult then
        begin
          respuesta.LoadFromStream(HTTP.Document);
          Res := trim(respuesta.Text);
          respuesta.Free;
          //ShowMessage(Res);
          // Si todo ha ido bien subimos las fotos
          if Res = 'ok' then
          begin
            if SubirFotos(GetValIni('GENERAL', 'DirImgsMarcas'), '\*', GetValIni('FTP', 'DirImgsMarcas'), GetValIni('GENERAL', 'ImgsMarcasFecha')) then
            begin
              Label1.Caption := 'Marcas actualizadas correctamente';
            end
            else
            begin
              Label1.Caption := 'Se produjo un error al subir las fotos de las marcas, póngase en contacto con nosotros.';
            end;
          end
          else
          begin
            Label1.Caption := Res;
          end;
        end
        else
        begin
          Label1.Caption := 'No se ha podido conectar con el servidor, así que ha ' +
          'sido imposible actualizar las marcas';
        end;
        HTTP.Free;
        Button1.Enabled := True;
        Button2.Enabled := True;
      end;
    end;
  end;
end;

Cuándo termine de programar el procedimiento anterior y viendo que todo funcionaba correctamente me puse a comentar todas aquellas líneas que usaba para debugear, bien pues exactamente cuándo comente la línea " //ShowMessage(Res);" (esta línea me devuelve lo que vuelca php al procesarse el formulario que estoy mandando con Lazarus) dejó de funcionar lo correspondiente a estos dos label:

Uno es este:

 // Limpiamos el label
      Label1.Caption := '';

Y otro este:

Label1.Caption := 'En proceso .... espere';

Sin embargo el resto de Labels si los hace de forma correcta, puesto que cuando termina de ejecutarse el procedimiento y todo ha ido bien si muestra el mensaje "Marcas actualizadas correctamente".

Mencionar que al siguiente "if MessageDlg('Advertencia', AdvMsg, mtConfirmation, [mbYes, mbNo] ,0) = mrYes then" entra correctamente.

¿Cuál puede ser el problema es que por muchas vueltas que le doy no doy con el?¿Y la posible solución?. Gracias a todos de antemano.

[Ñuño Martínez]

¿No será que lo hace tan rápido que no le da tiempo a cambiar el texto del título?

[Pedrote]

Empezado por Ñuño Martínez

¿No será que lo hace tan rápido que no le da tiempo a cambiar el texto del título?

Eso pensé, pero le puse un sleep y nada :S Además se queda un rato en blanco el Label hasta que aparece el mensaje que se han actualizado correctamente, con lo cual la ejecución no va tan rápida.

[Pedrote]

¿A alguien se le ocurre alguna otra cosa?. Me tiene desesperado este asunto. Gracias.

[[newtron]]

Hola.

¿Has probado a poner un application.processmessages antes de los labels?

[Pedrote]

No, voy a probar, muchas gracias por el aporte ahora cuando pruebe te digo.

[Pedrote]

Empezado por newtron

Hola.

¿Has probado a poner un application.processmessages antes de los labels?

No se soluciona tampoco añadiendo application.processmessages delante de los labels :S

[Julián]

Eso que te pasa no tiene nada de raro, pues estas tratando (tu o los componentes que usas) con eventos, con objetos, con threads, con apis de gestores de base de datos, etc. El flujo del programa puede que no sea tan lineal o estructurado como parece. Por eso newtron te dice que uses una llamada a Processmessages, que es algo asi como decirle al programa "¡Eh!, para un momento, haz lo que tengas pendiente, por ejemplo, actualizar los captions, y después sigues". Pero ese proccessmessages, que deberá estar después de modificar el caption y no antes, puede que no sea suficiente.

Creo que deberías actualizar los captions dentro de un evento, por ejemplo, dentro del evento SQLQuery1.OnOpen o BeforeOpen o AfterOpen o algo parecido. Incluso puede que debas incluir un .ProccessMessages tambien en dicho evento.

Ademas, si actualizas los captions en los eventos adecuados podrás estar seguro de que la información que muestran en correcta.

Como ejercicio practico del efecto que hace el proccessMessages que te recomienda Newtron puedes hacerte un form con un button y un label y el onclick del button hacer algo parecido a:

i :=0;
while for (i<5000) begin
  label1.caption := IntToStr(++i);
end;

y luego compararlo con

i :=0;
while for (i<5000) begin
  label1.caption := IntToStr(++i);
  Application.ProccessMessages;
end;

Un saludo!

[[fjcg02]]

Una tontería... para trazar la aplicación no podrías utilizar otros Tlabel para el caso de los que no te actualizan ?
Por lo que veo utilizas siempre el mismo. Así podrías saber si es un problema de refresco o es que nunca pasa por esa parte del código.
También podría ser interesante en los literales añadir la hora, para ver la secuencia. Si tuvieran la misma hora algunos de ellos, es que no le da tiempo a refrescarlos, o es tan rápido que no lo ves, tal y como te comentaban anteriormente.

Saludos

[Pedrote]

Empezado por fjcg02

Una tontería... para trazar la aplicación no podrías utilizar otros Tlabel para el caso de los que no te actualizan ?
Por lo que veo utilizas siempre el mismo. Así podrías saber si es un problema de refresco o es que nunca pasa por esa parte del código.
También podría ser interesante en los literales añadir la hora, para ver la secuencia. Si tuvieran la misma hora algunos de ellos, es que no le da tiempo a refrescarlos, o es tan rápido que no lo ves, tal y como te comentaban anteriormente.

Saludos

Se trata de un problema de refresco porque hice la traza tal y como me dijiste, es decir añadiendo un nuevo Tlabel y en dicho Tlabel si muestra el mensaje.

[[fjcg02]]

Entonces la prueba es concluyente. Haces un código tán rápido que para sí quisieran los de M$ por lo menos

Mira a ver si puedes poner en lugar de un tlabel un tmemo o similar y los literales que saques los incluyes en la primera línea. Así, quien quiera podrá ver qué ha hecho el sistema presentado de atrás para adelante ( como el correo electrónico, que en la badeja de entrada lo normal es que el orden sea descendente).

Un saludo

[Pedrote]

Empezado por fjcg02

Entonces la prueba es concluyente. Haces un código tán rápido que para sí quisieran los de M$ por lo menos

Mira a ver si puedes poner en lugar de un tlabel un tmemo o similar y los literales que saques los incluyes en la primera línea. Así, quien quiera podrá ver qué ha hecho el sistema presentado de atrás para adelante ( como el correo electrónico, que en la badeja de entrada lo normal es que el orden sea descendente).

Un saludo

Buena idea esa, gracias. Ya quisieran los de Microsoft jejeje, yo soy usuario de Linux también (por lo visto tú también), pero la necesidad para comer me hace picar código para este sistema operativo xD.

[[fjcg02]]

Empezado por Pedrote

Buena idea esa, gracias. Ya quisieran los de Microsoft jejeje, yo soy usuario de Linux también (por lo visto tú también), pero la necesidad para comer me hace picar código para este sistema operativo xD.

De linux entre poco y nada. La red de 10000 pc's y +- 1200 oficinas que gestionamos es de equipos WXP. Estoy valorando pasarme a hackintosh, pero seguramente me quede con alguna distro linux. Lo que pasa es que tendría que dejar Delphi y pasarme a lazarus, y no si mi maltrecho cuerpo lo soportaría. Además de que en mi entono natural ( trabajo, familias y amigos ) nadie usa linux, lo que hace difícil de el paso. Aunque no me gano las alubias programando...


Saludos