Как рисовать на экране
Falk0ner, вс, 06/07/2008 - 15:34.
Не забывайте после своих манипуляций посылать пострадавшим (или всем) окнам сообщение о необходимости перерисовки, для восстановления их первоначального вида.
Взято из http://forum.sources.ru
Как рисовать на экране Обладая такими способностями, вы сможете, например, разлиновать поверхность экрана как в тетради в клеточку, выводить пугающие пользователя надписи и даже создать эффект окаменение экрана, если, конечно, разработаете алгоритм выполнения данной задачи. Я покажу как рисовать на экране на примере разлиновки: Сначала объявите глобальную переменную Scr: TCanvas; Затем по событию OnCreate() для формы напишите такой код:
Scr := TCanvas.Create;
Scr.Handle := GetDC(HWND_DESKTOP);
По событию OnDestroy() такой:
Scr.Free;
Обработчик события по нажатию на кнопку пусть выглядит так:
Scr.Handle := GetDC(HWND_DESKTOP);
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;
end;
i := 0;
while i < 768 do
begin
with Scr do
begin
MoveTo(0, i);
LineTo(1024, i);
i := i + 10;
end;
end;
Button1.Refresh;
end;
http://delphiworld.narod.ru/
DelphiWorld 6.0
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;
end;
i := 0;
while i < 768 do
begin
with Scr do
begin
MoveTo(0, i);
LineTo(1024, i);
i := i + 10;
end;
end;
Button1.Refresh;
end;
Для этого надо воспользоваться функциями API. Получить контекст чужого окна, либо всего экрана:
function GetDC(Wnd: HWnd): HDC;
где Wnd - указатель на нужное окно, или 0 для получения контекста всего экрана. И далее, пользуясь функциями API, нарисовать все что надо.
procedure DrawOnScreen;
var
ScreenDC: hDC;
begin
ScreenDC := GetDC(0); {получить контекст экрана}
Ellipse(ScreenDC, 0, 0, 200, 200); {нарисовать}
ReleaseDC(0, ScreenDC); {освободить контекст}
end;
var
ScreenDC: hDC;
begin
ScreenDC := GetDC(0); {получить контекст экрана}
Ellipse(ScreenDC, 0, 0, 200, 200); {нарисовать}
ReleaseDC(0, ScreenDC); {освободить контекст}
end;
Не забывайте после своих манипуляций посылать пострадавшим (или всем) окнам сообщение о необходимости перерисовки, для восстановления их первоначального вида.
Взято из http://forum.sources.ru
// Пример рисует две горизонтальные линии на экране используя 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;
:= y;
Width := dx;
Height := 1;
BorderStyle := bsNone;
FormStyle := fsStayOn;
Visible := True;
end;
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.NormalizeMosts;
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.
http://delphiworld.narod.ru/
DelphiWorld 6.0
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;
:= y;
Width := dx;
Height := 1;
BorderStyle := bsNone;
FormStyle := fsStayOn;
Visible := True;
end;
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.NormalizeMosts;
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.
Отправить комментарий