Delphi World - Как рисовать линии (или ещё что-нибудь) на экране (TDesktopCanvas)
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Как рисовать линии (или ещё что-нибудь) на экране (TDesktopCanvas)


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

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования