[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    > Can anyone send me source of BMP Loader/Saver.
    > If you help me, I would be thankful to you.
    >
    > Mohammad Reza Nikrou
    > nikrou@kadous.gu.ac.ir
    >

    Hi,
      i send you a loader BMP, if you are interested try this :

    To ENCODE (and decode) GIF files
    two programs :

    gifpasse.zip : ftp.usask.ca /pub/dos/prog/gifpasse.zip
    endegif.zip  : ftp.uni-mainz.de/pub/pc/local/dos/programm/pascal/endegif.zip
                   ftp.ku-eichstaett.de/pub/dos/graphics/gifutils/endegif.zip
                   ftp.uni-koeln.de/msdos/graphics/gifutils/endegif.zip
             ftp.informatik.hu-berlin.de/pub/pc/msdos/graphics/gifutils/endegif.zip

      Edmond

    {X,Y - screen coordinates, if x <0 bmp file will be centered on the
    screen

    file_name - name and path of the bmp file

    erro - will return a error condition (0 no error)
    if error <0 it's a bmp problem
    if error >0 it's a disk error ( dos error codes)

    Carlos Rondao
    Universidade Catolica Portuguesa
    Lisboa
    Portugal

    Send me a note if you have any comments or problems ...}

    uses dos,graph;
    var
      grDriver : Integer;
      grMode   : Integer;
      ErrCode  : Integer;
      erro : integer;
    const filename = 'c:\download\picture1.bmp';{put filename and path here}
    Procedure GetEgaPal(cor :byte ;var pal:byte);assembler;
      asm
       mov bl,cor
       mov ah,$10
       mov al,$07
       int $10
       les DI,pal
       mov ES:[DI],BH
      end;

    Procedure SetEgaPal(cor :byte ;pal:byte);assembler;
      asm
       mov bl,cor
       mov bh,pal
       mov ah,$10
       mov al,$00
       int $10
      end;

    Procedure SetPal16(Cor,r,g,b : byte);assembler;
     asm
      mov AH,$10
      mov AL,$10
      xor BH,BH
      mov BL,cor
      mov DH,r
      mov CH,g
      mov CL,b
      int $10
     end;
    {===================================================}
    Procedure GetPal16(Cor:byte;Var r,g,b : byte);assembler;
     asm
      mov AH,$10
      mov AL,$15
      xor BH,BH
      mov BL,cor
      int $10
      les DI,r
      mov ES:[DI],DH
      les DI,g
      mov ES:[DI],CH
      les DI,b
      mov ES:[DI],CL
     end;
    Procedure SetAllPal16(var pal ;cor,n:integer);assembler;
     asm
      mov AH,$10
      mov AL,$12
      mov BX,cor
      mov CX,n
      les DX,pal
      int $10
     end;

    Procedure EgaDefault;
    var i,reg : byte;
        r,g,b : byte;
    begin
     for i:=0 to 15 do
      begin
       GetEgaPal(i,reg);
       SetEgaPal(i,i);
       GetPal16(reg,r,g,b);
       SetPal16(i,r,g,b);
      end;
    End;

    procedure Load_BMP(X,Y:integer;file_name : pathstr;var erro :
    integer);
     VAR
       header : array [1..27] of word;
       rgb_struct : array[0..255] of record
                                      b,g,r,cor : byte;
                                     end;
       rgb_triple : array[0..255] of record
                                      b,g,r : byte;
                                     end absolute rgb_struct;
       pal : array[0..255] of record
                                red,green,blue : byte;
                               end;
          F : File;
        i,j : integer;
      locer : integer;
       Xp,Yp,lido,larg,larg1,alt,cores,bufsize,desloc,reloc,grupo :
    word;
        buf : array[1..10000] of byte;
        pic_point_1,pic_point_2 : byte;
        sign : array[1..2] of char absolute header;
        maxX,maxY : word;
      Begin
       maxX := GetmaxX;
       maxY := GetMaxY;
       assign(f,file_name);
       {$I-}
       reset(f,1);
       {$I+}
       erro := IoResult;
       if erro<>0 THEN exit;
       {$I-}
       blockread(f,header,18,lido);
       erro := IoResult;
       if erro = 0 then
        if sign<>'BM' THEN
           erro := -100;
       IF erro = 0 THEN
        BEGIN
         desloc := header[8]-4;
         if desloc >36 then desloc := 36;
         blockread(f,header[10],desloc,lido);
         erro := IoResult;
        END;
       if erro = 0 THEN
        begin
         reloc := ord(desloc<>8);
         larg := header[10];
         alt := header[11+reloc];
         cores := 1 shl header[13+2*reloc];
         if (alt > maxY) OR (larg>maxX) then
            erro := -101;
        end;
       If erro = 0 THEN
        BEGIN
         if (X<0) OR (Y<0) THEN
           Begin
            X := (maxX-larg) DIV 2;
            Y := (maxY-alt) DIV 2;
           End;
         blockread(f,rgb_struct,header[6]-18-desloc,lido);
         erro := IoResult;
        END;
        IF erro = 0 THEN
         BEGIN
             if cores = 16 THEN
              begin
               larg1 := 8*(larg DIV 8) + 8*ord(larg MOD 8<>0);
               LARG1 := LARG1 div 2;
              end
             else
              begin
               larg1 := 4*(larg DIV 4) + 4*ord(larg MOD 4<>0);
              end;
             if reloc = 1 THEN
              for i := 0 to cores-1 do
               Begin
                pal[i].red := rgb_struct[i].r DIV 4;
                pal[i].green := rgb_struct[i].g DIV 4;
                pal[i].blue := rgb_struct[i].b DIV 4  ;
               end
             else
              for i := 0 to cores-1 do
               Begin
                pal[i].red := rgb_triple[i].r DIV 4;
                pal[i].green := rgb_triple[i].g DIV 4;
                pal[i].blue := rgb_triple[i].b DIV 4  ;
               end;
             EgaDefault;
             setallpal16(Pal,0,cores);
             bufsize := larg1*(10000 DIV larg1);
             lido := bufsize;
             While (lido=bufsize) AND (erro=0) do
              begin
               blockread(f,buf,bufsize,lido);
               erro := IoResult;
               if erro= 0 Then
                IF Cores = 16 THEN
                 For j := 1 to lido DIV larg1 do
                  For i:=0 to larg-1 do
                   Begin
                    XP := X+i;
                    YP := Y+alt-j;
                    pic_point_1 := buf[(j-1)*larg1+ 1 + i DIV 2];
                    pic_point_2:=(pic_point_1 SHR 4)*((i+1) MOD 2) +
                     (pic_point_1 AND 15)*((i+2) MOD 2) ;
                    putpixel(XP,YP,pic_point_2)
                  End
                ELSE
                 For j := 1 to lido DIV larg1 do
                  For i:=1 to larg do
                   Begin
                    XP := X+(i-1);
                    YP := Y+alt-j;
                    pic_point_1 := buf[(j-1)*larg1+i];
                    putpixel(XP,YP,pic_point_1);
                   end;
               Y := Y - lido DIV larg1;
             end; { while }
        END; { erro = 0 }
        close(f);
        {$I+}
        locer := Ioresult;
        If erro = 0 THEN erro := locer;
     END;
    begin
      grDriver := Detect;
      InitGraph(grDriver,grMode,'c:\tp\bgi');
      ErrCode := GraphResult;
      if ErrCode = grOk then
        begin
          Load_BMP(-1,0,filename,erro);
          readln;
          CloseGraph;
        end
      else
        WriteLn('Graphics error:',
                GraphErrorMsg(ErrCode));

    end.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]