Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Загрузка BMP [Delphi, Windows]


Sphinx ©   (2004-11-06 20:29:00) 

Пытаюсь собрать свой файл ресурсов, в котором будет хранитсья BMP картинка.
Далаю это так.

есть следующий юнит:

unit EngineClasses;

interface

type
 TResHeader = record
   Name:     String[5];  // описание формата файла
   Version:  Byte;       // версия заголовка
 end;

implementation

end.

так же юнит по работе с изображениями:

unit UnitPic;

interface
uses
 SysUtils,
 Windows,
 EngineClasses;

function LoadBitMap24File(const WHandle: THandle; FileName: String; out BMap: HBitmap): HResult;
function LoadBitMap24Res(HBmp: HBitMap; DestHandle: THandle):HResult;

implementation

function LoadBitMap24File(const WHandle: THandle;   // указатель на окно приложения
                     FileName: String;             // путь к файлу с изображением
                     out BMap: HBitmap): HResult;  // указатель на bitmap -
                                                   // выходной параметр
var
 HBMap:            HBitMap;            // указатель на структуру изображения
 FileHeader:       TResHeader;         // заголовок файла ресурсов
 F:                File;               // собственно файл
 BitmapFileHeader : TBITMAPFILEHEADER;
 BitmapInfoHeader: TBITMAPINFOHEADER;  // заголовок информации об изображении
 BitmapInfo:       TBitMapInfo;        // ***********************************
 BitmapBits:       Pointer;            // указатель на массив с хранимым изображением
 ReadCount:        DWORD;              // счетчик чтения
 DC:               HDC;                // контекст устройства
 LogFile:          TextFile;
begin
 // первоначальный результат - отрицательный
 Result:=S_FALSE;
 // проверка существования файла
 if not(FileExists(FileName)) then
   Exit;
 // открываем файл
 AssignFile(F, FileName);
 // указываем что открыт для чтения
 Reset(F, 1);

 AssignFile(LogFile, 'log.txt');
 Rewrite(LogFile);

 // читаем заголовок
 BlockRead(F, FileHeader, SizeOf(TResHeader), ReadCount);

 // если считалось что-то отличное от заголовка
 if ReadCount<>SizeOf(TResHeader) then
   begin
     CloseFile(F);
     WriteLn(LogFile, 'Не считан заголовок');
     CloseFile(LogFile);
     Exit;
   end;
 // считанный ресурс не является созданным для данного приложения
 if FileHeader.Name<>ResName then
   begin
     CloseFile(F);
     WriteLn(LogFile, 'Неверное имя ресурса');
     CloseFile(LogFile);
     Exit;
   end;
 // несовпадают версии ресурсов
 if FileHeader.Version<>ResVersion then
   begin
     CloseFile(F);
     WriteLn(LogFile, 'Неверная версия ресурса');
     CloseFile(LogFile);
     Exit;
   end;

BlockRead(F, BitmapFileHeader, SizeOf(TBitmapFileHeader), ReadCount);
if (ReadCount <> SizeOf(TBitmapFileHeader)) then
begin
     CloseFile(F);
     WriteLn(LogFile, 'Неверный заголовок файла ');
     CloseFile(LogFile);
     Exit;
end;

 // считываем заголовок изображения
 BlockRead(F, BitmapInfoHeader, SizeOf(TBitmapInfoHeader), ReadCount);
 // если считалось что-то отличное от заголовка изображения
 if ReadCount<>SizeOf(TBitmapInfoHeader) then
   begin
     CloseFile(F);
     WriteLn(LogFile, 'Неверный заголовок картинки');
     CloseFile(LogFile);
     Exit;
   end;
 // выделение памяти под изображение
 GetMem(BitmapBits, BitmapInfoHeader.biSizeImage);
 // читаем изображение
 BlockRead(F, BitmapBits^, BitmapInfoHeader.biSizeImage, ReadCount);
 // если считанно что-то отличное от изображения
 if (ReadCount<>BitmapInfoHeader.biSizeImage) then
   begin
     CloseFile(F);
     WriteLn(LogFile, 'считанно что-то отличное от изображения');
     CloseFile(LogFile);
     Exit;
   end;
 // создаем из всего считанного изображение в памяти
 BitmapInfo.bmiHeader:=BitmapInfoHeader;
 DC:=GetDC(WHandle);
 HBMap:=CreateDIBitmap(DC,
                       BitmapInfoHeader,
                       CBM_INIT,
                       BitmapBits,
                       BitmapInfo,
                       DIB_RGB_COLORS);
 ReleaseDC(WHandle, DC);
 // если получилось пустое изображение
 if HBMap=0 then
   begin
     CloseFile(F);
     WriteLn(LogFile, 'пустое изображение');
     CloseFile(LogFile);
     Exit;
   end;
 // передаем результат
 BMap:=HBMap;
 // закрываем файл
 CloseFile(F);
 CloseFile(LogFile);
 // если все прошло успешно
 Result:=S_OK;
end;

function LoadBitMap24Res(HBmp: HBitMap; DestHandle: THandle):HResult;
var
 HDCImg:       HDC;
 Bmp:          BitMap;
//  Res:          LongBool;
 x, y, dx, dy: Integer;
begin
 Result:=S_FALSE;
 if DestHandle=0 then Exit;
 HDCImg:=CreateCompatibleDC(0);
 if HDCImg=0 then Exit;
//  SelectObject(HDCImg, HBmp);
 GetObject(HBmp, sizeof(Bmp), @Bmp);
 x:=0;
 y:=0;
 dx:=Bmp.bmWidth;
 dy:=Bmp.bmHeight;
 BitBlt(DestHandle, x, y, dx, dy, HDCImg, 0, 0, SRCCOPY);
 DeleteDC(HDCImg);
 Result:=S_OK;
end;

end.

и в программе записан следующий текст:

procedure TForm1.Button1Click(Sender: TObject);
var
 Bmp:        TBitMap;
 OutStream:  TStream;
 BmpStream:  TStream;
 ResHeader:  TResHeader;
begin
 if Edit3.Text='' then Exit;
 Bmp:=TBitmap.Create;
 OutStream:=TFileStream.Create(Edit3.Text, fmCreate);
 BmpStream:=TMemoryStream.Create;

 ResHeader.Name:=ResName;
 ResHeader.Version:=ResVersion;

 BmpStream.Position:=0;
 Bmp.LoadFromFile(Edit1.Text);
 Bmp.SaveToStream(BmpStream);

 OutStream.Position:=0;
 OutStream.WriteBuffer(ResHeader, SizeOf(TResHeader));
 BmpStream.Position:=0;
 OutStream.CopyFrom(BmpStream, BmpStream.Size);
//  OutStream.

 Bmp.Free;
 BmpStream.Free;
 OutStream.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 HBMP: HBITMAP;
begin
 if Edit2.Text='' then Exit;
 if LoadBitMap24File(Form2.Canvas.Handle, Edit2.Text, HBMP)=S_OK then
   begin
     Form2.Show;
     LoadBitMap24Res(HBMP, Form2.Canvas.Handle);
   end;
end;

Так вот, Form2 создается, но изображение пустое. Может кто подскажет где ошибка?

Заранее спасибо.

NikeOLD   (2004-11-09 09:22:00) [1]

Долго изучал, сам когда-то подобное делал и все работало. Но мне надо было сразу на поверхности DD заливать, поэтому и не заморачивался особо.
Но та функция, что обеспечивала заливку на поверхности использовала StrechBlt. Попробуй ее, возможно проблема из-за несоотвествия размеров.
А так код вроде бы правильный.

Sphinx   (2004-11-08 20:31:00) [2]

> SelectObject(HDCImg, <Handle битмапа, который будет служить
> в DC для рисования>);

Это есть...только по глупости зачем-то закоментировал

> //  SelectObject(HDCImg, HBmp);
Убрал коментарий...и наслаждаюсь квадрадом Малевича вместо картинки. Отсюда вопрос...как можно проверить правильность загрузки картинки?

> А вот это LoadBitMap24Res(HBMP, Form2.Canvas.Handle); разве
> рисует на канвасе?

По идее должна, в примере из которого писал все работает, одна проблема, там сразу происходит загрузка на поверхности DX, а мне нужно сделать самый простой аналог TBitmap - только для хранения в нем картинки, загрузки её из файла и всё...

NikeOLD   (2004-11-08 11:32:00) [3]


> HDCImg:=CreateCompatibleDC(0);

Видишь ли, контекст устройства (твой DC) - это по сути битмап. Однако для того, чтобы иметь возможность на нем рисовать необходимо сначала выбрать битмап и поместить его в контекст, иначе отрисовки не будет.
SelectObject(HDCImg, <Handle битмапа, который будет служить в DC для рисования>);

А вообще придется долго читать SDK, т.к. не все так просто.

Sphinx   (2004-11-08 09:38:00) [4]

> cyborg ©   (08.11.04 08:49) [4]

> Не силён в API

В том-то и дело что я тоже :) а эта строка взята из одного примера, собственно по которому и переписывал свой код.
Спасибо, проверю что вы посоветовали, а то свои мысли закончились уже :(

cyborg   (2004-11-08 08:49:00) [5]

Не силён в API, но вот это не понятно
HDCImg:=CreateCompatibleDC(0);
а потом используется
BitBlt(DestHandle, x, y, dx, dy, HDCImg, 0, 0, SRCCOPY);
Что это такое? Чего-то нулевое создаёшь, потом используешь, может тут причина?

cyborg   (2004-11-08 08:43:00) [6]

Repaint форме или канвасу наверное нужно сделать, не знаю.

А вот это LoadBitMap24Res(HBMP, Form2.Canvas.Handle); разве рисует на канвасе?

Sphinx   (2004-11-07 21:59:00) [7]

Кхммм...извеняюсь....но Up :)

Sphinx   (2004-11-06 20:33:00) [8]

Извеняюсь, забыл описать.

> procedure TForm1.Button1Click(Sender: TObject);
Для создания ресурса.

> procedure TForm1.Button2Click(Sender: TObject);
Для проверки правильности компановки.

Ресурс создается верно, проверял.

Наверх

Титульная страница Поиск, карта сайта Написать письмо