Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.11.07;
Скачать: CL | DM;

Вниз

Изменение тектуры   Найти похожие ветки 

 
volser   (2004-07-13 11:32) [0]

Пишу под Direct3D.
Задача состоит в том что текстура во время работы программы будет изменятся.
Нужно "загрузить" текстуру с TPicture или TBitmap в IDirect3DTexture8.
Как это сделать? Скорость имеет значение.


 
Колбасьев ©   (2004-07-13 18:28) [1]

Можно использовать такой код (вроде из Краснова):

function TfrmD3D.InitTexture (var FD3TextBMP : IDIRECT3DTEXTURE8;
                             const FileName : String) : HRESULT;
var
 hRet : HRESULT;
 d3dlr : TD3DLOCKED_RECT;
 dwDstPitch : DWORD;
 X, Y : DWORD;
 Bmp : TBitmap;
 R, G, B : Byte;
begin
 Bmp := TBitmap.Create;
 try
   Bmp.LoadFromfile (FileName);
 except
   raise EAbort.Create ("Can""t open file: " + FileName);
   Result := S_FALSE;
   Exit;
 end;

 hRet := FD3DDevice.CreateTexture (Bmp.Width, Bmp.Height, 0, 0,
                                   D3DFMT_A8R8G8B8,
                                   D3DPOOL_MANAGED, FD3TextBMP);
 if FAILED(hRet) then begin
    Result := hRet;
    Exit;
 end;

 hRet := FD3TextBMP.LockRect(0, d3dlr, nil, 0);
 if FAILED(hRet) then begin
    Result := hRet;
    Exit;
 end;

 dwDstPitch := d3dlr.Pitch;
 for Y := 0 to Bmp.Height - 1 do
     for X := 0 to Bmp.Width - 1 do begin
        R := GetRValue (Bmp.Canvas.Pixels [X, DWORD (Bmp.Height - 1) - Y]);
        G := GetGValue (Bmp.Canvas.Pixels [X, DWORD (Bmp.Height - 1) - Y]);
        B := GetBValue (Bmp.Canvas.Pixels [X, DWORD (Bmp.Height - 1) - Y]);
        PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch + X * 4)^ := D3DCOLOR_XRGB(R, G, B);
 end;
 Bmp.Free;

 Result := FD3TextBMP.UnlockRect(0);
end;


Или такой (с указателем, чтобы можно было динамически менять текстуру: Lock, меняем цвет пикселей в памяти, Unlock):

function TfrmD3D.BukupTexture (var FD3TextBMP : IDIRECT3DTEXTURE8;
                              const FileName : String) : HRESULT;
var
 hRet : HRESULT;
 d3dlr : TD3DLOCKED_RECT;
 dwDstPitch : DWORD;
 X, Y : DWORD;
 Bmp : TBitmap;
 R, G, B : Byte;
begin
 Bmp := TBitmap.Create;
 try
   Bmp.LoadFromfile (FileName);
 except
   raise EAbort.Create ("Can""t open file: " + FileName);
   Result := S_FALSE;
   Exit;
 end;

 hRet := FD3DDevice.CreateTexture (Bmp.Width, Bmp.Height, 0, 0,
                                   D3DFMT_A8R8G8B8,
                                   D3DPOOL_MANAGED, FD3TextBMP);
 if FAILED(hRet) then begin
    Result := hRet;
    Exit;
 end;

 hRet := FD3TextBMP.LockRect(0, d3dlr, nil, 0);
 if FAILED(hRet) then begin
    Result := hRet;
    Exit;
 end;

 dwDstPitch := d3dlr.Pitch;
 for Y := 0 to Bmp.Height - 1 do
     for X := 0 to Bmp.Width - 1 do begin
        R := GetRValue (Bmp.Canvas.Pixels [X, DWORD (Bmp.Height - 1) - Y]);
        G := GetGValue (Bmp.Canvas.Pixels [X, DWORD (Bmp.Height - 1) - Y]);
        B := GetBValue (Bmp.Canvas.Pixels [X, DWORD (Bmp.Height - 1) - Y]);
        PDWORD (DWORD(d3dlr.pBits) + Y * dwDstPitch + X * 4)^ := D3DCOLOR_XRGB(R, G, B);
 end;

 GetMem (TexPointer, 4 * Bmp.Width * Bmp.Height);
 CopyMemory (TexPointer, d3dlr.pBits, 4 * Bmp.Width * Bmp.Height);

 wrkTexWidth := Bmp.Width;
 wrkTexHeight := Bmp.Height;

 Bmp.Free;

 Result := FD3TextBMP.UnlockRect(0);
end;


Осталось немного подправить и не из файла грузить, а из TBitmap или TPicture.


 
volser   (2004-07-13 22:46) [2]

Большое спасибо!!!



Страницы: 1 вся ветка

Текущий архив: 2004.11.07;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.042 c
3-1097148449
Hmm
2004-10-07 15:27
2004.11.07
Проблемма с запуском скрипта создания базы из моего приложения.


14-1098177817
peypivo
2004-10-19 13:23
2004.11.07
Самый убогий корпоративный сайт.


14-1098274091
Drakosha
2004-10-20 16:08
2004.11.07
.NET


1-1098353405
digger
2004-10-21 14:10
2004.11.07
Описание объектной модели Object Pascal


14-1098088255
les
2004-10-18 12:30
2004.11.07
serversocket