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

📄 jvgdigits.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
            Pen.Color := CActive
          else
          if SPassive then
            Pen.Color := CPassive
          else
            goto deTL_L;
          MoveTo(R.Left + FGap, R.Bottom);
          LineTo(R.Right - FGap + S, R.Bottom);
        deTL_L:
          if dlTL in DigitsSet[D] then
            Pen.Color := CActive
          else
          if SPassive then
            Pen.Color := CPassive
          else
            goto deTR_L;
          MoveTo(R.Left, R.Top + FGap);
          LineTo(R.Left, CenterY - FGap + S);
        deTR_L:
          if dlTR in DigitsSet[D] then
            Pen.Color := CActive
          else
          if SPassive then
            Pen.Color := CPassive
          else
            goto deBL_L;
          MoveTo(R.Right, R.Top + FGap);
          LineTo(R.Right, CenterY - FGap + S);
        deBL_L:
          if dlBL in DigitsSet[D] then
            Pen.Color := CActive
          else
          if SPassive then
            Pen.Color := CPassive
          else
            goto deBR_L;
          MoveTo(R.Left, R.Bottom - FGap);
          LineTo(R.Left, CenterY + Pen.Width - S + FGap);
        deBR_L:
          if dlBR in DigitsSet[D] then
            Pen.Color := CActive
          else
          if SPassive then
            Pen.Color := CPassive
          else
            goto deEND_L;
          MoveTo(R.Right, R.Bottom - FGap);
          LineTo(R.Right, CenterY + Pen.Width - S + FGap);
        deEND_L:
          Pt.X := Pt.X + FDSize.X + FInterspace;
        end;
    end;
    Result := Pt.X;
  end;

begin
  ClientR := GetClientRect;
  //--- gradient and Bevels
  if FGradient.Active then
    with FBevel, FGradient do
    begin
      InflateRect(ClientR, -FInteriorOffset, -FInteriorOffset);
      GradientBox(Canvas.Handle, ClientR, Gradient,
        Integer(BevelPenStyle), BevelPenWidth);
    end;
  if FBevel.Active then
    with FBevel do
    begin
      ClientR := ClientRect;
      Dec(ClientR.Right);
      Dec(ClientR.Bottom);
      Canvas.Pen.Width := BevelPenWidth;
      Canvas.Pen.Style := BevelPenStyle;
      ClientR := DrawBoxEx(Canvas.Handle, ClientR,
        Sides, Inner, Outer, Bold, 0, True);
      Inc(ClientR.Right);
      Inc(ClientR.Bottom);
    end;
  //InflateRect(ClientR,-InteriorOffset,-InteriorOffset);
  R := ClientR; //Dec( R.Right ); Dec( R.Bottom );
  Str := FloatToStr(FValue);
  if (DigitCount <> -1) and (DigitCount > Length(Str)) then
    for I := 1 to DigitCount - Length(Str) do
      Str := Str + '0';
  if FPositions > 0 then
    Str := Spaces(FPositions - Length(Str)) + Str;

  IWidth := 0;
  for I := 1 to Length(Str) do
    if Str[I] <> ',' then
      Inc(IWidth, FDSize.X + Interspace)
    else
      Inc(IWidth, Interspace);
  Inc(IWidth, Interspace);

  if (FInsertSpecialSymbolAt > 0) and (FInsertSpecialSymbolAt <= Length(Str)) then
    if FSpecialSymbol = ssyColon then
      Inc(IWidth, Interspace * 3)
    else
      Inc(IWidth, FDSize.X + Interspace);
  //else Inc( IWidth ,6 );
  case Alignment of
    taLeftJustify:
      XPos := Interspace;
    taCenter:
      XPos := (ClientR.Right - ClientR.Left - IWidth) div 2 + Interspace;
  else //taRightJustify
    XPos := ClientR.Right - ClientR.Left - IWidth + Interspace;
  end;
  YPos := (Height - FDSize.Y) div 2;
  I := Pos(',', Str);
  if (I <> 0) and (I <> FOldDotPos) then
    FNeedBackgroundPaint := True;
  //if (FInsertSpecialSymbolAt>0)and(OldSpSymbolxPos<>XPos) then FNeedBackgroundPaint:=True;
  with Canvas do
  begin
    if FNeedBackgroundPaint then
      FillBackground;
    Pen.Color := FActiveColor;
    Pen.Style := PenStyle;
    Pen.Width := FPenWidth;

    Pt.X := XPos;
    Pt.Y := YPos;
    SPassive := not FGradient.Active;
    for I := 1 to Length(Str) do
      Pt.X := DrawDigit(Pt, FActiveColor, FPassiveColor);
  end;
  FNeedBackgroundPaint := True;
end;

procedure TJvgDigits.WMSize(var Msg: TWMSize);
begin
  FNeedBackgroundPaint := True;
end;

procedure TJvgDigits.SmthChanged(Sender: TObject);
begin
  Repaint;
end;

procedure TJvgDigits.SetValue(NewValue: Double);
begin
  try
    if FValue <> NewValue then
    begin
      FValue := NewValue;
      FNeedBackgroundPaint := FOldStrWidth <> Length(FloatToStr(FValue));
      if FNeedBackgroundPaint then
        FOldStrWidth := Length(FloatToStr(FValue));
      Repaint;
    end;
  except
  end;
end;

procedure TJvgDigits.SetActiveColor(Value: TColor);
begin
  if FActiveColor <> Value then
  begin
    FActiveColor := Value;
    FNeedBackgroundPaint := False;
    Repaint;
  end;
end;

procedure TJvgDigits.SetPassiveColor(Value: TColor);
begin
  if FPassiveColor <> Value then
  begin
    FPassiveColor := Value;
    FNeedBackgroundPaint := False;
    Repaint;
  end;
end;

procedure TJvgDigits.SetBackgroundColor(Value: TColor);
begin
  if FBackgroundColor <> Value then
  begin
    FBackgroundColor := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetPositions(Value: Word);
begin
  if FPositions <> Value then
  begin
    FPositions := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetPenWidth(Value: Word);
begin
  if FPenWidth <> Value then
  begin
    FPenWidth := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetInterspace(Value: Word);
begin
  if FInterspace <> Value then
  begin
    FInterspace := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetGap(Value: Word);
begin
  if FGap <> Value then
  begin
    FGap := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetInteriorOffset(Value: Word);
begin
  if FInteriorOffset <> Value then
  begin
    FInteriorOffset := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetInsertSpecialSymbolAt(Value: Integer);
begin
  if FInsertSpecialSymbolAt <> Value then
  begin
    FInsertSpecialSymbolAt := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetPenStyle(Value: TPenStyle);
begin
  if FPenStyle <> Value then
  begin
    FPenStyle := Value;
    FNeedBackgroundPaint := False;
    Repaint;
  end;
end;

procedure TJvgDigits.SetSpecialSymbol(Value: TJvgSpecialSymbol);
begin
  if FSpecialSymbol <> Value then
  begin
    FSpecialSymbol := Value;
    if Value = ssyNone then
      FInsertSpecialSymbolAt := -1;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

procedure TJvgDigits.SetDigitCount(Value: Integer);
begin
  if FDigitCount <> Value then
  begin
    FDigitCount := Value;
    FNeedBackgroundPaint := True;
    Repaint;
  end;
end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.

⌨️ 快捷键说明

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