![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
DirectDraw [Delphi, Windows]
Zergling © (2003-09-30 06:41:00)Доброго всем дня! Начал изучать основы DirectX, купил библию по этому случаю (на С++), но пишу на Delphi
И вот возник у меня такой к Вам вопрос:
DDSURFACEDESC2 ddsd; // Первичная поверхность DirectDraw
int mempitch = (int)ddsd.lPitch; // Шаг в памяти
UCHAR *video_buffer = (UCHAR *)ddsd.lpSurface; // Указатель на область памяти
Думаю тут все ясно
for (int index=0; index < 1000; index++)
UCHAR color = rand()%256;
int x = rand()%640;
int y = rand()%480;
Интересует эта строка. Как указатель на область памяти превратился в массив (не доходит до меня эта запись)?
Суть вопороса, как тоже самое записать на дельфи, а то чото застрял я натоком приметивном элемете как точка :(
video_buffer[x+y*mempitch] = color;
Заранее благодарствую за помошь!
Zergling (2003-10-07 11:06:00) [21]Чего то у меня не выходит, поэтуму кидаю все.
Помогите начинающему в этом деле сдвинуться с мертвой точки.
Заранее благодарен за помощь!
Const
WW = 640;
WH = 480;
var
WC: WNDCLASSEX; // Класс окна
WC_HWND: HWND = 0; // Дескриптор окна
WC_MSG: TMsg; // Сообщение окна
WC_HDC: HDC = 0; // Контекст графического устройства
WC_Rect: TRect;
WC_PRect: PRect;
SrtTimes: Cardinal;
DXRep: TStringList;
{ DirectX }
// Интерфейс DirectX 7
DD7: IID_IDirectDraw7 = Nil;
// Поверхность DirectDraw 7
DDSurface: IID_IDirectDrawSurface7 = Nil;
// Первичная поверхность
DDSf: DDSURFACEDESC2;
// Палитра на 256 цветов
DDPal: IID_IDirectDrawPalette = Nil;
// Массив цветов
Palette: Array [0..255] of tagPALETTEENTRY;
// Заполнение палитры цветами
Procedure SetColorPalette;
var
I: Integer;
begin
// Заполнение палитры
for I := 1 to 254 do
with Palette[I] do
begin
peRed := Random(256);
peGreen := Random(256);
peBlue := Random(256);
// Не оптимизировать палитру
peFlags := PC_NOCOLLAPSE;
end;
with Palette[0] do
begin
peRed := 0;
peGreen := 0;
peBlue := 0;
peFlags := PC_NOCOLLAPSE;
end;
with Palette[255] do
begin
peRed := 255;
peGreen := 255;
peBlue := 255;
peFlags := PC_NOCOLLAPSE;
end;
end;
function Finalization_Game: Boolean;
begin
Result := True;
try
DXRep.SaveToFile('C:\DX.TXT');
DXRep.Free;
DD7 := Nil;
DDSurface := Nil;
DDPal := Nil;
except
Result := False;
end;
end;
function Initialization_Game: Boolean;
begin
Result := True;
try
DXRep := TStringList.Create;
SetColorPalette;
// Создание интерфейса DirectX 7
if DirectDrawCreateEx(Nil, DD7, IID_IDirectDraw7, Nil) <> DD_OK then DXRep.Add('DirectDrawCreateEx');
// Выбор выдекарты по умолчанию
if DD7.SetCooperativeLevel(WC_HWND, DDSCL_FULLSCREEN or DDSCL_EXCLUSIVE or DDSCL_ALLOWMODEX or DDSCL_ALLOWREBOOT) <> DD_OK then DXRep.Add('SetCooperativeLevel');
// Установка видео режима
if DD7.SetDisplayMode(WW, WH, 8, 0, 0) <> DD_OK then DXRep.Add('SetDisplayMode');
// Заполнение описания первичной поверхности
ZeroMemory(@DDSf, SizeOf(DDSf));
with DDSf do
begin
dwSize := SizeOf(DDSf);
// Задание поле (высота и ширина по умолчанию)
dwFlags := DDSD_CAPS;
// Запрос первичной поверхности
ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
end;
// Создание первичной поверхности
if DD7.CreateSurface(DDSf, DDSurface, Nil) <> DD_OK then DXRep.Add('CreateSurface');
// Содание палитры
if DD7.CreatePalette(DDPCAPS_8BIT or DDPCAPS_ALLOW256 or DDPCAPS_INITIALIZE, @Palette, DDPal, Nil) <> DD_OK then DXRep.Add('CreatePalette');
// Присоединение палитры к первичной поверхности
if DDSurface.SetPalette(DDPal) <> DD_OK then DXRep.Add('SetPalette');
except
Result := False;
Finalization_Game;
end;
end;
// Рисование точек
procedure DrawPixels;
var
I, X, Y: Integer;
PB : PByte;
begin
For I := 0 to 1000 do
begin
X := Random(WW); Y := Random(WH);
PB := DDSf.lpSurface;
Inc(PB, X + Y * DDSf.lPitch);
PB^ := Random(255);
end;
end;
// Обработка сообщений Windows
function WndProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
Result := 0;
case uMsg of
WM_DESTROY:
begin
Finalization_Game;
// Посылка сообщения в очередь о закрытии приложения
PostQuitMessage(0);
EXIT;
end;
end;
// Если сообщение не обработанной, то посылаем его окну для обработки по умолчанию
Result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end;
// Основная программа
Begin
// Заполнение свойств класса окна
with WC do
begin
cbSize := SizeOf(WNDCLASSEX); // Размер структуры
style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC or CS_DBLCLKS; // Стили окна
lpfnWndProc := @WndProc; // Процедура для обработки сообщений
cbClsExtra := 0; // Дополнительные параметры
cbWndExtra := 0; // Дополнительные параметры
hInstance := hInstance; // Дескриптор окна
hIcon := LoadIcon(0, IDI_APPLICATION); // Иконка окна
hCursor := LoadCursor(0, IDC_ARROW); // Курсор окна
hbrBackground := HBRUSH(GetStockObject(BLACK_BRUSH)); // Фоновый цвет кисти окна
lpszMenuName := Nil; // Меню окна
lpszClassName := 'WC_1'; // Имя класса окна
hIconSm := LoadIcon(0, IDI_APPLICATION); // Иконка окна (на панели задач)
end;
// Регистрация класса окна
RegisterClassEx(WC);
// Создание окна
WC_HWND := CreateWindowEx
(0, // Дополнительные стили окна
'WC_1', // Имя класса по образу которого создается окно
'Тестовая форточкка', // Заголовок окна
WS_POPUP or WS_VISIBLE, // Стиль окна
0, // Позиция по Х (Left)
0, // Позиция по Y (Top)
WW, // Ширина окна (Width)
WH, // Высота окна (Height)
0, // Дескриптор родительского окна (если оно есть)
0, // Дескриптор меню окна
HInstance, // Дескриптор экземляра приложения
nil); // Указатель на параметры создания окна
// Если окно не созданно, то выходим
if WC_HWND = 0 then Halt(1);
// Цикл для ловли и обработки сообщений
Initialization_Game;
DrawPixels;
While GetMessage(WC_MSG, 0, 0, 0) do
begin
SrtTimes := GetTickCount;
// Преобразование клавиатурного ввода
TranslateMessage(WC_MSG);
// Посылка сообщения в процедуру обработки сообщений (WndProc)
DispatchMessage(WC_MSG);
// Отлавливаем состояние нажатия клавиши ESCAPE
if Boolean(GetAsyncKeyState(VK_ESCAPE) shr 16) then SendMessage(WC_HWND, WM_DESTROY, 0, 0);
while GetTickCount - SrtTimes < 33 do
end;
// Уничтожаем окно
DestroyWindow(WC_HWND);
End.
Sapersky (2003-09-30 09:27:00) [22]Короче. Не вдаваясь в эту сишную бурду:
Var pb : PByte;
ddsd : TDDSurfaceDesc2;
surf.Lock(nil,ddsd,0,0);
// surf - поверхность 8 бит, так?
For i:=0 to 1000 do begin
x:=Random(640); y:=Random(480);
pb:=ddsd.lpSurface; Inc(pb, y * ddsd.lPitch + x);
pb^:=Random(255);
end;
surf.Unlock(nil);