Экранный вирус

Delphi , ОС и Железо , Монитор и Экран

Никогда не видели экранного вируса? Представьте, что Ваш экран заболел и покрылся красными пятнами :) А если эта болезнь нападёт на какое-нибудь окно ? Всё, что нам надо, это получить контекст устройства при помощи API функции GetWindowDC и рисовать, что душе угодно.

К исходному коду особых комментариев не требуется, скажу лишь только то, что основная часть кода находится в обработчике события OnTimer:

type
  TScreenVirus = class(TComponent)
  private
    FTimer: TTimer;
    FInterval: Cardinal;
    FColor: TColor;
    FRadius: Integer;
  protected
    procedure OnTimer(Sender: TObject);
    procedure SetInterval(Value: Cardinal);
  public
    constructor Create(AOwner: TComponent); override;
    procedure StartInfection;
  published
    property Interval: Cardinal
      read FInterval write SetInterval;
    property Color: TColor
      read FColor write FColor default clRed;
    property Radius: Integer
      read FRadius write FRadius default 10;
  end;

constructor TScreenVirus.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTimer := TTimer.Create(Owner);
  FInterval := FTimer.Interval;
  FTimer.Enabled := False;
  FTimer.OnTimer := OnTimer;
  FColor := clRed;
  FRadius := 10;
end;

procedure TScreenVirus.StartInfection;
begin
  if Assigned(FTimer) then
    FTimer.Enabled := True;
end;

procedure TScreenVirus.SetInterval(Value: Cardinal);
begin
  if Value <> FInterval then
  begin
    FInterval := Value;
    FTimer.Interval := Interval;
  end;
end;

procedure TScreenVirus.OnTimer(Sender: TObject);
var
  hdcDesk: THandle;
  Brush: TBrush;
  X, Y: Integer;
begin
  hdcDesk := GetWindowDC(GetDesktopWindow);
  Brush := TBrush.Create;
  Brush.Color := FColor;
  SelectObject(hdcDesk, Brush.Handle);
  X := Random(Screen.Width);
  Y := Random(Screen.Height);
  Ellipse(hdcDesk, X - FRadius, Y - FRadius,
    X + FRadius, Y + FRadius);
  ReleaseDC(hdcDesk, GetDesktopWindow);
  Brush.Free;
end;

Программный код на Delphi, который имитирует вирус экрана, рисуя красные точки (эллипсы) случайным образом на рабочем столе с помощью функций Windows API.

Вот подробное описание, как работает код:

1. Определен класс TScreenVirus, который имеет свойства для интервала, цвета и радиуса, а также методы для запуска и остановки процесса заражения.
2. В конструкторе создается экземпляр класса TTimer и присваивается свойству FTimer. По умолчанию устанавливаются значения для интервала, цвета и радиуса.
3. Метод StartInfection просто включает таймер, который триггерит событие OnTimer.
4. Метод SetInterval обновляет значение свойства FInterval, если оно отличается от текущего значения. Это влияет на частоту распространения вируса (т.е., рисования новых точек).
5. Обработчик события OnTimer - это место, где происходит фактическое рисование:
   • Получает контекст устройства (hdcDesk) для рабочего стола с помощью функций GetWindowDC и GetDesktopWindow.
   • Создает кисть с указанным цветом.
   • Выбирает кисть как текущую кисть для контекста устройства.
   • Генерирует случайные координаты x и y в пределах экрана.
   • Рисует эллипс (красную точку) на этих координатах с помощью функции Ellipse.
   • Освобождает контекст устройства и освобождает кисть.

Код довольно прост, но есть несколько предложений:

1. Вам может быть полезно добавить способ остановки или паузы процесса заражения. Текущее состояние - это бесконечное выполнение, пока таймер не будет отключен.
2. Вы можете добавить некоторые эффекты анимации, такие как рост или уменьшение точек со временем.
3. Если вы планируете использовать этот код в производственной среде, вам может быть полезно реализовать правильную обработку ошибок и управление ресурсами (например, освобождение всех ресурсов, когда вирус будет уничтожен).

В целом, это интересный пример использования функций Windows API для создания интересных визуальных эффектов!

В статье описывается создание экранных вирусов в Delphi, который может заразить окно компьютера красными пятнами.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Монитор и Экран ::