Процедура отображения файла в память и присвоения адреса его данным выглядит следующим образом:

Var Memory: pByteArray;
ее : Integer;

procedure TForml.OpenlClick(Sender: TObject); var

i: integer;
bmFile : pBitmapFileHeader;
bmlnfo : pBitmapInfoHeader;
begin
if not OpenDialogl.execute then Exit;

hf := CreateFile(pChar(OpenDialogl.FileName), GENERIC_READ or GENERIC_WRITE,

FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); if hf=INVALID_HANDLE_VALUE then

begin ec:=GetLastError;
ShowMessage(' File opening error '+IntTostr(ec) ) ;
Exit;
end;
hm := CreateFileMappingfhf, nil, PAGE^READONLY, 0,0,nil);
if hm=0 then begin
ShowMessage(' File Mapping error %d',[GetLastError]);
Exit;
end;
pb := MapViewOf File (hm, FILE_MAP__READ, 0,0,0);
if pb=nil then begin ec:=GetLastError ;
ShowMessage('Mapping error '+IntTostr(ec));
Exit;
end;
bmFile := pBitmapFileHeader(pb);
if (bmFileA.bfType<>$4D42) then BEGIN Exit;
END;
Memory:=@(рЬЛ[bmFileA.bfOffBits]);
bmlnfo := @(pbA[SizeOf(TBitmapFileHeader)]) ;
StrLen: = ( ( (bmInfoA.biWidth*bmInfo's.biBitCount)+31) div 32)*4;
PaintMe(Self) ;
end;

В этом коде последовательно получены дескрипторы файла (hf, с использованием функции CreateFile), его отображения в память (hm, с помощью функции CreateFileMapping) и указатель на отображенные данные (рь, посредством MapviewOfFile). Не будем вдаваться в детали внутренней реализации битовой карты - графический формат BMP известен достаточно хорошо. Отметим только, что результатом проделанных операций являются структура bminfo типа TBitmapinfo, полностью характеризующая битовую карту, и указатель Memory на данные битовой карты. Теперь загруженные данные нужно суметь нарисовать на канве, в данном случае на канве объекта PaintBox. Делается это следующим образом:

procedure TForml.PaintMe(Sender: TObject);
var OldP : hPalette;i : integer;
begin
if Memory=nil then Exit;
OldP := SelectPalette(PaintBox.Canvas.Handle, Palette, False);
RealizePalette(PaintBox.Canvas.Handle);
SetStretchBltMode(PaintBox.Canvas.Handle, STRETCH_DELETESCANS);

case ViewMode of vmStretch: with bminfo" do i : =

StretchDIBits(PaintBox.Canvas.Handle,0,0,PaintBox.Height, PaintBox.Width, 0,0,biWidth,Abs(biHeight),

Memory, pBitmapInfo(bminfo)A, DIB_RGB_COLORS, PaintBox.Canvas.CopyMode);

vmlxl:

with bminfoA,PaintBox.ClientRect do

i := SetDIBitsToDevice(PaintBox.Canvas.Handle,Left,Top,Right-Left,

Bottom-Top,

Left,Top,Top,Bottom-top, Memory, pBitmapInfо(bminfo)A, DIB_RGB_COLORS);

vmZoom: begin with bminfo",PaintBox.ClientRect do

i := StretchDIBits(PaintBox.Canvas.Handle,Left,Top,Right-Left,

Bottom-Top,

О,0,biWidth,Abs(biHeight) ,

Memory, pBitmapInfo(bminfo)л, DIB_RGB_COLORS, PaintBox.Canvas.CopyMode);
end;
end;
if (i=0) or (i=GDI_ERROR) then begin
ec :=GetLastError;
Forml.Caption := 'Error code '+IntToStr(ec);
end;
SelectPalette(PaintBox.Canvas.Handle, OldP, False);
end;

В зависимости от установленного режима отображения (vmstretch, vmZoom или vmlxi) применяются разные функции Win API: stretchDiBits или SetDiBitsToDevice. Выигрыш в скорости работы приложения особенно ощущается, если загружаемые файлы становятся велики и должны размещаться в файле подкачки. Наше же приложение не использует его и отображает данные прямо из файла на экран (рис. 10.3).


⇐ Предыдущая страница| |Следующая страница ⇒

Программирование в Delphi 7



Новости за месяц

  • Август
    2017
  • Пн
  • Вт
  • Ср
  • Чт
  • Пт
  • Сб
  • Вс