unit MainUnit;
 
interface
 
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
Vcl.Samples.Spin, OutputManager, DuplicationManager, Threadmanager,
CommonTypes, CommonUnit;
 
type
 
TOutputLoopThread = class(TThread)
procedure Execute; override;
constructor CreateIt;
destructor Destroy; override;
public
UnexpectedErrorEvent: Thandle;
ExpectedErrorEvent: Thandle;
TerminateThreadsEvent: Thandle;
ThreadTerminatedEvent: Thandle;
HandleToWrite: Thandle;
SingleOutput: integer;
private
OutputCount: uint;
DeskBounds: TRECT;
FirstTime: boolean;
fThreadMsgReport: TThreadMsgReport;
ThreadMgr: TTHREADMANAGER;
DynamicWait: TDYNAMIC_WAIT;
procedure preMsgReport(errorMsg: String);
procedure OnMsgFromOtherThreads(Sender: TObject; Msg: String);
public
property OnThreadMsgReport: TThreadMsgReport read fThreadMsgReport
write fThreadMsgReport;
end;
 
TMainUnitFrm = class(TForm)
btStart: TButton;
Memo: TMemo;
lblReport: TLabel;
pnViewer: TPanel;
lblViewer: TLabel;
btStop: TButton;
chkDupAllOutputs: TCheckBox;
spnOutput: TSpinEdit;
lblOutput: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btStartClick(Sender: TObject);
procedure btStopClick(Sender: TObject);
procedure chkDupAllOutputsClick(Sender: TObject);
private
SingleOutput: integer;
UnexpectedErrorEvent: Thandle;
ExpectedErrorEvent: Thandle;
TerminateThreadsEvent: Thandle;
ThreadTerminatedEvent: Thandle;
OutputLoopThread: TOutputLoopThread;
FWndProcPrevious: TFNWndProc;
FWndProcInstanceStub: pointer;
panelDefaultBackground: TBitmap;
procedure PanelProcSubClassed(var Msg: TMessage);
procedure blockStartButton;
procedure OnThreadMsgReport(Sender: TObject; Msg: String);
end;
 
var
MainUnitFrm: TMainUnitFrm;
Occluded: boolean = false;
HandledOnemsg: boolean = false;
OutMgr: TOutputManager = nil;
 
implementation
 
{$R *.dfm}
 
procedure TMainUnitFrm.blockStartButton;
begin
btStart.Enabled := false;
end;
 
procedure TMainUnitFrm.btStartClick(Sender: TObject);
begin
btStop.Enabled := true;
btStart.Enabled := false;
if chkDupAllOutputs.Checked then
SingleOutput := -1
else
SingleOutput := spnOutput.Value;
if OutMgr = nil then
OutMgr := TOutputManager.Create
else
begin
OutMgr.Free;
OutMgr.Create;
end;
OutputLoopThread := TOutputLoopThread.CreateIt;
with OutputLoopThread do
begin
HandleToWrite := pnViewer.Handle;
SingleOutput := self.SingleOutput;
OnThreadMsgReport := self.OnThreadMsgReport;
UnexpectedErrorEvent := self.UnexpectedErrorEvent;
ExpectedErrorEvent := self.ExpectedErrorEvent;
TerminateThreadsEvent := self.TerminateThreadsEvent;
ThreadTerminatedEvent := self.ThreadTerminatedEvent;
FreeOnTerminate := true;
Start;
end;
Memo.Lines.Add('Output Thread Started');
end;
 
procedure TMainUnitFrm.btStopClick(Sender: TObject);
begin
OutputLoopThread.Terminate;
WaitForSingleObjectEx(ThreadTerminatedEvent, 1000, false);
application.ProcessMessages;
FreeAndNil(OutMgr);
btStart.Enabled := true;
btStop.Enabled := false;
resetEvent(TerminateThreadsEvent);
end;
 
procedure TMainUnitFrm.chkDupAllOutputsClick(Sender: TObject);
begin
spnOutput.Enabled := not chkDupAllOutputs.Checked;
end;
 
procedure TMainUnitFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(panelDefaultBackground);
if UnexpectedErrorEvent <> 0 then
closehandle(UnexpectedErrorEvent);
if ExpectedErrorEvent <> 0 then
closehandle(ExpectedErrorEvent);
if TerminateThreadsEvent <> 0 then
closehandle(TerminateThreadsEvent);
if ThreadTerminatedEvent <> 0 then
closehandle(ThreadTerminatedEvent);
if OutMgr <> nil then
OutMgr.Free;
if FWndProcPrevious <> nil then
begin
SetWindowlong(pnViewer.Handle, GWL_WNDPROC, NativeInt(FWndProcPrevious));
FreeObjectInstance(FWndProcInstanceStub);
FWndProcPrevious := nil;
FWndProcInstanceStub := nil;
end;
end;
 
procedure TMainUnitFrm.FormCreate(Sender: TObject);
begin
if not(((AWWinVerVIx.dwMajorVersion = 6) and (AWWinVerVIx.dwMinorVersion >= 2)
) or (AWWinVerVIx.dwMajorVersion > 6)) then
begin
showmessage('Required Windows 8 or higher');
application.Terminate;
end;
 
UnexpectedErrorEvent := CreateEvent(nil, true, false, nil);
if UnexpectedErrorEvent = 0 then
begin
Memo.Lines.Add('UnexpectedErrorEvent creation failed');
blockStartButton();
end;
ExpectedErrorEvent := CreateEvent(nil, true, false, nil);
if ExpectedErrorEvent = 0 then
begin
Memo.Lines.Add('ExpectedErrorEvent creation failed');
blockStartButton();
end;
TerminateThreadsEvent := CreateEvent(nil, true, false, nil);
if TerminateThreadsEvent = 0 then
begin
Memo.Lines.Add('TerminateThreadsEvent creation failed');
blockStartButton();
end;
ThreadTerminatedEvent := CreateEvent(nil, false, false, nil);
if ThreadTerminatedEvent = 0 then
begin
Memo.Lines.Add('ThreadTerminatedEvent creation failed');
blockStartButton();
end;
panelDefaultBackground := TBitmap.Create;
panelDefaultBackground.Canvas.Brush.Color := clBtnFace;
panelDefaultBackground.PixelFormat := pf32bit;
FWndProcPrevious := TFNWndProc(GetWindowLong(pnViewer.Handle, GWL_WNDPROC));
FWndProcInstanceStub := MakeObjectInstance(PanelProcSubClassed);
SetWindowlong(pnViewer.Handle, GWL_WNDPROC, NativeInt(FWndProcInstanceStub));
end;
 
procedure TMainUnitFrm.OnThreadMsgReport(Sender: TObject; Msg: String);
begin
Memo.Lines.Add(Msg);
end;
 
procedure TMainUnitFrm.PanelProcSubClassed(var Msg: TMessage);
begin
if Msg.Msg = OCCLUSION_STATUS_MSG then
begin
Occluded := true;
end
else if Msg.Msg = WM_SIZE then
begin
if OutMgr <> nil then
begin
OutMgr.WindowResize();
end;
end;
HandledOnemsg := true;
Msg.Result := CallWindowProc(FWndProcPrevious, pnViewer.Handle, Msg.Msg,
Msg.WParam, Msg.LParam);
end;
 
{ TOutputLoopThread }
 
constructor TOutputLoopThread.CreateIt;
begin
inherited Create(true);
end;
 
destructor TOutputLoopThread.Destroy;
begin
inherited;
end;
 
procedure TOutputLoopThread.Execute;
var
Ret: TDUPL_RETURN;
SharedHandle: Thandle;
begin
ThreadMgr := TTHREADMANAGER.Create;
ThreadMgr.OnMsgReport := OnMsgFromOtherThreads;
DynamicWait := TDYNAMIC_WAIT.Create;
FirstTime := true;
Occluded := true;
try
while not terminated do
begin
Ret := DUPL_RETURN_SUCCESS;
if Occluded or HandledOnemsg then
begin
if Occluded then
begin
Occluded := false;
end
else
begin
HandledOnemsg := false;
end
end
else if WaitForSingleObjectEx(UnexpectedErrorEvent, 0, false) = WAIT_OBJECT_0
then
begin
preMsgReport('LoopThread - UnexpectedErrorEvent');
break;
end
else if FirstTime or (WaitForSingleObjectEx(ExpectedErrorEvent, 0, false)
= WAIT_OBJECT_0) then
begin
if not FirstTime then
begin
SetEvent(TerminateThreadsEvent);
ThreadMgr.WaitForThreadTermination();
resetEvent(TerminateThreadsEvent);
resetEvent(ExpectedErrorEvent);
ThreadMgr.Clean();
OutMgr.CleanRefs();
DynamicWait.Wait();
end
else
FirstTime := false;
Ret := OutMgr.InitOutput(HandleToWrite, SingleOutput, OutputCount,
DeskBounds);
if Ret = DUPL_RETURN_SUCCESS then
begin
SharedHandle := OutMgr.getSharedHandle;
if SharedHandle <> 0 then
begin
Ret := ThreadMgr.Initialize(SingleOutput, OutputCount,
UnexpectedErrorEvent, ExpectedErrorEvent, TerminateThreadsEvent,
SharedHandle, @DeskBounds);
end
else
begin
preMsgReport('Failed to get handle of shared surface');
Ret := DUPL_RETURN_ERROR_UNEXPECTED;
end;
end;
Occluded := true;
end
else
begin
if not Occluded then
Ret := OutMgr.UpdateApplicationWindow(ThreadMgr.GetPointerInfo(),
Occluded);
end;
if Ret <> DUPL_RETURN_SUCCESS then
begin
if Ret = DUPL_RETURN_ERROR_EXPECTED then
SetEvent(ExpectedErrorEvent)
else
break;
end;
if terminated then
preMsgReport('Received Terminate');
end;
finally
if SetEvent(TerminateThreadsEvent) then
ThreadMgr.WaitForThreadTermination;
SetEvent(ThreadTerminatedEvent);
DynamicWait.Free;
ThreadMgr.Free;
end;
ReturnValue := 0;
end;
 
procedure TOutputLoopThread.OnMsgFromOtherThreads(Sender: TObject; Msg: String);
begin
preMsgReport(Msg);
end;
 
procedure TOutputLoopThread.preMsgReport(errorMsg: String);
begin
queue(
procedure
begin
if assigned(fThreadMsgReport) then
fThreadMsgReport(self, errorMsg);
end);
end;
 
end.