LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  A Platform specific full-screen viewer.
6

7
  Note: Eng: Lazarus has problems with minimizing and normalizing windows.
8
  See code DoAvtivate DoDeactivate. Tests were conducted on
9
  Lazarus 0.9.29.24627. If these problems are fixed in future versions
10
  of FPC / Lazarus, you can safely remove work-arounds.
11
  Note: Linux still has problems intercepting mouse events and problems
12
  with DoActivate DoDeactivate.
13
  Ru(CP1251)
14
  Â ëàçàðóñå åñòü ïðîáëåìû ìèíèìèçàöèè - íîðìàëèçàöèè îêíà.
15
  Ñìîòðè êîä DoAvtivate DoDeactivate.
16
  Òåñòû ïðîâîäèëèñü íà ëàçàðóñå 0.9.29.24627.
17
   ñëó÷àå óñòðàíåíèÿ ïðîáëåì â ëàçàðóñå,
18
  óäàëèòå êîä ëàçàðóñà îñòàâèâ òîò êîòîðûé äëÿ äåëôè.
19
  Ìîäóëü åùå íå çàêîí÷åí!  ëèíóêñå åñòü ïðîáëåìû ïåðåõâàòà ìûøè
20
  è ïðîáëåìû ñ DoActivate DoDeactivate.
21

22
   History :  
23
   22/08/10 - DaStr - Restored backward-compatibility after previous changes
24
   11/06/10 - Yar - Fixed uses section after lazarus-0.9.29.26033 release
25
   28/04/10 - Yar - Merged GLFullScreenViewer and GLWin32FullScreenViewer into one unit
26
  (by Rustam Asmandiarov aka Predator)
27
   08/04/10 - Yar - Added more UNIX compatibility (thanks Rustam Asmandiarov aka Predator)
28
   07/01/10 - DaStr - Added UNIX compatibility (thanks Predator)
29
   07/11/09 - DaStr - Added to main GLScene CVS repository (from GLScene-Lazarus)
30
   24/07/03 - EG - Creation from GLWin32Viewer split
31
   
32
}
33
unit GLFullScreenViewer;
34

35
interface
36

37
{$I GLScene.inc}
38

39
uses
40
  Forms, Controls, Menus,
41
  Classes, Messages, GLViewer, GLScene, GLContext,LcLtype, LCLIntf
42
{$IFDEF MSWindows}
43
    , Windows
44
{$ENDIF}
45
    ;
46

47
type
48

49
  // TGLScreenDepth
50
  //
51
  TGLScreenDepth = (sd8bits, sd16bits, sd24bits, sd32bits);
52

53
  // TGLFullScreenViewer
54
  //
55
  { : A FullScreen viewer.
56
    This non visual viewer will, when activated, use the full screen as rendering
57
    surface. It will also switch/restore videomode depending on the required
58
    width/height. 
59
    This is performed by creating an underlying TForm and using its surface
60
    for rendering OpenGL, "decent" ICDs will automatically use PageFlipping
61
    instead of BlockTransfer (slower buffer flipping mode used for windowed
62
    OpenGL). 
63
    Note: if you terminate the application either via a kill or in the IDE,
64
    the original resolution isn't restored. }
65
  TGLFullScreenViewer = class(TGLNonVisualViewer)
66
  private
67
     
68
    FFormIsOwned: Boolean;
69
    FForm: TForm;
70
    FOwnDC: HWND;
71
    FScreenDepth: TGLScreenDepth;
72
    FActive: Boolean;
73
    FSwitchedResolution: Boolean;
74
    FManualRendering: Boolean;
75
    FUpdateCount: Integer;
76
    FOnMouseDown: TMouseEvent;
77
    FOnMouseUp: TMouseEvent;
78
    FOnMouseMove: TMouseMoveEvent;
79
    FOnMouseWheel: TMouseWheelEvent;
80
    FOnMouseWheelDown: TMouseWheelUpDownEvent;
81
    FOnMouseWheelUp: TMouseWheelUpDownEvent;
82
    FOnClick, FOnDblClick: TNotifyEvent;
83
    FOnKeyDown: TKeyEvent;
84
    FOnKeyUp: TKeyEvent;
85
    FOnKeyPress: TKeyPressEvent;
86
    FOnClose: TCloseEvent;
87
    FOnCloseQuery: TCloseQueryEvent;
88
    FStayOnTop: Boolean;
89
    FVSync: TVSyncMode;
90
    FRefreshRate: Integer;
91
    FCursor: TCursor;
92
    FPopupMenu: TPopupMenu;
93
    procedure SetScreenDepth(const val: TGLScreenDepth);
94
    procedure SetActive(const val: Boolean);
95
    procedure SetOnMouseDown(const val: TMouseEvent);
96
    procedure SetOnMouseUp(const val: TMouseEvent);
97
    procedure SetOnMouseMove(const val: TMouseMoveEvent);
98
    procedure SetOnMouseWheel(const val: TMouseWheelEvent);
99
    procedure SetOnMouseWheelDown(const val: TMouseWheelUpDownEvent);
100
    procedure SetOnMouseWheelUp(const val: TMouseWheelUpDownEvent);
101
    procedure SetOnClick(const val: TNotifyEvent);
102
    procedure SetOnDblClick(const val: TNotifyEvent);
103
    procedure SetOnCloseQuery(const val: TCloseQueryEvent);
104
    procedure SetOnClose(const val: TCloseEvent);
105
    procedure SetOnKeyUp(const val: TKeyEvent);
106
    procedure SetOnKeyDown(const val: TKeyEvent);
107
    procedure SetOnKeyPress(const val: TKeyPressEvent);
108
    procedure SetStayOnTop(const val: Boolean);
109
    procedure SetCursor(const val: TCursor);
110
    procedure SetPopupMenu(const val: TPopupMenu);
111
    procedure SetForm(aVal: TForm);
112
    procedure SetManualRendering(const val: Boolean);
113
  protected
114
     
115
    function GetHandle: HWND;
116

117
    procedure DoBeforeRender(Sender: TObject);
118
    procedure DoBufferChange(Sender: TObject); override;
119
    procedure DoBufferStructuralChange(Sender: TObject); override;
120

121
    procedure Startup;
122
    procedure Shutdown;
123
    procedure BindFormEvents;
124
    procedure DoCloseQuery(Sender: TObject; var CanClose: Boolean);
125
    procedure DoPaint(Sender: TObject);
126
    procedure DoActivate(Sender: TObject);
127
    procedure DoDeactivate(Sender: TObject);
128
    procedure DoFormDestroy(Sender: TObject);
129
  public
130
     
131
    constructor Create(AOwner: TComponent); override;
132
    destructor Destroy; override;
133

134
    procedure Render(baseObject: TGLBaseSceneObject = nil); override;
135

136
    { : Adjusts property so that current resolution will be used.
137
      Call this method if you want to make sure video mode isn't switched. }
138
    procedure UseCurrentResolution;
139

140
    procedure BeginUpdate;
141
    procedure EndUpdate;
142

143
    { : Activates/deactivates full screen mode. }
144
    property Active: Boolean read FActive write SetActive;
145

146
    procedure ReActivate;
147
    { : Read access to the underlying form handle.
148
      Returns 0 (zero) if the viewer is not active or has not yet
149
      instantiated its form. }
150
    property Handle: HWND read GetHandle;
151

152
    procedure Notification(AComponent: TComponent;
153
      Operation: TOperation); override;
154

155
    function LastFrameTime: Single;
156
    function FramesPerSecond: Single;
157
    function FramesPerSecondText(decimals: Integer = 1): String;
158
    procedure ResetPerformanceMonitor;
159

160
    property RenderDC: HWND read FOwnDC;
161
  published
162
     
163
    property Form: TForm read FForm write SetForm;
164

165
    property ManualRendering: Boolean read FManualRendering
166
      write SetManualRendering;
167

168
    // It is not used in UNIX
169
    { : Requested ScreenDepth. }
170
    property ScreenDepth: TGLScreenDepth read FScreenDepth write SetScreenDepth
171
      default sd32bits;
172

173
    { : Specifies if the underlying form is "fsStayOnTop".
174
      The benefit of StayOnTop is that it hides the windows bar and
175
      other background windows. The "fsStayOnTop" is automatically
176
      switched off/on when the underlying form loses/gains focus.
177
      It is recommended not to use StayOnTop while running in the IDE
178
      or during the debugging phase. }
179
    property StayOnTop: Boolean read FStayOnTop write SetStayOnTop
180
      default False;
181

182
    { : Specifies if the refresh should be synchronized with the VSync signal.
183
      If the underlying OpenGL ICD does not support the WGL_EXT_swap_control
184
      extension, this property is ignored. }
185
    property VSync: TVSyncMode read FVSync write FVSync default vsmSync;
186
    { : Screen refresh rate.
187
      Use zero for system default. This property allows you to work around
188
      the winxp bug that limits uses a refresh rate of 60hz when changeing
189
      resolution. it is however suggested to give the user the opportunity
190
      to adjust it instead of having a fixed value (expecially beyond
191
      75hz or for resolutions beyond 1024x768).
192
      the value will be automatically clamped to the highest value
193
      *reported* compatible with the monitor. }
194
    property RefreshRate: Integer read FRefreshRate write FRefreshRate;
195

196
    property Cursor: TCursor read FCursor write SetCursor default crDefault;
197
    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
198

199
    property OnClose: TCloseEvent read FOnClose write SetOnClose;
200
    property OnKeyUp: TKeyEvent read FOnKeyUp write SetOnKeyUp;
201
    property OnKeyDown: TKeyEvent read FOnKeyDown write SetOnKeyDown;
202
    property OnKeyPress: TKeyPressEvent read FOnKeyPress write SetOnKeyPress;
203
    property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery
204
      write SetOnCloseQuery;
205
    property OnClick: TNotifyEvent read FOnClick write SetOnClick;
206
    property OnDblClick: TNotifyEvent read FOnDblClick write SetOnDblClick;
207
    property OnMouseDown: TMouseEvent read FOnMouseDown write SetOnMouseDown;
208
    property OnMouseUp: TMouseEvent read FOnMouseUp write SetOnMouseUp;
209
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove
210
      write SetOnMouseMove;
211
    property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel
212
      write SetOnMouseWheel;
213
    property OnMouseWheelDown: TMouseWheelUpDownEvent read FOnMouseWheelDown
214
      write SetOnMouseWheelDown;
215
    property OnMouseWheelUp: TMouseWheelUpDownEvent read FOnMouseWheelUp
216
      write SetOnMouseWheelUp;
217
  end;
218

219
procedure Register;
220

221
// ------------------------------------------------------------------
222
// ------------------------------------------------------------------
223
// ------------------------------------------------------------------
224
implementation
225

226
// ------------------------------------------------------------------
227
// ------------------------------------------------------------------
228
// ------------------------------------------------------------------
229

230
uses OpenGLTokens, OpenGLAdapter, SysUtils, GLCrossPlatform, GLScreen
231

232
 {$IFDEF Linux}
233
   {$IFDEF LCLGTK2}
234
    , gtk2proc
235
   {$ENDIF}
236
   {$IFDEF LCLGTK}
237
    , gtkproc
238
   {$ENDIF}
239
 {$ENDIF} //Linux
240
 {$IF DEFINED(LCLWIN32) or DEFINED(LCLWIN64)}
241
   {$IFNDEF CONTEXT_INCLUDED}
242
    , GLWidgetContext
243
     {$DEFINE CONTEXT_INCLUDED}
244
   {$ENDIF}
245
 {$IFEND}
246
 {$IF DEFINED(LCLGTK) or DEFINED(LCLGTK2)}
247
   {$IFNDEF CONTEXT_INCLUDED}
248
    , GLWidgetContext
249
     {$DEFINE CONTEXT_INCLUDED}
250
   {$ENDIF}
251
 {$IFEND}
252
 {$IFDEF LCLCARBON}
253
    , GLCarbonContext
254
 {$ENDIF}
255
 {$IFDEF LCLQT}
256
   {$ERROR unimplemented QT context}
257
 {$ENDIF}
258

259
    ;
260

261
const
262
  cScreenDepthToBPP: array [sd8bits .. sd32bits] of Integer = (8, 16, 24, 32);
263

264
procedure Register;
265
begin
266
  RegisterComponents('GLScene', [TGLFullScreenViewer]);
267
end;
268

269
// ------------------
270
// ------------------ TGLFullScreenViewer ------------------
271
// ------------------
272

273
// Create
274
//
275
constructor TGLFullScreenViewer.Create(AOwner: TComponent);
276
begin
277
  inherited Create(AOwner);
278
  Width := 800;
279
  Height := 600;
280
  FScreenDepth := sd32bits;
281
  FVSync := vsmSync;
282
  FCursor := crDefault;
283
  Buffer.ViewerBeforeRender := DoBeforeRender;
284
end;
285

286
// Destroy
287
//
288
destructor TGLFullScreenViewer.Destroy;
289
begin
290
  Active := False;
291
  inherited Destroy;
292
end;
293

294
// DoBeforeRender
295
//
296
procedure TGLFullScreenViewer.DoBeforeRender(Sender: TObject);
297
begin
298
  SetupVSync(VSync);
299
end;
300

301
// DoBufferChange
302
//
303
procedure TGLFullScreenViewer.DoBufferChange(Sender: TObject);
304
begin
305
  if Assigned(FForm) and (not Buffer.Rendering) then
306
  begin
307
    Buffer.Render;
308
  end;
309
end;
310

311
// DoBufferStructuralChange
312
//
313
procedure TGLFullScreenViewer.DoBufferStructuralChange(Sender: TObject);
314
begin
315
  if Active and (FUpdateCount = 0) then
316
    ReActivate
317
end;
318

319
// Render
320
//
321
procedure TGLFullScreenViewer.Render(baseObject: TGLBaseSceneObject = nil);
322
begin
323
  Buffer.Render(baseObject);
324
end;
325

326
// BeginUpdate
327
//
328
procedure TGLFullScreenViewer.BeginUpdate;
329
begin
330
  Inc(FUpdateCount);
331
end;
332

333
// EndUpdate
334
//
335
procedure TGLFullScreenViewer.EndUpdate;
336
begin
337
  Dec(FUpdateCount);
338
  if FUpdateCount = 0 then
339
  begin
340
    if Active then
341
      DoBufferStructuralChange(Self)
342
  end
343
  else if FUpdateCount < 0 then
344
  begin
345
    FUpdateCount := 0;
346
    Assert(False, 'Unbalanced Begin/EndUpdate');
347
  end;
348
end;
349

350
procedure TGLFullScreenViewer.ReActivate;
351
begin
352
  Shutdown;
353
  Startup;
354
end;
355

356
procedure TGLFullScreenViewer.Notification(AComponent: TComponent;
357
  Operation: TOperation);
358
begin
359
  if (Operation = opRemove) and (Buffer <> nil) then
360
  begin
361
    if (AComponent = Buffer.Camera) then
362
      Buffer.Camera := nil;
363
    Active := False;
364
    if (AComponent = FForm) then
365
    begin
366
      Active := False;
367
      Form := nil;
368
    end;
369
  end;
370
  inherited Notification(AComponent, Operation);
371
end;
372

373
function TGLFullScreenViewer.LastFrameTime: Single;
374
begin
375
  Result := Buffer.LastFrameTime;
376
end;
377

378
function TGLFullScreenViewer.FramesPerSecond: Single;
379
begin
380
  Result := Buffer.FramesPerSecond;
381
end;
382

383
function TGLFullScreenViewer.FramesPerSecondText(decimals: Integer): String;
384
begin
385
  Result := Format('%.*f FPS', [decimals, Buffer.FramesPerSecond]);
386
end;
387

388
procedure TGLFullScreenViewer.ResetPerformanceMonitor;
389
begin
390
  Buffer.ResetPerformanceMonitor;
391
end;
392

393
// UseCurrentResolution
394
//
395
procedure TGLFullScreenViewer.UseCurrentResolution;
396
begin
397
  BeginUpdate;
398
  try
399
    Width := Screen.Width;
400
    Height := Screen.Height;
401
    case GetCurrentColorDepth of
402
      24:
403
        ScreenDepth := sd24bits;
404
      16:
405
        ScreenDepth := sd16bits;
406
      8:
407
        ScreenDepth := sd8bits;
408
    else
409
      // highest depth possible otherwise
410
      ScreenDepth := sd32bits;
411
    end;
412
  finally
413
    EndUpdate;
414
  end;
415
end;
416

417
// SetActive
418
//
419
procedure TGLFullScreenViewer.SetActive(const val: Boolean);
420
begin
421
  if val <> FActive then
422
  begin
423

424
    // Alt+Tab delayed until better times
425
    // {$IFDEF MSWindows}
426
    // Application.OnDeactivate:=DoDeActivate;
427
    // Application.OnActivate:=DoActivate;
428
    // {$ENDIF}
429

430
    if val then
431
      Startup
432
    else
433
      Shutdown;
434
  end;
435
end;
436

437
// Startup
438
//
439
procedure TGLFullScreenViewer.Startup;
440
var
441
  res: TResolution;
442
begin
443
  if FActive then
444
    Exit;
445

446
  if FForm = nil then
447
  begin
448
    FFormIsOwned := True;
449
    FForm := TForm.Create(nil);
450
    FForm.Show();
451
  end
452
  else
453
    FFormIsOwned := False;
454

455
  with FForm do
456
  begin
457
    If BorderStyle <> bsNone then
458
      BorderStyle := bsNone;
459
    Cursor := Self.Cursor;
460
    PopupMenu := Self.PopupMenu;
461
    Left := 0;
462
    Top := 0;
463
    ClientWidth := Self.Width;
464
    ClientHeight := Self.Height;
465
    BindFormEvents;
466
    res := GetIndexFromResolution(Width, Height,
467
      cScreenDepthToBPP[ScreenDepth]);
468
    if res = 0 then
469
      raise Exception.Create('Unsupported video mode');
470
    if StayOnTop then
471
      FormStyle := fsStayOnTop
472
    else
473
      FormStyle := fsNormal;
474
{$IFDEF MSWINDOWS}
475
    SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and
476
      not WS_CAPTION);
477
{$ENDIF}
478
    // WindowState:=wsMaximized;
479
    // Switch video mode
480
    if (Screen.Width <> Width) or (Screen.Height <> Height) or
481
      (GetCurrentColorDepth <> cScreenDepthToBPP[ScreenDepth]) then
482
    begin
483
      SetFullscreenMode(res, FRefreshRate);
484
      FSwitchedResolution := True;
485
    end;
486
{$IFDEF MSWINDOWS}
487
    // Hides Taskbar + Windows 7 Button
488
    ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE);
489
    ShowWindow(FindWindow('BUTTON', nil), SW_HIDE);
490
{$ENDIF}
491
    // Show;
492
  end;
493

494
  Buffer.Resize(0, 0, Width, Height);
495
  FOwnDC := GetDC(FForm.Handle);
496
  Buffer.CreateRC(FOwnDC, False);
497
  // Linux Unicode
498
{$IFDEF Linux}
499
  GrabMouseToForm(FForm);
500
{$ENDIF}
501
  // todo
502
  FActive := True;
503
end;
504

505
// Shutdown
506
//
507
procedure TGLFullScreenViewer.Shutdown;
508
begin
509
  if not FActive then
510
    Exit;
511
  Assert(FForm <> nil);
512

513
  Buffer.DestroyRC;
514
  with FForm do
515
  begin
516
    Cursor := crDefault;
517
    PopupMenu := nil;
518
  end;
519
{$IFDEF Linux}
520
  ReleaseMouseFromForm(FForm);
521
{$ENDIF}
522
{$IFDEF MSWINDOWS}
523
  // Restore Taskbar + Windows 7 Button
524
  ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOWNA);
525
  ShowWindow(FindWindow('BUTTON', nil), SW_SHOWNA);
526
{$ENDIF}
527
  // attempt that, at the very least...
528
  if FSwitchedResolution then
529
    RestoreDefaultMode;
530
  FActive := False;
531

532
  if FFormIsOwned then
533
    FreeAndNil(FForm);
534
end;
535

536
// BindFormEvents
537
//
538
procedure TGLFullScreenViewer.BindFormEvents;
539
begin
540
  if Assigned(FForm) then
541
    with FForm do
542
    begin
543
      OnMouseDown := FOnMouseDown;
544
      OnMouseUp := FOnMouseUp;
545
      OnMouseMove := FOnMouseMove;
546
      OnMouseWheel := FOnMouseWheel;
547
      OnMouseWheelDown := FOnMouseWheelDown;
548
      OnMouseWheelUp := FOnMouseWheelUp;
549
      OnClick := FOnClick;
550
      OnDblClick := FOnDblClick;
551
      OnCloseQuery := DoCloseQuery;
552
      OnClose := FOnClose;
553
      OnKeyUp := FOnKeyUp;
554
      OnKeyDown := FOnKeyDown;
555
      OnKeyPress := FOnKeyPress;
556
      OnPaint := DoPaint;
557
      OnDestroy := DoFormDestroy;
558
    end;
559
end;
560

561
// DoCloseQuery
562
//
563
procedure TGLFullScreenViewer.DoCloseQuery(Sender: TObject;
564
  var CanClose: Boolean);
565
begin
566
  if Assigned(FOnCloseQuery) then
567
    FOnCloseQuery(Sender, CanClose);
568
  CanClose := True;
569
  // if CanClose then Shutdown;
570
end;
571

572
// DoPaint
573
//
574
procedure TGLFullScreenViewer.DoPaint(Sender: TObject);
575
begin
576
  If not ManualRendering then
577
    if Form <> nil then
578
      Render;
579
end;
580

581
procedure TGLFullScreenViewer.DoActivate(Sender: TObject);
582
begin
583
   If not Active and (Form <> nil) then
584
   begin
585
    Application.Restore;
586
    end;
587
end;
588

589
procedure TGLFullScreenViewer.DoDeactivate(Sender: TObject);
590
begin
591
  If Active and (Form <> nil) then
592
  begin
593
    Shutdown;
594

595
    Application.Minimize;
596
  end;
597
end;
598

599
procedure TGLFullScreenViewer.DoFormDestroy(Sender: TObject);
600
begin
601
  Active := False;
602
end;
603

604
// SetScreenDepth
605
//
606
procedure TGLFullScreenViewer.SetScreenDepth(const val: TGLScreenDepth);
607
begin
608
  if FScreenDepth <> val then
609
  begin
610
    FScreenDepth := val;
611
    DoBufferStructuralChange(Self);
612
  end;
613
end;
614

615
// SetStayOnTop
616
//
617
procedure TGLFullScreenViewer.SetStayOnTop(const val: Boolean);
618
begin
619
  if val <> FStayOnTop then
620
  begin
621
    FStayOnTop := val;
622
    DoBufferStructuralChange(Self);
623
  end;
624
end;
625

626
// SetOnCloseQuery
627
//
628
procedure TGLFullScreenViewer.SetOnCloseQuery(const val: TCloseQueryEvent);
629
begin
630
  FOnCloseQuery := val; // this one uses a special binding
631
end;
632

633
// SetOnClose
634
//
635
procedure TGLFullScreenViewer.SetOnClose(const val: TCloseEvent);
636
begin
637
  If Form <> nil then
638
    Form.OnClose := val;
639
  FOnClose := val;
640
end;
641

642
// SetOnKeyPress
643
//
644
procedure TGLFullScreenViewer.SetOnKeyPress(const val: TKeyPressEvent);
645
begin
646
  If Form <> nil then
647
    Form.OnKeyPress := val;
648
  FOnKeyPress := val;
649
end;
650

651
// SetOnKeyUp
652
//
653
procedure TGLFullScreenViewer.SetOnKeyUp(const val: TKeyEvent);
654
begin
655
  If Form <> nil then
656
    Form.OnKeyUp := val;
657
  FOnKeyUp := val;
658
end;
659

660
// SetOnKeyDown
661
//
662
procedure TGLFullScreenViewer.SetOnKeyDown(const val: TKeyEvent);
663
begin
664
  If Form <> nil then
665
    Form.OnKeyDown := val;
666
  FOnKeyDown := val;
667
end;
668

669
// SetOnMouseWheel
670
//
671
procedure TGLFullScreenViewer.SetOnMouseWheel(const val: TMouseWheelEvent);
672
begin
673
  If Form <> nil then
674
    Form.OnMouseWheel := val;
675
  FOnMouseWheel := val;
676
end;
677

678
// SetOnMouseWheelDown
679
//
680
procedure TGLFullScreenViewer.SetOnMouseWheelDown
681
  (const val: TMouseWheelUpDownEvent);
682
begin
683
  If Form <> nil then
684
    Form.OnMouseWheelDown := val;
685
  FOnMouseWheelDown := val;
686
end;
687

688
// SetOnMouseWheelUp
689
//
690
procedure TGLFullScreenViewer.SetOnMouseWheelUp
691
  (const val: TMouseWheelUpDownEvent);
692
begin
693
  If Form <> nil then
694
    Form.OnMouseWheelUp := val;
695
  FOnMouseWheelUp := val;
696
end;
697

698
// SetOnClick
699
//
700
procedure TGLFullScreenViewer.SetOnClick(const val: TNotifyEvent);
701
begin
702
  If Form <> nil then
703
    Form.OnClick := val;
704
  FOnClick := val;
705
end;
706

707
// SetOnDblClick
708
//
709
procedure TGLFullScreenViewer.SetOnDblClick(const val: TNotifyEvent);
710
begin
711
  If Form <> nil then
712
    Form.OnDblClick := val;
713
  FOnDblClick := val;
714
end;
715

716
// SetOnMouseMove
717
//
718
procedure TGLFullScreenViewer.SetOnMouseMove(const val: TMouseMoveEvent);
719
begin
720
  If Form <> nil then
721
    Form.OnMouseMove := val;
722
  FOnMouseMove := val;
723
end;
724

725
// SetOnMouseDown
726
//
727
procedure TGLFullScreenViewer.SetOnMouseDown(const val: TMouseEvent);
728
begin
729
  If Form <> nil then
730
    Form.OnMouseDown := val;
731
  FOnMouseDown := val;
732
end;
733

734
// SetOnMouseUp
735
//
736
procedure TGLFullScreenViewer.SetOnMouseUp(const val: TMouseEvent);
737
begin
738
  If Form <> nil then
739
    Form.OnMouseUp := val;
740
  FOnMouseUp := val;
741
end;
742

743
// SetCursor
744
//
745
procedure TGLFullScreenViewer.SetCursor(const val: TCursor);
746
begin
747
  if val <> FCursor then
748
  begin
749
    FCursor := val;
750
    if Form <> nil then
751
      FForm.Cursor := val;
752
  end;
753
end;
754

755
// SetPopupMenu
756
//
757
procedure TGLFullScreenViewer.SetPopupMenu(const val: TPopupMenu);
758
begin
759
  if val <> FPopupMenu then
760
  begin
761
    FPopupMenu := val;
762
    if Assigned(FForm) then
763
      FForm.PopupMenu := val;
764
  end;
765
end;
766

767
procedure TGLFullScreenViewer.SetForm(aVal: TForm);
768
begin
769
  FForm := aVal;
770
end;
771

772
procedure TGLFullScreenViewer.SetManualRendering(const val: Boolean);
773
begin
774
  if FManualRendering <> val then
775
    FManualRendering := val;
776
end;
777

778
// GetHandle
779
//
780
function TGLFullScreenViewer.GetHandle: HWND;
781
begin
782
  if Form <> nil then
783
    Result := FForm.Handle
784
  else
785
    Result := 0;
786
end;
787

788
// ------------------------------------------------------------------
789
// ------------------------------------------------------------------
790
// ------------------------------------------------------------------
791
initialization
792

793
// ------------------------------------------------------------------
794
// ------------------------------------------------------------------
795
// ------------------------------------------------------------------
796

797
RegisterClasses([TGLFullScreenViewer]);
798

799
finalization
800

801
{$IFDEF MSWINDOWS}
802
// Restore Taskbar + Windows 7 Button
803
ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOWNA);
804
ShowWindow(FindWindow('BUTTON', nil), SW_SHOWNA);
805
{$ENDIF}
806

807
end.
808