Как рисовать на экране

Обладая такими способностями, вы сможете, например, разлиновать поверхность экрана как в тетради в клеточку, выводить пугающие пользователя надписи и даже создать эффект окаменение экрана, если, конечно, разработаете алгоритм выполнения данной задачи.

Я покажу как рисовать на экране на примере разлиновки:

Затем по событию OnCreate() для формы напишите такой код:

Обработчик события по нажатию на кнопку пусть выглядит так:

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

i: integer;

begin

i := 0;

while i < 1024 do

begin

with Scr do

begin

MoveTo(i, 0);

LineTo(i, 768);

i := i + 10;

end;

i := 0;

while i < 768 do

begin

with Scr do

begin

MoveTo(0, i);

LineTo(1024, i);

i := i + 10;

end;

Button1.Refresh;

end;

Для этого надо воспользоваться функциями API. Получить контекст чужого окна, либо всего экрана:

где Wnd - указатель на нужное окно, или 0 для получения контекста всего экрана. И далее, пользуясь функциями API, нарисовать все что надо.

Не забывайте после своих манипуляций посылать пострадавшим (или всем) окнам сообщение о необходимости перерисовки, для восстановления их первоначального вида.

Code:

// Пример рисует две горизонтальные линии на экране используя TDesktopCanvas.

program TrinitronTraining;

uses

Messages, Windows, Graphics, Forms;

type

TDesktopCanvas = class(TCanvas)

private

DC : hDC;

function GetWidth:Integer;

function GetHeight:Integer;

public

constructor Create;

destructor Destroy; override;

published

property Width: Integer read GetWidth;

property Height: Integer read GetHeight;

end;

{ Объект TDesktopCanvas }

function TDesktopCanvas.GetWidth:Integer;

begin

Result:=GetDeviceCaps(Handle,HORZRES);

end;

function TDesktopCanvas.GetHeight:Integer;

begin

Result:=GetDeviceCaps(Handle,VERTRES);

end;

constructor TDesktopCanvas.Create;

begin

inherited Create;

DC := GetDC(0);

Handle := DC;

end;

destructor TDesktopCanvas.Destroy;

begin

Handle := 0;

ReleaseDC(0, DC);

inherited Destroy;

end;

const

YCount = 2;

var

desktop : TDesktopCanvas;

dx,dy : Integer;

i : Integer;

F : array[1..YCount] of TForm;

function CreateLine(Y : Integer) : TForm;

begin

Result := TForm.Create(Application);

with Result do begin

Left := 0;

Top := y;

Width := dx;

Height := 1;

BorderStyle := bsNone;

FormStyle := fsStayOnTop;

Visible := True;

end;

procedure ProcessMessage;

var

Msg : TMsg;

begin

if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then

if Msg.message = WM_QUIT then

Application.Terminate;

end;

begin

desktop := TDesktopCanvas.Create;

try

dx := desktop.Width;

dy := desktop.Height div (YCount+1);

finally

desktop.free;

end;

for i:=1 to YCount do

F[i]:=CreateLine(i*dy);

Application.NormalizeTopMosts;

ShowWindow(Application.Handle, SW_Hide);

for i:=1 to YCount do

SetWindowPos(F[i].Handle, HWND_TOPMOST, 0,0,0,0, SWP_NOACTIVATE+SWP_NOMOVE+SWP_NOSIZE);

{

следующие строки используются для того, чтобы не останавливаться

repeat

ProcessMessage;

until false;

}

Sleep(15000);

for i:=1 to YCount do

F[i].Free;

end.