
09.08.2011, 17:28
|
Прохожий
|
|
Регистрация: 09.08.2011
Сообщения: 8
Репутация: 10
|
|
Проблемы с FormStyle и Direct3D
Форма, в клиентской области инициирую IDirect3D, по нажатию кнопок Alt+Enter перевожу IDirect3D в полноэкранный режим или обратно, после одной такой манипуляции форма остается постоянно StayOnTop хоть ты тресни, выставление свойства FormStyle в fsNormal никаких результатов не дает, что делать?
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Direct3D9, AppEvnts, DXTypes;
type
TForm1 = class(TForm)
ApplicationEventsMain: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ApplicationEventsMainIdle(Sender: TObject; var Done: Boolean);
procedure ApplicationEventsMainMinimize(Sender: TObject);
procedure ApplicationEventsMainRestore(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ Private declarations }
FD3D: IDirect3D9;
FD3DDevice: IDirect3DDevice9;
FIsActive: Boolean;
FWindowed: Boolean;
FX, FY, FHeight, FWidth: Integer;
function InitD3D: HResult;
function ClearDevice: HResult;
function RenderScene: HResult;
procedure FreeD3D;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.ApplicationEventsMainIdle(Sender: TObject; var Done: Boolean);
var
Hr: HResult;
begin
if FIsActive then
begin
Hr := FD3DDevice.TestCooperativeLevel;
if Hr = D3DERR_DEVICELOST then Exit;
if Hr = D3DERR_DEVICENOTRESET then
begin
FreeD3D;
InitD3D;
end;
RenderScene;
end;
Done := False;
end;
procedure TForm1.ApplicationEventsMainMinimize(Sender: TObject);
begin
FIsActive := False;
end;
procedure TForm1.ApplicationEventsMainRestore(Sender: TObject);
begin
FIsActive := True;
end;
function TForm1.ClearDevice: HResult;
begin
Result := E_FAIL;
if FD3DDevice = nil then Exit;
Result := FD3DDevice.Clear(0, nil, D3DCLEAR_TARGET, D3DCOLOR_XRGB($FF, 0, $FF), 1, 0);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
FIsActive := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FWindowed := True;
FX := Left;
FY := Top;
FWidth := Width;
FHeight := Height;
if Failed(InitD3D) then
begin
ShowMessage('Ошибка инициализации DirectX...');
Halt;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeD3D;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssAlt in Shift) and (Key = VK_RETURN) then
begin
FWindowed := not FWindowed;
if not FWindowed then
begin
FX := Left;
FY := Top;
FHeight := Height;
FWidth := Width;
end;
FreeD3D;
InitD3D;
end;
end;
procedure TForm1.FreeD3D;
begin
FD3D := nil;
FD3DDevice := nil;
end;
function TForm1.InitD3D: HResult;
var
D3DDisplayInfo: TD3DDisplayMode;
D3DParams: TD3DPresentParameters;
begin
Result := E_FAIL;
FD3D := Direct3DCreate9(D3D_SDK_VERSION);
if FD3D = nil then Exit;
Result := FD3D.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, D3DDisplayInfo);
if Failed(Result) then Exit;
ZeroMemory(@D3DParams, SizeOf(D3DParams));
D3DParams.Windowed := FWindowed;
D3DParams.SwapEffect := D3DSWAPEFFECT_DISCARD;
D3DParams.BackBufferFormat := D3DDisplayInfo.Format;
if not FWindowed then
begin
D3DParams.FullScreen_RefreshRateInHz := D3DDisplayInfo.RefreshRate;
D3DParams.BackBufferWidth := D3DDisplayInfo.Width;
D3DParams.BackBufferHeight := D3DDisplayInfo.Height;
BorderStyle := bsNone;
end
else
begin
BorderStyle := bsSizeable;
Left := FX;
Top := FY;
Height := FHeight;
Width := FWidth;
FormStyle := fsNormal; // Пробовал тут
end;
Result := FD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Handle,
D3DCREATE_SOFTWARE_VERTEXPROCESSING, @D3DParams, FD3DDevice);
if FWindowed then FormStyle := fsNormal; // И тут
end;
function TForm1.RenderScene: HResult;
begin
Result := ClearDevice;
if Failed(Result) then Exit;
FD3DDevice.Present(nil, nil, 0, nil)
end;
end.
При том до первого разворота в полноэкранный режим форма ведет себя нормально, как и должна.
Компилю все CodeGear RAD Studio 2009
|