Author: Erwin Molendijk
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.
1 program TrinitronTraining;
2
3 uses
4 Messages, Windows, Graphics, Forms;
5
6 type
7 TDesktopCanvas = class(TCanvas)
8 private
9 DC: hDC;
10 function GetWidth: Integer;
11 function GetHeight: Integer;
12 public
13 constructor Create;
14 destructor Destroy; override;
15 published
16 property Width: Integer read GetWidth;
17 property Height: Integer read GetHeight;
18 end;
19
20 { TDesktopCanvas object }
21
22 function TDesktopCanvas.GetWidth: Integer;
23 begin
24 Result := GetDeviceCaps(Handle, HORZRES);
25 end;
26
27 function TDesktopCanvas.GetHeight: Integer;
28 begin
29 Result := GetDeviceCaps(Handle, VERTRES);
30 end;
31
32 constructor TDesktopCanvas.Create;
33 begin
34 inherited Create;
35 DC := GetDC(0);
36 Handle := DC;
37 end;
38
39 destructor TDesktopCanvas.Destroy;
40 begin
41 Handle := 0;
42 ReleaseDC(0, DC);
43 inherited Destroy;
44 end;
45
46 const
47 YCount = 2;
48
49 var
50 desktop: TDesktopCanvas;
51 dx, dy: Integer;
52 i: Integer;
53 F: array[1..YCount] of TForm;
54
55 function CreateLine(Y: Integer): TForm;
56 begin
57 Result := TForm.Create(Application);
58 with Result do
59 begin
60 Left := 0;
61 Top := y;
62 Width := dx;
63 Height := 1;
64 BorderStyle := bsNone;
65 FormStyle := fsStayOnTop;
66 Visible := True;
67 end;
68 end;
69
70 procedure ProcessMessage;
71 var
72 Msg: TMsg;
73 begin
74 if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
75 if Msg.message = WM_QUIT then
76 Application.Terminate;
77 end;
78
79 begin
80 desktop := TDesktopCanvas.Create;
81 try
82 dx := desktop.Width;
83 dy := desktop.Height div (YCount + 1);
84 finally
85 desktop.free;
86 end;
87 for i := 1 to YCount do
88 F[i] := CreateLine(i * dy);
89 Application.NormalizeTopMosts;
90 ShowWindow(Application.Handle, SW_Hide);
91
92 for i := 1 to YCount do
93 SetWindowPos(F[i].Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE + SWP_NOMOVE
94 +
95 SWP_NOSIZE);
96
97 { use this if you don't want to stop
98 repeat
99 ProcessMessage;
100 until false;
101 {}
102 Sleep(15000);
103
104 for i := 1 to YCount do
105 F[i].Free;
106 end.
|
