Ver Mensaje Individual
  #2  
Antiguo 24-03-2008
Avatar de MaMu
MaMu MaMu is offline
Miembro
 
Registrado: abr 2006
Ubicación: Argentina
Posts: 863
Reputación: 19
MaMu Va por buen camino
Bueno, me voy a autoresponer, porque encontré un artículo interesante "googleando" por otros pagos:

Usando el evento OnDrawColumnCell, se pueden utilizar estas rutinas genéricas para pintar un ProgressBar en cualquier TCanvas (El segundo permite pintar un texto entero,y el primero, además una figura opcional del porcentaje). Esta rutina invierte el color del texto de modo que el texto sea siempre legible:


Código Delphi [-]
procedure PaintProgressBar(Canvas: TCanvas; const Rect: TRect; Progress: 
integer; PaintNumber: boolean = true; BarColor: TColor = clBlue; BackColor: 
TColor = clWhite); overload; 
  procedure PaintProgressBar(Canvas: TCanvas; const Rect: TRect; Progress: 
integer; const Text: string; TextAlign: TAlignment; BarColor: TColor = 
clBlue; BackColor: TColor = clWhite); overload; 


implementation 

procedure SetClipRect(Canvas: TCanvas; R: PRect); 
var 
  Rgn    : HRGN; 
begin 
  if R = nil then 
    SelectClipRgn(Canvas.Handle, 0) 
  else begin 
    With Canvas do begin 
      Rgn:=CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom); 
      try 
        SelectClipRgn(Canvas.Handle, Rgn); 
      finally 
        DeleteObject(Rgn); 
      end; 
    end; 
  end; 
end; 

procedure PaintProgressBar(Canvas: TCanvas; const Rect: TRect; Progress: 
integer; PaintNumber: boolean = true; BarColor: TColor = clBlue; BackColor: 
TColor = clWhite); 
begin 
  if Progress = -1 then 
    PaintProgressBar(Canvas, Rect, Progress, '', taCenter, BarColor, 
BackColor) 
  else begin 
    if PaintNumber then 
      PaintProgressBar(Canvas, Rect, Progress, i2s(Progress)+' %', taCenter, 
BarColor, BackColor) 
    else 
      PaintProgressBar(Canvas, Rect, Progress, '', taCenter, BarColor, 
BackColor); 
  end; 
end; 
procedure PaintProgressBar(Canvas: TCanvas; const Rect: TRect; Progress: 
integer; const Text: string; TextAlign: TAlignment; BarColor: TColor = 
clBlue; BackColor: TColor = clWhite); overload; 
var 
  ARect: TRect; 
  R    : TRect; 
  FLAGS: Word; 
begin 
  FLAGS:=0; 
  with Canvas do begin 
    Case TextAlign of 
      taLeftJustify : FLAGS:=DT_LEFT; 
      taRightJustify: FLAGS:=DT_RIGHT; 
      taCenter      : FLAGS:=DT_CENTER; 
    end; 
    FLAGS:=FLAGS or DT_VCENTER or DT_SINGLELINE; 
    ARect:=Rect; 
    InflateRect(ARect, -2, 0); 
    R:=Rect; 
    if Progress <> -1 then begin 
//    InflateRect(R, -1, -1); 
      R.Right:=Round(Progress*(Rect.Right-Rect.Left)/100); 
      Brush.Color:=BarColor; 
      FillRect(R); 
      if Text <> '' then begin 
        SetClipRect(Canvas, @R); 
        Font.Color:=BackColor; 
        DrawText(Handle, PChar(Text), -1, ARect, FLAGS); 
      end; 
      R.Left:=R.Right+1; 
      R.Right:=Rect.Right-1; 
    end; 
    Brush.Color:=BackColor; 
    if Text <> '' then 
      SetClipRect(Canvas, @R); 
    FillRect(R); 
    if Text <> '' then begin 
      Font.Color:=BarColor; 
      DrawText(Handle, PChar(Text), -1, ARect, FLAGS); 
      SetClipRect(Canvas, nil); 
    end; 
  end; 
end;

Y bueno, voy a ver si interpreto como usar todo esto. Lo postié porque me pareció muy interesamte.

Saludos
__________________
Código Delphi [-]
 
try 
ProgramarMicro(80C52,'Intel',MnHex,True);
except
On Exception do
MicroChip.IsPresent(True);
end;
Responder Con Cita