Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Загрузка текстуры, без TBitmap 
:(
    Опции темы
DragonFire
Дата 6.3.2006, 13:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Мне нужно загрузить текстуру. У меня есть такой код:
Код

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;

Но мне нужно составить процедуру, не использую TBitmap.
У меня есть и такой код:
Код

function ReadBitmap(const FileName : String;
                    var sWidth, tHeight: GLsizei):pointer;
const
  szh = SizeOf(TBitmapFileHeader);
  szi = SizeOf(TBitmapInfoHeader);
type
  TRGB = record
    r, g, b : GLbyte;
  end;
  TWrap = Array [0..0] of TRGB;
var
  BmpFile : File;
  bfh : TBitmapFileHeader;
  bmi : TBitmapInfoHeader;
  x, size: GLint;
  temp: GLbyte;
begin
  AssignFile (BmpFile, FileName);
  Reset (BmpFile, 1);
  Size := FileSize (BmpFile) - szh - szi;
  Blockread(BmpFile, bfh, szh);
  BlockRead (BmpFile, bmi, szi);
  If Bfh.bfType <> $4D42 then begin
    MessageBox(Window, 'Invalid Bitmap', 'Error', MB_OK);
    Result := nil;
    Exit;
  end;
  sWidth := bmi.biWidth;
  tHeight := bmi.biHeight;
  GetMem (Result, Size);
  BlockRead(BmpFile, Result^, Size);
  For x := 0 to sWidth*tHeight-1 do
    With TWrap(result^)[x] do begin
      temp := r;
      r := b;
      b := temp;
  end;
end;

Но в этой процедуре используется тип Pointer,а мне нужен pByteArray...
Как мне соместить эти две процедуры????
З.Ы.
Код

PByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;



--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 6.3.2006, 14:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
Мне кажется что решение черезчур сложное...
можно попробовать работать с bitmapom через api
Добавлено @ 15:02
Вот перечень функций для работы
Взято из справки
BitBlt
CreateBitmap
CreateBitmapIndirect
CreateCompatibleBitmap
CreateDIBitmap
CreateDIBSection
CreateDiscardableBitmap
ExtFloodFill
FloodFill
GetBitmapBits
GetBitmapDimensionEx
GetDIBColorTable
GetDIBits
GetPixel
GetStretchBltMode
LoadBitmap
MaskBlt
PatBlt
PlgBlt
SetBitmapBits
SetBitmapDimensionEx
SetDIBColorTable
SetDIBits
SetDIBitsToDevice
SetPixel
SetPixelV
SetStretchBltMode
StretchBlt
StretchDIBits


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 6.3.2006, 15:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Чтобы работать с TBitMaP нужно подключать модуль Graphics, а мне этого делать нельзя...
Вот составил процедурку - текстуры загружает, только нужно чтобы в pByteArray загрудала а не в Pointer...


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 6.3.2006, 15:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
причем здесь Graphics это Api функции определенные в модуле Windows
Добавлено @ 15:24
Эти функции не работают с tbitmap а с указателем на область памяти где хранится битмап HBITMAP (или handle картинки)
Добавлено @ 15:25
handle пролучают вызавом loadbitmap(...)
Добавлено @ 15:32
Вообще bitmap это некоторый зарегистрированный тип в windows
делфийский tbitmap это лишь оболочка виндовского.
Добавлено @ 15:36
А указтели любые можно и так присваивать без проблем
переменные pByteArray и Pointer присваиваются одна другой и наоборот.


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 6.3.2006, 20:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Если присваиваются, тогда почему при компиляции на строке With TWrap(result^)[x] do begin у меня выдает ошибку несоответствия типов, это я заменяю Pointer на pByteArray в описании функции...

Цитата(alexeis1 @ 6.3.2006, 15:22 Найти цитируемый пост)
причем здесь Graphics это Api функции определенные в модуле Windows

Тогда если не сложно, мог бы написать простенький код загрузки файла в Api TBitmap - создание его, объяление... smile


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
DragonFire
Дата 7.3.2006, 14:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
alexeis1
Можешь примерный код дать? плиз...


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Yanis
Дата 7.3.2006, 15:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 72
Всего: 111
Цитата(DragonFire @ 6.3.2006, 20:03 Найти цитируемый пост)
Если присваиваются, тогда почему при компиляции на строке With TWrap(result^)[x] do begin у меня выдает ошибку несоответствия типов, это я заменяю Pointer на pByteArray в описании функции...

У меня всё компилируется без ошибок.


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
DragonFire
Дата 7.3.2006, 15:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
А у меня ошибка на строке:
With (TWrap(result^)[x] do begin
вот какая:
[Error] PRL.dpr(459): Invalid typecast


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Romikgy
Дата 7.3.2006, 15:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
Код

BlockRead(BmpFile, Result, Size);
  For x := 0 to sWidth*tHeight-1 do
    With (TWrap(result))[x] do begin
      temp := r;
      r := b;
      b := temp;
  end;

А если так попробовать?


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Yanis
Дата 7.3.2006, 15:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

Репутация: 72
Всего: 111
Цитата(DragonFire @ 7.3.2006, 15:27 Найти цитируемый пост)
А у меня ошибка на строке:
With (TWrap(result^)[x] do begin
вот какая:
[Error] PRL.dpr(459): Invalid typecast

А у тебя какая версия Delphi?


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
DragonFire
Дата 7.3.2006, 15:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Цитата(Romikgy @ 7.3.2006, 15:31 Найти цитируемый пост)
А если так попробовать?

та же ошибка

Цитата(Yanis @ 7.3.2006, 15:46 Найти цитируемый пост)
А у тебя какая версия Delphi?

7 smile



--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Romikgy
Дата 7.3.2006, 16:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
Код

function ReadBitmap(const FileName : String;
                    var sWidth, tHeight: GLsizei):pointer;
const
  szh = SizeOf(TBitmapFileHeader);
  szi = SizeOf(TBitmapInfoHeader);
type
  TRGB = record
    r, g, b : GLbyte;
  end;
  TWrap = Array  of TRGB;
  
var
  BmpFile : File;
  bfh : TBitmapFileHeader;
  bmi : TBitmapInfoHeader;
  x, size: GLint;
  temp: GLbyte;
  per: TWrap;
begin
  AssignFile (BmpFile, FileName);
  Reset (BmpFile, 1);
  Size := FileSize (BmpFile) - szh - szi;
  Blockread(BmpFile, bfh, szh);
  BlockRead (BmpFile, bmi, szi);
  If Bfh.bfType <> $4D42 then begin
    MessageBox(Window, 'Invalid Bitmap', 'Error', MB_OK);
    Result := nil;
    Exit;
  end;
  sWidth := bmi.biWidth;
  tHeight := bmi.biHeight;
  GetMem (per, Size);// может и здесь надо будет @per[0]
  BlockRead(BmpFile, per, Size);
  For x := 0 to sWidth*tHeight-1 do
    With per[x] do begin
      temp := r;
      r := b;
      b := temp;
  end;
 Result:=@per[0];
end;

А так?


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
DragonFire
Дата 7.3.2006, 16:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Все прикрасно компелируется, даже если тип функции поменять на pByteArray но при загрузке выдает RunTime Errore...


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Romikgy
Дата 7.3.2006, 16:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
Цитата(DragonFire @ 7.3.2006, 15:17 Найти цитируемый пост)
RunTime Error

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


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Albinos_x
Дата 7.3.2006, 17:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


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

Репутация: 26
Всего: 108
попробуй в конце процедуры поставить
CloseFile(BmpFile);
и в свойствах файла убрать атрибут только для чтения...


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 7.3.2006, 18:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

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

Romikgy
На строке
BlockRead(BmpFile, per, Size);
Это перед циклом...


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 7.3.2006, 20:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


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

Репутация: 26
Всего: 108
Цитата(DragonFire @ 7.3.2006, 18:45 Найти цитируемый пост)
На строке
BlockRead(BmpFile, per, Size);
Это перед циклом...

если возмёшь маленький файл этой ошибки вылетать не будет, т.е. у этой функции видимо есть ограничение на Size, пока в справке ничего по этому поводу не нашёл... советую ограничить чтение блоком допустип - 8192 и считывать в цикле...


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 7.3.2006, 21:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Да...
Хотелось бы побольше, чем 16х16 smile


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 7.3.2006, 22:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


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

Репутация: 26
Всего: 108
Цитата(DragonFire @ 7.3.2006, 21:31 Найти цитируемый пост)
Да...
Хотелось бы побольше, чем 16х16

я имел ввиду считывать по блочно (кусками по 8192)


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 7.3.2006, 23:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
тоесть? кусок текстуры, а потом соеденить? интересно...
вот тока как это сделать? smile


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 7.3.2006, 23:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


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

Репутация: 26
Всего: 108
Цитата(DragonFire @ 7.3.2006, 23:03 Найти цитируемый пост)
тоесть? кусок текстуры, а потом соеденить? интересно...
вот тока как это сделать?

не.. то есть делаешь промежуточный массив, допустим pertemp, такой же как per, только размером 8192 в него считываешь блок, после дописываешь им per, и так в цикле пока per не заполнишь(или не прочитаешь весь файл)...


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 7.3.2006, 23:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Спасибо, щас попробую...
Добавлено @ 23:43
Код

function ReadBitmap(const FileName : String;
                    var sWidth, tHeight: GLsizei):PByteArray;
const
  szh = SizeOf(TBitmapFileHeader);
  szi = SizeOf(TBitmapInfoHeader);
type
  TRGB = record
    r, g, b : GLbyte;
  end;
  TWrap = Array  of TRGB;
  Tpertemp = Array [0..8190] of TRGB;
  
var
  BmpFile : File;
  bfh : TBitmapFileHeader;
  bmi : TBitmapInfoHeader;
  x, size: GLint;
  temp: GLbyte;
  per: TWrap;
  pertemp: Tpertemp;
  i:integer;
begin
  AssignFile (BmpFile, FileName);
  Reset (BmpFile, 1);
  Size := FileSize (BmpFile) - szh - szi;
  Blockread(BmpFile, bfh, szh);
  BlockRead (BmpFile, bmi, szi);
  If Bfh.bfType <> $4D42 then begin
    MessageBox(Window, 'Invalid Bitmap', 'Error', MB_OK);
    Result := nil;
    Exit;
  end;
  sWidth := bmi.biWidth;
  tHeight := bmi.biHeight;
  GetMem (per, Size);// ìîæåò è çäåñü íàäî áóäåò @per[0]
  while eof(BmpFile) do begin
    BlockRead(BmpFile, pertemp, Size);
    for i:=0 to 8190 do per[i]:=pertemp[i];
  end;

  For x := 0 to sWidth*tHeight-1 do
    With per[x] do begin
      temp := r;
      r := b;
      b := temp;
  end;
 Result:=@per[0];
end;

Вот так... грузит тока вместо текстур все черное...

...Я вот подумал может дело не в типе, а в хранении данных... мне нужно чтобы они хранились как тут хранятся:
Код

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;

может не надо так сложно это переделывать... теперь то это вообще не текстура smile



--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
DragonFire
Дата 8.3.2006, 12:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Короче, можно заменить делфийский TBitMap на какой-нибудь Api-шный Bitmap??


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 8.3.2006, 14:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


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

Репутация: 26
Всего: 108
Цитата(DragonFire @ 7.3.2006, 23:35 Найти цитируемый пост)
Вот так... грузит тока вместо текстур все черное...

это понятно... у тебя массив кроме первых 8190 элементов будет равен 0...
Цитата(DragonFire @ 7.3.2006, 23:35 Найти цитируемый пост)
for i:=0 to 8190 do per[i]:=pertemp[i];

тогда уж вот так:
Код

  j:=0;
  while not eof(BmpFile) do begin    
    BlockRead(BmpFile, pertemp, 8192);
   for i:=0 to 8191 do 
      begin
      per[j]:=pertemp[i];
      if j>=Size then break;
      inc(j);
      end;


Это сообщение отредактировал(а) Albinos_x - 8.3.2006, 16:24


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 8.3.2006, 15:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Ууу...
Так вообще ошибку выдает и открывает окно CPU...
Может можно просто как то заменить TBitMap Delphi на какой-нибудь TBitMap Api?


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 8.3.2006, 16:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


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

Репутация: 26
Всего: 108
Цитата(DragonFire @ 8.3.2006, 15:27 Найти цитируемый пост)
Так вообще ошибку выдает и открывает окно CPU...

угу... такое же окошечко я видел в твоём коде и до этого но с маленькой картинкой...

а так всё дело "в волшебных пузырьках"....:
Код

function ReadBitmap(const FileName : String;
                    var sWidth, tHeight: GLsizei):PByteArray;
const
  szh = SizeOf(TBitmapFileHeader);    
  szi = SizeOf(TBitmapInfoHeader);    
type
  TRGB = record    
    r, g, b : GLbyte;
  end;
  TWrap = Array  of TRGB;    
  Tpertemp = Array [0..8192] of TRGB;

var    
  BmpFile : File;    
  bfh : TBitmapFileHeader;
  bmi : TBitmapInfoHeader;    
  x, size: integer;
  temp: byte;
  per: TWrap;    
  pertemp: Tpertemp;    
  i,j,k:integer;
begin    
  AssignFile (BmpFile, FileName);
  Reset (BmpFile, 1);
  Size := FileSize (BmpFile) - szh - szi;    
  Blockread(BmpFile, bfh, szh);    
  BlockRead (BmpFile, bmi, szi);
  If Bfh.bfType <> $4D42 then begin    
    MessageBox(0, 'Invalid Bitmap', 'Error', MB_OK);
    Result := nil;
    Exit;    
  end;
  sWidth := bmi.biWidth;
  tHeight := bmi.biHeight;
  GetMem (per, Size*4);    
  j:=0;
  for k:=1 to trunc(Size/8192) do
    begin
    BlockRead(BmpFile, pertemp, 8192);
   for i:=0 to 8191 do
      begin
      per[j]:=pertemp[i];
      inc(j);
      end;
   end;
  k:=Size mod 8192;
  if (k)<>0 then
      begin
      BlockRead(BmpFile, pertemp, k);
      for i:=0 to k do
         begin
         per[j]:=pertemp[i];
         inc(j);
         end;
      end;
  For x := 0 to sWidth*tHeight-1 do
    With per[x] do begin
      temp := r;
      r := b;
      b := temp;
  end;
 Result:=@per[0];
end;


видимо глюк ловит ф-я BlockRead и вместе с
Код

while not eof(BmpFile) do

работать не хочет... хотя должна...
Добавлено @ 16:33
Цитата(DragonFire @ 8.3.2006, 15:27 Найти цитируемый пост)
Может можно просто как то заменить TBitMap Delphi на какой-нибудь TBitMap Api?

вотт так его описывает делфя:
Код

TBitmapImage = class(TSharedImage)
  private
    FHandle: HBITMAP;     // DDB or DIB handle, used for drawing
    FMaskHandle: HBITMAP; // DDB handle
    FPalette: HPALETTE;
    FDIBHandle: HBITMAP;  // DIB handle corresponding to TDIBSection
    FDIB: TDIBSection;
    FSaveStream: TMemoryStream; // Save original RLE stream until image is modified
    FOS2Format: Boolean;  // Write BMP file header, color table in OS/2 format
    FHalftone: Boolean;   // FPalette is halftone; don't write to file
  protected
    procedure FreeHandle; override;
  public
    destructor Destroy; override;
  end;

  TBitmapHandleType = (bmDIB, bmDDB);
  TPixelFormat = (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit, pfCustom);
  TTransparentMode = (tmAuto, tmFixed);

  TBitmap = class(TGraphic)
  private
    FImage: TBitmapImage;
    FCanvas: TCanvas;
    FIgnorePalette: Boolean;
    FMaskBitsValid: Boolean;
    FMaskValid: Boolean;
    FTransparentColor: TColor;
    FTransparentMode: TTransparentMode;
    procedure Changing(Sender: TObject);
...
...



--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 8.3.2006, 16:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Да... не пашет...
А насчет описания - я смотрел, только там оченб много ссылок на типы разные из SysUtillsa и другого...


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 8.3.2006, 17:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


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

Репутация: 26
Всего: 108
Цитата(DragonFire @ 8.3.2006, 16:55 Найти цитируемый пост)
Да... не пашет...

последний вариант попробовал?


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 8.3.2006, 19:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

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


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 8.3.2006, 20:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


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

Репутация: 26
Всего: 108
в чем выражается?
может попробовать не указатель(т.к. массив per заполняется нормально... проверял), а сам массив передавать?
Код
...
type    
  TRGB = record     
    r, g, b : GLbyte;    
  end;
...
function ReadBitmap(const FileName : String;    
                    var sWidth, tHeight: GLsizei):TRGB;    
...
...
  end;    
 Result:=per;    
end;



--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
DragonFire
Дата 8.3.2006, 22:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
При вызове функции пишет несоответствие типа TRGB и Pointer...


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Albinos_x
Дата 8.3.2006, 22:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Evil Skynet
****


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

Репутация: 26
Всего: 108
видимо ф-ю поменял, а принимаешь не в массив, а в указатель...(если я правильно понял)


--------------------
"Кто владеет информацией, тот владеет миром"    
Уинстон Черчилль
PM MAIL ICQ   Вверх
Демо
Дата 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.


--------------------
    
PM MAIL ICQ Skype   Вверх
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/
PM MAIL ICQ   Вверх
Демо
Дата 9.3.2006, 09:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 30
Всего: 50
Цитата(DragonFire @ 9.3.2006, 08:25 Найти цитируемый пост)
Функция не может иметь формат TRGB (TBMP) - при высове функции возникает ошибка несоответствия типов TRGB и Pointer.


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


--------------------
    
PM MAIL ICQ Skype   Вверх
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/
PM MAIL ICQ   Вверх
Alexeis
Дата 9.3.2006, 10:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 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 вечная память.

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Демо
Дата 9.3.2006, 10:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 30
Всего: 50
Цитата(DragonFire @ 9.3.2006, 10:16 Найти цитируемый пост)
В чем ошибка?


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


--------------------
    
PM MAIL ICQ Skype   Вверх
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/
PM MAIL ICQ   Вверх
Демо
Дата 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


--------------------
    
PM MAIL ICQ Skype   Вверх
Alexeis
Дата 9.3.2006, 11:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
Вот что на это говорит справка
Цитата

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


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


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
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/
PM MAIL ICQ   Вверх
Alexeis
Дата 9.3.2006, 11:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 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


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
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 smile smile smile

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


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 9.3.2006, 12:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 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


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Alexeis
Дата 9.3.2006, 12:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
В смысле указатель на карту битов который и будет pByteArray
Добавлено @ 12:29
Точнее это указатель на двумерный массив хранящий последовательно все строки картинки.
если размер картинки заранее известен то это будет что-то
вроде

trgb = packed record
b,g,r : byte;
end;
Var
b : ^array[1..height, 1..Width*3] of Byte;
или
b : ^array[1..height, 1..Width] of TRGB;
Добавлено @ 12:30
Если нет то смещение на каждую новую строку прийдется искать вручную


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 9.3.2006, 13:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
А как получить карту битов? где присваивать это b ??


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 9.3.2006, 13:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
Адресс этой карты хранится в DS.dsBm.bmBits


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Romikgy
Дата 9.3.2006, 13:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
LPVOID lpvBits, // address of array for bitmap bits


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Alexeis
Дата 9.3.2006, 13:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
Все эти операции и многие другие, кстати, можно посмотреть
в реализации TBITMAP - в конечном итоге он ведь оперирует средствами Windows - я как раз так и делаю.



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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 9.3.2006, 13:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Непаномаю...
как связать DS.dsBm.bmBits и это:
Цитата(alexeis1 @ 9.3.2006, 12:22 Найти цитируемый пост)
В смысле указатель на карту битов который и будет pByteArray
Добавлено @ 12:29
Точнее это указатель на двумерный массив хранящий последовательно все строки картинки.
если размер картинки заранее известен то это будет что-то
вроде

trgb = packed record
b,g,r : byte;
end;
Var
b : ^array[1..height, 1..Width*3] of Byte;
или
b : ^array[1..height, 1..Width] of TRGB;
Добавлено @ 12:30
Если нет то смещение на каждую новую строку прийдется искать вручную




--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 9.3.2006, 13:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
Romikgy, эта функция, как оказалось, делает не совсем то что надо.


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Romikgy
Дата 9.3.2006, 13:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
Цитата(alexeis1 @ 9.3.2006, 12:22 Найти цитируемый пост)
эта функция,

какая эта?


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
Guedda
Дата 9.3.2006, 13:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Подрывник
****


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

Репутация: 14
Всего: 78
Цитата(Romikgy @ 9.3.2006, 14:18)
LPVOID lpvBits, // address of array for bitmap bits

Эта


--------------------
Ll 2
PM MAIL WWW ICQ Skype GTalk   Вверх
Alexeis
Дата 9.3.2006, 13:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
b := DS.dsBm.bmBits
Добавлено @ 13:32
Sorry опять ошибочка объявлять придется примерно так
Код

 type
   arrtype = array[1..100,1..100] of byte;

var
  ar : ^arrtype;


Добавлено @ 13:35
Romikgy,
я имел ввиду функцию
Код

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
);

или я неправ smile


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 9.3.2006, 13:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Ну вот я написал:
Код

function ReadBitmap(const FileName : String;
                    var sWidth, tHeight: GLsizei):pByteArray;
type arrtype = array[1..100,1..100] of byte;
var
 h : HBITMAP;
 DS: TDIBSection;
 Bytes,i,j: Integer;
 b:^arrtype;
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;
  b:=DS.dsBm.bmBits;
  result:=b;
end;


Тока ошибка на result:=b; Что тут надо писать? Опять я что-то пропустил из объяснений?


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 9.3.2006, 13:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
я не знаю как здесь объявлен pByteArray
или он стандартый smile


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 9.3.2006, 13:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
PByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 9.3.2006, 13:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
если стандартный и не требуется разбиение на строки
то вообще просто
result := DS.dsBm.bmBits


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Romikgy
Дата 9.3.2006, 13:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Любитель-программер
****


Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146
Можно так попробывать
result:=pByteArray(b);


--------------------
Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности. 
smile
PM   Вверх
DragonFire
Дата 9.3.2006, 13:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

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


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 9.3.2006, 13:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

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


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 9.3.2006, 13:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Давайте рассуждать логически... Что нам нужно? Нужно, чтобы в pByteArray записывализь RGB в таком порялке: Пиксель1: R,G,B; Пиксель 2: R,G,B; и т.д.Тоесть должна получится цепочка: R,G,B,R,G,B,R,G,B...
Вопрос: как ее получить из DS.dsBm.bmBits?

Он не ругается - текстуры нету вообще просто...

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


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 9.3.2006, 13:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
что не нравится объява????!!!!!
Код

var
 p : pByteArray;
begin
p := DS.dsBm.bmBits;

странно у меня пашет....
Добавлено @ 14:03
интересно что DS.dsBm.bmBits и есть указатель на эту самую искомую текстуру!
а как дальше идет отрисовка(или проверка)???


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 9.3.2006, 16:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

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

function ReadBitmap(const FileName : String;
                    var sWidth, tHeight: GLsizei):pByteArray;
var
 h : HBITMAP;
 DS: TDIBSection;
 Bytes,i,j: Integer;
 p:pByteArray;
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;
  result:=DS.dsBm.bmBits;  
end;

Но вместо текстуры - все черное...
Где-то ошибка, если DS.dsBm.bmBits - и есть искомая структура...


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 10.3.2006, 11:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
DragonFire, это код загрузки хотелось бы посмотреть на код отображения (отрисовки) картинки.


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 10.3.2006, 12:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Примерно так:
Код

...
var TexKost:Pointer; SKost:GLSizei; 
...
procedure SetTex(TexNow:Pointer;NowSize:GLsizei);
begin
  glTexImage2D(GL_TEXTURE_2D, 0, 3, NowSize, NowSize, 0,
              GL_RGB, GL_UNSIGNED_BYTE, TexNow);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
  glTexEnvi(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_DECAL);
end;
procedure Paint;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glPushMatrix;
  glColor3F(0.1,0.7,0.5);
  SetTex(TexKost,SKost);
  glEnable(GL_TEXTURE_2D);
  glBegin(GL_Quads);
    glTexCoord2d(0, 1);
    glVertex3f(1.0-0.03,-0.65+0.03,0);
    glTexCoord2d(1, 1);
    glVertex3f(1.0+0.03,-0.65+0.03,0);
    glTexCoord2d(1, 0);
    glVertex3f(1.0+0.03,-0.65-0.03,0);
    glTexCoord2d(0, 0);
    glVertex3f(1.0-0.03,-0.65-0.03,0);
  glEnd;
  glDisable(GL_TEXTURE_2D);
  glPopMatrix;

  SwapBuffers (DC);
end;
...
begin
TexKost:=ReadBitmap(ExtractFilePath(Char(0))+'Bitmap\Bone.BMP', SKost, SKost);
...
end.



--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Girder
Дата 10.3.2006, 12:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Лентяй 2
***


Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 31
Всего: 155
Цитата(DragonFire @ 6.3.2006, 20:03 Найти цитируемый пост)
Если присваиваются, тогда почему при компиляции на строке With TWrap(result^)[x] do begin у меня выдает ошибку несоответствия типов, это я заменяю Pointer на pByteArray в описании функции...

pTWrap(DWord(Result)+x*SizeOf(TWrap))^[0];
где pTWrap = ^TWrap;



--------------------
Как слышим, так и пишим.
Истина где-то там...
PM   Вверх
Alexeis
Дата 10.3.2006, 12:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
DragonFire, есть еще проблема windws может (и делает это) грузить картинку прямо в видекарту (т.е. в аппаратный буфер)


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Alexeis
Дата 10.3.2006, 12:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
Порывшись в примерах я нашел чтото похожее на то что нужно
дання процедура использовалась для создания скина из битмапа
при помощи апи
Привожу фрагмент
Код

function CreateBitmapRgn(DC: hDC; Bitmap: hBitmap; TransClr: TColorRef): hRgn;
var
  bmInfo: TBitmap;               // структура BITMAP WinAPI
  W, H: Integer;                 // высота и ширина растра
  bmDIB: hBitmap;                // дискрептор независимого растра
  bmiInfo: BITMAPINFO;           // структура BITMAPINFO WinAPI
  lpBits, lpOldBits: PRGBTriple; // указатели на структуры RGBTRIPLE WinAPI
  lpData: PRgnData;              // указатель на структуру RGNDATA WinAPI
  X, Y, C, F, I: Integer;        // переменные циклов
  Buf: Pointer;                  // указатель
  BufSize: Integer;              // размер указателя
  rdhInfo: TRgnDataHeader;       // структура RGNDATAHEADER WinAPI
  lpRect: PRect;                 // указатель на TRect (RECT WinAPI)
begin
  Result:=0;
  //если растр не задан, выходим
  if Bitmap=0 then
    Exit;

  //узнаем размеры растра
  GetObject(Bitmap, SizeOf(bmInfo), @bmInfo);
  //используя структуру BITMAP
  W:=bmInfo.bmWidth;
  H:=bmInfo.bmHeight;
  //определяем смещение в байтах
  I:=(W*3)-((W*3) div 4)*4;
  if I<>0 then
    I:=4-I;

  //Пояснение: растр Windows Bitmap читается снизу вверх, причем каждая строка
  //дополняется нулевыми байтами до ее кратности 4.
  //для 32-х битный растров такой сдвиг делать не надо.

  //заполняем BITMAPINFO для передачи в CreateDIBSection

  bmiInfo.bmiHeader.biWidth:=W;            // ширина
  bmiInfo.bmiHeader.biHeight:=H;           // высота
  bmiInfo.bmiHeader.biPlanes:=1;           // всегда 1
  bmiInfo.bmiHeader.biBitCount:=24;        // три байта на пиксель
  bmiInfo.bmiHeader.biCompression:=BI_RGB; // без компрессии
  bmiInfo.bmiHeader.biSizeImage:=0;        // размер не знаем, ставим в ноль
  bmiInfo.bmiHeader.biXPelsPerMeter:=2834; // пикселей на метр, гор.
  bmiInfo.bmiHeader.biYPelsPerMeter:=2834; // пикселей на метр, верт.
  bmiInfo.bmiHeader.biClrUsed:=0;          // палитры нет, все в ноль
  bmiInfo.bmiHeader.biClrImportant:=0;     // то же
  bmiInfo.bmiHeader.biSize:=SizeOf(bmiInfo.bmiHeader); // размер структруы
  bmDIB:=CreateDIBSection(DC, bmiInfo, DIB_RGB_COLORS,
  Pointer(lpBits), 0, 0);
  //создаем независимый растр WxHx24, без палитры, в указателе lpBits получаем
  //адрес первого байта этого растра. bmDIB - дискрептор растра

  //заполняем первые шесть членов BITMAPINFO для передачи в GetDIBits

  bmiInfo.bmiHeader.biWidth:=W;            // ширина
  bmiInfo.bmiHeader.biHeight:=H;           // высота
  bmiInfo.bmiHeader.biPlanes:=1;           // всегда 1
  bmiInfo.bmiHeader.biBitCount:=24;        // три байта на пиксель
  bmiInfo.bmiHeader.biCompression:=BI_RGB; // без компресси
  bmiInfo.bmiHeader.biSize:=SizeOf(bmiInfo.bmiHeader); // размер структуры
  GetDIBits(DC, Bitmap, 0, H-1, lpBits, bmiInfo, DIB_RGB_COLORS);
  //конвертируем исходный растр в наш с его копированием по адресу lpBits



Добавлено @ 13:08
Порывшись в справке я еще нашел что функция
CreateDIBSection создает тот самый аппаратно независимый растр
который нам и нужен


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 10.3.2006, 13:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Цитата(Girder @ 10.3.2006, 12:19 Найти цитируемый пост)
pTWrap(DWord(Result)+x*SizeOf(TWrap))^[0];
где pTWrap = ^TWrap;

И куда это писать?
Простите нуба...

Цитата(alexeis1 @ 10.3.2006, 12:56 Найти цитируемый пост)
Порывшись в примерах я нашел чтото похожее на то что нужно
дання процедура использовалась для создания скина из битмапа
при помощи апи
Привожу фрагмент

Вещь хорошая, но непонятная...
Где тут название файла? она же ничего не загружает...
И еще как pByteArray или хотябы Pointer присобачить? Через Buf?


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Girder
Дата 10.3.2006, 13:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Лентяй 2
***


Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 31
Всего: 155
Цитата(DragonFire @ 10.3.2006, 13:08 Найти цитируемый пост)
И куда это писать?

http://forum.vingrad.ru/index.php?showtopi...st&p=662985 ("У меня есть и такой код:")

Вместо: With TWrap(result^)[x] do begin
Енто: With pTWrap(DWord(Result)+x*SizeOf(TWrap))^[0] do begin

Перед: TWrap = Array [0..0] of TRGB;
Енто: pTWrap = ^TWrap;


--------------------
Как слышим, так и пишим.
Истина где-то там...
PM   Вверх
Alexeis
Дата 10.3.2006, 13:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
DragonFire, файл предпологается загуженным заранее
Bitmap : hBitmap - handle загруженного битмапа
(то что мы получили функцией LoadImage и записывали в переменную h)
Добавлено @ 13:16
Далее анологично получили информацию
строчка GetObject(Bitmap, SizeOf(bmInfo), @bmInfo);
Добавлено @ 13:17
у нас это было ввиде
DS.dsbmih.biSize := 0;
FillChar(DS, SizeOf(DS), 0);
Bytes := GetObject(h, SizeOf(DS), @DS);
Добавлено @ 13:22
Потом заполнили специальную структуру для подготовки аппаратно независимого растра - это
bmiInfo

Затем вызвали
CreateDIBSection(DC, bmiInfo , DIB_RGB_COLORS,
Pointer(lpBits), 0, 0);

и получили злополучный указатель в переменной lpBits

Для чего нужно GetDIBits я еще не знаю.


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Alexeis
Дата 10.3.2006, 13:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
Понял smile GetDIBits делает копию растра в буфер, так как CreateDIBSection создает пустой растр (типа заготовки), а GetDIBits просто его заполняет.
Только после этого в lpBits будет нужный растр.
Вроде ВСЕ smile


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 10.3.2006, 14:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Girder
Спасибо, прога запустилась! Тока это проблемы не решило... где-то ошибка в загрузке текстур... Она всеравно натягивается неправильно...

alexeis1
А теперь, если можно полный код, потому что у меня выдает ошибку, когда я вместо h пытаюсь подставить Bitmap...


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Alexeis
Дата 10.3.2006, 15:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
К сожалению я с OpenGl ем не знаком поэтому выводил на экран как
мог.
У меня есть заготовленная картинка 200x250 ее я и использовал
("img.bmp")

Код

type
  Trgb = packed record
                 b,g,r : byte
                 end;

  arr = array[1..250,1..200] of Trgb;

procedure TForm1.Button1Click(Sender: TObject);
var
 DC : hDC;
 Bitmap : HBITMAP;
 p : ^arr;        //можно удалить
 i, j : integer;  //можно удалить
 bmInfo: TDIBSection;           // структура BITMAP WinAPI
 W, H : Integer;                 // высота и ширина растра
 bmDIB: hBitmap;                // дискрептор независимого растра
 bmiInfo: BITMAPINFO;           // структура BITMAPINFO WinAPI
 lpBits: PRGBTriple;            // указатели на структуры RGBTRIPLE WinAPI

begin
  DC := Form1.Canvas.Handle; {DC := GetDC(Handle)
                              Handle - окна вывода(или любого)}

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

  GetObject(Bitmap, SizeOf(bmInfo), @bmInfo);

  W := bmInfo.dsBm.bmWidth;
  H := bmInfo.dsBm.bmHeight;

  bmiInfo.bmiHeader.biWidth:=W;            // ширина
  bmiInfo.bmiHeader.biHeight:=H;           // высота    
  bmiInfo.bmiHeader.biPlanes:=1;           // всегда 1    
  bmiInfo.bmiHeader.biBitCount:=24;        // три байта на пиксель    
  bmiInfo.bmiHeader.biCompression:=BI_RGB; // без компрессии    
  bmiInfo.bmiHeader.biSizeImage:=0;        // размер не знаем, ставим в ноль    
  bmiInfo.bmiHeader.biXPelsPerMeter:=2834; // пикселей на метр, гор.    
  bmiInfo.bmiHeader.biYPelsPerMeter:=2834; // пикселей на метр, верт.    
  bmiInfo.bmiHeader.biClrUsed:=0;          // палитры нет, все в ноль    
  bmiInfo.bmiHeader.biClrImportant:=0;     // то же    
  bmiInfo.bmiHeader.biSize:=SizeOf(bmiInfo.bmiHeader); // размер структруы    
  bmDIB := CreateDIBSection(DC, bmiInfo, DIB_RGB_COLORS,
  Pointer(lpBits), 0, 0);
  //создаем независимый растр WxHx24, без палитры, в указателе lpBits получаем    
  //адрес первого байта этого растра. bmDIB - дискрептор растра    
  //заполняем первые шесть членов BITMAPINFO для передачи в GetDIBits    
  bmiInfo.bmiHeader.biWidth:=W;            // ширина    
  bmiInfo.bmiHeader.biHeight:=H;           // высота    
  bmiInfo.bmiHeader.biPlanes:=1;           // всегда 1    
  bmiInfo.bmiHeader.biBitCount:=24;        // три байта на пиксель    
  bmiInfo.bmiHeader.biCompression:=BI_RGB; // без компресси    
  bmiInfo.bmiHeader.biSize:=SizeOf(bmiInfo.bmiHeader); // размер структуры    
  GetDIBits(DC, Bitmap, 0, H - 1, lpBits, bmiInfo, DIB_RGB_COLORS);

  p := Pointer(lpBits); //это мой вариант с выводом на форму

  {здесь должно быть
  result:= Pointer(lpBits)
  вместо
  p := Pointer(lpBits);}

  For i := 1 to 200 do  //Вывод на форму
  for j := 1 to 250 do  //Можно удалить
   form1.Canvas.Pixels[i, 250 - j] := RGB(p^[j,i].r, p^[j,i].g, p^[j,i].b);
end;



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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
DragonFire
Дата 10.3.2006, 17:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Не, не загружает...
Вместо текстур - черное все... Тоесть это значит что текстуры загружены, только всеравно что черный квадрат загрузить...
Попробовал вот так, вообще виснит, хотя вроде все должнобыть так, как в примере с канвасом... smile
Код

function ReadBitmap(const FileName : String;
                    var sWidth, tHeight: GLsizei):pByteArray;
type
Trgb = packed record
                 b,g,r : byte
                 end;
arr = array[1..512,1..512] of Trgb;
var
 DC : hDC;
 Bitmap : HBITMAP;
 bmInfo: TDIBSection;           // ñòðóêòóðà BITMAP WinAPI
 W, H ,i,j: Integer;                 // âûñîòà è øèðèíà ðàñòðà
 bmDIB: hBitmap;                // äèñêðåïòîð íåçàâèñèìîãî ðàñòðà
 bmiInfo: BITMAPINFO;           // ñòðóêòóðà BITMAPINFO WinAPI
 lpBits: PRGBTriple;            // óêàçàòåëè íà ñòðóêòóðû RGBTRIPLE WinAPI
 p : ^arr;
begin
  Bitmap := LoadImage(0,
      PCHAR(FileName),
      IMAGE_BITMAP,
      0,
      0,
      LR_DEFAULTSIZE or
      LR_LOADFROMFILE);

  GetObject(Bitmap, SizeOf(bmInfo), @bmInfo);

  W := bmInfo.dsBm.bmWidth;
  H := bmInfo.dsBm.bmHeight;

  bmiInfo.bmiHeader.biWidth:=W;            // øèðèíà
  bmiInfo.bmiHeader.biHeight:=H;           // âûñîòà
  bmiInfo.bmiHeader.biPlanes:=1;           // âñåãäà 1
  bmiInfo.bmiHeader.biBitCount:=24;        // òðè áàéòà íà ïèêñåëü
  bmiInfo.bmiHeader.biCompression:=BI_RGB; // áåç êîìïðåññèè
  bmiInfo.bmiHeader.biSizeImage:=0;        // ðàçìåð íå çíàåì, ñòàâèì â íîëü
  bmiInfo.bmiHeader.biXPelsPerMeter:=2834; // ïèêñåëåé íà ìåòð, ãîð.
  bmiInfo.bmiHeader.biYPelsPerMeter:=2834; // ïèêñåëåé íà ìåòð, âåðò.
  bmiInfo.bmiHeader.biClrUsed:=0;          // ïàëèòðû íåò, âñå â íîëü
  bmiInfo.bmiHeader.biClrImportant:=0;     // òî æå
  bmiInfo.bmiHeader.biSize:=SizeOf(bmiInfo.bmiHeader); // ðàçìåð ñòðóêòðóû
  bmDIB := CreateDIBSection(DC, bmiInfo, DIB_RGB_COLORS,
  Pointer(lpBits), 0, 0);
  //ñîçäàåì íåçàâèñèìûé ðàñòð WxHx24, áåç ïàëèòðû, â óêàçàòåëå lpBits ïîëó÷àåì
  //àäðåñ ïåðâîãî áàéòà ýòîãî ðàñòðà. bmDIB - äèñêðåïòîð ðàñòðà
  //çàïîëíÿåì ïåðâûå øåñòü ÷ëåíîâ BITMAPINFO äëÿ ïåðåäà÷è â GetDIBits
  bmiInfo.bmiHeader.biWidth:=W;            // øèðèíà
  bmiInfo.bmiHeader.biHeight:=H;           // âûñîòà
  sWidth:=W;
  tHeight:=H;
  bmiInfo.bmiHeader.biPlanes:=1;           // âñåãäà 1
  bmiInfo.bmiHeader.biBitCount:=24;        // òðè áàéòà íà ïèêñåëü
  bmiInfo.bmiHeader.biCompression:=BI_RGB; // áåç êîìïðåññè
  bmiInfo.bmiHeader.biSize:=SizeOf(bmiInfo.bmiHeader); // ðàçìåð ñòðóêòóðû
  GetDIBits(DC, Bitmap, 0, H - 1, lpBits, bmiInfo, DIB_RGB_COLORS);
  p := Pointer(lpBits);
  for i:=0 to 512 do for j:=0 to 512 do begin
  result[i*3+h]:=p^[i,j].r;
  result[i*3+h+1]:=p[i,j].g;
  result[i*3+h+2]:=p[i,j].b;
  end;
end;



--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
DragonFire
Дата 12.3.2006, 10:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: нет
Всего: 9
Я ПОНЯЛ smile smile smile
Извините, я жестко ступил. На самом деле текстуры правильно отображаются при обоих моих способах (см. первую страницу), только при Api-шном способе тектура загружается снизу-вверх, а не сверху-вниз. Решение проблемы - отразить текстуру сверху вниз в пайнте smile
Еще раз извините, за мучения!


--------------------
http://dragonfire.cimanu.ru/
PM MAIL ICQ   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1502 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.