cxprogressbar.pas

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

PAS
1,716
字号
  try
    ADrawDelta := GetDrawDelta;
    CalcDrawingParams(ADrawProgressBarRect, ADrawOverloadBarRect, ADrawPeakBarRect,
      ADrawAnimationBarRect, ASolidRect, ALEDsWidth);
    ABarRect := BarRect;
    if IsInplace then
      InflateRectEx(ABarRect, -BarRect.Left, -BarRect.Top, -BarRect.Left, -BarRect.Top);
    FUsualBitmap.cxCanvas.SaveClipRegion;
    try
      DrawBackground(FUsualBitmap.cxCanvas, ACanvas, ABarRect);
      if FMarquee and not IsInplace then
      begin
        ExcludeRects(FUsualBitmap.cxCanvas, ASolidRect);
        ExcludeRects(FUsualBitmap.cxCanvas, ADrawAnimationBarRect);
        ExcludeLEDRects(FUsualBitmap.cxCanvas, ADrawAnimationBarRect);
        ASolidRect := ADrawAnimationBarRect;
      end
      else
      begin
        ExcludeRects(FUsualBitmap.cxCanvas, ASolidRect);
        ExcludeLEDRects(FUsualBitmap.cxCanvas, ASolidRect);
      end;
      case FBarStyle of
        cxbsSolid, cxbsLEDs, cxbsGradient, cxbsGradientLEDs:
          begin
            if (FBarStyle in [cxbsSolid, cxbsLEDs]) and not NativeStyle then
              DrawSolidBar(FUsualBitmap.cxCanvas, ADrawProgressBarRect, ADrawOverloadBarRect)
            else
              DrawGradientBar(FUsualBitmap.cxCanvas, ADrawProgressBarRect, ADrawOverloadBarRect, ABarRect);
            if not IsLEDStyle then
              PaintBarBevelOuter(FUsualBitmap.cxCanvas, ASolidRect);
          end;
        cxbsBitmap, cxbsBitmapLEDs:
          if IsGlyphAssigned(FForegroundImage) then
            DrawBarBitmap(FUsualBitmap.cxCanvas, ASolidRect);
        cxbsAnimation, cxbsAnimationLEDs:
          begin
            if not (FMarquee and IsDesigning) then
              DrawAnimationBarBackground(FUsualBitmap.cxCanvas, ASolidRect, FBeginColor, True);
            if not FMarquee then
              DrawAnimationBar(FUsualBitmap.cxCanvas, ADrawAnimationBarRect, ASolidRect);
          end;
      end;
      if IsLEDStyle then
        DrawBorderLEDs(FUsualBitmap.cxCanvas, ASolidRect, ALEDsWidth);
      if not (FBarStyle in [cxbsAnimation, cxbsAnimationLEDs]) then
        DrawPeak(FUsualBitmap.cxCanvas, ADrawPeakBarRect);
    finally
      FUsualBitmap.cxCanvas.RestoreClipRegion;
    end;
    DrawText(FUsualBitmap.cxCanvas);
    BitBlt(ACanvas.Canvas.Handle, BarRect.Left, BarRect.Top,
      FUsualBitmap.Width, FUsualBitmap.Height, FUsualBitmap.cxCanvas.Handle,
      ADrawDelta, ADrawDelta, SRCCOPY);
  finally
    RestoreCanvasFont(ACanvas, APrevLogFont);
  end;
end;

procedure TcxCustomProgressBarViewInfo.PaintProgressBarByPainter(ACanvas: TcxCanvas);
var
  AChunkRect: TRect;
  AContentRect: TRect;
  ARect: TRect;
  AVertical: Boolean;

  function CalcRect(AVertical: Boolean; const AContentRect: TRect;
    AProgressKf: Double): TRect;
  begin
    Result := AContentRect;
    if AVertical then
      Inc(Result.Top, Trunc(RectHeight(Result) * (1 - AProgressKf)))
    else
      Result.Right := Result.Left + Trunc(RectWidth(Result) * AProgressKf);
  end;

  procedure DrawOverload(ACanvas: TcxCanvas);
  var
    AOverloadRect: TRect;
  begin
    AOverloadRect := CalcRect(AVertical, AContentRect, RelativeOverloadValue / MaxMinDiff);
    if AVertical then
    begin
      AOverloadRect.Bottom := AOverloadRect.Top;
      AOverloadRect.Top := AChunkRect.Top;
    end  
    else
    begin
      AOverloadRect.Left := AOverloadRect.Right;
      AOverloadRect.Right := AChunkRect.Right;
    end;  

    if not IsRectEmpty(AOverloadRect) then
      ACanvas.InvertRect(AOverloadRect);
  end;

begin
  if Painter = nil then Exit;
  ARect := Bounds;
  AVertical := Orientation = cxorVertical;
  OffsetRect(ARect, -ARect.Left, -ARect.Top);
  CreatePainterBitmap;
  if not Assigned(FPainterBitmap) then
    Exit;
  if not IsInplace then
    cxDrawTransparentControlBackground(Edit, FPainterBitmap.cxCanvas, Bounds)
  else
    cxEditFillRect(FPainterBitmap.cxCanvas, ARect, BackgroundColor);

  ARect := Rect(BarRect.Left - Bounds.Left, BarRect.Top - Bounds.Top,
    FPainterBitmap.Width - (Bounds.Right - BarRect.Right),
    FPainterBitmap.Height - (Bounds.Bottom - BarRect.Bottom));

  AContentRect := cxRectContent(ARect, Painter.ProgressBarBorderSize(AVertical));
  if FMarquee and not IsInplace then
    AChunkRect := GetCorrectAnimationBarRect
  else
    AChunkRect := CalcRect(AVertical, AContentRect, RelativePosition / MaxMinDiff);
  Painter.DrawProgressBarBorder(FPainterBitmap.cxCanvas, ARect, AVertical);
  FPainterBitmap.cxCanvas.SetClipRegion(TcxRegion.Create(AContentRect), roSet);
  Painter.DrawProgressBarChunk(FPainterBitmap.cxCanvas, AChunkRect, AVertical);

  if FRealShowOverload then
    DrawOverload(FPainterBitmap.cxCanvas);
  DrawText(FPainterBitmap.cxCanvas);
  cxBitBlt(ACanvas.Handle, FPainterBitmap.cxCanvas.Handle, Bounds, cxNullPoint, SRCCOPY);
end;

procedure TcxCustomProgressBarViewInfo.CalcDrawingParams(out ADrawProgressBarRect, ADrawOverloadBarRect,
  ADrawPeakBarRect, ADrawAnimationBarRect, ASolidRect: TRect; out ALEDsWidth: Integer);
begin
  ADrawProgressBarRect := ProgressBarRect;
  ADrawOverloadBarRect := OverloadBarRect;
  ADrawPeakBarRect := PeakBarRect;
  ADrawAnimationBarRect := GetCorrectAnimationBarRect;

  if IsInplace then
  begin
    InflateRectEx(ADrawProgressBarRect, -BarRect.Left, -BarRect.Top, -BarRect.Left, -BarRect.Top);
    InflateRectEx(ADrawOverloadBarRect, -BarRect.Left, -BarRect.Top, -BarRect.Left, -BarRect.Top);
    InflateRectEx(ADrawPeakBarRect, -BarRect.Left, -BarRect.Top, -BarRect.Left, -BarRect.Top);
    InflateRectEx(ADrawAnimationBarRect, -BarRect.Left, -BarRect.Top, -BarRect.Left, -BarRect.Top);
  end;

  ALEDsWidth := CalcLEDsWidth;

  if IsLEDStyle then
    AdjustForLEDsBarBounds(ADrawProgressBarRect, ADrawOverloadBarRect, ALEDsWidth);

  if not FRealShowOverload then
    ASolidRect := ADrawProgressBarRect
  else
    if FOrientation = cxorHorizontal then
      ASolidRect := Rect(ADrawProgressBarRect.Left, ADrawProgressBarRect.Top,
        ADrawOverloadBarRect.Right, ADrawOverloadBarRect.Bottom)
    else
      ASolidRect := Rect(ADrawOverloadBarRect.Left, ADrawOverloadBarRect.Top,
        ADrawProgressBarRect.Right, ADrawProgressBarRect.Bottom);
end;

function TcxCustomProgressBarViewInfo.CanAnimationBarShow: Boolean;
begin
  Result := (((FBarStyle in [cxbsAnimation, cxbsAnimationLEDs]) and not FMarquee) or FMarquee) and
    (FAnimationSpeed > 0) and not IsDesigning and not IsInplace;
end;

procedure TcxCustomProgressBarViewInfo.CreateBarBmp;
var
  ADrawDelta: Integer;
begin
  FreeAndNil(FUsualBitmap);
  FUsualBitmap := TcxBitmap.Create;
  ADrawDelta := GetDrawDelta;
  FUsualBitmap.Width := RectWidth(BarRect) + ADrawDelta;
  FUsualBitmap.Height := RectHeight(BarRect) + ADrawDelta;
  ChangedBoundsBarRect := False;
end;

procedure TcxCustomProgressBarViewInfo.CreateNativeBitmap(const ASize: TSize);
var
  ATheme: TdxTheme;
  ACreateNewBitmap: Boolean;
  ANativeBitmapRect: TRect;
begin
  ACreateNewBitmap := not Assigned(FNativeBitmap);
  if not ACreateNewBitmap and
      ((FNativeBitmap.Height <> ASize.cy) or (FNativeBitmap.Width <> ASize.cx)) then
    ACreateNewBitmap := True;
  if not ACreateNewBitmap then
    Exit;
  if not Assigned(FNativeBitmap) then
    FNativeBitmap := TBitmap.Create;    
  ATheme := OpenTheme(totProgress);
  FNativeBitmap.Width := ASize.cx;
  FNativeBitmap.Height := ASize.cy;
  ANativeBitmapRect := FNativeBitmap.Canvas.ClipRect;
  if FOrientation = cxorHorizontal then
  begin
    ANativeBitmapRect.Left := -4;
    DrawThemeBackground(ATheme, FNativeBitmap.Canvas.Handle, PP_CHUNK, 1,
      ANativeBitmapRect);
  end
  else
  begin
    ANativeBitmapRect.Top := -4;
    DrawThemeBackground(ATheme, FNativeBitmap.Canvas.Handle, PP_CHUNKVERT, 1,
      ANativeBitmapRect);
  end;
end;

procedure TcxCustomProgressBarViewInfo.CreatePainterBitmap;
var
  ACreateNewBitmap: Boolean;
begin
  ACreateNewBitmap := not Assigned(FPainterBitmap);
  if not ACreateNewBitmap and
      ((FPainterBitmap.Height <> RectHeight(Bounds)) or
      (FPainterBitmap.Width <> RectWidth(Bounds))) then
    ACreateNewBitmap := True;
  if not ACreateNewBitmap then
    Exit;
  FreeAndNil(FPainterBitmap);
  FPainterBitmap := TcxBitmap.CreateSize(Bounds);
end;

procedure TcxCustomProgressBarViewInfo.ExcludeRects(ACanvas: TcxCanvas; const ABounds: TRect);
begin
  if (FBarStyle in [cxbsAnimation, cxbsAnimationLEDs]) and
    NativeStyle then
  begin
    if FOrientation = cxorHorizontal then
    begin
      ACanvas.ExcludeClipRect(Rect(ABounds.Right, Bounds.Top, Bounds.Right, Bounds.Bottom));
      ACanvas.ExcludeClipRect(Rect(Bounds.Left, Bounds.Top, ABounds.Left, Bounds.Bottom));
    end
    else
    begin
      ACanvas.ExcludeClipRect(Rect(Bounds.Left, Bounds.Top, Bounds.Right, ABounds.Top));
      ACanvas.ExcludeClipRect(Rect(Bounds.Left, ABounds.Bottom, Bounds.Right, Bounds.Bottom))
    end;
  end
  else
    ACanvas.SetClipRegion(TcxRegion.Create(ABounds), roIntersect);
end;
procedure TcxCustomProgressBarViewInfo.ExcludeLEDRects(ACanvas: TcxCanvas;
  const ABounds: TRect);
var
  I, ALEDsWidth, ALEDsMaxCount: Integer;
begin
  ALEDsWidth := CalcLEDsWidth;
  if IsLEDStyle then
  begin
    if FOrientation = cxorHorizontal then
    begin
      ALEDsMaxCount := RectWidth(ABounds) div ALEDsWidth;
      for I := 1 to ALEDsMaxCount do
        ACanvas.ExcludeClipRect(Rect(ABounds.Left + I * ALEDsWidth - 2, ABounds.Top,
          ABounds.Left + I * ALEDsWidth, ABounds.Bottom));
    end
    else
    begin
      ALEDsMaxCount := RectHeight(ABounds) div ALEDsWidth;
      for I := 1 to ALEDsMaxCount do
        ACanvas.ExcludeClipRect(Rect(ABounds.Left, ABounds.Bottom - I * ALEDsWidth,
          ABounds.Right, ABounds.Bottom - I * ALEDsWidth + 2));
    end;
  end;
end;

function TcxCustomProgressBarViewInfo.GetAnimationTimerInterval: Cardinal;
begin
  if FAnimationSpeed <= High(FAnimationSpeed) div 2 then
    Result := 30
  else
    Result := 30 + (High(FAnimationSpeed) - FAnimationSpeed) * 4;
end;

function TcxCustomProgressBarViewInfo.GetAnimationOffset: Integer;
begin
  if FAnimationSpeed >= High(FAnimationSpeed) div 2 then
    Result := 2
  else
    Result := 2 + (FAnimationSpeed + High(FAnimationSpeed)) * 2;
end;

function TcxCustomProgressBarViewInfo.GetMaxMinDiff: Double;
begin
  Result := Max - Min;
  if Result = 0 then
    Result := 1;
end;

function TcxCustomProgressBarViewInfo.GetRelativeOverloadValue: Double;
begin
  Result := OverloadValue - Min;
end;

function TcxCustomProgressBarViewInfo.GetRelativePeakValue: Double;
begin
  Result := PeakValue - Min;
end;

function TcxCustomProgressBarViewInfo.GetRelativePosition: Double;
begin
  if FMarquee then
    Result := Max
  else
    Result := Position - Min;
end;

function TcxCustomProgressBarViewInfo.IsLEDStyle: Boolean;
begin
  Result := FBarStyle in [cxbsLEDs, cxbsGradientLEDs, cxbsBitmapLEDs,
    cxbsAnimationLEDs];
end;

procedure TcxCustomProgressBarViewInfo.DrawBackground(ACanvas: TcxCanvas; const ACanvasParent: TcxCanvas; const ABounds: TRect);
const
  BarThemeTypeMap: array[TcxProgressBarOrientation] of Integer = (PP_BAR, PP_BARVERT);
begin
  if PropTransparent then
  begin
    if not IsInplace then
    begin
      cxDrawTransparentControlBackground(Edit, ACanvas, Bounds);
    end
    else
    begin
      BitBlt(ACanvas.Handle, 0, 0,
        ABounds.Right - ABounds.Left, ABounds.Bottom - ABounds.Top,
        ACanvasParent.Handle, ABounds.Left, ABounds.Top, SRCCOPY);
    end;
  end
  else
  begin
    if not (FBarStyle in [cxbsAnimation, cxbsAnimationLEDs]) then
    begin
      ACanvas.Brush.Style := bsSolid;
      ACanvas.FillRect(ABounds, BackgroundColor);
    end;
  end;
  if (NativeStyle or (FBarStyle in [cxbsAnimation, cxbsAnimationLEDs])) and
    not IsInplace and not PropTransparent then
  begin

⌨️ 快捷键说明

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