Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Y seguimos con los string de colores... (https://www.clubdelphi.com/foros/showthread.php?t=20141)

Elfoscuro 06-04-2005 21:37:07

Y seguimos con los string de colores...
 
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] 07-04-2005 10:14:14

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 07-04-2005 15:44:21

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


La franja horaria es GMT +2. Ahora son las 13:25:47.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi