cxprogressbar.pas

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

          Bottom), ABorderEndColor, ASolidColor, True);
        FillGradientRect(Handle, Rect(Right - ABorderWidth, Top, Right - ABorderExtPathWidth, Bottom),
          ASolidColor, ABorderEndColor, True);

        FillGradientRect(Handle, Rect(Left, Top, Right, Top + cxAnimationBarTopPartWidth),
          ATopBorderBeginColor, ATopBorderEndColor, False);
      end;
    end
    else
    begin
      if RectHeight(ASolidRect) < 3 * ABorderWidth then
      begin
        ABorderExtPathWidth := ABorderExtPathWidth * RectHeight(ASolidRect) div (3 * ABorderWidth);
        ABorderIntPathWidth := ABorderIntPathWidth * RectHeight(ASolidRect) div (3 * ABorderWidth);
      end;
      ABorderWidth := ABorderIntPathWidth + ABorderExtPathWidth;

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

        FillGradientRect(Handle, Rect(Left, Top + ABorderExtPathWidth, Right,
          Top + ABorderWidth), ABorderEndColor, ASolidColor, False);
        FillGradientRect(Handle, Rect(Left, Bottom - ABorderWidth, Right, Bottom - ABorderExtPathWidth),
          ASolidColor, ABorderEndColor, False);

        FillGradientRect(Handle, Rect(Left, Top, Left + cxAnimationBarTopPartWidth,
          Bottom), ATopBorderBeginColor, ATopBorderEndColor, True);
      end;
    end;
  end;
end;

function TcxCustomProgressBarViewInfo.CalcLEDsWidth: Integer;
begin
  if FOrientation = cxorHorizontal then
  begin
    Result := Trunc(RectHeight(ProgressBarRect) * 2 / 3) + 2;
    if (FBarStyle = cxbsBitmapLEDs) and
        Assigned(FForegroundImage) and
        (Result > FForegroundImage.Width) and
        (FForegroundImage.Width > 0) then
      Result := FForegroundImage.Width;
  end
  else
  begin
    Result := Trunc(RectWidth(ProgressBarRect) * 2 / 3) + 2;
    if (FBarStyle = cxbsBitmapLEDs) and
        Assigned(FForegroundImage) and
        (Result > FForegroundImage.Height) and
        (FForegroundImage.Height > 0) then
      Result := FForegroundImage.Height;
  end;
end;

procedure TcxCustomProgressBarViewInfo.AdjustForLEDsBarBounds(var ABarRect,
  AOverloadBarRect: TRect; const ALEDsWidth: Integer);
var
  ALEDsDelta: Integer;
begin
  if FOrientation = cxorHorizontal then
  begin
    if FRealShowOverload then
    begin
      ALEDsDelta := RectWidth(ABarRect) mod ALEDsWidth;
      Dec(ABarRect.Right, ALEDsDelta);
      Dec(AOverloadBarRect.Left, ALEDsDelta);
    end;
  end
  else
  begin
    if FRealShowOverload then
    begin
      ALEDsDelta := RectHeight(ABarRect) mod ALEDsWidth;
      Inc(ABarRect.Top, ALEDsDelta);
      Inc(AOverloadBarRect.Bottom, ALEDsDelta);
    end;
  end;
end;

procedure TcxCustomProgressBarViewInfo.DrawPeak(ACanvas: TcxCanvas; const APeakRect: TRect);
begin
  if FRealShowPeak = True then
  begin
    ACanvas.SetClipRegion(TcxRegion.Create(APeakRect), roAdd);
    cxEditFillRect(ACanvas, APeakRect, FPeakColor);
  end;
end;

procedure TcxCustomProgressBarViewInfo.DrawBorderLEDs(ACanvas: TcxCanvas;
  const ABarRect: TRect; ALEDsWidth: Integer);
var
  I, AMaxCount: Integer;
begin
  if FBarBevelOuter = cxbvNone then
    Exit;
  if FOrientation = cxorHorizontal then
  begin
    AMaxCount := RectWidth(ABarRect) div ALEDsWidth;
    for I := 1 to AMaxCount do
    begin
      PaintBarBevelOuter(ACanvas, Rect(ABarRect.Left + (I - 1) * ALEDsWidth, ABarRect.Top,
        ABarRect.Left + I * ALEDsWidth - 2, ABarRect.Bottom));
    end;
    if (ABarRect.Left + AMaxCount * ALEDsWidth) < ABarRect.Right then
      PaintBarBevelOuter(ACanvas, Rect(ABarRect.Left + AMaxCount * ALEDsWidth,
        ABarRect.Top, ABarRect.Right, ABarRect.Bottom));
  end
  else
  begin
    AMaxCount := RectHeight(ABarRect) div ALEDsWidth;
    for I := 1 to AMaxCount do
    begin
      PaintBarBevelOuter(ACanvas, Rect(ABarRect.Left, ABarRect.Bottom - (I - 1) * ALEDsWidth,
        ABarRect.Right, ABarRect.Bottom - I * ALEDsWidth + 2));
    end;
    if (ABarRect.Bottom - AMaxCount * ALEDsWidth) > ABarRect.Top then
      PaintBarBevelOuter(ACanvas, Rect(ABarRect.Left, ABarRect.Bottom - AMaxCount * ALEDsWidth,
        ABarRect.Right, ABarRect.Top));
  end;
end;

procedure TcxCustomProgressBarViewInfo.DoAnimationTimer(Sender: TObject);
begin
  if not CanAnimationBarShow then
    StopAnimationTimer;
  if not Assigned(FAnimationTimer) then Exit;
  CalcAnimationCurrentPosition;
  Edit.Repaint;
end;

procedure TcxCustomProgressBarViewInfo.DoAnimationRestartDelayTimer(Sender: TObject);
begin
  StopAnimationRestartDelayTimer;
end;

procedure TcxCustomProgressBarViewInfo.StartAnimationTimer;
begin
  if Assigned(FAnimationTimer) then
    StopAnimationTimer;
  if not CanAnimationBarShow then
    Exit;
  FAnimationTimer := TcxTimer.Create(nil);
  with FAnimationTimer do
  begin
    Enabled := False;
    Interval := GetAnimationTimerInterval;
    OnTimer := DoAnimationTimer;
    Enabled := True;
  end;
  SetAnimationFirstPosition;
end;

procedure TcxCustomProgressBarViewInfo.StartAnimationRestartDelayTimer;
begin
  if FAnimationRestartDelayTimer <> nil then
    StopAnimationRestartDelayTimer;
  if FAnimationRestartDelay = 0 then
    Exit;
  FAnimationRestartDelayTimer := TcxTimer.Create(nil);
  with FAnimationRestartDelayTimer do
  begin
    Enabled := False;
    Interval := AnimationRestartDelay;
    OnTimer := DoAnimationRestartDelayTimer;
    Enabled := True;
  end;
end;

procedure TcxCustomProgressBarViewInfo.StopAnimationTimer;
begin
  FreeAndNil(FAnimationTimer);
end;

procedure TcxCustomProgressBarViewInfo.StopAnimationRestartDelayTimer;
begin
  FreeAndNil(FAnimationRestartDelayTimer);
end;

procedure TcxCustomProgressBarViewInfo.SetAnimationPath(AValue: TcxProgressBarAnimationPath);
begin
  if AValue <> FAnimationPath then
  begin
    FAnimationPath := AValue;
    StartAnimationTimer;
  end;
end;

procedure TcxCustomProgressBarViewInfo.SetAnimationSpeed(AValue: Cardinal);
begin
  if AValue <> FAnimationSpeed then
  begin
    FAnimationSpeed := AValue;
    if Assigned(FAnimationTimer) then
    begin
      FAnimationTimer.Interval := GetAnimationTimerInterval;
      if FAnimationSpeed = 0 then
        StopAnimationTimer;
    end
    else
      if FAnimationSpeed > 0 then
        StartAnimationTimer;
  end;
end;

procedure TcxCustomProgressBarViewInfo.SetMarquee(AValue: Boolean);
begin
  if AValue <> FMarquee then
  begin
    FMarquee := AValue;
    StartAnimationTimer;
  end;
end;

procedure TcxCustomProgressBarViewInfo.SetBarStyle(
  AValue: TcxProgressBarBarStyle);
begin
  if AValue <> FBarStyle then
  begin
    FBarStyle := AValue;
    StartAnimationTimer;
  end;
end;

procedure TcxCustomProgressBarViewInfo.CalcAnimationCurrentPosition;
begin
  if FAnimationRestartDelayTimer <> nil then Exit;
  Inc(FAnimationPosition, FAnimationDirection * GetAnimationOffset);
  case FAnimationPath of
    cxapCycle:
      if (FAnimationPosition > (GetMaxPositionInBounds + GetAnimationBarDimension div 2)) or
          (FAnimationPosition < (GetMinPositionInBounds - GetAnimationBarDimension div 2)) then
      begin
        SetAnimationFirstPosition;
        StartAnimationRestartDelayTimer;
      end;
    cxapPingPong:
      begin
        if FAnimationDirection > 0 then
        begin
          if FAnimationPosition > (GetMaxPositionInBounds - GetAnimationBarDimension div 2) then
          begin
            FAnimationDirection := -FAnimationDirection;
            Dec(FAnimationPosition);
            StartAnimationRestartDelayTimer;
          end;
        end
        else
        begin
          if FAnimationPosition < (GetMinPositionInBounds + GetAnimationBarDimension div 2) then
          begin
            FAnimationDirection := -FAnimationDirection;
            Inc(FAnimationPosition);
            StartAnimationRestartDelayTimer;
          end;
        end;
      end;
  end;
end;

procedure TcxCustomProgressBarViewInfo.SetAnimationFirstPosition;
begin
  case FAnimationPath of
    cxapCycle:
      if GetAnimationDerection > 0 then
        FAnimationPosition := -GetAnimationBarDimension div 2
      else
        FAnimationPosition := GetAnimationBarDimension div 2;
    cxapPingPong:
      FAnimationPosition := GetAnimationBarDimension div 2;
  end;
  if FOrientation = cxorHorizontal then
    FAnimationDirection := GetAnimationDerection
  else
  begin
    FAnimationDirection := -GetAnimationDerection;
    FAnimationPosition := -FAnimationPosition;
  end;
  if FAnimationDirection > 0 then
    Inc(FAnimationPosition, GetMinPositionInBounds)
  else
    Inc(FAnimationPosition, GetMaxPositionInBounds);
end;

function TcxCustomProgressBarViewInfo.GetAnimationBarDimension: Integer;
begin
  Result := 50;
end;

function TcxCustomProgressBarViewInfo.GetAnimationDerection: Integer;
begin
  Result := 1;  
end;

function TcxCustomProgressBarViewInfo.GetCorrectAnimationBarRect: TRect;
begin
  Result := AnimationBarRect;
  if FOrientation = cxorHorizontal then
    OffsetRect(Result, FAnimationPosition, 0)
  else
    OffsetRect(Result, 0, FAnimationPosition);
end;

function TcxCustomProgressBarViewInfo.GetMaxPositionInBounds: Integer;
begin
  if FOrientation = cxorHorizontal then
    Result := Trunc(RectWidth(Bounds) / GetMaxMinDiff * GetRelativePosition)
  else
    Result := RectHeight(Bounds);
end;

function TcxCustomProgressBarViewInfo.GetMinPositionInBounds: Integer;
begin
  if FOrientation = cxorHorizontal then
    Result := 0
  else
    Result := RectHeight(Bounds) - Trunc(RectHeight(Bounds) / GetMaxMinDiff * GetRelativePosition);
end;

procedure TcxCustomProgressBarViewInfo.SetOrientation(
  AValue: TcxProgressBarOrientation);
begin
  if AValue <> FOrientation then
  begin
    FOrientation := AValue;
    StartAnimationTimer;
  end;
end;

{ TcxCustomProgressBarViewData }

procedure TcxCustomProgressBarViewData.CalculateViewInfoProperties(AViewInfo: TcxCustomEditViewInfo);
begin
  with TcxCustomProgressBarViewInfo(AViewInfo) do
  begin
    AnimationPath := Properties.AnimationPath;
    AnimationRestartDelay := Properties.AnimationRestar