DEMO.DESIGN FAQ


следующий фpагмент (2)
    Описание формата BMP для Window 3.0 (DIB)
    =========================================
    Основным  отличием  файлов  нового  формата  (DIB)  -   Device
 Independent Bitmap (аппаратно-независимый битовый образ) является
 то, что в них используется кодировка цветов с одной битовой плос-
 костью.
    Файлы битовых образов нового формата начинаются  со  структуры
 BITMAPFILEHEADER:

    typedef struct tagBITMAPFILEHEADER {
    word    bfType;     //тип файла (для битового образа - BM)
    dword   bfSize;     //размер файла в dword
    word    bfReserved1;    //не используется
    word    bfReserved2;    //не используется
    dword   bfOffbits;  //смещение данных битового образа от
                //заголовка в байтах

    }
    Hепосредственно за ней располагается структура BITMAPINFO, со-
 держащая всю информацию о битовом образе. Она делится на две час-
 ти: структуру BITMAPINFOHEADER, описывающей  размеры  и  цветовой
 формат битового образа, и массив структур  RGBQUAD,  определяющей
 цветовую палитру:

    typedef struct tagBITMAPINFO {
    BITMAPINFOHEADER     bmiHeader;
    RGBQUAD      bmiColors[1];
    }

    typedef struct tagBITMAPINFOHEADER {
    dword   biSize;     //число байт, занимаемых структурой
                //BITMAPINFOHEADER
    dword   biWidth;    //ширина битового образа в пикселах
    dword   biHeight;   //высота битового образа в пикселах
    word    biPlanes;   //число битовых плоскостей устройства
    word    biBitCount; //число битов на пиксель
    dword   biCompression;  //тип сжатия
    dword   biSizeImage;    //размер картинки в байтах
    dword   biXPelsPerMeter;//горизонтальное разрешение устройства,
                //пиксел/м
    dword   biYPelPerMeter; //вертикальное разрешение устройства,
                //пиксел/м
    dword   biClrUsed;  //число используемых цветов
    dword   biClrImportant; //число "важных" цветов
    } BITMAPINFOHEADER;

    Более подробно:

    biSize - обычно используется для облегчения доступа  к таблице
 цветов.

    biPlanes - определяет число битовых плоскостей;  однако,   по-
 скольку цвет кодируется последовательными битами, это число всег-
 да равно 1.

    biBitCount - этим полем определяется число  цветов, используе-
 мых битовым образом. В зависимости от способа  кодирования, может
 принимать значения:
    1 - битовый образ монохромный, и таблица цветов  должна содер-
 жать два элемента. Каждый бит в массиве данных кодирует один пик-
 сел. Если значение бита - 0, то пиксел становится  первым  цветом
 таблицы; если - 1, пиксел становится вторым цветом таблицы.
    4 - битовый образ имеет максимум 16 цветов, и массив bmiColors
 (таблица цветов) имеет до 16 элементов. Цвет каждого  пиксела оп-
 ределяется по таблице цветов при помощи  четырехбитного  индекса.
 Hапример, если первый байт данных  имеет  значение  3Ah,  то  при
 отображении битового образа цвет первого пиксела  определяет чет-
 вертый элемент таблицы цветов, а цвет второго - одиннадцатый.
    8 - битовый образ имеет максимум 256 цветов, и  таблица цветов
 имеет до 256 элементов. Каждый  байт  массива  данных  определяет
 цвет одного пиксела.
    24 - битовый образ имеет максимум 2  в  24-й  степени  цветов.
 Таблица цветов пуста, а цвет пикселов  определяется  пакетами  из
 трех байтов, описывающими цветовые интенсивности  красного, зеле-
 ного и голубого цветов.

    biCompression - тип сжатия. Может принимать значения:
    BI_RGB - сжатие отсутствует;
    BI_RLE8 - сжатие для формата 8 бит на пиксел;
    BI_RLE4 - сжатие для формата 4 бита на пиксел.

    biXPelsPerMeter и biYPelsPerMeter - могут  использоваться  для
 выбора из списка ресурсов пиктограммы,  наиболее  подходящей  для
 данного устройства.

    biClrUsed - число цветов, используемых данныи битовым образом.
 Если 0, то используются все цвета палитры  (указанные  в  массиве
 bmiColors).

    biClrImportant - используется для управления  алгоритмом отоб-
 ражения цветов. Так, если четыре различных  приложения отображают
 на экране по одному битовому образу с 75 цветами каждый, то адап-
 тер, выводящий 256 цветов одновременно, не  сможет  полностью ау-
 тентично отобразить на экране все 4 картинки. В  этом  случае ис-
 пользуется механизм замены цветов - ищется битовый  образ  с наи-
 меньшим приоритетом и его "лишние" цвета заменяются наиболее под-
 ходящими.

    typedef struct tagRGBQUAD {
    byte    rgbRed;     //интенсивность красного
    byte    rgbGreen;   //интенсивность зеленого
    byte    rgbBlue;    //интенсивность голубого
    byte    rgbRserved; //не используется
    } RGBQUAD;

    После того, как все параметры битового  образа  определены,  в
 файле идут сами  скан-строки  битовой  плоскости,  причем  первой
 скан-строкой в формате DIB считается нижняя скан-строка (т.е. на-
 чало координат находится в левом нижнем углу изображения).

    Скан-строки выровнены по 32-битной границе - dword !!!
То есть строки дополняются пустыми байтами до размера делящегося на 4 без
остатка.



следующий фpагмент (3)|пpедыдущий фpагмент (1)From : Alex Fedorov                        2:50/325.12

{Это загрузка битмапа - от 16 до 16м цветов}
Unit BMP;
Interface
  Uses Objects, Palette;
  Const
    aHalftone8x8 : Array[0..63] of Byte =
    ( 0, 38,  9, 47,  2, 40, 11, 50,
     25, 12, 35, 22, 27, 15, 37, 24,
      6, 44,  3, 41,  8, 47,  5, 43,
     31, 19, 28, 15, 34, 21, 31, 18,
      1, 39, 11, 49,  0, 39, 10, 48,
     27, 14, 36, 23, 26, 13, 35, 23,
      7, 46,  4, 43,  7, 45,  3, 42,
     33, 20, 30, 17, 32, 19, 29, 16);

  Type
    TRGB = Record
     B,G,R,Reserved : Byte;
    End;

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

    PBMP = ^TBMP;
    TBMP = Object(TObject)
     fID       : Word;
     fSize     : LongInt;
     fReserved : LongInt;
     fBitsOffs : LongInt;

     Size      : LongInt;
     Width     : LongInt;
     Height    : LongInt;
     Planes    : Word;
     BitCount  : Word;
     Compress  : LongInt;
     ImageSize : LongInt;
     XPelMeter : LongInt;
     YPelMeter : LongInt;
     ClrUsed   : LongInt;
     ImpColor  : LongInt;

     BMPPalette: Array[0..255] of TRGB;
     SLineSize : Word;

     CurLine : LongInt;
     LBuffer : PByteArray;
     SBuffer : PByteArray;

     S       : TDosStream;

     DitherMethod : Byte;

     PalSize : Word;

     CDL : LongInt;

      Constructor Init(FName:String);
      Destructor Done; Virtual;
      Procedure GetLine(Line:LongInt);
      Procedure DitherLine;
    End;
Implementation
      Constructor TBMP.Init(FName:String);
Begin
  S.Init(FName, stOpenRead);
  If S.Status<>stOk
  Then Begin
    S.Done;
    Fail;
  End;
  S.Read(fID,2);
  If fID<>$4D42 Then
  Begin
    Writeln('It''s a not BMP Image!');
    S.Done;
    Fail;
  End;
  S.Read(fSize,12);
  S.Read(Size,4);
  S.Read(Width, Size-4);
  GetMem(LBuffer,800);
  SLineSize:=(((Width*BitCount) div 8)+3) and $FFFC;
  GetMem(SBuffer, SLineSize);
  PalSize:=0;
  Case BitCount Of
    1: PalSize := 2;
    4: PalSize := 16;
    8: PalSize := 256;
  End;
  If PalSize>0 Then S.Read(BMPPalette,PalSize*SizeOf(TRGB));
End;

      Destructor TBMP.Done;
Begin
  S.Done;
  FreeMem(LBuffer,800);
  FreeMem(SBuffer, SLineSize);
End;
      Procedure TBMP.GetLine;
Var
  O : LongInt;
Begin
  O:=fBitsOffs+SLineSize*(Height-Line-1);
  S.Seek(O);
  S.Read(SBuffer^, SLineSize);
  CDL:=Line;
  DitherLine;
End;

      Procedure TBMP.DitherLine;
Var
  R,G,B : Byte;
  i : Word;
  HTIndex : Byte;
Begin
  HTIndex:=(CDL and 7)*8;
  Case PalSize Of
   0:
   Begin
     For i:=0 to 799 do
     Begin
       R:=SBuffer^[i*3+0];
       G:=SBuffer^[i*3+1];
       B:=SBuffer^[i*3+2];
       R:=(R div 51)+Byte((R mod 51)>aHalfTone8x8[HTIndex+(i and 7)]);
       G:=(G div 51)+Byte((G mod 51)>aHalfTone8x8[HTIndex+(i and 7)]);
       B:=(B div 51)+Byte((B mod 51)>aHalfTone8x8[HTIndex+(i and 7)]);
       LBuffer^[i]:=R+G*6+B*36+1;
     End;
   End;
   2: ;
   16:
   Begin
     For i:=0 to 799 do
     Begin
       if (i and 1)=0 Then
       Begin
         R:=BMPPalette[SBuffer^[i shr 4]].R;
         G:=BMPPalette[SBuffer^[i shr 4]].G;
         B:=BMPPalette[SBuffer^[i shr 4]].B;
       End Else
       Begin
         R:=BMPPalette[SBuffer^[i and 15]].R;
         G:=BMPPalette[SBuffer^[i and 15]].G;
         B:=BMPPalette[SBuffer^[i and 15]].B;
       End;
       R:=(R div 51)+Byte((R mod 51)>aHalfTone8x8[HTIndex+(i and 7)]);
       G:=(G div 51)+Byte((G mod 51)>aHalfTone8x8[HTIndex+(i and 7)]);
       B:=(B div 51)+Byte((B mod 51)>aHalfTone8x8[HTIndex+(i and 7)]);
       LBuffer^[i]:=R+G*6+B*36+1;
     End;
   End;

   256:
   Begin
     For i:=0 to 799 do
     Begin
       R:=BMPPalette[SBuffer^[i]].R;
       G:=BMPPalette[SBuffer^[i]].G;
       B:=BMPPalette[SBuffer^[i]].B;
       If (R+G+B>0) Then
       Begin
         R:=(R div 51)+Byte((R mod 51)>aHalfTone8x8[HTIndex+(i and 7)]);
         G:=(G div 51)+Byte((G mod 51)>aHalfTone8x8[HTIndex+(i and 7)]);
         B:=(B div 51)+Byte((B mod 51)>aHalfTone8x8[HTIndex+(i and 7)]);
       End;
       LBuffer^[i]:=R+G*6+B*36+1;
     End;
   End;
  End;
End;

End.

{И палитрочка}

Unit Palette;
Interface
Type
  RGB = Record
    R, G, B : Byte;
  End;

Var
  StdPalette : Array[0..255] of RGB;

Implementation
var
  R,G,B : Byte;
  Procedure DoPalette;
Var
  Index : Word;
Begin
  For B:=0 to 5 Do
  For G:=0 to 5 Do
  For R:=0 to 5 Do
  Begin
    Index:=Round(R+G*6+B*36)+1;
    StdPalette[Index].R:=Trunc(R*12.6);
    StdPalette[Index].G:=Trunc(G*12.6);
    StdPalette[Index].B:=Trunc(B*12.6);
  End;
End;
Begin
  DoPalette;
End.



следующий фpагмент (4)|пpедыдущий фpагмент (2)
алгоритм распаковки RLE4 
========================


procedure UnpackRLE4Block(lpSrc,lpDest : Pointer; wSize : Word); assembler;
asm
 push  ds
 lds   si,lpSrc                 { DS:SI - source block pointer }
 les   di,lpDest                { ES:DI - destination buffer pointer }
 mov   bx,si
 add   bx,wSize
 dec   bx                       { BX - offset of block end }
 xor   ax,ax
 xor   cx,cx
 cld
@Next:
 cmp   si,bx
 jae   @End
 lodsb
 or    al,al
 jnz   @Encoded
 lodsb
 cmp   al,3
 jb    @Next
 shr   al,1                     { AL := AL div 2 }
 mov   cl,al                    { CL - bytes counter }
 rep movsb                      { Move color byte from DS:SI to ES:DI }
 and   al,1
 add   si,ax
 jmp   @Next
@Encoded:
 mov   cl,al
 shr   cl,1                     { div 2 }
 lodsb                          { Load color byte }
 rep stosb                      { Fill by AL color }
 jmp   @Next
@End:
 pop   ds
end;

следующий фpагмент (5)|пpедыдущий фpагмент (3)
   Hижеследующее описание добросовестно из книги Гладкова
С.А. и Фролова Г.В. " Программирование в MS Windows ". В скобках
<.> даю комментарии на основании собственных экспериментов.

 WORD    bfType          Тип файла ( Для .BMP - 'BM' )
 DWORD   bfSize          Размер файла в DWORD'ах
    < а по-моему - в байтах >
 WORD bfReserved1    Hе используется
 WORD bfReserved2    Hе используется
 DWORD bfOffbits       Смещение от начала файла до
    начала битового образа
                                (в байтах)

 DWORD biSize          Число байт от biSize до
    biClrImportant включительно
 DWORD biWidth         Горизонтальный размер битового
    образа в пикселах
 DWORD biHeight        Вертикальный размер битового
    образа в пикселах
 WORD biPlanes        Число битовых плоскостей
    (всегда равно 1)
 WORD biBitCount      Число битов на пиксел :
    1  - для монохромной картинки,
       один байт описывает 8 точек
    4  - 16 цветов, один байт опи-
       сывает 2 точки
    8  - 256 цветов, байт на точку
    24 - 2^24 цветов, цвет точки
       описывается пакетом из трех
       байт - R,G,B
 DWORD biCompression   Тип сжатия ( 0 - сжатия нет )
 DWORD biImageSize     Кол-во байт в описании битового
    образа
 DWORD biXPixsPerMeter | В большинстве случаев равны 0
 DWORD biYPixsPerMeter | и не используются
 DWORD biClrUsed       0 - используются все цвета из
    массива bmiColors (см.ниже)
 DWORD biClrImportant  Обычно 0 и не используется

      Далее находится таблица кодирования цветов, содержащая не-
сколько элементов след. структуры :

 BYTE Red   |
 BYTE Green           | Интенсивности соотв. цветов
 BYTE Blue            |
 BYTE Reserved        Hе используется

      Эта таблица называется bmiColors,  а кол-во таких 4-байтных
равно кол-ву цветов в битовом образе ( картинке ).  апример, при
16 цветах biBitCount = 4, таблица содержит 48 байт,  по 4 на один
цвет. Обычно содержимое этой таблицы совпадает с палитрой Windows
по умолчанию.

      Далее в файле находится собственно битовый образ. Для 16-ти
цветного режима его структура такова :

Самая нижняя строка :  XX XX XX ... XX XX  - по 2 точки на 1 байт
       .
       .
       .
Самая верхняя строка:  XX XX XX ... XX XX

ВАЖHО : кол-во БАЙТ в строке кратно 4, т.е., 16 точек описываются
 8  байтами,  а 17 точек - 12 байтами,  причем в последних
четырех байтах задействованы только первые полбайта.

 Hа этом плагиат заканчивается.

 Здесь я привожу фрагменты процедур преобразования  из BMP
в PUT и обратно для 16-цветного режима.  Считать BMP-файл с диска
в память и организовать  цикл перекодировки по строкам,  я думаю,
труда не составит;  предлагаемые же процедурки  обрабатывают одну
строку.

;
;--------------------------------------------------------------
;
; --==  BMP -> PUT  ==--
;
;  Предполагается, что регистры установлены след. образом :
;
;   DS:SI -> BMP line
;   ES:DI -> PUT line
;   CX    =  Кол-во пикселов (точек) в преобразуемой строке
;
 jmp     @bp0

@P0:      db      0
@P1:      db      0
@P2:      db      0
@P3:      db      0
@PX:      dw      0

@bp0:   cld
 mov     [word ptr cs:@PX], cx
 add     cx, 2
 shr     cx, 1
 mov     ah, 4
;
@bp1:   mov     ds, dx
 lodsb
 mov     bx, cs
 mov     ds, bx
;
 rol     al, 1
 rcl     [byte ptr ds:@P0], 1
 rol     al, 1
 rcl     [byte ptr ds:@P1], 1
 rol     al, 1
 rcl     [byte ptr ds:@P2], 1
 rol     al, 1
 rcl     [byte ptr ds:@P3], 1
;
 rol     al, 1
 rcl     [byte ptr ds:@P0], 1
 rol     al, 1
 rcl     [byte ptr ds:@P1], 1
 rol     al, 1
 rcl     [byte ptr ds:@P2], 1
 rol     al, 1
 rcl     [byte ptr ds:@P3], 1
;
 dec     ah
 jnz     @bp4
;
 mov     bx, [word ptr ds:@PX]
 add     bx, 7
 shr     bx, 3
 add     di, bx
 add     di, bx
 mov     ax, [word ptr ds:@P2]
 mov     [es:di+bx], ah
 mov     [es:di], al
 mov     ax, [word ptr ds:@P0]
 sub     di, bx
 mov     [es:di], ah
 sub     di, bx
 stosb
 mov     ah, 4
;
@bp4:
 loop    @bp1
;
; --==  End of BMP -> PUT  ==--
;
;-------------------------------------------
;
; --==  PUT -> BMP  ==--
;
;  Предполагается, что регистры установлены след. образом :
;
;   DS:SI -> PUT line
;   ES:DI -> BMP line
;   CX    =  Кол-во пикселов (точек) в преобразуемой строке
;
 jmp     @pb0
;
@P0:      db      0
@P1:      db      0
@P2:      db      0
@P3:      db      0
@PX:      dw      0
;
@pb0:   cld
 mov     dx, ds
 mov     [word ptr cs:@PX], cx
 inc     cx
 shr     cx, 1
 xor     ah, ah
;
@pb1:   or      ah, ah
 jnz     @pb2
 mov     bx, [word ptr cs:@PX]
 add     bx, 7
 shr     bx, 3
 add     si, bx
 add     si, bx
 mov     ah, [ds:si+bx]
 mov     al, [ds:si]
 mov     [word ptr cs:@P2], ax
 sub     si, bx
        mov     ah, [ds:si]
        sub     si, bx
        lodsb
        mov     [word ptr cs:@P0], ax
        mov     ah, 4
;
@pb2:
        mov     bx, cs
        mov     ds, bx
        rol     [byte ptr ds:@P0], 1
        rcl     al, 1
        rol     [byte ptr ds:@P1], 1
        rcl     al, 1
        rol     [byte ptr ds:@P2], 1
        rcl     al, 1
        rol     [byte ptr ds:@P3], 1
        rcl     al, 1
;
        rol     [byte ptr ds:@P0], 1
        rcl     al, 1
        rol     [byte ptr ds:@P1], 1
        rcl     al, 1
        rol     [byte ptr ds:@P2], 1
        rcl     al, 1
        rol     [byte ptr ds:@P3], 1
        rcl     al, 1
;
        stosb
        mov     ds, dx
        dec     ah
        loop    @pb1
;
        pop ds
;
; --==  End of BMP -> PUT  ==--
;

 Это - куски живого граф. редактора BiC, к-рый работает с 16-цветными
и с двухцветными неупакованными BMP .
следующий фpагмент (6)|пpедыдущий фpагмент (4)
Program BMPView;  { by Barry Naujok, 1993 }
	{ This information was completely derived on my own (ALL of it). }
	{ If there are any errors or omisions, please let me know at ... }
	{          a1357665@cfs01.cc.monash.edu.au                       }
	{ Currently only supports 3-256 colours (not monochrome or true colour) }
	{ My opinion: As can be seen from decoding a BitMaP, I truly believe }
	{           that Microsoft is backwards! :) (other opinions welcome) }
Uses VESA,Crt,Dos,Strings;

Const bufsize=32000; { my optimal buffer size, could be bigger for other drives }
		     { Has to be even for the RLE decompression }
Type THeader=Record
       ID    : Word;     { 'BM' for a Windows BitMaP }
       FSize : LongInt;  { Size of file }
       Ver   : LongInt;  { BMP version (?), currently 0 }
       Image : LongInt;  { Offset of image into file }
       Misc  : LongInt;  { Unknown, appears to be 40 for all files }
       Width : LongInt;  { Width of image }
       Height: LongInt;  { Height of image }
       Num   : Word;     { Not sure, possibly number of images or planes (1) }
       Bits  : Word;     { Number of bits per pixel }
       Comp  : LongInt;  { Type of compression, 0 for uncompressed, 1,2 for RLE }
       ISize : LongInt;  { Size of image in bytes }
       XRes  : LongInt;  { X dots per metre (not inches! for US, unbelievable!) }
       YRes  : LongInt;  { Y dots per metre }
       PSize : LongInt;  { Palette size (number of colours) if not zero }
       Res   : LongInt;  { Probably reserved, currently 0 }
     End;  { 54 bytes }

     PByte = ^Byte;

     TPalette = Record
       b,g,r,x : Byte;   { BMP uses a fourth byte for the palette, not used }
     End;

Var  fl     : File;
     header : THeader;
     buffer : PByte;

Procedure BlankPalette;
Var pal : Array[0..767] Of Byte;
    r   : Registers;
Begin
  FillChar(pal,768,0);
  r.ax:=$1012;
  r.bx:=0;
  r.cx:=256;
  r.dx:=Ofs(pal);
  r.es:=Seg(pal);
  Intr($10,r);
End;

Procedure SetPalette;
Const Pal16:Array[0..15]Of Byte=(0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
Var palette : TPalette;  { ^ Actual BIOS palette numbers for 16 colour modes }
    BIOSpal : Array[0..767] Of Byte;
    i       : Byte;
    r       : Registers;
Begin
  For i:=0 To header.PSize-1 Do Begin
    BlockRead(fl,palette,4);
    If header.PSize>16 Then Begin
      BIOSpal[i*3]:=palette.r Shr 2;
      BIOSpal[i*3+1]:=palette.g Shr 2;
      BIOSpal[i*3+2]:=palette.b Shr 2;
    End Else Begin
      BIOSpal[Pal16[i]*3]:=palette.r Shr 2;
      BIOSpal[Pal16[i]*3+1]:=palette.g Shr 2;
      BIOSpal[Pal16[i]*3+2]:=palette.b Shr 2;
    End;
  End;
  r.ax:=$1012;
  r.bx:=0;
  r.cx:=256;
  r.dx:=Ofs(BIOSpal);
  r.es:=Seg(BIOSpal);
  Intr($10,r);
End;

Procedure ShowImage256(name:PChar); Assembler;
Var dseg,width,height,bytes,rows,bank,handle,cp:Word;
Asm
	Mov     dseg,ds
	Mov     ax,header.Comp.Word[0]
	Mov     cp,ax
	Mov     ax,header.Width.Word[0]
	Test    ax,1
	Jz      @0I
	Inc     ax  { image is word aligned so adjust width if needed }
  @0I:  Mov     width,ax
	Mov     ax,header.Height.Word[0]
	Mov     height,ax
	Mov     di,ax
	Dec     di
	Mov     ax,VesaMode.Bytes
	Mov     bytes,ax
	Mov     ax,VesaMode.Height
	Mov     rows,ax
	Mov     es,VesaMode.SegA

	Mov     ax,$3D00
	Lds     dx,name
	Int     $21                     { Open the file for assembler }
	Mov     ds,dseg                 { Restore the data segment }
	Jc      @Ex
	Mov     handle,ax

	Mov     bx,ax
	Mov     ax,$4200
	Mov     cx,header.Image.Word[2]
	Mov     dx,header.Image.Word[0]
	Int     $21                     { Seek to image location }
	Call    @FR
	Jmp     @0N

  @FR:  Push    ax
	Push    cx
	Push    dx
	Mov     ds,dseg
	Mov     bx,handle
	Mov     cx,bufsize
	Lds     si,buffer
	Mov     dx,si
	Mov     ah,$3F
	Int     $21
	Mov     bx,ax                   { Bytes left to read from the buffer }
	Pop     dx
	Pop     cx
	Pop     ax
	RetN

  @0N:  Mov     ax,bytes
	Mul     di
	Mov     di,ax
	Mov     bank,dx
	Call    @B1                     { Set the last line & bank }
	Mov     dx,width

	Cmp     cp,0
	Je      @0S

	{ RLE bitmap }
  @1S:  Xor     dx,dx                   { Set DX as the width count }
  @10:  Xor     ah,ah                   { Clear upper byte }
	Lodsb                           { Get "index" byte }
	Dec     bx                      { Decrement buffer count }
	Jnz     @11                     { Jump if not empty }
	Call    @FR                     { Reload buffer }
  @11:  Or      al,al
	Jz      @14                     { Jump if following is a string }
	{ Repeat byte }
	Mov     cx,ax                   { else "index" is a repeat count }
	Add     dx,cx
	Lodsb                           { Load data to repeat "index" times }
	Dec     bx
	Jnz     @12                     { Jump if buffer isn't empty }
	Call    @FR
  @12:  Stosb                           { Draw byte to screen }
	Or      di,di                   { Check to see if line crosses bank }
	Jnz     @13
	Inc     bank                    { Change bank if crossed }
	Call    @B1
  @13:  Loop    @12                     { Store all repeated bytes }
	Jmp     @10
	{ Dump string }
  @14:  Lodsb                           { Load "count", number of bytes in the string }
	Mov     cx,ax
	Add     dx,cx
	Dec     bx
	Jnz     @1T                     { Update buffer count (& buffer contents) }
	Call    @FR
  @1T:  Or      al,al
	Jz      @20
  @15:  Movsb                           { Transfer string to screen }
	Or      di,di
	Jnz     @16                     { bank checking }
	Inc     bank
	Call    @B1
  @16:  Dec     bx                      { Update buffer count, etc }
	Jnz     @17
	Call    @FR
  @17:  Loop    @15                     { Repeat for string }
	Test    al,1                    { See if there was an odd numbered count }
	Jz      @10                     { Jump if even }
	Lodsb                           { Clear extra byte, due to word alignment }
	Dec     bx
	Jnz     @10                     { Update buffer count, etc }
	Call    @FR
	Jmp     @10
  @20:  Sub     di,dx                   { Move screen pointer to start of line }
	Jnc     @21                     { Jump if not crossed bank }
	Dec     bank                    { Update bank if crossed }
	Call    @B1
  @21:  Sub     di,bytes                { Move to screen line above }
	Jnc     @23                     { Jump if not crossed bank }
	Dec     bank                    { Update bank if crossed }
	Call    @B1
  @23:  Dec     height                  { Update line count }
	Jnz     @1S                     { Jump to start if not end of the image }
	Jmp     @Ex                     { Exit if image drawn }

	{ Un-compressed bitmap }
  @0S:  Mov     cx,dx
	Mov     ax,di
	Add     ax,cx
	Jc      @03                     { Jump if line crosses bank }
	Cmp     bx,cx
	Jle     @03                     { Jump if file buffer will run out }
	Sub     bx,cx                   { Update buffer counter }
	Shr     cx,1
	Jnc     @01
	Movsb
  @01:  Rep     Movsw                   { Show line }
	Sub     di,dx                   { Go to next line (above) }
	Sub     di,bytes
	Jnc     @02
	Dec     bank                    { See if line above is in another bank }
	Call    @B1
  @02:  Dec     height
	Jnz     @0S
	Jmp     @Ex
  @03:  Movsb
	Or      di,di
	Jnz     @04
	Inc     bank
	Call    @B1
  @04:  Dec     bx
	Jnz     @05
	Call    @FR
  @05:  Loop    @03
	Sub     di,dx
	Jnc     @06
	Dec     bank
	Call    @B1
  @06:  Sub     di,bytes
	Jnc     @07
	Dec     bank
	Call    @B1
  @07:  Dec     height
	Jnz     @0S
	Jmp     @Ex


	{ Set bank }
  @B1:  Push    ax
	Push    ds
	Mov     ds,dseg
	Mov     al,vesaon
	Or      al,al
	Jz      @B3
	Push    bx
	Push    dx
	Mov     dx,bank
	Xor     bx,bx
	Mov     ax,64
	Mul     dx
	Div     VesaMode.Gran
	Mov     dx,ax
	Push    dx
	Call    VesaMode.WinFunc
	Pop     dx
	Inc     bx
	Call    VesaMode.WinFunc
	Pop     dx
	Pop     bx
  @B3:  Pop     ds
	Pop     ax
	RetN
  @Ex:  Mov     ds,dseg
        Mov     bx,handle              { Close the file }
	Mov     ah,$3E
	Int     $21
End;

Procedure ShowImage16(name:PChar); Assembler;
Var dseg,width,height,bytes,rows,bank,handle,cp,rc,bc:Word;
Asm
	Mov     dseg,ds
	Mov     ax,header.Comp.Word[0]
	Mov     cp,ax
	Mov     ax,header.Width.Word[0]
	Mov     width,ax
	Mov     ax,header.Height.Word[0]
	Mov     height,ax
	Mov     di,ax
	Dec     di
	Mov     ax,VesaMode.Bytes
	Mov     bytes,ax
	Mov     ax,VesaMode.Height
	Mov     rows,ax
	Mov     es,VesaMode.SegA

	Mov     ax,$3D00
	Lds     dx,name
	Int     $21                     { Open the file for assembler }
	Mov     ds,dseg                 { Restore the data segment }
	Jc      @Ex
	Mov     handle,ax

	Mov     bx,ax
	Mov     ax,$4200
	Mov     cx,header.Image.Word[2]
	Mov     dx,header.Image.Word[0]
	Int     $21                     { Seek to image location }
	Call    @FR
	Jmp     @0N

  @FR:  Push    ax
	Push    bx
	Push    cx
	Push    dx
	Mov     ds,dseg
	Mov     bx,handle
	Mov     cx,bufsize
	Lds     si,buffer
	Mov     dx,si
	Mov     ah,$3F
	Int     $21
	Mov     bc,ax                   { Bytes left to read from the buffer }
	Pop     dx
	Pop     cx
	Pop     bx
	Pop     ax
	RetN

  @0N:  Mov     ax,bytes
	Mul     di
	Mov     di,ax
	Mov     bank,dx
	Call    @B1                     { Set the last line & bank }
	Mov     dx,$3CE
	Mov     ax,$205
	Out     dx,ax                   { Set Write Mode 2 }
	Mov     ax,$8008                { Initial bit mask }

	Cmp     cp,0
	Je      @0S

	{ RLE bitmap }
  @1S:  Mov     rc,0
	Mov     ax,$8008
  @10:  Xor     ch,ch                   { Clear upper byte }
	Mov     cl,[si]                 { Get "index" byte }
	Inc     si
	Dec     bc                      { Decrement buffer count }
	Jnz     @11                     { Jump if not empty }
	Call    @FR                     { Reload buffer }
  @11:  Or      cl,cl
	Jz      @14                     { Jump if following is a string }
	{ Repeat byte }
	Shr     cl,1                    {   Divide the "index" by two }
	Mov     bl,[si]                 { Load data to repeat "index" times }
	Inc     si
	Dec     bc
	Jnz     @12                     { Jump if buffer isn't empty }
	Call    @FR
  @12:  Rol     bl,4
	Out     dx,ax
	Mov     bh,es:[di]
	Mov     es:[di],bl              { Update screen }
	Ror     ah,1
	Jnc     @1B
	Inc     di
	Jnc     @1B
	Inc     bank                    { Change bank if crossed }
	Call    @B1
  @1B:  Out     dx,ax
	Rol     bl,4
	Mov     bh,es:[di]
	Mov     es:[di],bl
	Ror     ah,1
	Jnc     @13
	Inc     di
	Inc     rc
	Jnc     @13
	Inc     bank                    { Change bank if crossed }
	Call    @B1
  @13:  Loop    @12                     { Store all repeated bytes }
	Jmp     @10
	{ Dump string }
  @14:  Mov     cl,[si]                 { Load "count", number of bytes in the string }
	Inc     si
	Dec     bc
	Jnz     @1E                     { Update buffer count (& buffer contents) }
	Call    @FR
  @1E:  Or      cl,cl
	Jz      @20
	Shr     cl,1                    { Divide the "count" by 2 }
	Push    cx
  @15:  Mov     bl,[si]
	Inc     si
	Rol     bl,4
	Out     dx,ax
	Mov     bh,es:[di]
	Mov     es:[di],bl
	Ror     ah,1
	Jnc     @1A
	Inc     di
	Jnz     @1A                     { bank checking }
	Inc     bank
	Call    @B1
  @1A:  Out     dx,ax
	Rol     bl,4
	Mov     bh,es:[di]
	Mov     es:[di],bl
	Ror     ah,1
	Jnc     @16
	Inc     di
	Inc     rc
	Jnz     @16
	Inc     bank
	Call    @B1
  @16:  Dec     bc                      { Update buffer count, etc }
	Jnz     @17
	Call    @FR
  @17:  Loop    @15                     { Repeat for string }
	Pop     cx
	Test    cl,1                    { See if there was an odd numbered count }
	Jz      @10                     { Jump if even }
	Mov     cl,[si]                 { Clear extra byte, due to word alignment }
	Inc     si
	Dec     bc
	Jnz     @10                     { Update buffer count, etc }
	Call    @FR
	Jmp     @10
  @20:  Sub     di,rc                   { Move screen pointer to start of line }
	Jnc     @21                     { Jump if not crossed bank }
	Dec     bank                    { Update bank if crossed }
	Call    @B1
  @21:  Sub     di,bytes                { Move to screen line above }
	Jnc     @22                     { Jump if not crossed bank }
	Dec     bank                    { Update bank if crossed }
	Call    @B1
  @22:  Dec     height                  { Update line count }
	Jnz     @1S                     { Jump to start if not end of the image }
	Jmp     @Ex                     { Exit if image drawn }

	{ Un-compressed bitmap }
  @0S:  Mov     ax,width
	Xor     bx,bx
	Mov     rc,ax                   { Initialize rowcount }
	Mov     ax,$8008
  @02:  Out     dx,ax                   { Update bit mask register }
	Mov     cl,[si]                 { Load a byte (2 pixels) }
	Inc     si                      { Update buffer pointer }
	Dec     bc                      { Updata buffer count }
	Jnz     @03
	Call    @FR                     { Reload buffer if necessary }
  @03:  Ror     cl,4                    { Move 1st pixel in low part of CL }
	Mov     ch,es:[di]              { Load latches }
	Mov     es:[di],cl              { Update latches }
	Ror     ah,1                    { Shift bit mask right a pixel }
	Out     dx,ax                   { Update bit mask register }
	Ror     cl,4                    { Move 2nd pixel in low part of CL }
	Mov     ch,es:[di]              { as above 3 steps }
	Mov     es:[di],cl              { ... }
	Sub     rc,2
	Jle     @04
	Ror     ah,1
	Jnc     @02
	Inc     di
	Inc     bx
	Jnc     @02
	Inc     bank
	Call    @B1
	Jmp     @02
  @04:  Mov     ax,si                   { Discard extra bytes for }
	Mov     cx,4                    { LongInt alignment (?) }
	And     ax,3
	Sub     cx,ax
	And     cx,3
	Add     si,cx
	Sub     bc,cx
	Sub     di,bx
	Jnc     @06
	Dec     bank
	Call    @b1
  @06:  Sub     di,bytes
	Jnc     @07
	Dec     bank
	Call    @b1
  @07:  Dec     height
	Jnz     @0S
	Jmp     @Ex

	{ Set bank }
  @B1:  Push    ax
	Push    ds
	Mov     ds,dseg
	Mov     al,vesaon
	Or      al,al
	Jz      @B3
	Push    bx
	Push    dx
	Mov     dx,bank
	Xor     bx,bx
	Mov     ax,64
	Mul     dx
	Div     VesaMode.Gran
	Mov     dx,ax
	Push    dx
	Call    VesaMode.WinFunc
	Pop     dx
	Inc     bx
	Call    VesaMode.WinFunc
	Pop     dx
	Pop     bx
  @B3:  Pop     ds
	Pop     ax
	RetN
  @Ex:  Mov     ds,dseg
        Mov     bx,handle              { Close the file }
	Mov     ah,$3E
	Int     $21
End;

Procedure ShowBMP;
Var fn:Array[0..63]Of Char;
Begin
  StrPCopy(fn,ParamStr(1));
  GetMem(buffer,bufsize);
  Case header.PSize Of
    1..16: Begin
	 Case header.Width Of
	      0..640  : SetMode($12);
	    641..800  : SetMode($102);
	    801..1024 : SetMode($104);
	   1025..9999 : SetMode($106);
	 End;
         SetPalette;
	 {BlankPalette;}
	 ShowImage16(fn);
       End;
    17..256: Begin
	 Case header.Width Of
	      0..320  : SetMode($13);
	    321..640  : SetMode($101);
	    641..800  : SetMode($103);
	    801..1024 : SetMode($105);
	   1025..9999 : SetMode($107);
	 End;
         SetPalette;
	 {BlankPalette;}
	 ShowImage256(fn);
       End;
  End;
  FreeMem(buffer,bufsize);
  {SetPalette;}
  Sound(660);
  Delay(100);
  Sound(880);
  Delay(50);
  Sound(440);
  Delay(75);
  NoSound;
  ReadKey;
  SetMode(3);
End;

Procedure SetPSize;
Begin
  If header.PSize=0 Then Case header.Bits Of
    1 : header.PSize:=2;  { These are the only valid bits in a BMP }
    4 : header.PSize:=16;
    8 : header.PSize:=256;
    24: header.PSize:=0;  { A 24 bit image does not have a palette }
  End;
End;

Begin
  If ParamCount>0 Then Begin
    Assign(fl,ParamStr(1));
    {$I-}
    Reset(fl,1);
    {$I+}
    If IOResult=0 Then Begin
      BlockRead(fl,header,54);
      If header.ID=$4D42 Then Begin
	SetPSize; { Set the PSize field in the header if not defined }
	Writeln;
	Writeln('Width  . . . . . ',header.Width,' pixels');
	Writeln('Height . . . . . ',header.Height,' pixels');
	Writeln('Bits per Pixel . ',header.Bits);
	Writeln('Palette Size . . ',header.PSize,' colours, ',header.PSize*4,' bytes');
	Write('Compression  . . type ',header.Comp);
	If header.Comp=0 Then Writeln(' (not compressed)')
	  Else Writeln(' (RLE)');
	Writeln('Image Offset . . ',header.Image);
	Writeln('Image Size . . . ',header.ISize,' bytes');
	Writeln('X Resolution . . ',header.XRes,' D/m, ',header.XRes*254 Div 10000,' DPI');
	Writeln('Y Resolution . . ',header.YRes,' D/m, ',header.YRes*254 Div 10000,' DPI');
	Writeln;
	If ((header.Width<641)And(header.Height<481)And(header.PSize<17))
	   Or((header.Width<321)And(header.Height<201))Or(IsVesa) Then
	If header.PSize>2 Then Begin
	  Writeln('Press a key to show the image');
	  ReadKey;
	  ShowBMP;
	End Else Writeln('Cannot display the image without VESA graphics support');
	Close(fl);
      End Else Writeln('The file is not a Windows BitMaP file');
    End Else Writeln('File not found, try again');
  End Else Writeln('Usage: BMPVIEW <filename>');
End.
Всего 5 фpагмент(а/ов) |пpедыдущий фpагмент (5)

оглавление \| demo party в ex-СССР \| infused bytes e-mag \| новости от ib/news \| другие проекты \| письмо \|	win koi lat