画完成百分比的进度条

procedure DrawProgressColorEH(Canvas: TCanvas;nProgress: Integer; const Rect: TRect; Column: TColumnEh);
var
  ldValue:integer;
  lsValue,lsTemp1,lsTemp2:string;
  lRect: TRect;
  X, Y,liTemp: Integer;
begin
  ldValue :=nProgress;
  with Canvas do //画 cell 的边框
  begin
    Pen.Color := $00ff0000; //定义画笔颜色(蓝色)
    MoveTo(Rect.Left, Rect.Top); //画笔定位
    LineTo(Rect.Right, Rect.Top); //画顶部蓝色的横线
    MoveTo(Rect.Left, Rect.Top); //画笔定位
    LineTo(Rect.Left, Rect.Bottom); //画左边绿色的竖线
    MoveTo(Rect.Left, Rect.Bottom); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画底部蓝色的横线
    MoveTo(Rect.Right, Rect.Top); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画右边绿色的竖线

    //画背景色
    Brush.Color:=clBtnFace;
    FillRect(Rect);

    //画百分比内容
    Brush.Color:=clNavy;
    lRect.Left :=Rect.Left ;
    lRect.Top := Rect.Top ;
    lRect.Bottom :=Rect.Bottom ;
    lRect.Right :=Rect.Left + Round((Rect.Right  - Rect.Left) * ldValue / 100);
    FillRect(lRect);

    //显示内容
    lsValue:=IntToStr(ldValue) + '%';
    X := (Rect.Left+Rect.Right) div 2 - TextWidth(lsValue) div 2;
    Y := (Rect.Bottom+Rect.Top) div 2 - TextHeight(lsValue) div 2;

    //如果有半个字在中间的,移动X解决半个字问题
    for liTemp:=1 to length(lsValue) do
    begin
      lsTemp1 :=MidBStr(lsValue,liTemp,1);
      lsTemp2 :=MidBStr(lsValue,1,liTemp - 1 );
      if (lRect.Right > (X + TextWidth(lsTemp2))) and (lRect.Right < (X + TextWidth(lsTemp2) + TextWidth(lsTemp1))) then
      begin
        if (lRect.Right > (X + TextWidth(lsTemp2) + TextWidth(lsTemp1) div 2)) then
          X := X - (X + TextWidth(lsTemp2) + TextWidth(lsTemp1) - lRect.Right)
        else
          X := X + ( lRect.Right - X - TextWidth(lsTemp2) );
      end;
    end;

    //单元格太小时的处理
    if X < lRect.Left then
       X:= lRect.Left;

    for liTemp:=1 to length(lsValue) do
    begin
      lsTemp1 :=MidBStr(lsValue,liTemp,1);     //需要显示的字符
      lsTemp2 :=MidBStr(lsValue,1,liTemp - 1 );     //
      if (lRect.Right > (x + TextWidth(lsTemp2) + TextWidth(lsTemp1) div 2)) then
      begin
        Brush.Color:=clNavy;
        Font.Color := clWhite;
      end
      else
      begin
        Brush.Color:=clBtnFace;
        Font.Color := clBlack;
      end;
      //字超过单元格时不显示
      if (x + TextWidth(lsTemp2) + TextWidth(lsTemp1)) < Rect.Right then
        Canvas.TextOut(X+ TextWidth(lsTemp2), Y, lsTemp1);
    end;
  end;
end;