⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvsegmentedleddisplay.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 4 页
字号:
begin
  Result.X := X - Trunc(ArcTan(Angle * Pi / 180.0) * Y);
  Result.Y := Y;
end;

//=== { TJvCustomSegmentedLEDDisplay } =======================================

constructor TJvCustomSegmentedLEDDisplay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  IncludeThemeStyle(Self, [csParentBackground]);
  {$IFDEF VCL}
  AutoSize := True;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  FAutoSize := True; // asn: prevents redraws
  {$ENDIF VisualCLX}
  FDigitClass := TJv7SegmentedLEDDigit;
  FCharacterMapper := TJvSegmentedLEDCharacterMapper.Create(Self);
  FDigits := TJvSegmentedLEDDigits.Create(Self);
  FDigitHeight := 30;
  FDigitSpacing := 2;
  FDigitWidth := 20;
  FDotSize := 4;
  FSegmentLitColor := clWindowText;
  FSegmentSpacing := 2;
  FSegmentThickness := 2;
  FSegmentUnlitColor := clDefaultLitColor;
  ClientWidth := 20;
  ClientHeight := 30;
end;

destructor TJvCustomSegmentedLEDDisplay.Destroy;
begin
  FreeAndNil(FDigits);
  inherited Destroy;
end;

procedure TJvCustomSegmentedLEDDisplay.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('MapperData', CharacterMapper.LoadFromStream,
    CharacterMapper.SaveToStream, CharacterMapper.MappingChanged);
end;

procedure TJvCustomSegmentedLEDDisplay.Loaded;
begin
  inherited Loaded;
  RemapText;
end;

procedure TJvCustomSegmentedLEDDisplay.Paint;
var
  I: Integer;
begin
  Canvas.Brush.Color := Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Style := psSolid;
  DrawThemedBackground(Self, Canvas, ClientRect);
  for I := 0 to FDigits.Count - 1 do
    Digits[I].Paint;
end;

function TJvCustomSegmentedLEDDisplay.GetText: string;
begin
  Result := FText;
end;

procedure TJvCustomSegmentedLEDDisplay.SetText(Value: string);
begin
  if Value <> Text then
    PrimSetText(Value);
end;

procedure TJvCustomSegmentedLEDDisplay.SetDigitHeight(Value: Integer);
var
  MaxHeight: Integer;
  I: Integer;
begin
  if Value <> DigitHeight then
  begin
    FDigitHeight := Value;
    MaxHeight := 0;
    for I := 0 to Digits.Count -1 do
    begin
      Digits[I].InvalidateRefPoints;
      if Digits[I].Height + Digits[I].GetVertAdjust > MaxHeight then
        MaxHeight := Digits[I].Height + Digits[I].GetVertAdjust;
    end;
    if MaxHeight = 0 then
      MaxHeight := 13;
    // Adjust control height
    if AutoSize and not (Align in [alLeft, alRight, alClient]) and
      (Anchors * [akTop, akBottom] <> [akTop, akBottom]) and (ClientHeight <> MaxHeight) then
      ClientHeight := MaxHeight;
    InvalidateView;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.SetDigits(Value: TJvSegmentedLEDDigits);
begin
end;

procedure TJvCustomSegmentedLEDDisplay.SetDigitSpacing(Value: Integer);
begin
  if Value <> DigitSpacing then
  begin
    FDigitSpacing := Value;
    UpdateDigitsPositions;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.SetDigitWidth(Value: Integer);
begin
  if Value <> DigitWidth then
  begin
    FDigitWidth := Value;
    if Digits.Count > 0 then
    begin
      UpdateDigitsPositions;
      Digits[0].InvalidateRefPoints;
    end;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.SetDigitClass(Value: TJvSegmentedLEDDigitClass);
var
  I: Integer;
begin
  if (DigitClass <> Value) and (Value <> nil) then
  begin
    FDigitClass := Value;
    I := Digits.Count;
    FreeAndNil(FDigits);
    FDigits := TJvSegmentedLEDDigits.Create(Self);
    while (I > 0) do
    begin
      Digits.Add;
      Dec(I);
    end;
    if CharacterMapper <> nil then
      CharacterMapper.LoadDefaultMapping;  
    if not (csLoading in ComponentState) then
      RemapText;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.SetDotSize(Value: Integer);
begin
  Value := Value and not 1;
  if Value <> DotSize then
  begin
    FDotSize := Value;
    InvalidateDigits;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.SetSegmentLitColor(Value: TColor);
begin
  if Value <> SegmentLitColor then
  begin
    FSegmentLitColor := Value;
    InvalidateView;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.SetSegmentSpacing(Value: Integer);
begin
  Value := Value and not 1;
  if Value <> SegmentSpacing then
  begin
    FSegmentSpacing := Value;
    InvalidateDigits;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.SetSegmentThickness(Value: Integer);
begin
  Value := Value and not 1;
  if Value <> SegmentThickness then
  begin
    FSegmentThickness := Value;
    InvalidateDigits;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.SetSegmentUnlitColor(Value: TUnlitColor);
begin
  if Value <> SegmentUnlitColor then
  begin
    FSegmentUnlitColor := Value;
    InvalidateView;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.SetSlant(Value: TSlantAngle);
begin
  if Value <> Slant then
  begin
    FSlant := Value;
    InvalidateDigits;
    UpdateDigitsPositions;
  end;
end;

{$IFDEF VisualCLX}
procedure TJvCustomSegmentedLEDDisplay.SetAutoSize(Value: Boolean);
begin
  FAutoSize := Value;
  if Value then
    UpdateBounds;
end;
{$ENDIF VisualCLX}

function TJvCustomSegmentedLEDDisplay.GetDigitClassName: TJvSegmentedLEDDigitClassName;
begin
  if DigitClass <> nil then
    Result := DigitClass.ClassName
  else
    Result := '';
end;

procedure TJvCustomSegmentedLEDDisplay.SetDigitClassName(Value: TJvSegmentedLEDDigitClassName);
var
  AClass: TClass;
begin
  if not AnsiSameStr(Value, DigitClassName) then
  begin
    if Value <> '' then
    begin
      AClass := FindClass(Value);
      if AClass.InheritsFrom(TJvCustomSegmentedLEDDigit) then
        DigitClass := TJvSegmentedLEDDigitClass(FindClass(Value))
      else
        raise EJVCLSegmentedLEDException.CreateRes(@RsEInvalidClass);
    end
    else
      DigitClass := nil;
  end;
end;

function TJvCustomSegmentedLEDDisplay.GetRealUnlitColor: TColor;
begin
  if SegmentUnlitColor = clNone then
    Result := Color
  else
  if SegmentUnlitColor = clDefaultBackground then
    Result := CalcRealUnlitColorBackground
  else
  if SegmentUnlitColor = clDefaultLitColor then
    Result := CalcRealUnlitColorLitColor
  else
    Result := SegmentUnlitColor;
end;

function TJvCustomSegmentedLEDDisplay.CalcRealUnlitColorBackground: TColor;
var
  Int: Integer;
begin
  Int := Intensity(Color32(Color));
  if Int > 127 then
    { Light color; darken a little }
    Result := DarkColor(Color, 30)
  else
    { Dark color; lighten a little }
    Result := BrightColor(Color, 30);
end;

function TJvCustomSegmentedLEDDisplay.CalcRealUnlitColorLitColor: TColor;
begin
  if Intensity(Color32(SegmentLitColor)) > Intensity(Color32(Color)) then
    Result := DarkColor(SegmentLitColor, 70)
  else
    Result := BrightColor(SegmentLitColor, 70);
end;

procedure TJvCustomSegmentedLEDDisplay.PrimSetText(Value: string);
var
  P: PChar;
  I: Integer;
begin
  { Apply mapping of text. If any digit is changed Invalidate will be called. The stored value for
    FText will be the concatenation of each Digit's Text value. }
  if CharacterMapper <> nil then
  begin
    P := PChar(Value);
    for I := 0 to Digits.Count -1 do
      CharacterMapper.MapText(P, Digits[I]);
    UpdateText;
  end
  else
    FText := Value;
end;

procedure TJvCustomSegmentedLEDDisplay.BaseTopChanged;
var
  I: Integer;
  MaxHeight: Integer;
begin
  // Determine MaxBaseTop
  FMaxBaseTop := 0;
  for I := 0 to Digits.Count - 1 do
    if Digits[I].GetBaseTop > FMaxBaseTop then
      FMaxBaseTop := Digits[I].GetBaseTop;
  // Vertically adjust digits and determine maximum height
  MaxHeight := 0;
  for I := 0 to Digits.Count - 1 do
  begin
    Digits[I].SetVertAdjust(FMaxBaseTop - Digits[I].GetBaseTop);
    if Digits[I].Height + Digits[I].GetVertAdjust > MaxHeight then
      MaxHeight := Digits[I].Height + Digits[I].GetVertAdjust;
  end;
  if MaxHeight = 0 then
    MaxHeight := 13;
  // Adjust control height
  if AutoSize and not (Align in [alLeft, alRight, alClient]) and
    (Anchors * [akTop, akBottom] <> [akTop, akBottom]) and (ClientHeight <> MaxHeight) then
  begin
    InvalidateView;
    ClientHeight := MaxHeight;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.HeightChanged;
var
  MaxHeight: Integer;
  I: Integer;
begin
  MaxHeight := 0;
  for I := 0 to Digits.Count - 1 do
    if Digits[I].Height + Digits[I].GetVertAdjust > MaxHeight then
      MaxHeight := Digits[I].Height + Digits[I].GetVertAdjust;
  if MaxHeight = 0 then
    MaxHeight := 13;
  // Adjust control height
  if AutoSize and not (Align in [alLeft, alRight, alClient]) and
    (Anchors * [akTop, akBottom] <> [akTop, akBottom]) and (ClientHeight <> MaxHeight) then
  begin
    InvalidateView;
    ClientHeight := MaxHeight;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.UpdateDigitsPositions;
var
  I: Integer;
  X: Integer;
begin
  if Digits.Count > 0 then
  begin
    Digits[0].SetLeft(0);
    X := Digits[0].Width + DigitSpacing;
    for I := 1 to Digits.Count - 1 do
    begin
      Digits[I].SetLeft(X);
      Inc(X, Digits[I].Width + DigitSpacing);
    end;
    Dec(X, DigitSpacing);
    if AutoSize and not (Align in [alTop, alBottom, alClient]) and
      (Anchors * [akLeft, akRight] <> [akLeft, akRight]) and (ClientWidth <> X) then
      ClientWidth := X;
    InvalidateView;
  end;
end;

procedure TJvCustomSegmentedLEDDisplay.InvalidateDigits;
var
  I: Integer;
begin
  for I := 0 to Digits.Count - 1 do
    Digits[I].InvalidateRefPoints;
end;

procedure TJvCustomSegmentedLEDDisplay.InvalidateView;
begin
  Invalidate;
end;

procedure TJvCustomSegmentedLEDDisplay.UpdateText;
var
  I: Integer;
begin
  FText := '';
  for I := 0 to Digits.Count - 1 do
    FText := FText + Digits[I].Text;
end;

procedure TJvCustomSegmentedLEDDisplay.UpdateBounds;
begin
  HeightChanged;
  UpdateDigitsPositions;
end;

procedure TJvCustomSegmentedLEDDisplay.RemapText;
begin
  PrimSetText(Text);
end;

function TJvCustomSegmentedLEDDisplay.GetHitInfo(X, Y: Integer): TSLDHitInfo;
var
  DummyDigit: TJvCustomSegmentedLEDDigit;
  DummyIndex: Integer;
begin
  Result := GetHitInfo(X, Y, DummyDigit, DummyIndex);
end;

function TJvCustomSegmentedLEDDisplay.GetHitInfo(X, Y: Integer;
  out Digit: TJvCustomSegmentedLEDDigit; out SegmentIndex: Integer): TSLDHitInfo;
var
  I: Integer;
begin
  Result := shiNowhere;
  if PtInRect(ClientRect, Point(X, Y)) then
  begin
    // Iterate over each digit and get the hit info from them
    I := Digits.Count;
    while (I > 0) and (Result = shiNowhere) do
    begin
      Dec(I);
      Result := Digits[I].GetHitInfo(X, Y, SegmentIndex);
    end;
    if Result <> shiNowhere then
      Digit := Digits[I]
    else // Result = shiNowhere, but we are in fact in the client area of the control (see outer if) 
      Result := shiClientArea;
  end;
end;

//=== { TJvSegmentedLEDDigits } ==============================================

constructor TJvSegmentedLEDDigits.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TJvCustomSegmentedLEDDisplay(AOwner).DigitClass);
end;

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

procedure TJvSegmentedLEDDigits.SetItem(Index: Integer; Value: TJvCustomSegmentedLEDDigit);
begin
  inherited Items[Index] := Value;
end;

function TJvSegmentedLEDDigits.Display: TJvCustomSegmentedLEDDisplay;
begin
  Result := TJvCustomSegmentedLEDDisplay(GetOwner);
end;

procedure TJvSegmentedLEDDigits.Update(Item: TCollectionItem);
begin
  Assert(Display <> nil);
  Display.UpdateBounds;
end;

//=== { TJvCustomSegmentedLEDDigit } =========================================

constructor TJvCustomSegmentedLEDDigit.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  InvalidateRefPoints;
end;

function TJvCustomSegmentedLEDDigit.GetBaseTop: Integer;
begin
  Result := 0;
end;

procedure TJvCustomSegmentedLEDDigit.SetBaseTop(Value: Integer);
begin
end;

function TJvCustomSegmentedLEDDigit.GetHeight: Integer;
begin
  Result := Display.DigitHeight;
end;

function TJvCustomSegmentedLEDDigit.GetVertAdjust: Integer;
begin
  Result := FVertAdjust;
end;

procedure TJvCustomSegmentedLEDDigit.SetVertAdjust(Value: Integer);
begin
  if Value <> GetVertAdjust then
  begin
    FVertAdjust := Value;
    InvalidateRefPoints;
  end;
end;

procedure TJvCustomSegmentedLEDDigit.SetIndex(Value: Integer);
begin
  inherited SetIndex(Value);
  Display.UpdateDigitsPositions;
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -