vrspectrum.pas

作工控的好控件

end;

procedure TVrSpectrum.CreateBarImages;
var
  I, Y, P1, P2, Point: Integer;
begin
  for I := 0 to 1 do
  begin
    FBarImages[I].Width := BarWidth;
    FBarImages[I].Height := HeightOf(FViewPort);
  end;
  P1 := Percent1;
  P2 := Percent2;
  Y := HeightOf(FViewPort);
  if PlainColors then
  begin
    Point := SolveForX(P1, Ticks);
    P1 := (Point * (TickHeight + Spacing));
    Point := SolveForX(P2, Ticks);
    P2 := (Point * (TickHeight + Spacing));
  end else
  begin
    P1 := SolveForX(P1, Y);
    P2 := SolveForX(P2, Y);
  end;

  DrawBarImage(FBarImages[0].Canvas, BitmapRect(FBarImages[0]),
    FPalette3[0], FPalette2[0], FPalette1[0], P1, P2, PlainColors);
  DrawBarImage(FBarImages[1].Canvas, BitmapRect(FBarImages[1]),
    FPalette3[1], FPalette2[1], FPalette1[1], P1, P2, PlainColors);
end;

procedure TVrSpectrum.PaletteModified(Sender: TObject);
begin
  UpdateControlCanvas;
end;

procedure TVrSpectrum.BevelChanged(Sender: TObject);
var
  R: TRect;
begin
  if not Loading then
  begin
    R := ClientRect;
    FBevel.GetVisibleArea(R);
    InflateRect(FViewPort, R.Left, R.Top);
    BoundsRect := Bounds(Left, Top, WidthOf(FViewPort),
      HeightOf(FViewPort));
  end;
  UpdateControlCanvas;
end;

function TVrSpectrum.GetCount: Integer;
begin
  Result := Collection.Count;
end;

function TVrSpectrum.GetItem(Index: Integer): TVrSpectrumBar;
begin
  Result := Collection.Items[Index];
end;

procedure TVrSpectrum.SetSpacing(Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetColumns(Value: Integer);
begin
  if (FColumns <> Value) and (Value > 0) then
  begin
    FColumns := Value;
    CreateObjects;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetMaxValue(Value: Integer);
var
  I: Integer;
begin
  if (FMaxValue <> Value) and (Value > FMinValue) then
  begin
    FMaxValue := Value;
    for I := 0 to Pred(Count) do
      with Items[I] do
        if (Position > FMaxValue) then Position := FMaxValue;
  end;
end;

procedure TVrSpectrum.SetMinValue(Value: Integer);
var
  I: Integer;
begin
  if (FMinValue <> Value) and (Value < FMaxValue) then
  begin
    FMinValue := Value;
    for I := 0 to Pred(Count) do
      with Items[I] do
        if (Position < FMinValue) then Position := FMinValue;
  end;
end;

procedure TVrSpectrum.SetMarkerColor(Value: TColor);
begin
  if FMarkerColor <> Value then
  begin
    FMarkerColor := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetMarkerVisible(Value: Boolean);
begin
  if FMarkerVisible <> Value then
  begin
    FMarkerVisible := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetTickHeight(Value: Integer);
begin
  if (FTickHeight <> Value) and (Value > 0) then
  begin
    FTickHeight := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetPalette1(Value: TVrPalette);
begin
  FPalette1.Assign(Value);
end;

procedure TVrSpectrum.SetPalette2(Value: TVrPalette);
begin
  FPalette2.Assign(Value);
end;

procedure TVrSpectrum.SetPalette3(Value: TVrPalette);
begin
  FPalette3.Assign(Value);
end;

procedure TVrSpectrum.SetBevel(Value: TVrBevel);
begin
  FBevel.Assign(Value);
end;

procedure TVrSpectrum.SetPercent1(Value: TVrPercentInt);
begin
  if (FPercent1 <> Value) then
  begin
    if not Loading then
      if Value + Percent2 > 100 then Value := 100 - Percent2;
    FPercent1 := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetPercent2(Value: TVrPercentInt);
begin
  if (FPercent2 <> Value) then
  begin
    if not Loading then
      if Value + Percent1 > 100 then Value := 100 - Percent1;
    FPercent2 := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetShowInactive(Value: Boolean);
begin
  if FShowInactive <> Value then
  begin
    FShowInactive := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetBarWidth(Value: TVrMaxInt);
begin
  if FBarWidth <> Value then
  begin
    FBarWidth := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetBarSpacing(Value: Integer);
begin
  if FBarSpacing <> Value then
  begin
    FBarSpacing := Value;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpectrum.SetPlainColors(Value: Boolean);
begin
  if FPlainColors <> Value then
  begin
    FPlainColors := Value;
    UpdateControlCanvas;
  end;
end;

function TVrSpectrum.GetPercentDone(Position: Longint): Longint;
begin
  Result := SolveForY(Position - FMinValue, FMaxValue - FMinValue);
end;

procedure TVrSpectrum.UpdateBar(Index: Integer);
var
  R, PaintRect, ImageRect: TRect;
  I: Integer;
  TicksOn, TicksOff: Integer;
  Item: TVrSpectrumBar;
begin
  Item := Collection.Items[Index];

  GetItemRect(Index, R);

  TicksOn := SolveForX(GetPercentDone(Item.Position), Ticks);
  TicksOff := Ticks - TicksOn;
  PaintRect := Bounds(R.Left, R.Top, R.Right - R.Left, FTickHeight);

  with DestCanvas do
  begin
    for I := 1 to TicksOff do
    begin
      if FShowInactive then
      begin
        ImageRect := Bounds(0, PaintRect.Top - FViewPort.Top,
          BarWidth, TickHeight);
        CopyRect(PaintRect, FBarImages[0].Canvas, ImageRect);
      end else
      begin
        Brush.Color := Self.Color;
        FillRect(PaintRect);
      end;
      OffsetRect(PaintRect, 0, FTickHeight + FSpacing);
    end;

    for I := 1 to TicksOn do
    begin
      if (MarkerVisible) and (I = 1) then
      begin
        Brush.Color := FMarkerColor;
        FillRect(PaintRect);
      end else
      begin
        ImageRect := Bounds(0, PaintRect.Top - FViewPort.Top,
          BarWidth, TickHeight);
        CopyRect(PaintRect, FBarImages[1].Canvas, ImageRect);
      end;
      OffsetRect(PaintRect, 0, FTickHeight + FSpacing);
    end;
  end;
end;

procedure TVrSpectrum.UpdateBars;
var
  I: Integer;
begin
  for I := 0 to Collection.Count - 1 do
    UpdateBar(I);
end;

procedure TVrSpectrum.Paint;
var
  R: TRect;
begin
  CalcPaintParams;
  ClearBitmapCanvas;
  DestCanvas := BitmapCanvas;
  try
    R := ClientRect;
    FBevel.Paint(BitmapCanvas, R);
    UpdateBars;
    inherited Paint;
  finally
    DestCanvas := Self.Canvas;
  end;
end;

procedure TVrSpectrum.CalcPaintParams;
var
  R: TRect;
  Step: Integer;
  NewWidth, NewHeight: Integer;
begin
  R := ClientRect;
  FBevel.GetVisibleArea(R);
  FViewPort := R;
  Step := FTickHeight + FSpacing;
  Ticks := (HeightOf(R) + FSpacing) div Step;
  CreateBarImages;
  NewWidth := (R.Left * 2) +
    ((FBarWidth + FBarSpacing) * FColumns) - FBarSpacing;
  NewHeight := (R.Top * 2) + (Ticks * Step) - FSpacing;
  if (Width <> NewWidth) or (Height <> NewHeight) then
    BoundsRect := Bounds(Left, Top, NewWidth, NewHeight);
end;

procedure TVrSpectrum.GetItemRect(Index: Integer; var R: TRect);
var
  X: Integer;
begin
  X := (BarWidth + BarSpacing) * Index;
  R := Bounds(FViewPort.Left + X, FViewPort.Top,
    BarWidth, HeightOf(FViewPort));
end;

procedure TVrSpectrum.Reset(Value: Integer);
var
  I: Integer;
begin
  if Value > FMaxValue then Value := FMaxValue
  else if Value < FMinValue then Value := FMinValue;
  for I := 0 to Pred(Count) do
    Collection.Items[I].Position := Value;
end;



end.