mmgauge.pas

一套及时通讯的原码

    Old: LongInt;
begin
    Value := MinMax(Value,MinValue,MaxValue);
    if Value <> FCurValue then
    begin
        Old       := PercentDone;
        FCurValue := Value;
        if Old <> PercentDone then
           Refresh;
    end;
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.AddProgress(Value: Longint);
begin
    Progress := FCurValue + Value;
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.SetCaption(const Value: string);
begin
    if Value <> FCaption then
    begin
        FCaption := Value;
        Invalidate;
    end;
end;

{-- TMMCustomGauge ------------------------------------------------------}
function TMMCustomGauge.GetPercentDone: LongInt;
begin
    Result := SolveForY(FCurValue-FMinValue, FMaxValue-FMinValue);
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.Paint;
var
    R: TRect;
    OffScreen: TBitmap;
begin
    R := Bevel.PaintBevel(Canvas,ClientRect,True);
    OffScreen := TBitmap.Create;
    try
        with OffScreen do
        begin
            Width := R.Right  - R.Left;
            Height:= R.Bottom - R.Top;
            PaintImage(Canvas,Bounds(0,0,Width,Height));
            if FShowText then
                PaintText(Canvas,Bounds(0,0,Width,Height));
        end;
        Canvas.Draw(R.Left,R.Top,OffScreen);
    finally
        OffScreen.Free;
    end;
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.PaintImage(Canvas: TCanvas; R: TRect);
begin
    case FKind of
        gkHorizontalBar, gkVerticalBar: PaintAsBar(Canvas,R,FKind = gkHorizontalBar);
        gkPie: PaintAsPie(Canvas,R);
        gkNeedle: PaintAsNeedle(Canvas,R);
    else
        PaintAsNothing(Canvas,R);
    end;
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.PaintText(Canvas: TCanvas; R: TRect);
var
    TextBmp : TBitmap;
    Text    : string;
    OldMode : TCopyMode;
    X, Y    : Integer;
    X2, Y2  : Integer;
begin
    if Caption <> '' then
        Text := Format('%s %d%%',[Caption,PercentDone])
    else
        Text := Format('%d%%',[PercentDone]);

    if (((Kind = gkHorizontalBar) or (Kind = gkVerticalBar))) and BWText then
    begin
        Canvas.Font := Self.Font;

        X  := R.Left + (R.Right - R.Left - Canvas.TextWidth(Text)) div 2;
        Y  := R.Top + (R.Bottom - R.Top - Canvas.TextHeight(Text)) div 2;
        X2 := R.Left + SolveForX(PercentDone,R.Right-R.Left);
        Y2 := R.Bottom - SolveForX(PercentDone,R.Bottom-R.Top);

        Canvas.Brush.Style := bsClear;
        if Kind = gkHorizontalBar then
            Canvas.TextRect(Rect(X2,Y,R.Right,R.Bottom),X,Y,Text)
        else
            Canvas.TextRect(Rect(X,Y,R.Right,Y2),X,Y,Text);
        Canvas.Font.Color := ColorToRGB(clWhite) xor Self.Font.Color;
        if Kind = gkHorizontalBar then
            Canvas.TextRect(Rect(X,Y,X2,R.Bottom),X,Y,Text)
        else
            Canvas.TextRect(Rect(X,Y2,R.Right,R.Bottom),X,Y,Text);
    end
    else
    begin
        TextBmp := TBitmap.Create;
        try
            with TextBmp do
            begin
                Width       := R.Right - R.Left;
                Height      := R.Bottom - R.Top;
                Canvas.Brush.Color := clBlack;
                Canvas.FillRect(Bounds(0,0,Width,Height));
                Canvas.Font := Self.Font;
                Canvas.Font.Color := clWhite;
                X := (Width - Canvas.TextWidth(Text)) div 2;
                Y := (Height - Canvas.TextHeight(Text)) div 2;
                Canvas.TextOut(X, Y, Text);
            end;
            OldMode := Canvas.CopyMode;
            try
                Canvas.CopyMode := cmSrcInvert;
                Canvas.Draw(R.Left,R.Top,TextBmp);
            finally
                Canvas.CopyMode := OldMode;
            end;
        finally
            TextBmp.Free;
        end;
    end;
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.PaintAsBar(Canvas: TCanvas; R: TRect; Horz: Boolean);
var
    FillSize: Integer;
    W, H    : Integer;
begin
    with Canvas do
    begin
        Brush.Color := BackColor;
        FillRect(R);
        Brush.Color := ForeColor;
        Pen.Width   := 1;
        Pen.Color   := ForeColor;
        W           := R.Right - R.Left;
        H           := R.Bottom - R.Top;
        if Horz then
        begin
            FillSize := SolveForX(PercentDone,W);
            if FillSize > 0 then
                FillRect(Bounds(R.Left,R.Top,FillSize,H));
        end
        else
        begin
            FillSize := SolveForX(PercentDone,H);
            if FillSize > 0 then
                FillRect(Bounds(R.Left,R.Top+H-FillSize,W,FillSize));
        end;
    end;
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.PaintAsPie(Canvas: TCanvas; R: TRect);
var
    MiddleX, MiddleY: Integer;
    Angle           : Double;
    W, H            : Integer;
begin
    W := R.Right - R.Left;
    H := R.Bottom - R.Top;
    with Canvas do
    begin
        Brush.Color := Color;
        FillRect(R);
        Brush.Color := BackColor;
        Pen.Color := ForeColor;
        Pen.Width := 1;
        Ellipse(R.Left, R.Top, W, H);
        if PercentDone > 0 then
        begin
            Brush.Color := ForeColor;
            MiddleX := W div 2;
            MiddleY := H div 2;
            Angle := (Pi * ((PercentDone / 50) + 0.5));
            Pie(R.Left, R.Top, W, H,
                Round(MiddleX * (1 - Cos(Angle))),Round(MiddleY * (1 - Sin(Angle))),
                MiddleX, 0);
        end;
    end;
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.PaintAsNeedle(Canvas: TCanvas; R: TRect);
var
    MiddleX     : Integer;
    Angle       : Double;
    X, Y, W, H  : Integer;
begin
    with R do
    begin
        X := Left;
        Y := Top;
        W := Right - Left;
        H := Bottom - Top;
    end;
    with Canvas do
    begin
        Brush.Color := Color;
        FillRect(R);
        Brush.Color := BackColor;
        Pen.Color := ForeColor;
        Pen.Width := 1;
        Pie(X, Y, W, H * 2 - 1, X + W, R.Bottom - 1, X, R.Bottom - 1);
        MoveTo(X, R.Bottom);
        LineTo(X + W, R.Bottom);
        if PercentDone > 0 then
        begin
            Pen.Color := ForeColor;
            MiddleX := Width div 2;
            MoveTo(MiddleX, R.Bottom - 1);
            Angle := (Pi * ((PercentDone / 100)));
            LineTo(Round(MiddleX * (1 - Cos(Angle))),
                   Round((R.Bottom - 1)*(1 - Sin(Angle))));
        end;
    end;
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.PaintAsNothing(Canvas: TCanvas; R: TRect);
begin
    with Canvas do
    begin
        Brush.Color := BackColor;
        FillRect(R);
    end;
end;

{-- TMMCustomGauge ------------------------------------------------------}
procedure TMMCustomGauge.SetBWText(Value: Boolean);
begin
    if Value <> FBWText then
    begin
        FBWText := Value;
        Invalidate;
    end;
end;

end.