VPF::Загрузка текстуры - Форум программистов

DragonFire

Дата 8.3.2006, 22:45 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9

При вызове функции пишет несоответствие типа TRGB и Pointer...

--------------------

http://dragonfire.cimanu.ru/

Albinos_x

Дата 8.3.2006, 22:58 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 26
Всего: 108

видимо ф-ю поменял, а принимаешь не в массив, а в указатель...(если я правильно понял)

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Демо

Дата 9.3.2006, 00:35 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Код


type
    TBMP=packed record
        BFH: TBitmapFileHeader;
        BIH: TBitmapInfoHeader;
        Data: PByteArray;
    end;


function LoadBMP(const FilePath: String): TBMP;
var
    FS: TFileStream;
    Rcv: Integer;
    LenHeaders,LenData: Integer;
begin
    LenHeaders := SizeOf(Result.BFH)+SizeOf(Result.BIH);

    FS := TFileStream.Create(FilePath,fmOpenRead);
    try
        LenData := FS.Size-LenHeaders;
        if LenData>32768
            then raise Exception.Create('Error FileSize');
        Rcv := FS.Read(Result.BFH,SizeOf(Result.BFH));
        if Rcv<>SizeOf(Result.BFH) then raise Exception.Create('Error read file');
        Rcv := FS.Read(Result.BIH,SizeOf(Result.BIH));
        if Rcv<>SizeOf(Result.BIH) then raise Exception.Create('Error read file');
        New(Result.Data);
        FS.Read(Result.Data^,LenData);
    finally
        FS.Free;
    end;
end;

Только надо не забывать освобождать память TBMP.Data после использования.

PS.
Хочу заметить, что PByteArray мне кажется неправильным выбором для хранения BMP, так как максимальный размер его - 32768.

--------------------

DragonFire

Дата 9.3.2006, 08:25 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9

Функция не может иметь формат TRGB (TBMP) - при высове функции возникает ошибка несоответствия типов TRGB и Pointer.
P.S. А может вообще не стоит загружать BMP? Написать свой формат?

Это сообщение отредактировал(а) DragonFire - 9.3.2006, 08:50

--------------------

http://dragonfire.cimanu.ru/

Демо

Дата 9.3.2006, 09:40 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Цитата(DragonFire @ 9.3.2006, 08:25

)

Функция не может иметь формат TRGB (TBMP) - при высове функции возникает ошибка несоответствия типов TRGB и Pointer.

В каком месте кода?

--------------------

DragonFire

Дата 9.3.2006, 10:16 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9

Вот в этом:

Код


TexGrass:=ReadBitmap(ExtractFilePath(Char(0))+'Bitmap\GrassHi.BMP', SGrass, SGrass);

Я переделал прогу под свой формат, так я его кодирую:

Код


procedure TForm1.exClick(Sender: TObject);
var f:file of byte;
    i,j:integer;
    t:byte;
begin
  if SaveD.Execute then begin
    assignfile(f,SaveD.FileName);
    rewrite(f);
    t:=Image2.Width div 16;
    write(f,t);
    for i:=0 to Image2.Width do begin
    for j:=0 to Image2.Height do begin
      getRvalue(Image2.Canvas.Pixels[i,j]);
      write(f,t);
      getGvalue(Image2.Canvas.Pixels[i,j]);
      write(f,t);
      getBvalue(Image2.Canvas.Pixels[i,j]);
      write(f,t);
    end;
    end;
    closefile(f);
  end;
end;

А так загружаю (по аналогии с самым первым кодом в этой теме, где еще через TBitMap), только вот вместо текстур - все черное...

Код


function ReadBitmap(const FileName : String;
                    var sWidth, tHeight: GLsizei):pByteArray;
var
  i,j : Integer;
  f:file of byte;
  t,s:byte;
begin
  assignfile(f,FileName);
  reset(f);
  read(f,t);
  sWidth:=t*16;
  tHeight:=t*16;
  GetMem(result,sWidth*tHeight*3);
  for j:=0 to t*16-1 do begin
  for i:=0 to t*16-1 do begin
    read(f,s);
    result[(j*sWidth + i)*3]:=s;
    read(f,s);
    result[(j*sWidth + i)*3+1]:=s;
    read(f,s);
    result[(j*sWidth+ i)*3+2]:=s;
  end;
  end;
  closefile(f);
end;

В чем ошибка?

--------------------

http://dragonfire.cimanu.ru/

Alexeis

Дата 9.3.2006, 10:23 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

DragonFire
Спрашивал как грузить при помощи api
примерно так
h := LoadImage(0,
'..\Images\YourImage.bmp',
IMAGE_BITMAP,
0,
0,
LR_DEFAULTSIZE or
LR_LOADFROMFILE);

h - HBITMAP

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Демо

Дата 9.3.2006, 10:27 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Цитата(DragonFire @ 9.3.2006, 10:16

)

В чем ошибка?

Для PByteArray память выделяется процедурой New.

--------------------

DragonFire

Дата 9.3.2006, 10:46 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9

Цитата(alexeis1 @ 9.3.2006, 10:23

)

DragonFire
Спрашивал как грузить при помощи api
примерно так
h := LoadImage(0,
'..\Images\YourImage.bmp',
IMAGE_BITMAP,
0,
0,
LR_DEFAULTSIZE or
LR_LOADFROMFILE);

h - HBITMAP

А как тогда получить размер изображения? Как этот код переделать под h?

Код


function TLoad( const AFileName : String; var width,height:integer):pByteArray;
var B : TBitmap;
    i,j : Integer;
    temp: GLbyte;
begin
  B := TBitmap.Create;
  B.LoadFromFile(AFileName);
  Width := B.Width;
  Height := B.Height;

  GetMem(result,Width*Height*3);

  for j := 0 to Height - 1 do begin
    for i := 0 to Width - 1 do begin
      result[(j*Width + i)*3] := GetRValue(B.Canvas.Pixels[i,j]);
      result[(j*Width + i)*3+1] := GetGValue(B.Canvas.Pixels[i,j]);
      result[(j*Width + i)*3+2] := GetBValue(B.Canvas.Pixels[i,j]);

    end;
  end;

  B.Free;
end;

Цитата(Демо @ 9.3.2006, 10:27

)

Для PByteArray память выделяется процедурой New.

Написал
New(Resualt);
нифега не помогло smile

--------------------

http://dragonfire.cimanu.ru/

Демо

Дата 9.3.2006, 10:53 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Вообще, у тебя нужные данные содержатся в заголовках.

Код


  PBitmapInfoHeader = ^TBitmapInfoHeader;
  {$EXTERNALSYM tagBITMAPINFOHEADER}
  tagBITMAPINFOHEADER = packed record
    biSize: DWORD;
[B]    biWidth: Longint;
    biHeight: Longint;
[/B]    biPlanes: Word;
    biBitCount: Word;
    biCompression: DWORD;
    biSizeImage: DWORD;
    biXPelsPerMeter: Longint;
    biYPelsPerMeter: Longint;
    biClrUsed: DWORD;
    biClrImportant: DWORD;
  end;

  PBitmapFileHeader = ^TBitmapFileHeader;
  {$EXTERNALSYM tagBITMAPFILEHEADER}
  tagBITMAPFILEHEADER = packed record
    bfType: Word;
    bfSize: DWORD;
    bfReserved1: Word;
    bfReserved2: Word;
    bfOffBits: DWORD;
  end;
  TBitmapFileHeader = tagBITMAPFILEHEADER;

В приведенном мной коде ты получаешь оба заголовка и саму двоичную карту в PByteArray.
Дальше уже дело техники - как их использовать.

Это сообщение отредактировал(а) Демо - 9.3.2006, 10:54

--------------------

Alexeis

Дата 9.3.2006, 11:01 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Вот что на это говорит справка

Цитата

BOOL GetBitmapDimensionEx(
HBITMAP hBitmap, // handle to bitmap
LPSIZE lpDimension // dimensions
);

lpDimension - указатель на структуру типа Tpoint где x - width
y - height

--------------------

DragonFire

Дата 9.3.2006, 11:36 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9

Цитата(Демо @ 9.3.2006, 10:53

)

В приведенном мной коде ты получаешь оба заголовка и саму двоичную карту в PByteArray.
Дальше уже дело техники - как их использовать.

Все, совсем запутался... Как из этого описания получить что-либо? Где что объявлять и вызывать?

Цитата(alexeis1 @ 9.3.2006, 11:01

)

lpDimension - указатель на структуру типа Tpoint где x - width
y - height

Все, запутался... Пишу:

Код


var t:Tpoint;
begin
GetBitmapDimensionEx(h,t^);

и не пашет ничего... smile

Потолковее мона плиз, так чтобы мне нубу было понятно smile

--------------------

http://dragonfire.cimanu.ru/

Alexeis

Дата 9.3.2006, 11:50 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Вот так будет работать

Код


procedure TForm1.Button1Click(Sender: TObject);
var
 h : HBITMAP;
 DS: TDIBSection;
 Bytes: Integer;

begin
  h := LoadImage(0,
      'IMG.bmp',
      IMAGE_BITMAP,
      0,
      0,
      LR_DEFAULTSIZE or
      LR_LOADFROMFILE);

  DS.dsbmih.biSize := 0;
  FillChar(DS, SizeOf(DS), 0);
  Bytes := GetObject(h, SizeOf(DS), @DS);

  if Bytes = 0
  then
    Showmessage('FAIL')
  else
    Showmessage(inttostr(ds.dsBm.bmWidth) + ' ' + inttostr(ds.dsBm.bmHeight));
end;

Добавлено @ 11:53
Эту штуку я "украл" у Борланда
Добавлено @ 11:54
DS будет хранить вообще всю инфу о битмапе smile

--------------------

DragonFire

Дата 9.3.2006, 11:58 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9

Цитата(alexeis1 @ 9.3.2006, 11:50

)

Вот так будет работать

Код


function ReadBitmap(const FileName : String;
                    var sWidth, tHeight: GLsizei):pByteArray;
var
 h : HBITMAP;
 DS: TDIBSection;
 Bytes,i,j: Integer;
begin
  h:=LoadImage(0,PCHAR(FileName),IMAGE_BITMAP,0,0,LR_DEFAULTSIZE or LR_LOADFROMFILE);
  DS.dsbmih.biSize := 0;
  FillChar(DS, SizeOf(DS), 0);
  Bytes := GetObject(h, SizeOf(DS), @DS);
  sWidth:=ds.dsBm.bmWidth;
  tHeight:=ds.dsBm.bmHeight;
  for j:=0 to sWidth-1 do begin
  for i:=0 to tHeight-1 do begin
    result[(j*sWidth + i)*3]:=getRValue(h);
    result[(j*sWidth + i)*3+1]:=getGValue(h);
    result[(j*sWidth + i)*3+2]:=getBValue(h);
  end;
  end;
end;

Вместо текстуры - зеленый цвет smile

Это сообщение отредактировал(а) DragonFire - 9.3.2006, 11:59

--------------------

http://dragonfire.cimanu.ru/

Alexeis

Дата 9.3.2006, 12:06 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

не удивительно
GetRValue - прининимает в качестве параметра TRGB а ей передают
handle bitmapa
Добавлено @ 12:09
нужное действие выполняет

Цитата

int GetDIBits(
HDC hdc, // handle to DC
HBITMAP hbmp, // handle to bitmap
UINT uStartScan, // first scan line to set
UINT cScanLines, // number of scan lines to copy
LPVOID lpvBits, // array for bitmap bits
LPBITMAPINFO lpbi, // bitmap data buffer
UINT uUsage // RGB or palette index
);

Добавлено @ 12:19
Кажись я ошибся нужная информация уже хранится в
DS.dsBm.bmBits

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »