trackbar和processbar功能合并

小弟最近用delphi做在线回放的播放器时遇到一个问题,播放进度条和下载进度条合在一起,一分析,马上得出一个是trackbar功能,另一个是processbar功能,但是在网上找了好久,也没找到相关的控件,只有个LMDtrackbar控件能够控制刻度条的底色,但是不能以百分比显示底色,没有现成的控件可用,只有自己改一下喽,加个属性Colorpostion,用来控制底色显示的百分比,把PaintPos这个过程改一下

procedure TCpTrackProcessBar.PaintPos(aValue:Integer);
var
  aRect:TRect;
  partId,
  stateId: Integer;
  aTheme : HTHEME;
begin
  FillControl;

   FCRect:=ClientRect;
   InflateRect(FCRect,-FMargin,-FMargin);

   with FCRect do
     begin
       fmyw:=Right-Left;
       fmyh:=Bottom-Top;
     end;

   if FOrientation=toVertical then
     begin
       if (FTickStyle=tsNone) or (FTickMarks=tmBottomRight) then
         FTrackRect:=Bounds(FCRect.Left+FTrackWidth div 2, FCRect.Top+fh, FTrackWidth, fmyh-2*fh)
       else
         if FTickMarks=tmTopLeft then
           // changed to avoid collision focus frame and thumb
           FTrackRect:=Bounds(FCRect.Left+fmyw-FTrackWidth-(FTrackWidth div 2), FCRect.Top+fh,
                              FTrackWidth, fmyh-2*fh)
         else
           FTrackRect:=Bounds(FCRect.Left+((fmyw-FTrackWidth) div 2), FCRect.Top+fh,
                              FTrackWidth, fmyh-2*fh);
     end
   else
     begin
       if (FTickStyle=tsNone) or (FTickMarks=tmBottomRight) then
         FTrackRect:=Bounds(FCRect.Left+fh, FCRect.Top+(FTrackWidth div 2)+1,
                            fmyw-2*fh,FTrackWidth)
       else
         if FTickMarks=tmTopLeft then
           FTrackRect:=Bounds(FCRect.Left+fh, FCRect.Top+fmyh-FTrackWidth-(FTrackWidth div 2),
                              fmyw-2*fh,FTrackWidth)
         else
           FTrackRect:=Bounds(FCRect.Left+fh, FCRect.Top+(fmyh-FTrackWidth) div 2,
                              fmyw-2*fh,FTrackWidth);
     end;


  {draw track}
  aRect:=FTrackRect;
  with Canvas do
    begin
      if not UseXP then
        begin
          LMDDrawStdFrame(Canvas, aRect, FTrackBorderStyle, 0);
          InflateRect(aRect, -FTrackBorder, -FTrackBorder);
        end
      else
        begin
          aTheme := OpenThemeData (Parent.Handle, 'TRACKBAR');
          try
            if Orientation <> toVertical then
              partId := TKP_TRACK
            else
              partId := TKP_TRACKVERT;
            stateId := TRS_NORMAL;
            DrawThemeBackGround (aTheme, Canvas.Handle, partId, stateID, @aRect, nil);
            GetThemeBackgroundContentRect (aTheme, Canvas.Handle, partId, stateID, @aRect, @aRect);
          finally
            CloseThemeData (aTheme);
          end;
        end;
      if not FTrackTransparent then
        if (FTrackFillObject.Style = TLMDFillStyle(sfNone)) and not UseXP then
          begin
           Brush.Color:=FTrackColor;
           arect.Right:=aRect.Right*FColorpostion div 100;//这句控制了显示百分比

            FillRect(aRect);
          end
        else
          FTrackFillObject.FillCanvas (Canvas, aRect, Color)
      else //trans track
        if not Transparent or UseXP {XP -> we need to restore back} then
          BackDrawArea (Canvas, aRect, Point(Left+aRect.Left, Top+aRect.Top), 0);
      Brush.Color:=Color;
    end;

  if FTickStyle<>tsNone then DrawTicks;
  {!!!}
  DrawThumb(aValue);
end;

最后显示效果是这样的

原文地址:https://www.cnblogs.com/cp1982/p/1443008.html