среда, 24 июня 2026 г.

Два элемента для панели XFCE на Lazarus 4.6 и Debian 13

1) Размещение приложения созданого в Lazarus 4.6 на панель XFCE под Debian 13

Чтобы добавить пользовательский элемент на панель XFCE, необходимо нажать правай кнопкой мыши на панели XFCE, выбрать пункт меню Панель → Добавить новый элемент. В окне добавления новых элементов найдите универсальный монитор и добавте его на панель XFCE (Смотрите рисунок 1).

 

Рисунок 1. Окно добавления универсального монитора

Теперь нажмите на добавленом универсальном мониторе правой кнопкой мыши и выберите пункт меню свойства. В окне настройки универсального монитора в поле команда пропишите путь до вашего приложения с необходимыми параметрами, если необходимо. Отключите метку сняв с неё опцию. Установите периюд на 1 секунду для приложения цифровых часов и 5 секунд для приложения статуса интернета (Смотрите рисунок 2 и рисунок 3) .

Рисунок 2. Окно настройки универсального монитора для элемента цифровые часы
 

Рисунок 3. Окно настройки универсального монитора для элемента статус интернета

 

2) Пример элементов цифровые часы и статуса интернета

Как выгледят цифровые часы и статус интернета на панели XFCE можно посмотреть на рисунке 4 для горизонтальной панели XFCE и на рисунке 5 для вертикальной панели XFCE.

Рисунок 4. Пример работы элемента цифровых часов и статуса интернета на горизонтальной панели XFCE 

Рисунок 5. Пример работы элемента цифровых часов и статуса интернета на вертикальной панели XFCE 

Код элемента цифровые часы:

program p3;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, Process, FPimage, FPImgCanv, FPWritePNG;

type
  TDigitsArray = array[0..9, 0..4, 0..2] of Integer;

const
  DIGITS: TDigitsArray = (
    ((1,1,1), (1,0,1), (1,0,1), (1,0,1), (1,1,1)), // 0
    ((0,1,0), (0,1,0), (0,1,0), (0,1,0), (0,1,0)), // 1
    ((1,1,1), (0,0,1), (1,1,1), (1,0,0), (1,1,1)), // 2
    ((1,1,1), (0,0,1), (1,1,1), (0,0,1), (1,1,1)), // 3
    ((1,0,1), (1,0,1), (1,1,1), (0,0,1), (0,0,1)), // 4
    ((1,1,1), (1,0,0), (1,1,1), (0,0,1), (1,1,1)), // 5
    ((1,1,1), (1,0,0), (1,1,1), (1,0,1), (1,1,1)), // 6
    ((1,1,1), (0,0,1), (0,0,1), (0,0,1), (0,0,1)), // 7
    ((1,1,1), (1,0,1), (1,1,1), (1,0,1), (1,1,1)), // 8
    ((1,1,1), (1,0,1), (1,1,1), (0,0,1), (1,1,1))  // 9
  );

function IsPanelVertical: Boolean;
var OutputStr: string;
begin
  Result := False;
  try
    if RunCommand('xfconf-query', ['-c', 'xfce4-panel', '-p', '/panels/panel-1/mode'], OutputStr) then
    begin
      OutputStr := Trim(OutputStr);
      if (OutputStr = '1') or (OutputStr = '2') then Result := True;
    end;
  except
  end;
end;

function GetPanelSize: Integer;
var OutputStr: string;
begin
  Result := 48;
  try
    if RunCommand('xfconf-query', ['-c', 'xfce4-panel', '-p', '/panels/panel-1/size'], OutputStr) then
      Result := StrToIntDef(Trim(OutputStr), 48);
  except
  end;
end;

function IsXfceThemeDark: Boolean;
var OutputStr: string;
begin
  Result := True;
  try
    if RunCommand('xfconf-query', ['-c', 'xsettings', '-p', '/Net/ThemeName'], OutputStr) then
    begin
      OutputStr := LowerCase(Trim(OutputStr));
      if (Pos('light', OutputStr) > 0) or (Pos('white', OutputStr) > 0) or (Pos('clear', OutputStr) > 0) then
        Result := False;
    end;
  except
  end;
end;

procedure DrawSolidRectFP(Canvas: TFPImageCanvas; X1, Y1, X2, Y2: Integer; Color: TFPColor);
var X, Y: Integer;
begin
  for Y := Y1 to Y2 do
    for X := X1 to X2 do
      Canvas.Colors[X, Y] := Color;
end;

procedure DrawDigitFP(Canvas: TFPImageCanvas; Digit, StartX, SquareSize, Spacing: Integer; NeonColor: TFPColor; SolidMode: Boolean);
var
  R, C, X, Y, X2, Y2: Integer;
begin
  for R := 0 to 4 do
    for C := 0 to 2 do
      if DIGITS[Digit, R, C] = 1 then
      begin
        X := StartX + C * (SquareSize + Spacing);
        Y := R * (SquareSize + Spacing);

        if SolidMode then
        begin
          // В сплошном режиме расширяем границы отрисовки пикселей до краев ячейки,
          // чтобы они полностью перекрывали внутренний Spacing и сливались в линии
          X2 := X + SquareSize + Spacing - 1;
          Y2 := Y + SquareSize + Spacing - 1;

          // Защита от выхода линий за правый/нижний край матрицы цифры
          if C = 2 then X2 := X + SquareSize - 1;
          if R = 4 then Y2 := Y + SquareSize - 1;
        end
        else
        begin
          // В обычном режиме сохраняем жесткие зазоры (-2 пикселя) для разделения кубиков
          X2 := X + SquareSize - 2;
          Y2 := Y + SquareSize - 2;
        end;

        DrawSolidRectFP(Canvas, X, Y, X2, Y2, NeonColor);
      end;
end;

procedure DrawColonFP(Canvas: TFPImageCanvas; StartX, SquareSize, Spacing: Integer; Visible: Boolean; NeonColor: TFPColor; SolidMode: Boolean);
var Y1, Y2, SizeMod: Integer;
begin
  if not Visible then Exit;
  Y1 := 1 * (SquareSize + Spacing);
  Y2 := 3 * (SquareSize + Spacing);

  if SolidMode then SizeMod := -1 else SizeMod := -2;

  DrawSolidRectFP(Canvas, StartX, Y1, StartX + SquareSize + SizeMod, Y1 + SquareSize + SizeMod, NeonColor);
  DrawSolidRectFP(Canvas, StartX, Y2, StartX + SquareSize + SizeMod, Y2 + SquareSize + SizeMod, NeonColor);
end;

function ResizeImageFP(SrcImg: TFPMemoryImage; NewWidth, NewHeight: Integer): TFPMemoryImage;
var
  X, Y, SrcX, SrcY: Integer;
begin
  Result := TFPMemoryImage.Create(NewWidth, NewHeight);
  for Y := 0 to NewHeight - 1 do
    for X := 0 to NewWidth - 1 do Result.Colors[X, Y] := FPColor(0,0,0,0);

  for Y := 0 to NewHeight - 1 do
  begin
    SrcY := (Y * SrcImg.Height) div NewHeight;
    if SrcY >= SrcImg.Height then SrcY := SrcImg.Height - 1;

    for X := 0 to NewWidth - 1 do
    begin
      SrcX := (X * SrcImg.Width) div NewWidth;
      if SrcX >= SrcImg.Width then SrcX := SrcImg.Width - 1;

      Result.Colors[X, Y] := SrcImg.Colors[SrcX, SrcY];
    end;
  end;
end;

procedure CreateClockImage(Hour, Min, Sec: Word; const OutPath: string; SquareSize, Spacing: Integer; Vertical, ShowSeconds, SolidMode: Boolean; NeonColor: TFPColor);
var
  FullImg, FinalImg: TFPMemoryImage;
  Canvas: TFPImageCanvas;
  Writer: TFPWriterPNG;
  DigitWidth, DigitHeight, CurX: Integer;
  InternalDigitSpacing, BlockSpacing, MarginSpacing: Integer;
  IsColonVisible: Boolean;
  PanelSize, NewWidth, NewHeight, X, Y: Integer;
begin
  DigitWidth := (3 * SquareSize) + (2 * Spacing);
  DigitHeight := (5 * SquareSize) + (4 * Spacing);

  InternalDigitSpacing := 6;
  BlockSpacing := 10;
  MarginSpacing := 8;

  IsColonVisible := (Sec mod 2 = 0);

  FullImg := TFPMemoryImage.Create(0, 0);
  try
    if ShowSeconds then
      X := (DigitWidth * 6) + (SquareSize * 2) + (InternalDigitSpacing * 3) + (BlockSpacing * 4) + (MarginSpacing * 2)
    else
      X := (DigitWidth * 4) + (SquareSize * 1) + (InternalDigitSpacing * 2) + (BlockSpacing * 2) + (MarginSpacing * 2);

    FullImg.SetSize(X, DigitHeight);

    for Y := 0 to FullImg.Height - 1 do
      for X := 0 to FullImg.Width - 1 do FullImg.Colors[X, Y] := FPColor(0,0,0,0);

    Canvas := TFPImageCanvas.Create(FullImg);
    try
      CurX := MarginSpacing;

      // --- ЧАСЫ ---
      DrawDigitFP(Canvas, Hour div 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
      CurX := CurX + DigitWidth + InternalDigitSpacing;
      DrawDigitFP(Canvas, Hour mod 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
      CurX := CurX + DigitWidth + BlockSpacing;

      // --- РАЗДЕЛИТЕЛЬ 1 ---
      DrawColonFP(Canvas, CurX, SquareSize, Spacing, IsColonVisible, NeonColor, SolidMode);
      CurX := CurX + SquareSize + BlockSpacing;

      // --- МИНУТЫ ---
      DrawDigitFP(Canvas, Min div 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
      CurX := CurX + DigitWidth + InternalDigitSpacing;
      DrawDigitFP(Canvas, Min mod 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);

      if ShowSeconds then
      begin
        CurX := CurX + DigitWidth + BlockSpacing;

        // --- РАЗДЕЛИТЕЛЬ 2 ---
        DrawColonFP(Canvas, CurX, SquareSize, Spacing, IsColonVisible, NeonColor, SolidMode);
        CurX := CurX + SquareSize + BlockSpacing;

        // --- СЕКУНДЫ ---
        DrawDigitFP(Canvas, Sec div 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
        CurX := CurX + DigitWidth + InternalDigitSpacing;
        DrawDigitFP(Canvas, Sec mod 10, CurX, SquareSize, Spacing, NeonColor, SolidMode);
      end;
    finally
      Canvas.Free;
    end;

    Writer := TFPWriterPNG.Create;
    try
      Writer.Indexed := False;
      Writer.UseAlpha:= True;

      // Получаем реальный физический размер панели XFCE из системы (хоть вертикальной, хоть горизонтальной)
      PanelSize := GetPanelSize();

      if Vertical then
      begin
        // --- ВЕРТИКАЛЬНАЯ ПАНЕЛЬ ---
        // Жестко вписываем ШИРИНУ картинки в ШИРИНУ панели (PanelSize)
        NewWidth := PanelSize;
        NewHeight := Round((FullImg.Height * NewWidth) / FullImg.Width);
      end
      else
      begin
        // --- ГОРИЗОНТАЛЬНАЯ ПАНЕЛЬ ---
        // Жестко вписываем ВЫСОТУ картинки в ВЫСОТУ панели (PanelSize) с небольшим отступом (85% от высоты панели)
        NewHeight := Round(PanelSize * 0.85);
        if NewHeight < 16 then NewHeight := 16; // Защита от слишком мелких панелей

        NewWidth := Round((FullImg.Width * NewHeight) / FullImg.Height);
      end;

      // Запускаем наше качественное пиксельное масштабирование для ОБОИХ режимов
      FinalImg := ResizeImageFP(FullImg, NewWidth, NewHeight);
      try
        FinalImg.SaveToFile(OutPath, Writer);
      finally
        FinalImg.Free;
      end;

    finally
      Writer.Free;
    end;
  finally
    FullImg.Free;
  end;
end;

var
  Hour, Min, Sec, MSec: Word;
  ImagePath: string;
  SqSize, Spac: Integer;
  VerticalMode, ShowSeconds, SolidMode: Boolean;
  I: Integer;
  ActiveColor: TFPColor;
  ColorForced: Boolean;
begin
  try
    ImagePath := '/tmp/xfce_neon_clock.png';
    VerticalMode := IsPanelVertical;

    ShowSeconds := True;
    SolidMode := False; // По умолчанию режим раздельных кубиков
    ColorForced := False;
    ActiveColor.alpha := $FFFF;

    for I := 1 to ParamCount do
    begin
      if (ParamStr(I) = '--no-sec') or (ParamStr(I) = '-no-sec') then ShowSeconds := False;
      if (ParamStr(I) = '--solid')  or (ParamStr(I) = '-solid')  then SolidMode := True;

      if (ParamStr(I) = '--green') then begin ActiveColor.red := $3333; ActiveColor.green := $FFFF; ActiveColor.blue := $3333; ColorForced := True; end;
      if (ParamStr(I) = '--blue')  then begin ActiveColor.red := $3333; ActiveColor.green := $9999; ActiveColor.blue := $FFFF; ColorForced := True; end;
      if (ParamStr(I) = '--amber') then begin ActiveColor.red := $FFFF; ActiveColor.green := $A9A9; ActiveColor.blue := $3333; ColorForced := True; end;

      if (ParamStr(I) = '--dark-blue')  then begin ActiveColor.red := $0000; ActiveColor.green := $2222; ActiveColor.blue := $8888; ColorForced := True; end;
      if (ParamStr(I) = '--dark-graph') then begin ActiveColor.red := $2222; ActiveColor.green := $2222; ActiveColor.blue := $2222; ColorForced := True; end;
    end;

    if not ColorForced then
    begin
      if IsXfceThemeDark() then
      begin
        ActiveColor.red := $3333; ActiveColor.green := $FFFF; ActiveColor.blue := $3333;
      end
      else
      begin
        ActiveColor.red := $0000; ActiveColor.green := $2222; ActiveColor.blue := $8888;
      end;
    end;

    SqSize := 10; Spac := 2;
    DecodeTime(Now, Hour, Min, Sec, MSec);

    CreateClockImage(Hour, Min, Sec, ImagePath, SqSize, Spac, VerticalMode, ShowSeconds, SolidMode, ActiveColor);

    WriteLn('<img>' + ImagePath + '</img>');
    WriteLn('<tool>'Цифровые часы'</tool>');
  except
    on E: Exception do WriteLn('<txt>'[ Ошибка часов ]'</txt>');
  end;
end.

Код элемента статус интернета:

program p2;
{$mode objfpc}{$H+}

uses
  Classes, SysUtils, Process, FPimage, FPWritePNG;

function IsInternetAvailable(): Boolean;
var
  DummyOutput: string;
begin
  // RunCommand запускает ping скрытно и собирает его вывод в переменную DummyOutput.
  // На экран (и в Genmon) ничего лишнего не попадает.
  Result := RunCommand('/usr/bin/ping', ['-c', '1', '-W', '2', '8.8.8.8'], DummyOutput);
end;

// Процедура генерации красивого объёмного огонька напрямую по пикселям
procedure CreateLedIcon(const APath: string; IsGreen: Boolean);
var
  Img: TFPMemoryImage;
  Writer: TFPWriterPNG;
  X, Y, DX, DY: Integer;
  Dist: Double;
  RColor, GColor, BColor: Word;
  Alpha: Word;
  EdgeAlpha: Integer; // Добавили эту переменную для сглаживания
begin
  Img := TFPMemoryImage.Create(16, 16);
  Writer := TFPWriterPNG.Create;
  try
    // Заполняем фон: абсолютно прозрачный (последний параметр $0000)
    for Y := 0 to 15 do
      for X := 0 to 15 do
        Img.Colors[X, Y] := FPColor(0, 0, 0, $0000);

        // Рисуем 3D-сферу со сглаженными краями (Антиалиасинг)
    for Y := 0 to 15 do
    begin
      for X := 0 to 15 do
      begin
        Dist := Sqrt(Sqr(X - 7.5) + Sqr(Y - 7.5));

        // Ограничиваем радиус сглаживания (до 7.2 пикселей, чтобы не обрезать края)
        if Dist <= 7.2 then
        begin
          DX := X - 5;
          DY := Y - 5;
          Alpha := Trunc(255 * (1.0 - (Sqrt(Sqr(DX) + Sqr(DY)) / 12.0)));
          if Alpha > 255 then Alpha := 255;
          if Alpha < 50 then Alpha := 50;

          if IsGreen then
          begin
            RColor := (Alpha * $33) div 255;
            GColor := (Alpha * $FF) div 255;
            BColor := (Alpha * $33) div 255;
          end
          else
          begin
            RColor := (Alpha * $FF) div 255;
            GColor := (Alpha * $22) div 255;
          end;

          // --- БЛОК СГЛАЖИВАНИЯ КРАЕВ ---
          // Если пиксель находится на внешнем краю круга (между 6.0 и 7.2 пикселей)
          if Dist > 6.0 then
          begin
            // Вычисляем коэффициент прозрачности края от 1.0 (на расстоянии 6.0) до 0.0 (на расстоянии 7.2)
            // Формула: (7.2 - Dist) / (7.2 - 6.0)
            EdgeAlpha := Trunc($FFFF * ((7.2 - Dist) / 1.2));
            if EdgeAlpha < 0 then EdgeAlpha := 0;
          end
          else
          begin
            // Внутри круга пиксели полностью непрозрачны
            EdgeAlpha := $FFFF;
          end;

          // Записываем цвет, подставляя вычисленный EdgeAlpha вместо жесткого $FFFF
          Img.Colors[X, Y] := FPColor(RColor shl 8, GColor shl 8, BColor shl 8, EdgeAlpha);
        end;
      end;
    end;

    Writer.UseAlpha := True;

    Img.SaveToFile(APath, Writer);
  finally
    Writer.Free;
    Img.Free;
  end;
end;

var
  Online: Boolean;
  IconPath: string;
  TextMon, TooltipText: string;
begin
  Online := IsInternetAvailable();

  if Online then IconPath := '/tmp/genmon-net-on.png'
  else IconPath := '/tmp/genmon-net-off.png';

  CreateLedIcon(IconPath, Online);

  if Online then
  begin
    TextMon := 'Инт.вкл.';
    TooltipText := 'Интернет подключен';
  end
  else
  begin
    TextMon := 'Инт.откл.';
    TooltipText := 'Соединение отсутствует';
  end;

	writeln('<txt>' + textmon + '</txt>');
	writeln('<img>' + iconpath + '</img>');
	writeln('<tool>' + tooltiptext + '</tool>');
end.

 

Комментариев нет:

Отправить комментарий