Repintado de un objeto grafico

[vic_ia]

hola...

tal vez el problema radica que dibujas o asignas las propiedades del FONT antes de dibujar el resto de tu imagen o grafico, he probado colocar en el evento OnPaint del PaintBox el codigo de esta forma y funciona..

Código Delphi [-]
  PaintBox.Canvas.Brush.Color := clRed;  { cambio el color del brush }
  PaintBox.Canvas.RoundRect(0,0,150,150,7,10); { dibujo un rectangulo sobre el que coloco el texto }
  LOGFONT.lfHeight := 30;
  LOGFONT.lfWidth  := 10;
  LOGFONT.lfWeight := FW_NORMAL;
  LOGFONT.lfEscapement := 900; { angulo expresado en decimas de grado }
  LOGFONT.lfStrikeOut  := 0; { distinto de cero para activarlo }
  LOGFONT.lfItalic     := 0; { distinto de cero para activarlo }
  LOGFONT.lfUnderline  := 0; { distinto de cero para activarlo }
  LOGFONT.lfFaceName := 'Tahoma';

  Font := CreateFontIndirect(LOGFONT);
  SelectObject(PaintBox.Canvas.Handle,Font);
  PaintBox.Canvas.TextOut(100,100,Edit1.Text);
  DeleteObject(Font);

saludos...

[senpiterno]

Desde el eveto onpaint llamo a la funcion que crea el texto vertical de esta forma:

Código Delphi [-]
procedure TFEntradaSistema.GradianPaint(Sender: TObject);
begin
   
    //Crea un gradian sobre el objeto PaintBox
    CreaGradian(FEntradaSistema.Gradian);
    
     //Donde gradian es el objeto PaintBox
    CreaTextoVertical(FEntradaSistema.Gradian,'Entrada');
end;

 
Function CreaTextoVertical(Objeto:TPaintBox;Texto:String):Boolean;
Var
  LOGFONT : TLogFont;
  Font    : HFONT;
Begin
  
Try //Iniciamos el codigo de control de errores
 
   Result:=False;//Asignamos el valor por defecto de la funcion
   
   Objeto.Canvas.Brush.Color := $00C0FFFF;
   LOGFONT.lfHeight := 15;
   LOGFONT.lfWidth  := 0;
   LOGFONT.lfWeight := FW_NORMAL;
   LOGFONT.lfEscapement := 900; { angulo expresado en decimas de grado }
   LOGFONT.lfStrikeOut  := 0; { distinto de cero para activarlo }
   LOGFONT.lfItalic     := 0; { distinto de cero para activarlo }
   LOGFONT.lfUnderline  := 0; { distinto de cero para activarlo }
   LOGFONT.lfFaceName := 'Tahoma';
   Font := CreateFontIndirect(LOGFONT);
   SelectObject(Objeto.Canvas.Handle,Font);
   Objeto.Canvas.TextOut(3,Objeto.Height - 10,'Entrada');
   
   Result:=True;//Le damos el valor de salida a la funcion
 
Except //Se ha producido un error
   On E:Exception Do
      If (MensajesDeError(ErroresSistema(E), E, MsgErrorCreaTextoVertical,False)<> Reintentar) Then Begin
          Result:=False; //enviamos la respuesta de error
      End;//If
   End;//on
End;//Function

Respecto al crear un rectangulo donde dibujar el texto no me sirve, ya que el efecto que pretendo dar con el texto vertical es crear primero un gradian sobre el objeto (PaintBox) y despues crear el texto en forma vertical, estilo barra de inicio de win. Por esto que la creacion de un rectangulo haria que el efecto que pretendo lograr no se viera bien.
Y les vuelvo a repetir cuando se genera el efecto onpaint en efecto del texto desaparece mostrandome el texto en forma horizontal y no vertical.
quizas puedo estar realizando algo mal...ademas para completar tambien les muestro el codigo utilizado para gererar el gradian:

Código Delphi [-]
 
Function CreaGradian(Objeto:TPaintBox):Boolean;
Var
     Row, Ht: Word ;
Begin
    Try //Iniciamos el codigo de control de errores
       
       Result:=False;//Asignamos el valor por defecto de la funcion
       
       Ht := (Objeto.ClientHeight + 255) div 256 ;
       For Row := 0 to 255 do Begin
           With Objeto.Canvas do begin
               Brush.Color := RGB(0, 0, Row+20) ;
               FillRect(Rect(0, Row * Ht, Objeto.ClientWidth, (Row + 1) * Ht));
           End;
       End;
       
       Objeto.Canvas.Refresh;
       
        Result:=True;//Le damos el valor de salida a la funcion
    
Except //Se ha producido un error
   On E:Exception Do
      If (MensajesDeError(ErroresSistema(E), E, MsgErrorCreaGradina,False)<> Reintentar) Then Begin
          Result:=False; //enviamos la respuesta de error
      End;//If
   End;//on
End;//Function

[vic_ia]

hola...

respecto a lo que muestras de tu codigo ...

Empezado por senpiterno

Desde el eveto onpaint llamo a la funcion que crea el texto vertical de esta forma:

Código Delphi [-]
procedure TFEntradaSistema.GradianPaint(Sender: TObject);
begin
    //Crea un gradian sobre el objeto PaintBox
    CreaGradian(FEntradaSistema.Gradian);
     //Donde gradian es el objeto PaintBox
    CreaTextoVertical(FEntradaSistema.Gradian,'Entrada');
end;

Respecto al crear un rectangulo donde dibujar el texto no me sirve, .....

Código Delphi [-]
Function CreaGradian(Objeto:TPaintBox):Boolean;
Var
     Row, Ht: Word ;
Begin
    Try //Iniciamos el codigo de control de errores
       Result:=False;//Asignamos el valor por defecto de la funcion
       Ht := (Objeto.ClientHeight + 255) div 256 ;
       For Row := 0 to 255 do Begin
           With Objeto.Canvas do begin
               Brush.Color := RGB(0, 0, Row+20) ;
               FillRect(Rect(0, Row * Ht, Objeto.ClientWidth, (Row + 1) * Ht));
           End;
       End;
       Objeto.Canvas.Refresh;
        Result:=True;//Le damos el valor de salida a la funcion
Except //Se ha producido un error
   On E:Exception Do
      If (MensajesDeError(ErroresSistema(E), E, MsgErrorCreaGradina,False)<> Reintentar) Then Begin
          Result:=False; //enviamos la respuesta de error
      End;//If
   End;//on
End;//Function

creo que el enfoque que le has dado no es muy correcto (si alguien cree que esoy diciendo una tarugada, que me corrija por favor ) y pudieran ser dos las situaciones por las que se pierde la transformación del texto

quiero entender que el procedimiento GradianPain es el asignado al evento OnPaint de tu PaintBox, si es asi, esto hace que cada vez que pides que se dibuje (por algun evento, este cambia sus dimensiones varias veces, lo que posiblemente haga que otros objetos vuelvan a llamar a ese evento, y esto puede hacer que al solicitar la creación del font no tenga los recursos necesarios; por otro lado dentro del procedimiento llamas a Refresh lo que hara que se vuelva a solicitar el repintado, lo cual no necesariamente se hara de manera inmediata, tal vez esto ultimo sea lo que hace que se pierda la transformación...

yo cambiaria el enfoque, pienso que cada vez que cambias las dimensiones del control este llama a su evento OnPain, por lo que dentro de este solo debiera estar lo concerniente al dibujado interior del el, nada mas, creo que el cambio de las dimensiones lo debieras llevar a cabo desde.. no se por ejemplo desde donde lo llamas para que aparezca...

en cuanto tenga tiempo tratare de checarlo con detenimiento...

saludos...

[senpiterno]

vic_ia, ya encontre el problema....como en mi aplicacion creo algunos formularios de la forma:

Código Delphi [-]
FEntradaSistema:= TFEntradaSistema.Create(nil);

antes de crear en formulario principal, ya que bien sabras que en primer formulario que se crea, sera el que tambien cerrara la aplicacion al monento de cerrarse este tambien. Como necesito cargar algunos formularios antes de crear el form principal, los creo pero no los cargo en memoria hasta mostrarlos, debido a esto algunos eventos como onpaint del objeto PaintBox actuaban en forma irregular, causando que el efecto del texto vertical se perdiera....

Mi problema es ahora que cuando se crea el texto a su alrrededor tambien se crea un rectangulo de color oscuro, el cual daña la apariencia del gradian sobre el que esta creado el texto, ¿este rectangulo es parte de la creacion del texto sobre el objeto? , ¿ es posible crear el texto sin ese molesto rectangulo a su alrrededor?...

De antemano gracias por cualquier ayuda....

[senpiterno]

Ya solucione el problema del rectangulo que se generaba al crear el texto sobre el gradian, utilizando la propiedad Brush.Style del canvas del objeto en donde se genera el texto, a continuación muestro el codigo por si a alguien le pudiera servir:

Código Delphi [-]
Function CreaTextoVertical(Objeto:TPaintBox;Texto:String):Boolean;
Var
LOGFONT : TLogFont;
Font : HFONT;
Begin
Result:=False;//Asignamos el valor por defecto de la funcion
//Utilizamos la propiedad Brush.Style y le asignamos bsClear, para indicar que 
//cuando se pinte el objeto no se rellene su interior
 
Objeto.Canvas.Brush.Style:=bsClear;
Objeto.Canvas.Font.color:= $00C0FFFF;
LOGFONT.lfHeight := -13;
LOGFONT.lfWidth := 0;
LOGFONT.lfWeight := FW_NORMAL;
LOGFONT.lfEscapement := 900; { angulo expresado en decimas de grado }
LOGFONT.lfStrikeOut := 0; { distinto de cero para activarlo }
LOGFONT.lfItalic := 0; { distinto de cero para activarlo }
LOGFONT.lfUnderline := 0; { distinto de cero para activarlo }
LOGFONT.lfFaceName := 'Tahoma';
LOGFONT.lfQuality:=PROOF_QUALITY; 
Font := CreateFontIndirect(LOGFONT);
SelectObject(Objeto.Canvas.Handle,Font);
Objeto.Canvas.TextOut(6,Objeto.Height - 10,'Entrada');
 
Result:=True;//Le damos el valor de salida a la funcion
 
End;//Function

Gracias a todos por su ayuda.....