Before looking at the code, I will attach a rendering to you:
Without further ado, I will just post the code for you.
unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, ComCtrls, ImgList;typeTForm1 = class(TForm)btn1: TButton;lv1: TListView;trckbr1: TTrackBar;il1: TImageList;procedure lv1CustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean); procedure lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean); procedure btn1Click(Sender: TObject); procedure trckbr1Change(Sender: TObject);privatefunction ReDrawItem(HwndLV: HWND; ItemIndex: integer): boolean;{ Private declarations }public{ Public declarations }end;varForm1: TForm1;implementationusesCommCtrl;{$R *.dfm}//Drawing status bar procedure DrawSubItem(LV : TListView; Item: TListItem; SubItem: Integer; Prosition: Single; Max, Style: Integer; IsShowProgress: Boolean; DrawColor: TColor = $00005B00; FrameColor: TColor = $00002F00);//Get the area function of SubItem GetItemRect(hWndLV: HWnd; iItem, iSubItem: Integer): TRect ;varRect: TRect;beginListView_GetSubItemRect(hWndLV, iItem, iSubItem, iSubItem, @Rect);Result := Rect;end;varPaintRect, R: TRect;i, iWidth, x, y: Integer;S: string;beginwith lv dobeginPaintRect := GetItemRect( lv.Handle, Item.Index, SubItem);R := PaintRect;if Prosition >= Max thenProsition := 100elsebeginif Prosition <= 0 thenProsition := 0elseProsition := Round((Prosition / MAX) * 100);end;if (Prosition = 0) and (not IsShowProgress ) thenCanvas.FillRect(r) //If it is 0 , directly display the blank elsebegin//Fill the background first Canvas.FillRect(r);Canvas.Brush.Color:= Color;//Draw an outer frameInflateRect(R, -2, -2);Canvas.Brush.Color:= FrameColor;Canvas.FrameRect(R);Canvas.Brush.Color := Color;InflateRect(R, -1, -1);//InflateRect(R,-1,-1);//Calculate the progress bar content overview based on the percentage iWidth := R.Right - Round((R.Right - R.Left) * ( (100 - Prosition) / 100));case Style of0: //Solid beginCanvas.Brush.Color := DrawColor;R.Right := iWidth;Canvas.FillRect(R);end;1: //Vertical line filling begini := r.Left;while i < iWidth dobeginCanvas.Pen.Color := Color;Canvas.MoveTo(i, R.Top);Canvas .Pen.Color := DrawColor;Canvas.LineTo(i, R.Bottom);Inc(i, 3);end;end;end; //case end//After drawing the progress bar, all you need to do now is to display the progress number. Canvas.Brush.Style := bsClear;if Prosition = Round(Prosition) thenS := Format('%d%%', [Round(Prosition) )])elseS := FormatFloat('#0.0', Prosition);with PaintRect dobeginx := 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;//Restore after painting Canvas.Brush.Color := Color;end;end;procedure TForm1.lv1CustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);beginend;//The above is to draw the progress bar. Now we need to process the Item redraw message for TlistView. The event is OnCustomDrawItem. It needs to be explained that, If you want to draw your own items as you like, then you have to do it all by yourself and no longer need the system to handle it: procedure TForm1.lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);varBoundRect, Rect: TRect;i: integer;TextFormat: Word;LV: TListView; //This sub-process is used to draw CheckBox and ImageList procedure Draw_CheckBox_ImageList(r: TRect; aCanvas: TCanvas; Checked: Boolean);varR1: TRect;i: Integer;beginif Sender.Checkboxes thenbeginaCanvas.Pen.Color := clBlack;aCanvas.Pen.Width := 2;//Draw the CheckBox outer frame aCanvas.Rectangle (R.Left + 2, R.Top + 2, R.Left + 14, R.Bottom - 2);if Checked then //Draw the hook of CheckBox beginCanvas.MoveTo(R.Left + 4, R.Top + 6);aCanvas.LineTo(R.Left + 6, R.Top + 11); aCanvas.LineTo(R.Left + 11, R.Top + 5);end;aCanvas.Pen.Width := 1;end;//Start drawing icon i := 2; //The value of ImageIndex can be arbitrary if i > -1 thenbegin//Get the RECT of the icon if Boolean(ListView_GetSubItemRect(sender.Handle, item.Index, 0, LVIR_ICON, @R1)) thenbegin//ImageList_Stats.Draw(LV.Canvas, R1.Left, R1.Top, i);if item.ImageIndex > -1 thenLV.SmallImages.Draw(LV.Canvas, R1.Right + 2, R1.Top, item.ImageIndex);end;end;end;beginLV := TListView(Sender);BoundRect := Item.DisplayRect(drBounds);InflateRect(BoundRect, -1, 0);//You can set this place to the desired color according to your own requirements to achieve highlighting LV.Canvas.Font.Color := clBtnText;//Check whether it is selected if Item.Selected thenbeginif cdsFocused in State thenbeginLV. Canvas.Brush.Color := $00ECCCB9; // //clHighlight;endelsebeginLV.Canvas.Brush.Color := $00F8ECE5; //clSilver;end;endelsebeginif (Item.Index mod 2) = 0 thenLV.Canvas.Brush.Color := clWhiteelseLV.Canvas.Brush.Color := $00F2F2F2;end;LV.Canvas.FillRect(BoundRect) ; // Initialize background for i := 0 to LV.Columns.Count - 1 dobegin//Get the RectListView_GetSubItemRect(LV.Handle, Item.Index, i, LVIR_LABEL, @Rect);case LV.Columns[i].Alignment oftaLeftJustify:TextFormat := DT_LEFT;taRightJustify:TextFormat := DT_RIGHT;taCenter:TextFormat := DT_CENTER;elseTextFormat := DT_CENTER;end;case i of0: //Draw Caption, 0 means Caption, not Subitembegin//Draw the selection box and icon first Draw_CheckBox_ImageList(BoundRect, LV.Canvas, Item.Checked);//Then draw the Caption TextInflateRect(Rect, -(5 + il1.Width), 0); //Move back 3 pixels to avoid being overwritten when the wireframe is drawn later //InflateRect(Rect, -(5), 0); //Move 3 pixels back to avoid being overwritten when the wireframe is drawn later DrawText( LV.Canvas.Handle, PAnsiChar(Item.Caption), Length(Item.Caption), Rect, DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);end;1..MaxInt: //Draw SubItem[i]beginif (i - 1) = 1 then //Display the status bar, this example is the third column display, you can customize beginDrawSubItem(LV, Item, i , StrToFloatDef(Item.SubItems[i - 1], 0), 100, 0, True);endelsebegin//Draw the text of SubItemInflateRect(Rect, -2, -2);if i - 1 <= Item.SubItems.Count - 1 thenDrawText(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 caseend; //end forLV.Canvas.Brush.Color := clWhite;if Item.Selected then //Draw the selected bar outline beginif cdsFocused in State then/ /Whether the control is active LV.Canvas.Brush.Color := $00DAA07A // $00E2B598; //clHighlight;elseLV.Canvas.Brush.Color := $00E2B598; //$00DAA07A // clHighlight;LV.Canvas.FrameRect(BoundRect); //end;DefaultDraw := False; //Do not let the system draw with Sender.Canvas doif Assigned(Font.OnChange) thenFont.OnChange(Font);end;function TForm1.ReDrawItem(HwndLV: HWND; ItemIndex: integer): boolean;beginResult := ListView_RedrawItems(HwndLV, ItemIndex, ItemIndex);end;procedure TForm1.btn1Click(Sender: TObject);varItem: TListItem;begin//Use: item: = LV1.Items[1];if Item = nil thenExit;item.subitems[1] := '30'; //Set to 30%//Then refresh this itemReDrawItem(LV1.handle, Item.Index);end;procedure TForm1.trckbr1Change(Sender: TObject);varItem: TListItem;begin//Use: item := LV1.Items[0];item.subitems[1] := IntToStr(trckbr1.Position);//Then refresh this itemReDrawItem(LV1.handle, Item.Index);end;end. object Form1: TForm1Left = 416Top = 301Width = 494Height = 170Caption = 'Form1'Color = clBtnFaceFont.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -11Font.Name = 'MS Sans Serif'Font.Style = []OldCreateOrder = FalsePixelsPerInch = 96TextHeight = 13object btn1: TButtonLeft = 272Top = 96Width = 75Height = 25Caption = 'btn1'TabOrder = 0OnClick = btn1Clickendobject lv1: TListViewLeft = 16Top = 8Width = 457Height = 81Columns = <itemCaption = 'Name'Width = 100enditemCaption = 'Category'Width = 100enditemCaption = 'Progress'Width = 100enditemCaption = 'Resource'Width = 100end>GridLines = TrueItems.Data = {5B000000020000000200000000000000FFFFFFFF02000000000000006B4F3B8BBCECC04D3CECFB70333354D01000000F FFFFFFFFFFFFFFF020000000000000008446F7461B4ABC6E604D3CECFB7043130304DFFFFFFFFFFFFFFFF}ShowWorkAreas il1: TImageListLeft = 384Top = 96Bitmap = {