Bmp-вьювер., Гляньте и исправьте Опции

[EXE]

Смотрим: :low:

Unit bmp;

interface

Procedure BMPDisplay(const FileName: String);

implementation

Uses Graph;

Type
 TBitMapHeader =
  Record
   bfType :             Word;        { Метка файла BM }
   bfSize :             LongInt;     { Длина файла в байтах }
   bfReserved :         LongInt;     { Резервные должны быть = 0 }
   bfOffBits :          LongInt;     { Смещение области данных }
   biSize :             LongInt;     { Длина BITMAP_INFO заголовка }
   biWidth :            LongInt;     { Ширина изображения в пикселах }
   biHeight :           LongInt;     { Высота изображения в пикселах }
   biPlanes :           Word;        { Цветовые плоскости = 1 }
   biBitCount :         Word;        { Количество битов на пиксел 1,4,8,24 }
   biCompression :      LongInt;     { Тип сжатия данных }
   biSizeImage :        LongInt;     { Размер изображения в байтах }
   biXPelsPerMeter :    LongInt;     { Разрешение по горизонтали }
   biYPelsPerMeter :    LongInt;     { Разрешение по вертикали }
   biClrUsed :          LongInt;     { Количество используемых цветов }
   biClrImportant :     LongInt;     { Количество основных цветов }
  End;

 TRGBQuad =                   { Описание цвета }
  Record
   rgbBlue,                   { Интенсивность голубого }
   rgbGreen,                  { Интенсивность зеленого }
   rgbRed,                    { Интенсивность красного }
   rgbReserved :        Byte; { Резервный }
  End;

Type TByteArray = Array[0..50000] of byte;

Procedure Display1 (Var f : File; const BitMapHeader : TBitMapHeader);
Begin
 WriteLn ('Monocrome mode not support.');
End;

Procedure Display4 (Var f : File; const BitMapHeader : TBitMapHeader);
Var i,j : Integer;
Var RGBQuad : TRGBQuad;
Var TwoPixel : Byte;
Var Black : Byte;
Var Line : ^TByteArray;
Var number : Word;
Var BeginX,BeginY,EndY : Integer;
    CurrentX: Integer;
Begin
 If GetMaxColor < 15 then
  Begin
   WriteLn ('This Graph Mode not paint 16 colors.');
   Exit;
  End;

 Black := 16;
 With BitMapHeader do
  begin
   For i:= 0 to 15 do         { Чтение и изменение палитры }
    Begin
     BlockRead(f,RGBQuad,SizeOf(RGBQuad));
     If (LongInt(RGBQuad)=0) then Black := i;
     With RGBQuad do
      SetRGBPalette(i, rgbRed shr 2, rgbGreen shr 2, rgbBlue shr 2);
     SetPalette(i,i);
    End;

   Number := (biWidth div 2 + 3) and not 3;  { Длина одной строки в байтах }
   BeginX := (GetMaxX - biWidth) div 2;
   BeginY := GetMaxY - (GetMaxY - biHeight) div 2;
   EndY := BeginY+1-biHeight;
  End;

 GetMem (Line,number+1);          { Выводим изображение }
 For j:=BeginY downto EndY do
  Begin
   BlockRead(f,Line^[1],number);
   CurrentX := BeginX;
   For i:=1 to number do
    Begin
     TwoPixel := Line^[i];
     If TwoPixel shr 4 <> Black then { Черный цвет считаем прозрачным }
      PutPixel(CurrentX,j,TwoPixel shr 4);
     Inc(CurrentX);
     If TwoPixel and 15 <> Black then
      PutPixel(CurrentX,j,TwoPixel and 15);
     Inc(CurrentX);
    End;
  End;
 FreeMem (Line,number+1);
End;

Procedure Display8 (Var f : File; const BitMapHeader : TBitMapHeader);
Begin
 WriteLn ('Mode of 256 colors no support.');
End;

Procedure Display24 (Var f : File; const BitMapHeader : TBitMapHeader);
Begin
 WriteLn ('Mode of 24 bit color not support.');
End;

Procedure BMPDisplay(const FileName: String);
Var f: File;
    BitMapHeader : TBitMapHeader;
Begin
 Assign(f,FileName);
 {$I-}
 FileMode:=0;  { Открываем файл для чтения }
 Reset(f,1);
 {$I+}

 If IOResult<>0 Then
  Begin
   WriteLn ('File not found.');
   Exit;
  End;

 BlockRead(f,BitMapHeader,SizeOf(BitMapHeader));
 With BitMapHeader do
  Begin
   If (bfType<>19778) or (bfReserved<>0) or (biPlanes<>1) then
    Begin
     WriteLn ('No format of BMP-file.');
     Close(f);
     Exit;
    End;
   If biCompression<>0 Then
    Begin
     WriteLn ('File has been packed.');
     Close(f);
     Exit;
    End;
   ClearDevice;
   Case biBitCount of
    1  : Display1  (f, BitMapHeader);
    4  : Display4  (f, BitMapHeader);
    8  : Display8  (f, BitMapHeader);
    24 : Display24 (f, BitMapHeader);
   else
    Begin
     WriteLn ('No format of BMP-file.');
     Close(f);
     Exit;
    End;
   End;
  End;
 Close(f);
End;
End.

Этот модуль читает только 16-тиразрядные а хотелось бы побольше! Помогите если можете!!!

[Altair]

Этот модуль читает только 16-тиразрядные а хотелось бы побольше! Помогите если можете!!!

Я же выложил модуль для работы с 256 BMP - смотри в тестовом форуме.

[EXE]

Извини, не заметил. :molitva: