skyguage.pas

很好用的 比自代的好用多了 请看说明

    gg:= GetGValue(gRGB);
    gb:= GetBValue(gRGB);
    iWidth := ARect.Right - ARect.Left;
    if iWidth <= 0 then Exit;
    iSpace := 0;
    Inc(iSpace, Integer(FDrawFrame));
    Inc(iSpace, Integer(FKeepSpace));
    for y := ARect.Top to ARect.Bottom -1 do begin
      p := Bmp.ScanLine[y];
      x := ARect.Left;
      if x < iSpace then x := iSpace;
      iLeft := x - ARect.Left;
      Inc(p, x *3);
      while iLeft < iWidth do begin
        iValue := iWidth - iLeft;
        p^ := b + (gb - b) * iValue div iWidth;
        Inc(p);
        p^ := g + (gg - g) * iValue div iWidth;
        Inc(p);
        p^ := r + (gr - r) * iValue div iWidth;
        Inc(p);
        Inc(iLeft);
      end;
    end;
  end;

  procedure DrawPercentText(ACanvas: TCanvas; ARect: TRect);
  var
    sPer: string;
    rtNeed, rtCopy: TRect;
    bmpOver: TBitmap;
    iLeft, iTop: Integer;
  begin
    if csLoading in ComponentState then Exit;
    sPer := Format('%d%%', [(Progress - Self.Min) * 100 div (Self.Max - Self.Min)]);
    with ACanvas do begin
      //Brush.Style := bsClear;
      Font.Assign(Self.Font);
      DrawText(Handle, PChar(sPer), Length(sPer), rtNeed, DT_SINGLELINE or DT_CALCRECT);
      iLeft := ARect.Left + (ARect.Right - ARect.Left - rtNeed.Right + rtNeed.Left) div 2;
      iTop  := ARect.Top + (ARect.Bottom - ARect.Top - rtNeed.Bottom + rtNeed.Top) div 2;
      rtCopy  := Rect(iLeft, iTop, iLeft + rtNeed.Right - rtNeed.Left, iTop + rtNeed.Bottom - rtNeed.Top);
      bmpOver := TBitmap.Create;
      try
        bmpOver.Width  := rtNeed.Right - rtNeed.Left;
        bmpOver.Height := rtNeed.Bottom - rtNeed.Top;
        with bmpOver.Canvas do begin
          Brush.Color := TColor(0);
          Brush.Style := bsSolid;
          FillRect(ClipRect);
          Font.Assign(Self.Font);
          Brush.Style := bsClear;
          rtNeed := ClipRect;
          DrawText(Handle, PChar(sPer), Length(sPer), rtNeed, DT_SINGLELINE or DT_VCENTER or DT_CENTER);
        end;
        CopyMode := cmSrcInvert;
        Draw(rtCopy.Left, rtCopy.Top, bmpOver);
      finally
        bmpOver.Free;
      end;
    end;
  end;

var
  ARect, PerRect: TRect;
begin
  //inherited;
  with FBmpBuf.Canvas do begin
    Lock;
    try
      FBmpBuf.Width  := ClientWidth;
      FBmpBuf.Height := ClientHeight;
      ARect := ClipRect;
      //填充背景
      if FDrawFrame then InflateRect(ARect, -1, -1);
      if UseGraph and not BackGraph.Empty then begin
        StretchDraw(ARect, BackGraph);
      end else begin
        Brush.Color := BackColor;
        FillRect(ARect);
      end;
      //画进度条
      if FKeepSpace then InflateRect(ARect, -1, -1);
      PerRect := ARect;
      ARect.Right := ARect.Left + (ARect.Right - ARect.Left) * (Progress - Min) div (Max - Min);
      ARect.Left  := ARect.Right - Step;
      if UseGraph and not ForeGraph.Empty then begin
        StretchDraw(ARect, ForeGraph);
      end else begin
        if UseShade then begin
          //DrawShade(FBmpBuf.Canvas, ARect);
          QuickDrawShade(FBmpBuf, ARect);
        end else begin
          Brush.Color := ForeColor;
          FillRect(ARect);
        end;
      end;
      //画百分比
      if ShowPercent then DrawPercentText(FBmpBuf.Canvas, PerRect);
      //画外框
      DoDrawFrame(FBmpBuf.Canvas, ClipRect);
    finally
      Unlock;
    end;
  end;
  Canvas.Draw(0, 0, FBmpBuf);
end;

procedure TSkyGuage.SetBackColor(Value: TColor);
begin
  if Value <> FBackColor then begin
    FBackColor := Value;
    Paint;
  end;
end;

procedure TSkyGuage.SetForeColor(Value: TColor);
begin
  if Value <> FForeColor then begin
    FForeColor := Value;
    Paint;
  end;
end;

procedure TSkyGuage.SetFrameColor(Value: TColor);
begin
  if Value <> FFrameColor then begin
    FFrameColor := Value;
    Paint;
  end;
end;

procedure TSkyGuage.SetMax(Value: Integer);
begin
  if (Value <> FMax) and (Value > FMin) then begin
    FMax := Value;
    if FProgress > FMax then FProgress := FMax;
    Paint;
  end;
end;

procedure TSkyGuage.SetMin(Value: Integer);
begin
  if (Value <> FMin) and (Value >= 0) and (Value < FMax) then begin
    FMin := Value;
    if FProgress < FMin then FProgress := FMin;
    Paint;
  end;
end;

procedure TSkyGuage.SetProgress(Value: Integer);
begin
  if (Value <> FProgress) and (Value >= FMin) and (Value <= FMax) then begin
    FProgress := Value;
    Paint;
  end;
end;

procedure TSkyGuage.SetStep(Value: Integer);
begin
  if Value <> FStep then begin
    FStep := Value;
    Paint;
  end;
end;

procedure TSkyGuage.StepIt(iLength: Integer);
begin
  Inc(FProgress, iLength);
  if FProgress > FMax then begin
    if FAutoResume then FProgress := FMin
    else FProgress := FMax;
  end;
  Paint;
end;

procedure TSkyGuage.WMEraseBkgnd(var Message: TMessage);
begin
  Message.Result := 1;
end;

procedure TSkyGuage.SetUseShade(Value: Boolean);
begin
  if Value <> FUseShade then begin
    FUseShade := Value;
    Paint;
  end;
end;

procedure TSkyGuage.SetShadeColor(Value: TColor);
begin
  if Value <> FShadeColor then begin
    FShadeColor := Value;
    if UseShade then Paint;
  end;
end;

procedure TSkyGuage.SetDrawFrame(Value: Boolean);
begin
  if Value <> FDrawFrame then begin
    FDrawFrame := Value;
    Paint;
  end;
end;

procedure TSkyGuage.SetKeepSpace(Value: Boolean);
begin
  if Value <> FKeepSpace then begin
    FKeepSpace := Value;
    Paint;
  end;
end;

procedure TSkyGuage.SetUseGraph(Value: Boolean);
begin
  if Value <> FUseGraph then begin
    FUseGraph := Value;
    Paint;
  end;
end;

function TSkyGuage.GetBackGraph: TGraphic;
begin
  Result := FBackGraph;
end;

procedure TSkyGuage.SetBackGraph(Value: TGraphic);
begin
  FBackGraph.Assign(Value);
  if UseGraph then Paint;
end;

function TSkyGuage.GetForeGraph: TGraphic;
begin
  Result := FForeGraph;
end;

procedure TSkyGuage.SetForeGraph(Value: TGraphic);
begin
  FForeGraph.Assign(Value);
  if UseGraph then Paint;
end;

procedure TSkyGuage.SetShowPer(Value: Boolean);
begin
  if Value <> FShowPer then begin
    FShowPer := Value;
    Paint;
  end;
end;

end.