Procedure y Funcion nuevos DrwGradientLine y LabLinea

[[José Luis Garcí]]

Hola Compañeros Como siempre os pongo dos trozos de códigos nuevo, un procedure que dibuja una linea gradient y una funcion que hice para crear separaciones, espero os sirvan de ayuda

Código Delphi [-]
procedure DrawGradientLine(bCanvas:
TCanvas; X, Y, Width,height: integer;
StartColor, EndColor: TColor;Parejo:boolean);
//------------------------------------------------------------------------------
//****************************************************[ DRAWGRADIENTLINE ]******
//  Bajado originalmente de codeunivers.com/…/draw_gradient_line
//  Modificado por mi, se añade  la posibilidad de ancho y de si estilo continuo
//  21/08/2011           JLGT
//------------------------------------------------------------------------------
//  bCanvas     Canvas sobre el qiue dibujar la linea
//  X           Posición left a comenzar
//  Y           Posición Top a cpmenzar
//  Width       Ancho de la linea
//  Hight       Alto de la linea  (Mia)
//  StarColor   Color de inicio
//  EndColor    Color Final
//  Parejo      Si es truedibuja todas las lineas empezando igual,
//              si es false cada inicio de linea incrementa 1 desplazandose los colores 
//              diagonalmente (Mia)
//--------------------------------------------------------------EJEMPLO---------
//   Form1.DoubleBuffered:=True;
//   DrawGradientLine(Form1.Canvas,0,0,Form1.Width,5,clRed,clLime,True);
//   DrawGradientLine(Form1.Canvas,0,Form1.Height-43,Form1.Width,5,clRed,clLime,True);
//   DrawGradientLine(Form1.Canvas,0,0,50,Form1.Height,clBlack,clRed,True);
//   DrawGradientLine(Form1.Canvas,Form1.Width-66,0,50,Form1.Height,clLime,clBlack,True);
//------------------------------------------------------------------------------
var
fX,hy:integer;
dr,dg,db:Extended;
C1,C2:TColor;
r1,r2,g1,g2,b1,b2:Byte;
R,G,B:Byte;
cnt:integer;
begin
  if Parejo=False then  cnt:=0;
  for HY := y to y+height - 1 do
  begin
    if Parejo=True then cnt := 0;
    C1 := StartColor;
    C2 := EndColor;
    R1 := GetRValue(C1) ;
    G1 := GetGValue(C1) ;
    B1 := GetBValue(C1) ;
    R2 := GetRValue(C2) ;
    G2 := GetGValue(C2) ;
    B2 := GetBValue(C2) ;
    dr := (R2-R1) / Width;
    dg := (G2-G1) / Width;
    db := (B2-B1) / Width;
    for fX := X to X + Width - 1 do
    begin
      R := R1+Ceil(dr*cnt) ;
      G := G1+Ceil(dg*cnt) ;
      B := B1+Ceil(db*cnt) ;
      bCanvas.Pixels[fX, hy] := RGB(R,G,B);
      inc(cnt);
    end;
  end;
end;

function TForm1.LabLinea(Cap,Carc:string;Ali:TAlignment;Whi:Integer):string;
//------------------------------------------------------------------------------
//************************************************************[ LabLinea ]******
//  Función propia  JLGT 20/08/2011
//  texto con relleno a elejir posicion, para separaciones
//------------------------------------------------------------------------------
//  Cap   Cadena de Texto
//  Car   Caracter
//  Ali   taLeftJustify   cadena a la izquierda, Relleno a la derecha
//        taRightJustify  cadena a la derecha, Relleno a la izquierda
//        taCenter        cadena al centro, relleno a ambos lados
//  Whi
//---------------------------------------------------------------EJEMPLO--------
//
//  Label1.Caption:=LabLinea('Opciones',' ',taCenter,200);
//
//  Si el Label1 Cambiamos las caracteristicas del Font a negrita y subrallado,
//  queda un curios separador
//------------------------------------------------------------------------------

var VarIAnc,VariDif:Integer;
    VarSCad:string;
    lab:TLabel;
begin
    lab:=TLabel.Create(Self);
    lab.Parent:=Self;
    VarIAnc:=lab.Canvas.TextWidth(Cap);
    VariDif:=whi-VarIAnc;
    VarSCad:=Cap;
    case Ali of
      taLeftJustify: begin
                        while lab.Canvas.TextWidth(VarSCad) < Whi do  VarSCad:=VarSCad+Carc;
                     end;
      taRightJustify:begin
                        while lab.Canvas.TextWidth(VarSCad)  < Whi do  VarSCad:=Carc+VarSCad;
                     end;
      taCenter:begin
                        while lab.Canvas.TextWidth(VarSCad) < lab.Canvas.TextWidth(Cap)+(VariDif/2) do  VarSCad:=VarSCad+Carc;
                        while lab.Canvas.TextWidth(VarSCad) < whi do  VarSCad:=Carc+VarSCad
               end;
    end;
   Result:=VarSCad
end;