vrscanner.pas

作工控的好控件

  case FStyle of
    lsRaised:
      begin
        DrawOutline3D(DestCanvas, R, clBlack, clBlack, 1);
        if not FPlainColors then
          DrawOutline3D(DestCanvas, R, AColor, clBlack, 1)
        else
        begin
          if not Item.Active then
            DrawOutline3D(DestCanvas, R, FPalette.High, FPalette.Low, 1)
          else DrawOutline3D(DestCanvas, R, clBtnHighlight, FPalette.High, 1);
        end;
      end;
    lsLowered:
      begin
        DrawOutline3D(DestCanvas, R, clBtnShadow, clBtnHighlight, 1);
        DrawOutline3D(DestCanvas, R, clBlack, clBlack, 1);
      end;
    lsFlat:
      DrawOutline3D(DestCanvas, R, clBlack, clBlack, 1);
    lsNone:;
  end;
end;

procedure TVrScanner.UpdateLeds;
var
  I: Integer;
begin
  for I := 0 to Collection.Count - 1 do UpdateLed(I);
end;

procedure TVrScanner.Paint;
begin
  ClearBitmapCanvas;
  DestCanvas := BitmapCanvas;
  try
    UpdateLeds;
    inherited Paint;
  finally
    DestCanvas := Self.Canvas;
  end;
end;

procedure TVrScanner.GetItemRect(Index: Integer; var R: TRect);
var
  X, W, Gap: Integer;
begin
  Gap := Pred(FLeds) * FSpacing;
  W := (Width - Gap) div FLeds;
  X := (FLeds * W) + Gap;
  X := (Width - X) div 2;
  Inc(X, (W * Index) + (FSpacing * Index));
  R := Bounds(X, 0, W, Height);
end;

procedure TVrScanner.SetLeds(Value: Integer);
begin
  if FLeds <> Value then
  begin
    FLeds := Value;
    CreateItems;
    FPosition := -1;
    PrevPosition := -1;
    UpdateControlCanvas;
  end;
end;

function TVrScanner.GetTimeInterval: Integer;
begin
  Result := FTimer.Interval;
end;

procedure TVrScanner.SetActive(Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    if Designing then Exit;
    FTimer.Enabled := FActive;
  end;
end;

procedure TVrScanner.SetTimeInterval(Value: Integer);
begin
  FTimer.Interval := Value;
end;

procedure TVrScanner.SetPosition(Value: Integer);
begin
  if FPosition <> Value then
  begin
    FPosition := Value;
    UpdateLedState;
    Change;
  end;
end;

procedure TVrScanner.SetThreaded(Value: Boolean);
begin
  if FThreaded <> Value then
  begin
    FThreaded := Value;
    if Value then FTimer.TimerType := ttThread
    else FTimer.TimerType := ttSystem;
  end;
end;

procedure TVrScanner.SetPalette(Value: TVrPalette);
begin
  FPalette.Assign(Value);
end;

procedure TVrScanner.UpdateLedState;
begin
  AdjustRange(FPosition, -1, Pred(FLeds));
  if PrevPosition <> -1 then
    TVrscannerLeds(Collection).Items[PrevPosition].Active := False;
  if FPosition <> -1 then
    TVrscannerLeds(Collection).Items[Position].Active := True;
  PrevPosition := FPosition;
end;

procedure TVrScanner.TimerEvent(Sender: TObject);
begin
  case FDirection of
    sdBoth:
      begin
        if (ToLeft) then
        begin
          if (FPosition > 0) then Position := Position - 1
          else ToLeft := false;
        end
       else
        begin
          if (FPosition < FLeds - 1) then Position := Position + 1
          else ToLeft := true;
        end;
      end;
    sdLeftRight:
      begin
        if (FPosition < FLeds - 1) then
          Position := Position + 1 else Position := 0;
      end;
    sdRightLeft:
      begin
        if FPosition > 0 then Position := Position - 1
        else Position := FLeds - 1;
      end;
  end;
end;

{ TVrIndicatorLed }

constructor TVrIndicatorLed.Create(Collection: TVrCollection);
begin
  FColorLow := clGreen;
  FColorHigh := clLime;
  inherited Create(Collection);
end;

{ TVrIndicatorLeds }

constructor TVrIndicatorLeds.Create(AOwner: TVrIndicator);
begin
  inherited Create;
  FOwner := AOwner;
end;

function TVrIndicatorLeds.GetItem(Index: Integer): TVrIndicatorLed;
begin
  Result := TVrIndicatorLed(inherited Items[Index]);
end;

procedure TVrIndicatorLeds.Update(Item: TVrCollectionItem);
begin
  if Item <> nil then
    FOwner.UpdateLed(Item.Index) else
    FOwner.UpdateLeds;
end;

{ TVrIndicator }

constructor TVrIndicator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMaxValue := 100;
  FMinValue := 0;
  FLedsLow := 3;
  FLedsMedium := 2;
  FLedsHigh := 2;
  FPosition := 0;
  FStep := 10;
  FPalette1 := TVrPalette.Create;
  FPalette1.OnChange := PaletteModified;
  FPalette2 := TVrPalette.Create;
  with FPalette2 do
  begin
    Low := clOlive;
    High := clYellow;
    OnChange := PaletteModified;
  end;
  FPalette3 := TVrPalette.Create;
  with FPalette3 do
  begin
    Low := clMaroon;
    High := clRed;
    OnChange := PaletteModified;
  end;
  Collection := TVrIndicatorLeds.Create(Self);
  CreateItems;
end;

procedure TVrIndicator.CreateItems;
var
  I: Integer;
  Item: TVrIndicatorLed;
begin
  Collection.Clear;
  Leds := FLedsLow + FLedsMedium + FLedsHigh;
  for I := 0 to Leds - 1 do
  begin
    Item := TVrIndicatorLed.Create(Collection);
    if I < FLedsLow then
    begin
      Item.ColorLow := Palette1[0];
      Item.ColorHigh := Palette1[1];
    end
    else
    if I < FLedsLow + FLedsMedium then
    begin
      Item.ColorLow := Palette2[0];
      Item.ColorHigh := Palette2[1];
    end
    else
    begin
      Item.ColorLow := Palette3[0];
      Item.ColorHigh := Palette3[1];
    end;
  end;
end;

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

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

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

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

procedure TVrIndicator.UpdatePosition;
var
  I, Ticks: Integer;
begin
  AdjustRange(FPosition, FMinValue, FMaxValue);
  Ticks := SolveForX(PercentDone, Leds);
  for I := 0 to Leds - 1 do
    TVrIndicatorLeds(Collection).Items[I].Active := Succ(I) <= Ticks;
end;

procedure TVrIndicator.SetPosition(Value: Integer);
begin
  if FPosition <> Value then
  begin
    FPosition := Value;
    UpdatePosition;
    Change;
  end;
end;

procedure TVrIndicator.SetMaxValue(Value: Integer);
begin
  if (FMaxValue <> Value) and (Value > FMinValue) then
  begin
    FMaxValue := Value;
    UpdatePosition;
  end;
end;

procedure TVrIndicator.SetMinValue(Value: Integer);
begin
  if (FMinValue <> Value) and (Value < FMaxValue) then
  begin
    FMinValue := Value;
    UpdatePosition;
  end;
end;

procedure TVrIndicator.SetLedsLow(Value: Integer);
begin
  if FLedsLow <> Value then
  begin
    FLedsLow := Value;
    CreateItems;
    UpdateControlCanvas;
  end;
end;

procedure TVrIndicator.SetLedsMedium(Value: Integer);
begin
  if FLedsMedium <> Value then
  begin
    FLedsMedium := Value;
    CreateItems;
    UpdateControlCanvas;
  end;
end;

procedure TVrIndicator.SetLedsHigh(Value: Integer);
begin
  if FLedsHigh <> Value then
  begin
    FLedsHigh := Value;
    CreateItems;
    UpdateControlCanvas;
  end;
end;

procedure TVrIndicator.StepIt;
begin
  Position := Position + FStep;
end;

procedure TVrIndicator.StepBy(Delta: Integer);
begin
  Position := Position + Delta;
end;

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

procedure TVrIndicator.UpdateLed(Index: Integer);
var
  R: TRect;
  AColor: TColor;
  Item: TVrIndicatorLed;
begin
  Item := TVrIndicatorLeds(Collection).Items[Index];
  if Item.Active then AColor := Item.ColorHigh
                 else AColor := Item.ColorLow;

  GetItemRect(Index, R);

  if not FPlainColors then
    DrawGradientExt(DestCanvas, R, AColor, clBlack, gdUpDown, ColorWidth)
  else
  begin
    DestCanvas.Brush.Color := AColor;
    DestCanvas.FillRect(R);
  end;

  case FStyle of
    lsRaised:
      begin
        DrawOutline3D(DestCanvas, R, clBlack, clBlack, 1);
        if not FPlainColors then
          DrawOutline3D(DestCanvas, R, AColor, clBlack, 1)
        else
        begin
          if not Item.Active then
            DrawOutline3D(DestCanvas, R, Item.ColorHigh, Item.ColorLow, 1)
          else DrawOutline3D(DestCanvas, R, clBtnHighlight, Item.ColorHigh, 1);
        end;
      end;
    lsLowered:
      begin
        DrawOutline3D(DestCanvas, R, clBtnShadow, clBtnHighlight, 1);
        DrawOutline3D(DestCanvas, R, clBlack, clBlack, 1);
      end;
    lsFlat:
      DrawOutline3D(DestCanvas, R, clBlack, clBlack, 1);
    lsNone:;
  end;
end;

procedure TVrIndicator.UpdateLeds;
var
  I: Integer;
begin
  for I := 0 to Collection.Count - 1 do UpdateLed(I);
end;

procedure TVrIndicator.Paint;
begin
  ClearBitmapCanvas;
  DestCanvas := BitmapCanvas;
  try
    UpdateLeds;
    inherited Paint;
  finally
    DestCanvas := Self.Canvas;
  end;
  UpdatePosition;
end;

procedure TVrIndicator.GetItemRect(Index: Integer; var R: TRect);
var
  X, W, Gap: Integer;
begin
  Gap := Pred(Leds) * FSpacing;
  W := (ClientWidth - Gap) div Leds;
  X := (Leds * W) + Gap;
  X := (ClientWidth - X) div 2;
  Inc(X, (W * Index) + (FSpacing * Index));
  R := Bounds(X, 0, W, ClientHeight);
end;


end.