Как рисовать линии (или ещё что-нибудь) на экране (TDesktopCanvas)

Previous  Top  Next

    
 

 

 

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;

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.

 

 

 

©Drkb::03732

Взято из http://forum.sources.ru