Y seguimos con los string de colores...

Elfoscuro · #1 06-04-2005

Hola...

He estado jugueteando con los TListBox y he intentado hacer una cosa, solo una, y me han salido un montón de cosas indeseadas, y me está volviendo loco. Joer, no puede ser que con tan poco código falle tanto... Esto parece el RMCobol87 ;-)

Bueno, empiezo:

TListBox, nombre BASIC_List, Fuente Arial, Style=lbOwnerDrawFixed (he probado también con el variable, pero como no entiendo la diferencia entre ambos, y el resultado es el mismo, como que he pasado de él y lo he dejado así). El código asociado es el siguiente:

Código:

  
procedure TForm1.BASIC_ListDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Str,Str2:string;
  f:byte;
  ARect:TRect;
  Ancho_Letra,Ancho_de_Antes:integer;
begin
  f:=0;
  Str:=BASIC_List.Items[Index];
  //BASIC_List.Canvas.TextRect(Rect, 0, 0, '');
  while f<length (Str) do
	begin
	  if (Str[f]<#32) or (Str[f] in [#144..#164]) then
		  begin
			case ord(Str[f]) of
			  144..164:begin
				Ancho_Letra:=BASIC_List.Canvas.TextWidth(Str[f]);
				Str2:=copy(Str,0,f);
				Ancho_de_Antes:=BASIC_List.Canvas.TextWidth(Str2);
				BASIC_List.Canvas.Font.Style:=[fsUnderline,fsItalic];
				ARect:=Rect;
				ARect.Left:=ARect.Left+Ancho_de_Antes+1;
				ARect.Right:=ARect.Right+Ancho_de_Antes+Ancho_Letra+1;
				BASIC_List.Canvas.TextRect(aRect, ARect.Left, aRect.Top, 
				chr(ord(Str[f])-79));
			  end;
			  else
			   begin
				  //De momento nada
			   end;
			end;
			inc (f);
		  end
		else
		  begin
			Ancho_Letra:=BASIC_List.Canvas.TextWidth(Str[f]);
			Str2:=copy(Str,0,f);
			Ancho_de_Antes:=BASIC_List.Canvas.TextWidth(Str2);
			BASIC_List.Canvas.Font.Style:=[];
			ARect:=Rect;
			ARect.Left:=ARect.Left+Ancho_de_Antes+1;
			ARect.Right:=ARect.Right+Ancho_de_Antes+Ancho_Letra+1;
			BASIC_List.Canvas.TextRect(aRect, ARect.Left, aRect.Top, Str[f]);
			inc(f);
		  end;
	end;
end;

El código en si es una basura, pero es que estoy empezando con el bloque y está todo dejado a saco (demasiado código redundante y demás). El objetivo es el siguiente: con la cadena que haya, hace un bucle letra a letra, y va pintando el caracter que toque diferenciando si es menor que #32 o está en el margen que le pongo. Si está en ese margen el caracter debe salir subrayado (el margen es A..U, pero sumando 79). Si no lo es, debe salir normal. Si es menor de 32, deberá hacer otras cosas, que de momento no he implementado.

Pues bien, el resultado es el que hay en la figura1 (adjunta, espero). Me sale un merder que no veas. Si le pongo una fuente de tamaño fijo (Curier New), sale como la figura2 (adjunta también, espero). Sale ¿perfecto? Pues no. La línea larga de CBBBBBBBBBBBBB... sale en cursiva, pero no en subrayado. Es decir, que en Arial se subraya, pero en Curier no... y las dos fuentes funciona el subrayado (lo he hecho en otros códigos y ha funcionado bien). Lo del poner la cursiva era para ver si es que no me estaba cogiendo ningún estilo, pero vi que no era así...

En los dos casos, además, el texto sale desplazado un caracter a la derecha (debería salir pegado al borde como en todos los TListBox), lo que hace que al mover le ratón, con el botón izquierdo pulsado, arriba y abajo, salga una especie de caja de puntitos en el primer caracter, que es un resto de la barra oscura que sale al pulsar sobre una linea, barra que podeis ver como sale...

Yo flipo. Joer, que el código es bastante sencillo. ¿Cómo puedo cometer tantos errores? Y eso que aun no he empezado a cambiar el color del fondo...

NOTA: No me deja subir JPGs de más de ¿1k? al foro. Os describo un poco el resultado: la figura 1 salen las letras, pero solo unos dos o tres pixels. A continuación y montada sobre la anterior, la letra siguiente. La única letra que se ve entera es la última de la línea. Las demás salen cortadas...

Y en la segunda figura sale bien, pero como digo más arriba lo que debería salir subrayado no sale (sale solo en cursiva), y al principio de la línea sale un resto en forma de C, pero cuadrada, que es un resto de la barra de selección.

De todas formas, si no lo entendeis, decidme donde puedo poner las dos imágenes (46k y 67k).

Saludos del elfo al que le crecen los enanos...

Neftali [Germán.Estévez] · #2 07-04-2005

Prueba con esta:

Código Delphi [-] var
   Str,Str2:string;
   f:byte;
   ARect:TRect;
   Ancho_Letra,Ancho_de_Antes:integer;
   _Left:Integer;
 begin
   f:=0;
   _Left:=0;
   Str:=BASIC_List.Items[Index];
   //BASIC_List.Canvas.TextRect(Rect, 0, 0, '');
 
   while f<=length (Str) do begin
       if (Str[f]<#32) or (Str[f] in [#144..#164]) then begin
             case ord(Str[f]) of
               144..164:
         begin
           Ancho_Letra:=BASIC_List.Canvas.TextWidth(Str[f]);
           Str2:=copy(Str,0,f);
           Ancho_de_Antes:=BASIC_List.Canvas.TextWidth(Str2);
           BASIC_List.Canvas.Font.Style:=[fsUnderline,fsItalic];
           ARect:=Rect;
           ARect.Left:=ARect.Left+Ancho_de_Antes+1;
           ARect.Right:=ARect.Right+Ancho_de_Antes+Ancho_Letra+1;
           BASIC_List.Canvas.TextRect(aRect, ARect.Left, aRect.Top,
           chr(ord(Str[f])-79));
               end;
               else  begin
                   //De momento nada
                end;
             end;
             inc (f);
           end
         else  begin
             Ancho_Letra:=BASIC_List.Canvas.TextWidth(Str[f]);
             Str2:=copy(Str,0,f);
             Ancho_de_Antes:=BASIC_List.Canvas.TextWidth(Str2);
             BASIC_List.Canvas.Font.Style:=[];
             ARect:=Rect;
       ARect.Left:=_Left;
 
       if (fthen begin  // ultima
               ARect.Right:=_Left+Ancho_Letra;
       end;
       
       _LEft := _LEft + Ancho_Letra;
             BASIC_List.Canvas.TextRect(aRect, ARect.Left + 1, aRect.Top, Str[f]);
             inc(f);
     end;
     end;
 
   // Cambiar cuando tiene el foco...
   if odFocused in State then begin
     BASIC_List.Canvas.Brush.Style := bsClear;
     BASIC_List.Canvas.Rectangle(Rect);
     DrawFocusRect(BASIC_List.Canvas.Handle, Rect);
   end;
 end;

De todas forma la condición (Str[f] in [#144..#164]) nunca se cumple y por lo tanto nunca va a entar en la primera parte del procedimiento.

Elfoscuro · #3 07-04-2005

Vale. No he entendido nada. De todas formas, tampoco funcionaba bien... hay un fallo en un if... "if (fthen begin" me peta. Creo que te has comido el resto de la comparación del IF al Cortar-Pegar.

De todas formas, olvidad todo lo anterior. He remodelado el código completamente (eso de ir probando no mola... debería empezar a programar siempre bien, y no ir arreglando luego... si es que soy de dejao...

). Este es el nuevo código:

Código:

procedure TForm1.BASIC_ListDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Str:string;
  f,Ancho_Letra:integer;
  ARect:TRect;
  chrs:Char;

begin
  f:=1;
  Str:=BASIC_List.Items[Index];
  ARect:=Rect;
  BASIC_List.Canvas.TextRect(Rect,0,0,'');
  while f<=length (Str) do
	begin
	  chrs:=Str[f];
	  if (chrs<chr(32)) or ((chrs>=chr(144)) and (chrs<=chr(164))) then
		  begin
			if (chrs>=chr(144)) and (chrs<=chr(164)) then
				begin
				  chrs:=chr(ord(Chrs)-79);
				  BASIC_List.Canvas.Font.Style:=[fsBold,fsUnderline,fsItalic];
				end
			  else
				begin
				  //De momento nada
				end;
		  end
		else
		  begin
			BASIC_List.Canvas.Font.Style:=[];
		  end;
	  Ancho_Letra:=BASIC_List.Canvas.TextWidth(chrs);
	  ARect.Right:=ARect.Left+Ancho_Letra;
	  BASIC_List.Canvas.TextRect(ARect, ARect.Left, ARect.Top, chrs);
	  ARect.Left:=ARect.Left+Ancho_Letra;
	  inc(f);
	end;
end;

Vale. Con esto he solucionado bastantes cosas. Ahora ya da igual que la fuente sea fija o proporcional. Ya no me machaca letras. Con respecto al recuadro que señala la línea, lo he solucionado con "BASIC_List.Canvas.TextRect(Rect,0,0,'');", que me dibuja el rectángulo completo antes de hacer nada, por lo que luego ya no quedan partes del canvas sin dibujar (que era lo que me generaba la basurilla residual al mover el cursor).

En cuanto a lo de que la condición siempre era falsa, la verdad es que no se a que te refieres. La condición se cumplía perfectamente, entraba al bloque (comprobado con showmessages y puntos de ruptura), y lo ejecutaba casi sin problemas. De hecho, el único problema que tenía ahí, lo sigo teniendo con la nueva versión del código. Es el único que me queda:

¿Porqué si uso la fuente arial, me salen las letras subrayadas, negrita y cursiva (solo los chr entre 144 y 164), mientras que si pongo la curier new (que es la que al final se tiene que quedar) solo sale en negrita y cursiva?

Ambas fuentes tienen todas las posibilidades. Si en lugar de estilos, uso colores, va bien, los pinta de un color diferente al resto. Pero parece que el subrayado se le atraganta al joio TListBox...

A ver si podeis echarme una mano en esto... ¿puede ser que al dibujar el TextRect me esté comiendo la parte de abajo y por eso no salga? Es una tontería mu gorda, lo se, pero es que no se que $&$%&$%&$%&$%& puede ser...

Saludos del elfo