FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
#1
|
|||
|
|||
Problema con la Label en este código
Código:
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; Uno es este: Código:
// Limpiamos el label Label1.Caption := ''; Código:
Label1.Caption := 'En proceso .... espere'; 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. |
#2
|
||||
|
||||
¿No será que lo hace tan rápido que no le da tiempo a cambiar el texto del título?
|
#3
|
|||
|
|||
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.
Última edición por Pedrote fecha: 13-01-2013 a las 14:05:36. |
#4
|
|||
|
|||
¿A alguien se le ocurre alguna otra cosa?. Me tiene desesperado este asunto. Gracias.
|
#5
|
||||
|
||||
Hola.
¿Has probado a poner un application.processmessages antes de los labels?
__________________
Be water my friend. |
#6
|
|||
|
|||
No, voy a probar, muchas gracias por el aporte ahora cuando pruebe te digo.
|
#7
|
|||
|
|||
No se soluciona tampoco añadiendo application.processmessages delante de los labels :S
|
#8
|
||||
|
||||
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: Código:
i :=0; while for (i<5000) begin label1.caption := IntToStr(++i); end; Código:
i :=0; while for (i<5000) begin label1.caption := IntToStr(++i); Application.ProccessMessages; end;
__________________
"la única iglesia que ilumina es la que arde" Anonimo |
#9
|
||||
|
||||
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
__________________
Cuando los grillos cantan, es que es de noche - viejo proverbio chino - |
#10
|
|||
|
|||
Cita:
|
#11
|
||||
|
||||
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
__________________
Cuando los grillos cantan, es que es de noche - viejo proverbio chino - |
#12
|
|||
|
|||
Cita:
|
#13
|
||||
|
||||
Cita:
Saludos
__________________
Cuando los grillos cantan, es que es de noche - viejo proverbio chino - |
|
|
Temas Similares | ||||
Tema | Autor | Foro | Respuestas | Último mensaje |
Label que este encima de todos los demas componentes | jourdan | OOP | 4 | 23-07-2010 20:35:05 |
Porque este código me da error (adjunto código) | David | JAVA | 1 | 12-03-2009 20:07:27 |
Cual es el problema con este codigo? | THACKER | Varios | 10 | 03-03-2009 09:59:42 |
problema envio de label | anubis | Varios | 2 | 09-05-2007 21:05:58 |
Problemas al imprimir label con código | josevaldez | Impresión | 0 | 31-01-2006 22:30:34 |
|