Переворачиваем рабочий стол

Весёлая программка, которая позволяет подшутить над Вашими друзьями:-]. Пример переворачивает десктоп и держит его в таком положение, до тех пор пока не кликнуть по нему мышкой. По мимо этого код содержит в себе довольно интересные моменты.

В примере используется TDesktopCanvas, который получить доступ к десктопу через объект TCanvas.

Так же в примере используется TQuickPixel, который позволяет увеличить скорость доступа к пикселям.

Скачайте исходник, откомпилируйте его, и поместите программку в папку "Автозагрузка" на компьютере Вашего друга и смело идите по своим делам :-).

Для завершения работы программки достаточно кликнуть по перевёрнутому экрану.

Класс TQuickPixel был сделан для быстрого доступа к пикселям, чтобы не возиться со строками развёртки. Для увеличения производительности, данный класс кэширует строки развёртки. Единственный недостаток данного класса заключается в том, что он устанавливает Ваш Bitmap в 24 бита.

Code:

unit QuickPixel;

interface

uses

Windows, Graphics;

type

TQuickPixel = class

private

FBitmap: TBitmap;

FScanLines: array of PRGBTriple;

function GetPixel(X, Y: Integer): TColor;

procedure SetPixel(X, Y: Integer; const Value: TColor);

function GetHeight: Integer;

function GetWidth: Integer;

public

constructor Create(const ABitmap: TBitmap);

property Pixel[X, Y: Integer]: TColor read GetPixel write SetPixel;

property Width: Integer read GetWidth;

property Height: Integer read GetHeight;

end;

implementation

{ TQuickPixel }

constructor TQuickPixel.Create(const ABitmap: TBitmap);

var

I: Integer;

begin

inherited Create;

FBitmap:= ABitmap;

FBitmap.PixelFormat:= pf24bit;

SetLength(FScanLines, FBitmap.Height);

for I:= 0 to FBitmap.Height-1 do

FScanLines[I]:= FBitmap.ScanLine[I];

end;

function TQuickPixel.GetHeight: Integer;

begin

Result:= FBitmap.Height;

end;

function TQuickPixel.GetPixel(X, Y: Integer): TColor;

var

P: PRGBTriple;

begin

P:= FScanLines[Y];

Inc(P, X);

Result:= (P^.rgbtBlue shl 16) or (P^.rgbtGreen shl 8) or P^.rgbtRed;

end;

function TQuickPixel.GetWidth: Integer;

begin

Result:= FBitmap.Width;

end;

procedure TQuickPixel.SetPixel(X, Y: Integer; const Value: TColor);

var

P: PRGBTriple;

begin

P:= FScanLines[Y];

Inc(P, X);

P^.rgbtBlue:= (Value and $FF0000) shr 16;

P^.rgbtGreen:= (Value and $00FF00) shr 8;

P^.rgbtRed:= Value and $0000FF;

end;

end.

Ну, надеюсь, вы с ним разобрались, перейдём же к самому проекту. Свойство окна BorderStyle установите в bsNone, свойство FormStyle - в fsStayOnTop, а свойству WindowState задайте значение wsMaximized. Вынесите на форму компонент TImage, его свойство Align выставьте в alClient, по нажатию на TImage напишите:

Затем следующим образом опишите обработчик создания окна [событие OnCreate()]:

Code:

procedure TForm1.FormCreate(Sender: TObject);

var

B: TBitmap;

Desktop: TDesktopCanvas;

QP: TQuickPixel;

X, Y: Integer;

EndCopyIndex: Integer;

Temp: TColor;

begin

Left:= 0;

Top:= 0;

Width:= Screen.Width;

Height:= Screen.Height;

B:= nil;

Desktop:= nil;

try

Desktop:= TDesktopCanvas.Create;

B:= TBitmap.Create;

B.Width:= Screen.Width;

B.Height:= Screen.Height;

B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height),

Desktop, Rect(0, 0, B.Width, B.Height));

B.PixelFormat:= pf24bit;

QP:= TQuickPixel.Create(B);

try

for Y:= 0 to (QP.Height div 2)-1 do

begin

EndCopyIndex:= (QP.Height-1)-Y;

for X:= 0 to QP.Width-1 do

begin

Temp:= QP.Pixel[X, Y];

QP.Pixel[X, Y]:= QP.Pixel[X, EndCopyIndex];

QP.Pixel[X, EndCopyIndex]:= Temp;

end;

finally

QP.Free;

end;

with Image1.Picture.Bitmap do

begin

Width:= Image1.Width;

Height:= Image1.Height;

Canvas.CopyRect(Rect(0, 0, Width, Height), B.Canvas,

Rect(0, 0, Width, Height));

end;

finally

B.Free;

Desktop.Free;

end;

Проверьте, все ли модули у вас подключены. Раздел uses должен выглядеть так: