Delphi

Софта я написал немало. Если б он ещё работал в придачу… =)

На 8 марта очень оригинально будет послать это поздравление.

Работает, открывается, но фиг потом закроешь.

Более того, CD-дисковод вылезает и ни в какую не хочет обратно.

Диспетчер задач подавляется.

Жаль, работает только при разрешении 1280Х960 и выше.

Листингформы:

object Form1: TForm1

  Left = 192

  Top = 114

  BorderStyle = bsNone

  Caption = 'Form1'

  ClientHeight = 566

  ClientWidth = 862

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object MediaPlayer1: TMediaPlayer

    Left = 8

    Top = 8

    Width = 253

    Height = 30

    DeviceType = dtCDAudio

    TabOrder = 0

  end

  object Timer1: TTimer

    OnTimer = Button1Click

    Left = 8

  end

end

Листингтекста:

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls, MPlayer;

type

  TForm1 = class(TForm)

    Timer1: TTimer;

    procedure Button1Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

impluentation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);  {этапроцедура – всвойстве OnTimer объекта TTimer}

var c:tcanvas;     {монитор}

b:TBitmap;         {картинка-цветок}

begin

MediaPlayer1.Eject;          {Вытаскиваниепривода}

c:=TCanvas.Create; {создание переменных}

b:=TBitmap.Create;

c.Handle:=GetDc(hwnd_desktop); {Подключение монитора}

{Рисование}

b.LoadFromFile('kart.bmp');   {В объект TBitmap загружен рисунок kart.bmp}

c.Brush.Color:=clblack;

c.Rectangle(-1,-1, 10000,10000); {Заполнение экрана}

c.Draw(20,20,b);                 {Вывод рисунка}

c.Brush.Style:=bsClear;          {Вывод надписи}

c.Font.Color:=clwhite;

c.Font.Size:=24;

c.TextOut(20, 840, 'Все цветы мира - нашим женщинам!');

ReleaseDc(c.handle, hwnd_desktop); {Отключение монитора}          

c.Free;                            {Очистка памяти}

b.free;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

hide {форма не должна быть видна}

MediaPlayer1.Open; {Открытие CD-привода}

end;

end.

Скачать exe-модуль

Скачать исходник

P.S. Если вы хотите ухудшить участь того, кому посылаете, уменьшите свойство Interval объекта Timer1.