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.