oxvs.pas

来自「Newton Game Dynamic 1.52 Delphi下基于GLSce」· PAS 代码 · 共 321 行

unit oxVS;
(*==============================================================================
                    
 Version: MPL 1.1

 The contents of this file are subject to the Mozilla Public License Version
 1.1 (the "License"); you may not use this file except in compliance with
 the License. You may obtain a copy of the License at
 http://www.mozilla.org/MPL/


 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 for the specific language governing rights and limitations under the
 License.

 The Original Code is "oxNewton opengl-Dynamics-delphi-component".

 The Initial Developer of the Original Code is
 Dave Gravel, OrionX3D Opengl & Delphi Programming, [e-mail].
                       http://www.Dave.ServeUsers.com
                       http://www.k00m.sexidude.com

 Portions created by Dave Gravel are Copyright (C) 2004 - 2006.
 Dave Gravel. All Rights Reserved.

 Contributor(s): GLScene (http://www.glscene.org) -
 Julio Jerez and Alain Suero (http://www.newtondynamics.com) -
 Sascha Willems (www.delphigl.de)

================================================================================
 oxNewton v1.47 by Dave Gravel.

PS: I request only one thing from the users of my oxNewton Component,
it is to put on your about or your help a comment saying you using the
oxNewton Component with my name Dave Gravel and my
e-mail: [e-mail]
Don't modify or remove any comment or information on my file
if you do some modification on my code please contact me.
Read the Newton license too, it is realy important.

===============================================================================*)
interface
{******************************************************************************}
 // [10-04-2006]: oxVS last change by Dave Gravel.
{******************************************************************************}
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  GLWin32Viewer, GLTexture, GLUtils, Dialogs, jpeg, ExtCtrls, StdCtrls, GLScreen,
  GLContext, GLGraphics, GLCadencer, GLMisc, GLScene;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
type
  ToxVideoFrm = class(TForm)
    Image1: TImage;
    ListBox1: TListBox;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    Panel1: TPanel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    RadioButton5: TRadioButton;
    CheckBox1: TCheckBox;
    Label3: TLabel;
    Timer1: TTimer;
    CheckBox2: TCheckBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton5Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    oxVirtualVSync: integer;
    oxVirtualFullScreen: integer;
    oxVirtualFsaa: integer;
    oxVirtualSave: TStringList;
    oxVirtualPath: string;
    oxVirtualMainFrm: TForm;
    oxVirtualViewer: TGLSceneViewer;
    oxVirtualCadencer: TGLCadencer;
    procedure SetSaveFile;
  end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
var
  oxVideoFrm: ToxVideoFrm;
implementation
{$R *.dfm}
uses oxVideoSetting;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  DevMode: TDeviceMode;
  liRetValue: Longint;
begin
  oxVirtualCadencer.Enabled:= True;
  liRetValue:= 0;
  {$IFOPT R+}
   {$DEFINE CKRANGE}
   {$R-} //range-checking of
  {$ENDIF}
  if EnumDisplaySettings( nil, Listbox1.ItemIndex, Devmode ) then
  begin
    liRetValue:= ChangeDisplaySettings( DevMode, 0 );
  end;
  PostMessage( HWND_BROADCAST, WM_DISPLAYCHANGE, SPI_SETNONCLIENTMETRICS, 0 );
  {$IFDEF CKRANGE}
   {$UNDEF CKRANGE}
   {$R+}  //range-checking on
  {$ENDIF}
  if ( FileExists( oxVirtualPath + 'Screen.cfg' ) = False ) then
  begin
    SetSaveFile;
    oxVirtualSave.SaveToFile( oxVirtualPath + 'Screen.cfg' );
    case liRetValue of
      DISP_CHANGE_SUCCESSFUL: ShowMessage( 'The settings change was successful.'+#13+'If you like to change it again delete the Screen.cfg.' );
      DISP_CHANGE_RESTART   : ShowMessage( 'The computer must be restarted in order for the graphics mode to work.' );
      DISP_CHANGE_BADFLAGS  : ShowMessage( 'An invalid set of flags was passed in.' );
      DISP_CHANGE_FAILED    : ShowMessage( 'The display driver failed the specified graphics mode' );
      DISP_CHANGE_BADMODE   : ShowMessage( 'The graphics mode is not supported' );
      DISP_CHANGE_NOTUPDATED: ShowMessage( 'Unable to write settings to the registry.' );
    end;
  end;
  if (oxVirtualFullScreen = 1) then
  begin
    oxVirtualMainFrm.BorderIcons:= [];
    oxVirtualMainFrm.BorderStyle:= bsNone;
    oxVirtualMainFrm.WindowState:= wsMaximized;
    oxVirtualMainFrm.Width:= screen.Width;
    oxVirtualMainFrm.Height:= screen.Height;
    oxVirtualMainFrm.Top:= 0;
    oxVirtualMainFrm.Left:= 0;
    oxVirtualMainFrm.Show;
  end else
  if (oxVirtualFullScreen = 0) then
  begin
    oxVirtualMainFrm.BorderIcons:= [biSystemMenu,biMinimize,biMaximize];
    oxVirtualMainFrm.BorderStyle:= bsSingle;
    oxVirtualMainFrm.WindowState:= wsNormal;
    oxVirtualMainFrm.Width:= screen.Width;
    oxVirtualMainFrm.Height:= screen.Height;
    oxVirtualMainFrm.Top:= 0;
    oxVirtualMainFrm.Left:= 0;
    oxVirtualMainFrm.Show;
  end;
  oxVirtualMainFrm:= nil;
  oxVirtualViewer:= nil;
  oxVirtualCadencer:= nil;
  oxVirtualSave.Free;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.SetSaveFile;
begin
  oxVirtualSave.Add( IntToStr( Listbox1.ItemIndex ) );
  oxVirtualSave.Add( IntToStr( oxVirtualFsaa ) );
  oxVirtualSave.Add( IntToStr( oxVirtualVSync ) );
  oxVirtualSave.Add( IntToStr( oxVirtualFullScreen ) );
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.Button1Click(Sender: TObject);
begin
  if Listbox1.ItemIndex >= 0 then close else
  Showmessage('choice a resolution plz.');
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.RadioButton1Click(Sender: TObject);
begin
  oxVirtualFsaa:= 0;
  oxVirtualViewer.Buffer.AntiAliasing:= aaNone;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.RadioButton2Click(Sender: TObject);
begin
  oxVirtualFsaa:= 1;
  oxVirtualViewer.Buffer.AntiAliasing:= aa2x;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.RadioButton3Click(Sender: TObject);
begin
  oxVirtualFsaa:= 2;
  oxVirtualViewer.Buffer.AntiAliasing:= aa2xHQ;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.RadioButton4Click(Sender: TObject);
begin
  oxVirtualFsaa:= 3;
  oxVirtualViewer.Buffer.AntiAliasing:= aa4x;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.RadioButton5Click(Sender: TObject);
begin
  oxVirtualFsaa:= 4;
  oxVirtualViewer.Buffer.AntiAliasing:= aa4xHQ;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.FormShow(Sender: TObject);
begin
  if ( FileExists( oxVirtualPath + 'Screen.cfg' ) ) then
  begin
    WindowState:= wsMinimized;
    Panel1.Enabled:= False;
    ListBox1.Enabled:= False;
    CheckBox1.Enabled:= False;
  end;
  oxVirtualCadencer.Enabled:= False;
  Timer1.Enabled:= True;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
  begin
    oxVirtualVSync:= 1;
    oxVirtualViewer.VSync:= vsmSync;
  end else begin
    oxVirtualVSync:= 0;
    oxVirtualViewer.VSync:= vsmNoSync;
  end;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.FormCreate(Sender: TObject);
begin
  oxVirtualFsaa:= -1;
  oxVirtualVSync:= -1;
  oxVirtualFullScreen:= 0;
  oxVirtualPath:= ExtractFilePath( Application.ExeName );
  oxVirtualSave:= TStringList.Create;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.Timer1Timer(Sender: TObject);
begin
  if ( FileExists( oxVirtualPath + 'Screen.cfg' ) ) then
  begin
    oxVirtualSave.LoadFromFile( oxVirtualPath + 'Screen.cfg' );
    Listbox1.ItemIndex:=StrToInt( oxVirtualSave.Strings[0] );
    Listbox1.Selected[Listbox1.ItemIndex]:= True;
    if ( StrToInt( oxVirtualSave.Strings[1] ) = 0 ) then begin
      oxVirtualViewer.Buffer.AntiAliasing:= aaNone; RadioButton1.Checked:= True; end;
    if ( StrToInt( oxVirtualSave.Strings[1] ) = 1 ) then begin
      oxVirtualViewer.Buffer.AntiAliasing:= aa2x; RadioButton2.Checked:= True; end;
    if ( StrToInt( oxVirtualSave.Strings[1] ) = 2 ) then begin
      oxVirtualViewer.Buffer.AntiAliasing:= aa2xHQ; RadioButton3.Checked:= True; end;
    if ( StrToInt( oxVirtualSave.Strings[1] ) = 3 ) then begin
      oxVirtualViewer.Buffer.AntiAliasing:= aa4x; RadioButton4.Checked:= True; end;
    if ( StrToInt( oxVirtualSave.Strings[1] ) = 4 ) then begin
      oxVirtualViewer.Buffer.AntiAliasing:= aa4xHQ; RadioButton5.Checked:= True; end;
    if ( StrToInt( oxVirtualSave.Strings[2] ) = 0 ) then begin
      oxVirtualViewer.VSync:= vsmNoSync; CheckBox1.Checked:= True; end;
    if ( StrToInt( oxVirtualSave.Strings[2] ) = 1 ) then begin
      oxVirtualViewer.VSync:= vsmSync; CheckBox1.Checked:= True; end;
    if ( StrToInt( oxVirtualSave.Strings[3] ) = 0 ) then
      oxVirtualFullScreen:= 0 else
    if ( StrToInt( oxVirtualSave.Strings[3] ) = 1 ) then
      oxVirtualFullScreen:= 1;
    Button1.OnClick( self );
  end;
  Timer1.Enabled:= False;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.CheckBox2Click(Sender: TObject);
begin
  if CheckBox2.Checked then
    oxVirtualFullScreen:= 1
  else
    oxVirtualFullScreen:= 0;
end;
{******************************************************************************}
 // [10-04-2006]: ToxVideoFrm last change by Dave Gravel.
{******************************************************************************}
procedure ToxVideoFrm.ListBox1Click(Sender: TObject);
begin
  if Listbox1.ItemIndex >= 0 then Button1.Enabled:= True;
end;
{******************************************************************************}
{$D '[10-04-2006]: TOXNewtonManager v1.47 by Dave Gravel under MPL-1.1 license.'}
{******************************************************************************}

end.