cxprogressbar.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,716 行 · 第 1/5 页

PAS
1,716
字号
    if NativeStyle then
      DrawThemeBackground(OpenTheme(totProgress), ACanvas.Handle, BarThemeTypeMap[FOrientation], 1, ABounds);
  end;
  if (FBarStyle in [cxbsAnimation, cxbsAnimationLEDs]) then
  begin
    if NativeStyle then
      ACanvas.SetClipRegion(TcxRegion.CreateRoundCorners(ABounds, 2, 2), roIntersect);
    if not PropTransparent then
      DrawAnimationBarBackground(ACanvas, ABounds, BackgroundColor, False);
  end;
end;

function TcxCustomProgressBarViewInfo.GetDrawDelta: Integer;
begin
  if NativeStyle or IsInplace or (Painter <> nil) then
    Result := 0
  else
    Result := 2;
end;

function TcxCustomProgressBarViewInfo.GetDrawText: string;
begin
  Result := '';
  case FShowTextStyle of
    cxtsPercent:
      Result := IntToStr(GetPercentDone) + ' %';
    cxtsPosition:
      Result := FloatToStr(FPosition);
    cxtsText:
      Result := Text;
  end;
  if FMarquee then
    Result := Text;
end;

procedure TcxCustomProgressBarViewInfo.DrawBarCaption(ACanvas: TcxCanvas);
var
  ABarText: string;
  ATextBmp, ATextSavedBmp: TcxBitmap;
  ATextRect: TRect;
  ABarRect: TRect;
begin
  if  not FShowText then Exit;
  ABarRect := BarRect;
  if IsInplace then
    InflateRectEx(ABarRect, -BarRect.Left, -BarRect.Top,  -BarRect.Left, -BarRect.Top);
  ABarText := GetDrawText;
  ACanvas.Font.Assign(Font);
  if (Painter = nil) or ((Painter <> nil) and (Painter.ProgressBarTextColor = clDefault)) then
    ACanvas.Font.Color := TextColor
  else
    ACanvas.Font.Color := Painter.ProgressBarTextColor;
  ACanvas.Brush.Style := bsClear;
  if FTextOrientation = cxorVertical then
    ACanvas.SetFontAngle(270);
  ATextRect := Rect(0, 0, ACanvas.TextWidth(ABarText), ACanvas.TextHeight(ABarText));
  if FTextOrientation = cxorVertical then
    ATextRect := Rect(ATextRect.Top, ATextRect.Left, ATextRect.Bottom, ATextRect.Right);
  OffsetRect(ATextRect, GetDrawDelta, GetDrawDelta);
  OffsetRect(ATextRect,
    (RectWidth(ABarRect) - RectWidth(ATextRect)) div 2,
    (RectHeight(ABarRect) - RectHeight(ATextRect)) div 2);
  if (SolidTextColor = False) and (Painter = nil) then
  begin
    ATextBmp := TcxBitmap.Create;
    ATextSavedBmp := TcxBitmap.Create;
    try
      ATextBmp.Width := RectWidth(ABarRect);
      ATextBmp.Height := RectHeight(ABarRect);
      ATextSavedBmp.Width := ATextBmp.Width;
      ATextSavedBmp.Height := ATextBmp.Height;
      ATextBmp.cxCanvas.Font.Assign(ACanvas.Font);
      ATextBmp.cxCanvas.Font.Color := clBlack;
      ATextBmp.cxCanvas.Brush.Color := clWhite;
      ATextBmp.cxCanvas.FillRect(ABarRect);
      if FTextOrientation = cxorVertical then
        TextOut(ATextBmp.cxCanvas.Handle, ATextRect.Right, ATextRect.Top, PChar(ABarText), Length(ABarText))
      else
        TextOut(ATextBmp.cxCanvas.Handle, ATextRect.Left, ATextRect.Top, PChar(ABarText), Length(ABarText));
      BitBlt(ATextSavedBmp.cxCanvas.Handle, 0, 0, ATextBmp.Width, ATextBmp.Height,
        ACanvas.Handle, 0, 0, SRCCOPY);
      BitBlt(ATextBmp.cxCanvas.Handle, 0, 0, ATextBmp.Width, ATextBmp.Height,
        ACanvas.Handle, 0, 0, DSTINVERT);
      cxTextOut(ACanvas.Handle, PChar(ABarText), Bounds, CXTO_CENTER_HORIZONTALLY or CXTO_CENTER_VERTICALLY);
      ACanvas.CopyMode := cmSrcCopy;
      ACanvas.Draw(0, 0, ATextSavedBmp);
      ACanvas.CopyMode := cmSrcInvert;
      ACanvas.Draw(0, 0, ATextBmp);
    finally
      FreeAndNil(ATextBmp);
      FreeAndNil(ATextSavedBmp);
    end;
  end
  else
    if FTextOrientation = cxorVertical then
      TextOut(ACanvas.Handle, ATextRect.Right, ATextRect.Top, PChar(ABarText), Length(ABarText))
    else
      TextOut(ACanvas.Handle, ATextRect.Left, ATextRect.Top, PChar(ABarText), Length(ABarText));
end;

procedure TcxCustomProgressBarViewInfo.PaintBarBevelOuter(
  ACanvas: TcxCanvas; ABBORect: TRect);
begin
  if FBarBevelOuter = cxbvLowered then
  begin
    DrawEdge(ACanvas.Handle, ABBORect, BDR_SUNKENOUTER, BF_TOPLEFT);
    DrawEdge(ACanvas.Handle, ABBORect, BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
  end;
  if FBarBevelOuter = cxbvRaised then
  begin
    DrawEdge(ACanvas.Handle, ABBORect, BDR_RAISEDINNER, BF_TOPLEFT);
    DrawEdge(ACanvas.Handle, ABBORect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);
  end;
end;

procedure TcxCustomProgressBarViewInfo.DrawBarBitmap(ACanvas: TcxCanvas; ARect: TRect);
begin
  ACanvas.Brush.Bitmap := FForegroundImage;
  ACanvas.FillRect(ARect);
end;

procedure TcxCustomProgressBarViewInfo.DrawGradientBar(ACanvas: TcxCanvas; const ANormalRect, AOverloadRect, ABarRect: TRect);
var
  ASize: TSize;
  R: TRect;
begin
  with ACanvas do
  begin
    if NativeStyle then
    begin
      if FOrientation = cxorHorizontal then
      with ANormalRect do
      begin
        ASize.cx := 1;
        if RectHeight(ANormalRect) < 0 then
          ASize.cy := 0
        else
          ASize.cy := RectHeight(ANormalRect);
        CreateNativeBitmap(ASize);
        if not Assigned(FNativeBitmap) then
          Exit;
        StretchBlt(Handle, ANormalRect.Left, ANormalRect.Top, RectWidth(ANormalRect),
          RectHeight(ANormalRect), FNativeBitmap.Canvas.Handle, 0, 0,
          FNativeBitmap.Width, FNativeBitmap.Height, SRCCOPY);
      end
      else
        with ANormalRect do
        begin
          ASize.cy := 1;
          if RectWidth(ANormalRect) < 0 then
            ASize.cx := 0
          else
            ASize.cx := RectWidth(ANormalRect);
          CreateNativeBitmap(ASize);
          if not Assigned(FNativeBitmap) then
            Exit;
          StretchBlt(Handle, ANormalRect.Left, ANormalRect.Top, RectWidth(ANormalRect),
            RectHeight(ANormalRect), FNativeBitmap.Canvas.Handle, 0, 0,
            FNativeBitmap.Width, FNativeBitmap.Height, SRCCOPY);
        end;
    end
    else
      if FOrientation = cxorHorizontal then
        FillGradientRect(Handle, ABarRect, FBeginColor, FEndColor, True)
      else
        FillGradientRect(Handle, ABarRect, FEndColor, FBeginColor, False);

    if FRealShowOverload then
    begin
      R := AOverloadRect;
      R.Right := ABarRect.Right;
      R.Top := ABarRect.Top;
      if FOrientation = cxorHorizontal then
        FillGradientRect(Handle, R, FOverloadBeginColor, FOverloadEndColor, True)
      else
        FillGradientRect(Handle, R, FOverloadEndColor, FOverloadBeginColor, False);
    end;
  end;
end;

procedure TcxCustomProgressBarViewInfo.DrawSolidBar(ACanvas: TcxCanvas; const ANormalRect, AOverloadRect: TRect);
begin
  with ACanvas do
  begin
    cxEditFillRect(ACanvas, ANormalRect, FBeginColor);
    if FRealShowOverload then
      cxEditFillRect(ACanvas, AOverloadRect, FOverloadBeginColor);
  end;
end;

procedure TcxCustomProgressBarViewInfo.DrawAnimationBar(ACanvas: TcxCanvas; const ABar, ASolidRect: TRect);

  procedure LightCanvasByGradient(ACanvas: TcxCanvas; const ARect: TRect; AIsHorizontal: Boolean = True);
  var
    I: Integer;
    ABeginColor: TColor;
    AEndColor: TColor;
    ACurrentPercentage: Byte;
    ADeltaPercentage: Byte;
    AWidth: Integer;
  begin
    if AIsHorizontal then
    begin
      AWidth := RectWidth(ARect) div 2;
      for I := ARect.Top to (ARect.Top + cxAnimationBarTopPartWidth - 1) do
      begin
        ABeginColor := ACanvas.Canvas.Pixels[ASolidRect.Left + 1, I];
        AEndColor := Light(ABeginColor, cxAnimationBarColorLightPercentage);
        FillGradientRect(ACanvas.Handle, Rect(ARect.Left - AWidth, I,
          ARect.Left + AWidth - cxAnimationBarMiddlePartWidth div 2, I + 1),
          ABeginColor, AEndColor, True);
        FillRectByColor(ACanvas.Handle, Rect(ARect.Left + AWidth - cxAnimationBarMiddlePartWidth div 2,
          I, ARect.Left + AWidth + cxAnimationBarMiddlePartWidth div 2, I +1), AEndColor);
        FillGradientRect(ACanvas.Handle, Rect(ARect.Left + AWidth + cxAnimationBarMiddlePartWidth div 2,
          I, ARect.Right + AWidth, I + 1), AEndColor, ABeginColor, True);
      end;
      ACanvas.SaveClipRegion;
      try
        ACanvas.SetClipRegion(TcxRegion.Create(Rect(ARect.Left, ARect.Top,
          ARect.Right, ARect.Bottom)), roIntersect);
        for I := ARect.Left to ARect.Right do
        begin
          ACurrentPercentage := cxAnimationBarColorLightPercentage;
          ADeltaPercentage := 0;
          if I < (AWidth + ARect.Left - cxAnimationBarMiddlePartWidth div 2) then
            ADeltaPercentage := (100 - cxAnimationBarColorLightPercentage) *
              (AWidth + ARect.Left - (cxAnimationBarMiddlePartWidth div 2) - I) div
              (AWidth - cxAnimationBarMiddlePartWidth div 2)
          else
            if I > (AWidth + ARect.Left + cxAnimationBarMiddlePartWidth div 2) then
              ADeltaPercentage := (100 - cxAnimationBarColorLightPercentage) *
                (I - AWidth - ARect.Left - cxAnimationBarMiddlePartWidth div 2) div
                (AWidth - cxAnimationBarMiddlePartWidth div 2);
          Inc(ACurrentPercentage, ADeltaPercentage);
          ABeginColor := ACanvas.Canvas.Pixels[I, ARect.Top + cxAnimationBarTopPartWidth];
          AEndColor := Light(ABeginColor, ACurrentPercentage);
          ACanvas.FillRect(Rect(I, ARect.Top + cxAnimationBarTopPartWidth, I + 1,
            ARect.Bottom), AEndColor);
        end;
      finally
        ACanvas.RestoreClipRegion;
      end;
    end
    else
    begin
      AWidth := RectHeight(ARect) div 2;
      for I := ARect.Left to (ARect.Left + cxAnimationBarTopPartWidth - 1) do
      begin
        ABeginColor := GetPixel(ACanvas.Handle, I, ASolidRect.Bottom - 2);
        AEndColor := Light(ABeginColor, cxAnimationBarColorLightPercentage);
        FillGradientRect(ACanvas.Handle, Rect(I, ARect.Top - AWidth, I + 1,
          ARect.Top + AWidth - cxAnimationBarMiddlePartWidth div 2), ABeginColor, AEndColor, False);
        ACanvas.FillRect(Rect(I, ARect.Top + AWidth - cxAnimationBarMiddlePartWidth div 2,
          I + 1, ARect.Top + AWidth + cxAnimationBarMiddlePartWidth div 2), AEndColor);
        FillGradientRect(ACanvas.Handle, Rect(I, ARect.Top + AWidth + cxAnimationBarMiddlePartWidth div 2,
          I + 1, ARect.Bottom + AWidth), AEndColor, ABeginColor, False);
      end;
      ACanvas.SaveClipRegion;
      try
        ACanvas.SetClipRegion(TcxRegion.Create(Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom)), roIntersect);
        for I := ARect.Top to ARect.Bottom do
        begin
          ACurrentPercentage := cxAnimationBarColorLightPercentage;
          ADeltaPercentage := 0;
          if I < (AWidth + ARect.Top - cxAnimationBarMiddlePartWidth div 2) then
            ADeltaPercentage := (100 - cxAnimationBarColorLightPercentage) *
              (AWidth + ARect.Top - (cxAnimationBarMiddlePartWidth div 2) - I) div
              (AWidth - cxAnimationBarMiddlePartWidth div 2)
          else
            if I > (AWidth + ARect.Top + cxAnimationBarMiddlePartWidth div 2) then
              ADeltaPercentage := (100 - cxAnimationBarColorLightPercentage) *
                (I - AWidth - ARect.Top - cxAnimationBarMiddlePartWidth div 2) div
                (AWidth - cxAnimationBarMiddlePartWidth div 2);
          Inc(ACurrentPercentage, ADeltaPercentage);
          ABeginColor := ACanvas.Canvas.Pixels[ARect.Left + cxAnimationBarTopPartWidth, I];
          if (ABeginColor < 0) or (ABeginColor >= (1 shl 24)) then
            Continue;
          AEndColor := Light(ABeginColor, ACurrentPercentage);
          ACanvas.FillRect(Rect(ARect.Left + cxAnimationBarTopPartWidth, I, ARect.Right, I + 1), AEndColor);
        end;
      finally
        ACanvas.RestoreClipRegion;
      end;
    end;
  end;

begin
  if not CanAnimationBarShow then
  begin
    StopAnimationTimer;
    Exit;
  end;
  if not Assigned(FAnimationTimer) then
  begin
    if FAnimationSpeed > 0 then
      StartAnimationTimer;
    Exit;
  end;
  LightCanvasByGradient(ACanvas, ABar, (FOrientation = cxorHorizontal));
end;

procedure TcxCustomProgressBarViewInfo.DrawAnimationBarBackground(ACanvas: TcxCanvas; const ASolidRect: TRect; ASolidColor: TColor; ADrawBar: Boolean);
var
  ABorderBeginColor, ABorderEndColor: TColor;
  ATopBorderBeginColor, ATopBorderEndColor: TColor;
  ABorderExtPathWidth, ABorderIntPathWidth, ABorderWidth: Integer;
begin
  ATopBorderBeginColor := Light(ASolidColor, cxAnimationBarTopBeginColorLightPercentage);
  ATopBorderEndColor := Light(ASolidColor, cxAnimationBarTopEndColorLightPercentage);
  ABorderBeginColor := Dark(ASolidColor, cxAnimationBarBorderExtPartColorLightPercentage);
  ABorderEndColor := Dark(ASolidColor, cxAnimationBarBorderIntPartColorLightPercentage);

  if ADrawBar then
  begin
    ABorderExtPathWidth := cxAnimationBarBorderExtPathWidth;
    ABorderIntPathWidth := cxAnimationBarBorderIntPathWidth;
end
  else
  begin
    ABorderExtPathWidth := 1;
    ABorderIntPathWidth := cxAnimationBarBackgroundBorderWidth;
  end;
  ABorderWidth := ABorderExtPathWidth + ABorderIntPathWidth;

  with ACanvas do
  begin
    cxEditFillRect(ACanvas, ASolidRect, ASolidColor);
    if FOrientation = cxorHorizontal then
    begin
      if ADrawBar and (RectWidth(ASolidRect) < 3 * ABorderWidth) then
      begin
        ABorderExtPathWidth := ABorderExtPathWidth * RectWidth(ASolidRect) div (3 * ABorderWidth);
        ABorderIntPathWidth := ABorderIntPathWidth * RectWidth(ASolidRect) div (3 * ABorderWidth);
      end;
      ABorderWidth := ABorderIntPathWidth + ABorderExtPathWidth;

      with ASolidRect do
      begin
        FillGradientRect(Handle, Rect(Left, Top, Left + ABorderExtPathWidth, Bottom),
          ABorderBeginColor, ABorderEndColor, True);
        FillGradientRect(Handle, Rect(Right - ABorderExtPathWidth, Top, Right, Bottom),
          ABorderEndColor, ABorderBeginColor, True);

        FillGradientRect(Handle, Rect(Left + ABorderExtPathWidth, Top, Left + ABorderWidth,

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?