fcprogressbar.pas

一套及时通讯的原码

      DrawBar(TheImage.Canvas);

      OverlayImage := TBltBitmap.Create;
      try
        OverlayImage.MakeLike(TheImage);
//        PaintBackground(OverlayImage);
        DrawBar(TheImage.Canvas);
//        DrawProgressText(TheImage.Canvas);

        TheImage.Canvas.CopyMode := cmSrcInvert;
        TheImage.Canvas.Draw(0, 0, OverlayImage);
        TheImage.Canvas.CopyMode := cmSrcCopy;
        PaintRect := ClientRect;
//        DrawProgressText(TheImage.Canvas);
{        if ShowText then }PaintAsText(TheImage, PaintRect);
      finally
        OverlayImage.Free;
      end;
      Canvas.CopyMode := cmSrcCopy;
      Canvas.Draw(0, 0, TheImage);
    finally
      TheImage.Destroy;
    end;


//   DrawBar;
//   DrawProgressText;
end;

function TfcProgressBar.GetMin: Integer;
begin
   Result := FMin;
end;

function TfcProgressBar.GetMax: Integer;
begin
   Result := FMax;
end;

function TfcProgressBar.GetProgress: Integer;
var
  Value: integer;
begin
   if (csPaintCopy in  ControlState) and (FDataLink.Field <> nil) then
   begin
      Value:= FDataLink.Field.AsInteger;
      if Value>Max then Value:= Max;
      result:= Value;
   end
   else begin
      result:= FPosition;
   end;
end;


procedure TfcProgressBar.SetMin(Value: Integer);
begin
  SetParams(Value, FMax);
end;

procedure TfcProgressBar.SetMax(Value: Integer);
begin
  SetParams(FMin, Value);
end;

procedure TfcProgressBar.Loaded;
begin
   inherited;
   Changed; 
end;

procedure TfcProgressBar.Changed;
begin
   if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TfcProgressBar.SetProgress(Value: Integer);
begin
   if FPosition<>Value then
   begin
     Value := fcMin(Value, Max);
     FPosition:= fcMax(Value, Min);
     if not (csLoading in ComponentState) then
        Changed;
     Invalidate;
   end
end;


procedure TfcProgressBar.SetParams(AMin, AMax: Integer);
begin
  if AMax < AMin then
    raise EInvalidOperation.CreateFmt(SPropertyOutOfRange, [Self.Classname]);
  if (FMin <> AMin) or (FMax <> AMax) then
  begin
    FMin := AMin;
    FMax := AMax;
  end;
end;

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

procedure TfcProgressBar.StepIt;
begin
  Progress:= fcMin(Max, Progress + Step);
end;

procedure TfcProgressBar.StepBy(Delta: Integer);
begin
  Progress:= fcMin(Max, Progress + Delta);
end;

procedure TfcProgressBar.SetOrientation(Value: TfcProgressBarOrientation);
begin
  if FOrientation <> Value then
  begin
    FOrientation := Value;
    RecreateWnd;
  end;
end;

procedure TfcProgressBar.SetSmooth(Value: Boolean);
begin
  if FSmooth <> Value then
  begin
    FSmooth := Value;
    Invalidate;
  end;
end;

procedure TfcProgressBar.SetDisplayFormat(Value: String);
begin
  if FDisplayFormat <> Value then
  begin
     FDisplayFormat:= Value;
     Invalidate;
  end
end;

procedure TfcProgressBar.SetBlockSize(Value: Integer);
begin
  if FBlockSize <> Value then
  begin
    FBlockSize := Value;
    Invalidate;
  end;
end;

procedure TfcProgressBar.SetBlockColor(Value: TColor);
begin
  if FBlockColor <> Value then
  begin
    FBlockColor := Value;
    Invalidate;
  end;
end;

constructor TfcProgressBar.Create(AOwner: TComponent);
begin
   Inherited Create(AOwner);
   ControlStyle := ControlStyle + [csReplicatable];
   Width := 150;
   Height := GetSystemMetrics(SM_CYVSCROLL);
   FMin := 0;
   FMax := 100;
   FStep := 10;
   FOrientation := fcpbHorizontal;
   FBlockColor:= clHighlight;
   FBlockSize:= 10;
   FShowProgressText:= True;

   FDataLink := TFieldDataLink.Create;
   FDataLink.Control := Self;
   FDataLink.OnDataChange := DataChange;
   FDataLink.OnUpdateData := UpdateData;


end;

procedure TfcProgressBar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
//  ControlStyle := ControlStyle + [csAcceptsControls];
end;

function TfcProgressBar.GetDataSource: TDataSource;
begin
  if (FDataLink<>Nil) and (FDataLink.DataSource is TDataSource) then begin
     Result := FDataLink.DataSource as TDataSource
  end
  else Result:= Nil;
end;

procedure TfcProgressBar.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then begin
    Value.FreeNotification(Self);
  end
end;

function TfcProgressBar.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TfcProgressBar.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

procedure TfcProgressBar.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

function TfcProgressBar.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TfcProgressBar.UpdateData(Sender: TObject);
begin
    if (FDataLink.Field.asInteger <> Progress) then
       FDataLink.Field.asInteger:= Progress;
end;

procedure TfcProgressBar.DataChange(Sender: TObject);
var Value: Integer;
begin
  if FDataLink.Field <> nil then
  begin
    Value := FDataLink.Field.asInteger;
    Progress:= Value;
  end
end;
procedure TfcProgressBar.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
    Message.Result := 1;
    exit;
{  if ThemeServices.ThemesEnabled then
  begin
    Message.Result := 1;
  end
  else
     inherited;}
end;

procedure TfcProgressBar.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

destructor TfcProgressBar.Destroy;
begin
  FDataLink.OnDataChange := nil;
  FDataLink.Free;
  FDataLink := nil;
  FCanvas.Free;
  inherited Destroy;
end;

function TfcProgressBar.GetCanvas: TCanvas;
begin
   if csPaintCopy in ControlState then
      result:= FCanvas
   else result:= inherited Canvas;
end;


procedure TfcProgressBar.PaintAsText(AnImage: TBitmap; PaintRect: TRect);
var
  S: string;
  X, Y: Integer;
  OverRect: TBltBitmap;
  Percent: integer;
begin
  if not ShowProgressText then exit;

  OverRect := TBltBitmap.Create;
  try
    OverRect.MakeLike(AnImage);
    Percent:= Trunc(Progress/(Max-Min)*100);

    if DisplayFormat = '' then
       S:= FloatToStr(Percent) + '%'
    else S := FormatFloat(DisplayFormat, Percent);

    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;

end.