Форум: "Игры";
Текущий архив: 2004.01.09;
Скачать: [xml.tar.bz2];
Вниз
Non full screen DirectX... Найти похожие ветки
← →
Mihey (2003-06-21 00:24) [0]Есть код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AppEvnts, DirectDraw;
type
TForm1 = class(TForm)
ApplicationEvents1: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure ApplicationEvents1Restore(Sender: TObject);
procedure ApplicationEvents1Deactivate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
FDirectDraw : IDirectDraw7;
FPrimarySurface : IDirectDrawSurface7;
BKBitmap : TBitmap;
procedure ErrorOut(hRet : HRESULT);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ErrorOut(hRet: HRESULT);
begin
MessageBox(0, PChar(DDErrorString(hRet)), "Ошибка", MB_OK or MB_ICONSTOP);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
hRet : HRESULT;
SurfaceDesc : TDDSurfaceDesc2;
begin
FPrimarySurface := nil;
FDirectDraw := nil;
hRet := DirectDrawCreateEx (nil, FDirectDraw, IDirectDraw7, nil);
if hRet <> DD_OK then
begin
ErrorOut(hRet);
Close;
Exit;
end;
hRet := FDirectDraw.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE);
if hRet <> DD_OK then
begin
ErrorOut(hRet);
Close;
Exit;
end;
hRet := FDirectDraw.SetDisplayMode (640, 480, 16, 0, 0);
if hRet <> DD_OK then
begin
ErrorOut(hRet);
Close;
Exit;
end;
FillChar (SurfaceDesc, SizeOf(SurfaceDesc), 0);
SurfaceDesc.dwSize := SizeOf(SurfaceDesc);
SurfaceDesc.dwFlags := DDSD_CAPS;
SurfaceDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
hRet := FDirectDraw.CreateSurface(SurfaceDesc, FPrimarySurface, nil);
if hRet <> DD_OK then
begin
ErrorOut(hRet);
Close;
Exit;
end;
BkBitmap := TBitmap.Create;
BkBitmap.LoadFromFile ("1.bmp");
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FPrimarySurface) then FPrimarySurface := nil;
if Assigned(FDirectDraw) then FDirectDraw := nil;
BkBitmap.Free;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
DC : HDC;
TempCanvas : TCanvas;
hRet : HRESULT;
bltfx : TDDBLTFX;
begin
ZeroMemory(@bltfx, SizeOf(bltfx));
bltfx.dwSize := sizeof(bltfx);
bltfx.dwFillColor := 0;
while True do
begin
hRet := FPrimarySurface.Blt(nil, nil, nil, DDBLT_COLORFILL or DDBLT_WAIT, @bltfx);
if hRet = DDERR_SURFACELOST then
begin
hRet := FPrimarySurface._Restore;
if hRet <> DD_OK then Break;
end
else Break;
end;
hRet := FPrimarySurface.GetDC(DC);
if hRet=0 then
begin
TempCanvas := TCanvas.Create;
TempCanvas.Handle := DC;
TempCanvas.Draw(95, 15, BkBitmap);
TempCanvas.Free;
( DC) Есть код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AppEvnts, DirectDraw;
type
TForm1 = class(TForm)
ApplicationEvents1: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure ApplicationEvents1Restore(Sender: TObject);
procedure ApplicationEvents1Deactivate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
FDirectDraw : IDirectDraw7;
FPrimarySurface : IDirectDrawSurface7;
BKBitmap : TBitmap;
procedure ErrorOut(hRet : HRESULT);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ErrorOut(hRet: HRESULT);
begin
MessageBox(0, PChar(DDErrorString(hRet)), "Ошибка", MB_OK or MB_ICONSTOP);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
hRet : HRESULT;
SurfaceDesc : TDDSurfaceDesc2;
begin
FPrimarySurface := nil;
FDirectDraw := nil;
hRet := DirectDrawCreateEx (nil, FDirectDraw, IDirectDraw7, nil);
if hRet <> DD_OK then
begin
ErrorOut(hRet);
Close;
Exit;
end;
hRet := FDirectDraw.SetCooperativeLevel(Handle, DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE);
if hRet <> DD_OK then
begin
ErrorOut(hRet);
Close;
Exit;
end;
hRet := FDirectDraw.SetDisplayMode (640, 480, 16, 0, 0);
if hRet <> DD_OK then
begin
ErrorOut(hRet);
Close;
Exit;
end;
FillChar (SurfaceDesc, SizeOf(SurfaceDesc), 0);
SurfaceDesc.dwSize := SizeOf(SurfaceDesc);
SurfaceDesc.dwFlags := DDSD_CAPS;
SurfaceDesc.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
hRet := FDirectDraw.CreateSurface(SurfaceDesc, FPrimarySurface, nil);
if hRet <> DD_OK then
begin
ErrorOut(hRet);
Close;
Exit;
end;
BkBitmap := TBitmap.Create;
BkBitmap.LoadFromFile ("1.bmp");
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FPrimarySurface) then FPrimarySurface := nil;
if Assigned(FDirectDraw) then FDirectDraw := nil;
BkBitmap.Free;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
DC : HDC;
TempCanvas : TCanvas;
hRet : HRESULT;
bltfx : TDDBLTFX;
begin
ZeroMemory(@bltfx, SizeOf(bltfx));
bltfx.dwSize := sizeof(bltfx);
bltfx.dwFillColor := 0;
while True do
begin
hRet := FPrimarySurface.Blt(nil, nil, nil, DDBLT_COLORFILL or DDBLT_WAIT, @bltfx);
if hRet = DDERR_SURFACELOST then
begin
hRet := FPrimarySurface._Restore;
if hRet <> DD_OK then Break;
end
else Break;
end;
hRet := FPrimarySurface.GetDC(DC);
if hRet=0 then
begin
TempCanvas := TCanvas.Create;
TempCanvas.Handle := DC;
TempCanvas.Draw(95, 15, BkBitmap);
TempCanvas.Free;
FPrimarySurface.ReleaseDC (DC);
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=VK_ESCAPE then Close;
end;
procedure TForm1.ApplicationEvents1Restore(Sender: TObject);
begin
WindowState := wsMaximized;
end;
procedure TForm1.ApplicationEvents1Deactivate(Sender: TObject);
begin
Application.Minimize;
end;
end.
Он показывает картинку в полноэкранном режиме. Нужно сделать то же, только чтобы картинка показывалась в оконном режиме 1024х768х24. Что нужно изменить в этом коде?
← →
jel (2003-06-21 12:36) [1]
hRet := FDirectDraw.SetCooperativeLevel(Handle, DDSCL_NORMAL);
Однако это только для этого конкретного случая. В общем случае все немного сложнее. Подробности в справке из DirectX SDK.
← →
Mihey (2003-06-21 19:08) [2]Сейчас попробую, спасибо за помощь.
← →
Mihey (2003-06-21 19:58) [3]2 jel:
Ты был прав, не всё так просто и изменение параметра вызвало ошибку. Пробовал запустить в Delphi и извне, но не помогло. Сначала потребовало exclusive mode, я добавил, но пошла ошибка уже вроде бы в цикле рисования формы.
← →
Mihey (2003-06-21 23:51) [4]Народ! Ну помогите. Очевидно, далее идёт ошибка где-то в прорисовке. Как сделать так, чтобы рисунок выводился на форму? Может, у вас есть свой код?
← →
Sapersky_ (2003-06-23 11:58) [5]Пример, судя по всему, из книги Краснова. Так вот - там есть и примеры оконных приложений. Или см. DelphiGFX. На Королевстве Дельфи были статьи по DX, там, наверное, есть. В общем, это базовая теория, и информацию по ней достаточно легко найти.
Могу и так сказать - SetDisplayMode не надо. И ещё учитывать положение и размеры окна (GetWindowRect). И вообще вывод обычно делается в задний буфер (backbuffer). Только не надо спрашивать, что это такое :)
← →
Mihey (2003-06-23 19:19) [6]Ладно ребята, не дождался помощи я от вас, но ничего, выберусь.. сам выберусь.
← →
jel (2003-06-24 09:35) [7]hRet := FDirectDraw.SetDisplayMode (640, 480, 16, 0, 0);
if hRet <> DD_OK then
begin
ErrorOut(hRet);
Close;
Exit;
end;
Вот это при работе в оконном режиме не пройдет и будет требовать Exclusive
← →
Mihey (2003-06-24 13:15) [8]Буду разбираться.
← →
Kelegorm (2003-06-24 18:59) [9]Ну, блин. А книга Краснова зачем. По-моему, там это есть. Щас посмотрю.
← →
Kelegorm (2003-06-24 19:05) [10]"Вы, должно быть, привыкли к тому, что наши примеры -//- в полноэкранном режиме. -//- Экранный режим нужно исп. в случае крайней нужды. -/(долго рисуется)/- Свойство BorderStyle = bsSizeable, потом как сказал jel, уврать все компоненты с формы. Если нужно подробнее (вост экрана, перерисовка, сообщи в форуме. всем привет, пишите мне. У меня книга есть.
Страницы: 1 вся ветка
Форум: "Игры";
Текущий архив: 2004.01.09;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.015 c
