频道分类

Delphi ListView 实现进度条显示

作者:admin 来源: 日期:2020/2/22 20:57:00 人气: 标签:ListView

 

代码参考互联网,本人在Win10 + Delphi 10.3.2 社区版中测试通过,现将测试通过的代码分享如下

 

  unit Unit1;

 

 interface

 

 uses

   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,

   System.ImageList, Vcl.ImgList;

 

 type

   TForm1 = class(TForm)

     lv1: TListView;

     btn1: TButton;

     procedure lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;

       State: TCustomDrawState; var DefaultDraw: Boolean);

     procedure btn1Click(Sender: TObject);

   private

     procedure DrawSubItem(ALV: TListView; AItem: TListItem; ASubItem: Integer;

                           APosition: Single; AMax, AStyle: Integer; AIsShowProgress: Boolean;

                           ADrawColor: TColor = $00005B00; AFrameColor: TColor = $00002F00);

     function ReDrawItem(AHwndLV: HWND; AItemIndex: integer): boolean;

   public

     { Public declarations }

   end;

 

 var

   Form1: TForm1;

 

 implementation

 uses

   Winapi.CommCtrl;

 {$R *.dfm}

 

 procedure TForm1.btn1Click(Sender: TObject);

 var

   NewColumn: TListColumn;

   NewItem: TListItem;

   i: Integer;

 begin

   lv1.Items.Clear;

   lv1.Columns.Clear;

   NewColumn := lv1.Columns.Add; NewColumn.Caption := '名称';

   NewColumn := lv1.Columns.Add; NewColumn.Caption := '进度';

   NewColumn := lv1.Columns.Add; NewColumn.Caption := '进度条';

 

   for I := 0 to 10 do

   begin

     NewItem := lv1.Items.Add;

     NewItem.Caption := IntToStr(i);

     NewItem.SubItems.Add(IntToStr(i * 10));

     NewItem.SubItems.Add(IntToStr(i * 10));

   end;

 end;

 

 procedure TForm1.DrawSubItem(ALV: TListView; AItem: TListItem; ASubItem: Integer;

                              APosition: Single; AMax, AStyle: Integer; AIsShowProgress: Boolean;

                              ADrawColor: TColor = $00005B00; AFrameColor: TColor = $00002F00);

 var

  PaintRect, r: TRect;

  i, iWidth, x, y: integer;

  S: string;

  function GetItemRect(LV_Handle, iItem, iSubItem: Integer): TRect;

  var

    Rect: TRect;

  begin

    ListView_GetSubItemRect(LV_Handle, iItem, iSubItem, LVIR_LABEL, @Rect);

    Result := Rect;

  end;

 begin

   with ALV do

   begin

     PaintRect := GetItemRect(ALV.Handle, AItem.Index, ASubItem);

     r := PaintRect;

     //这一段是算出百分比

     if APosition >= AMax then

       APosition := 100

     else

       if APosition <= 0 then

         APosition := 0

       else

         APosition := Round((APosition / AMax) * 100);

 

     if (APosition = 0) and (not AIsShowProgress) then

     begin

       //如果是百分比是0,就直接显示空白

       Canvas.FillRect(r);

     end else begin

       //先直充背景色

       Canvas.FillRect(r);

       Canvas.Brush.Color := Color;

       //画一个外框

       InflateRect(r, -2, -2);

       Canvas.Brush.Color := AFrameColor; //$00002F00;

       Canvas.FrameRect(R);

       Canvas.Brush.Color := Color;

       InflateRect(r, -1, -1);

       InflateRect(r, -1, -1);

       //根据百分比算出要画的进度条内容宽度

       iWidth := R.Right - Round((R.Right - r.Left) * ((100 - APosition) / 100));

       case AStyle of

         0: //进度条类型,实心填充

           begin

             Canvas.Brush.Color := ADrawColor;

             r.Right := iWidth;

             Canvas.FillRect(r);

           end;

         1: //进度条类型,竖线填充

           begin

             i := r.Left;

             while i < iWidth do

             begin

               Canvas.Pen.Color := Color;

               Canvas.MoveTo(i, r.Top);

               Canvas.Pen.Color := ADrawColor;

               canvas.LineTo(i, r.Bottom);

               Inc(i, 3);

             end;

           end;

       end;

       //画好了进度条后,现在要做的就是显示进度数字了

       Canvas.Brush.Style := bsClear;

       if APosition = Round(APosition) then

         S := Format('%d%%', [Round(APosition)])

       else

         S := FormatFloat('#0.0', APosition);

 

       with PaintRect do

       begin

         x := Left + (Right - Left + 1 - Canvas.TextWidth(S)) div 2;

         y := Top + (Bottom - Top + 1 - Canvas.TextHeight(S)) div 2;

       end;

       SetBkMode(Canvas.handle, TRANSPARENT);

 

       Canvas.TextRect(PaintRect, x, y, S);

     end; // end of if (Prosition = 0) and (not IsShowProgress) then

      //进度条全部画完,把颜色设置成默认色了

     Canvas.Brush.Color := Color;

 

   end; // end of with LV do

 end;

 

 procedure TForm1.lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;

   State: TCustomDrawState; var DefaultDraw: Boolean);

 var

   BoundRect, Rect: TRect;

   i: integer;

   TextFormat: Word;

   LV: TListView;

 begin

   LV := TListView(Sender);

   BoundRect := Item.DisplayRect(drBounds);

   InflateRect(BoundRect, -1, 0);

   //这个地方你可以根据自己的要求设置成想要的颜色,实现突出显示

   LV.Canvas.Font.Color := clBtnText;

   //查看是否被选中

   if Item.Selected then

   begin

     if cdsFocused in State then

     begin

       LV.Canvas.Brush.Color := $00ECCCB9; // //clHighlight;

     end

     else

     begin

       LV.Canvas.Brush.Color := $00F8ECE5; //clSilver;

     end;

   end

   else

   begin

     if (Item.Index mod 2) = 0 then

       LV.Canvas.Brush.Color := clWhite

     else

       LV.Canvas.Brush.Color := $00F2F2F2;

   end;

 

   LV.Canvas.FillRect(BoundRect); // 初始化背景

   for i := 0 to LV.Columns.Count - 1 do

   begin

    //获取SubItem的Rect

     ListView_GetSubItemRect(LV.Handle, Item.Index, i, LVIR_LABEL, @Rect);

     case LV.Columns[i].Alignment of

       taLeftJustify:

         TextFormat := DT_LEFT;

       taRightJustify:

         TextFormat := DT_RIGHT;

       taCenter:

         TextFormat := DT_CENTER;

     else

       TextFormat := DT_CENTER;

     end;

     case i of

       0: //画Caption,0表示Caption,不是Subitem

         begin

           InflateRect(Rect, -(5 + 0), 0); //向后移3个像素,避免被后面画线框时覆盖

           DrawText(LV.Canvas.Handle,

                    PCHAR(Item.Caption),

                    Length(Item.Caption),

                    Rect,

                    DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);

 

         end;

       1..MaxInt: //画SubItem[i]

         begin

           if (i - 1) = 1 then //显示状态条,本示例是第三栏显示,

           begin

             DrawSubItem(LV, Item, i, StrToFloatDef(Item.SubItems[i - 1], 0), 100, 0, True, clMedGray);

           end

           else

           begin

             //画SubItem的文字

             InflateRect(Rect, -2, -2);

 

             if i - 1 <= Item.SubItems.Count - 1 then

               DrawText(LV.Canvas.Handle, PCHAR(Item.SubItems[i - 1]), Length(Item.SubItems[i - 1]), Rect, DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);

           end;

         end;

     end; //end case

   end; //end for

   LV.Canvas.Brush.Color := clWhite;

 

   if Item.Selected then //画选中条外框

   begin

     if cdsFocused in State then//控件是否处于激活状态

       LV.Canvas.Brush.Color := $00DAA07A // $00E2B598; //clHighlight;

     else

       LV.Canvas.Brush.Color := $00E2B598; //$00DAA07A // clHighlight;

     LV.Canvas.FrameRect(BoundRect); //

   end;

   DefaultDraw := False; //不让系统画了

   with Sender.Canvas do

     if Assigned(Font.OnChange) then

       Font.OnChange(Font);

 end;

 

 function TForm1.ReDrawItem(AHwndLV: HWND; AItemIndex: integer): boolean;

 begin

   Result := ListView_RedrawItems(AHwndLV, AItemIndex, AItemIndex);

 end;

 

 end.


来源:https://www.cnblogs.com/pchmonster/