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

Материал из DRKB

Как рисовать на экране[править | править код]

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

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

Сначала объявите глобальную переменную

Scr: TCanvas;

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

Scr := TCanvas.Create;
Scr.Handle := GetDC(HWND_DESKTOP);


По событию OnDestroy() такой:

Scr.Free;

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

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;


Source: http://delphiworld.narod.ru/
ID: 01866



Для этого надо воспользоваться функциями 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;


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


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



// Пример рисует две горизонтальные линии на экране используя 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.


Source: http://delphiworld.narod.ru/
ID: 01868