In meiner Gauges.pas sieht die Paint-Methode so aus:
Delphi-Quellcode:
procedure TGauge.Paint;
var
TheImage: TBitmap;
OverlayImage: TBltBitmap;
PaintRect: TRect;
begin
with Canvas do
begin
TheImage := TBitmap.Create;
try
TheImage.Height := Height;
TheImage.Width := Width;
PaintBackground(TheImage);
PaintRect := ClientRect;
if FBorderStyle = bsSingle then InflateRect(PaintRect, -1, -1);
OverlayImage := TBltBitmap.Create;
try
OverlayImage.MakeLike(TheImage);
PaintBackground(OverlayImage);
case FKind of
gkText: PaintAsNothing(OverlayImage, PaintRect);
gkHorizontalBar, gkVerticalBar: PaintAsBar(OverlayImage, PaintRect);
gkPie: PaintAsPie(OverlayImage, PaintRect);
gkNeedle: PaintAsNeedle(OverlayImage, PaintRect);
end;
TheImage.Canvas.CopyMode := cmSrcInvert;
TheImage.Canvas.Draw(0, 0, OverlayImage);
TheImage.Canvas.CopyMode := cmSrcCopy;
if ShowText then PaintAsText(TheImage, PaintRect);
finally
OverlayImage.Free;
end;
Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, TheImage);
finally
TheImage.Destroy;
end;
end;
end;
Besonderes Augenmerk solltest Du mal auf die CopyModes legen.
Und hier noch die PaintAsText-Methode:
Delphi-Quellcode:
procedure TGauge.PaintAsText(AnImage: TBitmap; PaintRect: TRect);
var
S: string;
X, Y: Integer;
OverRect: TBltBitmap;
begin
OverRect := TBltBitmap.Create;
try
OverRect.MakeLike(AnImage);
PaintBackground(OverRect);
S := Format('%d%%', [PercentDone]);
with OverRect.Canvas do
begin
Brush.Style := bsClear;
Font := Self.Font;
Font.Color := clWhite;
with PaintRect do
begin
X := (Right - Left + 1 - TextWidth(S)) div 2;
Y := (Bottom - Top + 1 - TextHeight(S)) div 2;
end;
TextRect(PaintRect, X, Y, S);
end;
AnImage.Canvas.CopyMode := cmSrcInvert;
AnImage.Canvas.Draw(0, 0, OverRect);
finally
OverRect.Free;
end;
end;
P.S.: Du meintest sicher invertieren und nicht intervenieren
