unit lcdunit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
TimeIndicator: TLabel;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormDblClick(Sender: TObject);
procedure ScreenThread;
procedure Terminate;
procedure FormClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
{ Public declarations }
protected
procedure UpdateScreen(var WinMsg:TMessage); message WM_USER+1;
end;

const
adjust: Longint = 5;
var
Form1: TForm1;
start_freq: Longint;
freq: Longint;
Processing: Boolean;
screen_id: DWord;
Screen_Delay: Integer;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
DevMode: TDevMode;
begin
{ set form size to screen size }
Form1.Width := Screen.Width;
Form1.Height := Screen.Height;
{ bring window to foreground }
SetForegroundWindow(Handle);
SetActiveWindow(Application.Handle);
ShowCursor(false);
{ try to start screen frequency to be same as vertical refresh of monitor }
EnumDisplaySettings(nil, 0, DevMode);
if DevMode.dmDisplayFrequency = 0 then
start_freq := 16 { ms for 60hz }
else
start_freq := (1000 div DevMode.dmDisplayFrequency);
Processing := false;
end;

procedure TForm1.Terminate;
{ terminates all threads and then the application }
begin
Processing := false;
ShowCursor(True);
WaitForSingleObject(screen_id, INFINITE);
Application.Terminate;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key in [vk_up, vk_right] then
begin
if freq < 100 then
begin
inc(freq, adjust);
TimeIndicator.Caption := IntToStr(freq) + ' ms';
end;
TimeIndicator.Visible := true;
Timer1.Enabled := true;
end
else
if key in [vk_down, vk_left] then
begin
if freq-adjust > 0 then
begin
dec(freq, adjust);
TimeIndicator.Caption := IntToStr(freq) + ' ms';
end;
TimeIndicator.Visible := true;
Timer1.Enabled := true;
end
else
Terminate;
end;

procedure TForm1.UpdateScreen(var WinMsg:TMessage);
begin
Form1.Color := WinMsg.LParam;
TimeIndicator.Color := Form1.Color;
end;

procedure TForm1.ScreenThread;
{ process screen. Keep changing screen from Red -> Green -> Blue }
const
ColorList: array[1..3] of TColor = (clRed, clGreen, clBlue);
var
colortype: integer;
begin
sleep(1000); { to let the user see a pure black screen }
while Processing do
for colortype := 1 to 3 do
begin
PostMessage(Form1.Handle, WM_USER+1, 0, Integer(ColorList[colortype]));
sleep(freq);
end;
EndThread(0);
end;

procedure TForm1.FormDblClick(Sender: TObject);
begin
Memo1.Visible := false;
processing := true;
freq := start_freq;
TimeIndicator.Caption := IntToStr(freq) + ' ms';
TimeIndicator.Left := Screen.Width - TimeIndicator.Width - 50;
TimeIndicator.Top := Screen.Height - TimeIndicator.Height - 20;
BeginThread(nil, 0, Addr(TForm1.ScreenThread), nil, 0, screen_id);
end;

procedure TForm1.FormClick(Sender: TObject);
{ single click, we do not want to respond if we have not started processing
via double-click }
begin
if Processing then Terminate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
{ timer is triggered to make the TimeIndicator disappear after 2 seconds }
begin
TimeIndicator.Visible := false;
Timer1.Enabled := false;
end;

end.