2008. október 24., péntek
Creating two horizontal lines on your screen? (TDesktopCanvas)
Problem/Question/Abstract:
How do I create lines (or whatever) on the screen?
Answer:
This program demonstrates a TDesktopCanvas. I wrote this to prepare my self for using Trinitron monitors :) The code parts are gathered from different parts of the www.
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 object }
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);
{ use this if you don't want to stop
repeat
ProcessMessage;
until false;
{}
Sleep(15000);
for i := 1 to YCount do
F[i].Free;
end.
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése