Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.04.2010, 11:17   #1
olikke
 
Регистрация: 22.03.2010
Сообщений: 8
По умолчанию MappedFile

Привет, помогите загрузить BitMap в MappedFile...
Нашла пример на delphikingdom, но что-то не выходит... Вот код

function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;
begin
Dec(Alignment);
Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;
Result := Result div 8;
end;

procedure Test;
type
AI = Array [0..0] of integer;
BA = Array[0..0] of Byte;
var
Bitmap : TBitmap;

BInfo: tagBITMAPINFO;
FHandle,
BWidth, BHeight : integer;
MemoryDC : HDC;
FBitmap,
OldBitmap : HBitmap;
Scr : ^BA;
DrawLineI : ^AI;
l,
X : integer;
begin
//Прочитаем какую-нибудь картинку, чтобы было с чем работать
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('a.bmp');
BWidth := Bitmap.Width;
BHeight := Bitmap.Height;

//Создаем Bitmap c массивом в FileMapping
FHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, 200000, 'BITMAP_BUFFER' );

BInfo.bmiHeader.biSize := sizeof(tagBITMAPINFOHEADER);
BInfo.bmiHeader.biWidth := BWidth;
BInfo.bmiHeader.biHeight := BHeight;
BInfo.bmiHeader.biPlanes := 1;
BInfo.bmiHeader.biBitCount := 32;
BInfo.bmiHeader.biCompression := BI_RGB;
X := BytesPerScanLine(BInfo.bmiHeader.bi Width, BInfo.bmiHeader.biBitCount, 32) ;

MemoryDC := CreateCompatibleDC(0);
FBitmap := CreateDIBSection(MemoryDC, BInfo, DIB_RGB_COLORS, Pointer(Scr), FHandle, 0);
OldBitmap := SelectObject( MemoryDC, FBitmap );

//Коприуем в нее прочитанную картинку с уменьшением
StretchBlt( MemoryDC,
0, 0,
BWidth div 2,
BHeight div 2,
Bitmap.Canvas.Handle,
0, 0,
BWidth,
BHeight,
SRCCOPY );
Bitmap.Free;

//Перечеркиваем прямо в памяти
for l := 0 to BHeight - 1 do
begin
DrawLineI := @Scr^[l*X];
DrawLineI^[BHeight - 1 - l] := 0;
end;
//Все закрываем, кроме FileMapping

SelectObject( MemoryDC, OldBitmap );
DeleteDC(MemoryDC);
DeleteObject( FBitmap );

//Смотрим, что осталось в FileMapping
MemoryDC := CreateCompatibleDC(0);
FBitmap := CreateDIBSection(MemoryDC, BInfo, DIB_RGB_COLORS, Pointer(Scr), FHandle, 0);
OldBitmap := SelectObject( MemoryDC, FBitmap );

Bitmap := TBitmap.Create;
Bitmap.Width := BWidth;
Bitmap.Height := BHeight;

BitBlt( Bitmap.Handle,
0, 0,
BWidth,
BHeight,
MemoryDC,
0, 0,
SRCCOPY );
Bitmap.SaveToFile('b.bmp');
Bitmap.Free;

SelectObject( MemoryDC, OldBitmap );
DeleteDC(MemoryDC);
DeleteObject( FBitmap );

CloseHandle(FHandle);
end;

В результате в файле b.bmp сохраняется белое изображение, правда размеры его соответствуют a.bmp.
olikke вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск