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