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 + -
显示快捷键?