[Nasgool]

Форма, в клиентской области инициирую 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

[Nasgool]

в OnResize тоже пробовал, результат нулевой, форма остается стоять по верх всех остальных.

[Nasgool]

Код:

procedure TForm1.ApplicationEventsMainDeactivate(Sender: TObject);
begin
  SetForegroundWindow(GetActiveWindow);
end;

Да что за на пасть то такая, даже так не хочет!!!
Хелп, гуру!

[Nasgool]

Код:

procedure TForm1.ApplicationEventsMainDeactivate(Sender: TObject);
begin
  WindowState := wsMinimized;
end;

Так работает, но это, извиняюсь за выражение, анальная порнография.

[x128]

Возможно "Application.NormalizeAllTopMosts" спасет ситуацию.

[Nasgool]

к сожалению и этот вариант не проходит, рою в сторону работы Direct3D, имхо там собака зарыта

[Nasgool]

ктате, варианты с SetWindowLong тоже не работают