Переворачиваем рабочий стол
Falk0ner, вс, 06/07/2008 - 15:34.
Переворачиваем рабочий стол Автор: William Egge Весёлая программка, которая позволяет подшутить над Вашими друзьями:-]. Пример переворачивает десктоп и держит его в таком положение, до тех пор пока не кликнуть по нему мышкой. По мимо этого код содержит в себе довольно интересные моменты. В примере используется TDesktopCanvas, который получить доступ к десктопу через объект TCanvas. Так же в примере используется TQuickPixel, который позволяет увеличить скорость доступа к пикселям. Скачайте исходник, откомпилируйте его, и поместите программку в папку "Автозагрузка" на компьютере Вашего друга и смело идите по своим делам :-). Для завершения работы программки достаточно кликнуть по перевёрнутому экрану. А теперь давайте разберёмся с исходником: Класс TQuickPixel был сделан для быстрого доступа к пикселям, чтобы не возиться со строками развёртки. Для увеличения производительности, данный класс кэширует строки развёртки. Единственный недостаток данного класса заключается в том, что он устанавливает Ваш Bitmap в 24 бита. Ниже представлен собственно сам код TQuickPixel.
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 - в fsStayOn, а свойству WindowState задайте значение wsMaximized. Вынесите на форму компонент TImage, его свойство Align выставьте в alClient, по нажатию на TImage напишите:
Close;
Затем следующим образом опишите обработчик создания окна [событие OnCreate()]:
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.
procedure TForm1.FormCreate(Sender: TObject);
var
B: TBitmap;
Desktop: TDesktopCanvas;
QP: TQuickPixel;
X, Y: Integer;
EndCopyIndex: Integer;
Temp: TColor;
begin
Left:= 0;
:= 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;
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;
end;
Проверьте, все ли модули у вас подключены. Раздел uses должен выглядеть так:
var
B: TBitmap;
Desktop: TDesktopCanvas;
QP: TQuickPixel;
X, Y: Integer;
EndCopyIndex: Integer;
Temp: TColor;
begin
Left:= 0;
:= 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;
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;
end;
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, DesktopCanvas, QuickPixel;
Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, DesktopCanvas, QuickPixel;
http://delphiworld.narod.ru/ DelphiWorld 6.0
Отправить комментарий