[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]

    {
    From: ELM MORROW
    Subj: LOADBMPS.PAS
    }

    {$R-}

    unit LoadBMPs;

    interface

    uses WinProcs, WinTypes, Strings, WinDos;

    function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
      var Width, Height: LongInt): hBitMap;

    implementation

    function CreateBIPalette(BI: PBitMapInfoHeader): HPalette;
    type
      ARGBQuad = Array[1..5000] of TRGBQuad;
    var
      RGB: ^ARGBQuad;
      NumColors: Word;
      Pal: PLogPalette;
      hPal: hPalette;
      I: Integer;
    begin
      CreateBiPalette := 0;
      RGB := Ptr(Seg(BI^), Ofs(BI^)+BI^.biSize);
      if BI^.biBitCount<24 then
      begin
        NumColors:= 1 shl BI^.biBitCount;
        if NumColors<>0 then
        begin
          GetMem(Pal, SizeOf(PLogPalette)+NumColors*SizeOf(TPaletteEntry));
          Pal^.palNumEntries := NumColors;
          Pal^.palVersion := $300;
          for I := 0 to NumColors-1 do
          begin
            Pal^.palPalEntry[I].peRed := RGB^[I].rgbRed;
            Pal^.palPalEntry[I].peGreen := RGB^[I].rgbGreen;
            Pal^.palPalEntry[I].peBlue := RGB^[I].rgbBlue;
            Pal^.palPalEntry[I].peFlags := 0;
          end;
          hPal := CreatePalette(Pal^);
          FreeMem(Pal, SizeOf(PLogPalette) + NumColors * SizeOf(TPaletteEntry));
          CreateBiPalette := hPal;
        end;
      end;
    end;

    function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
      var Width, Height: LongInt): hBitMap;
    var
      BitMapFileHeader: TBitMapFileHeader;
      DibSize, ReadSize, ColorTableSize, TempReadSize: LongInt;
      DIB: PBitMapInfoHeader;
      TempDib: Pointer;
      Bits: Pointer;
      F: File;
      BitMap: hBitMap;
      Handle: Word;
      DC: hDC;
      OldCursor: HCursor;
    begin
      Assign(F, Name);
      {$I-}Reset(F, 1);{$I+}
      if IOResult<>0 then
      begin
        LoadBMP := 0;
        Exit;
      end;
      OldCursor := SetCursor(LoadCursor(0, IDC_Wait));
      BlockRead(F, BitMapFileHeader, SizeOf(BitMapFileHeader));
      DibSize := BitMapFileHeader.bfSize - BitMapFileHeader.bfOffBits;
      ReadSize := LongInt(BitMapFileHeader.bfSize) - SizeOf(BitMapFileHeader);
      Handle := GlobalAlloc(GMem_Moveable, ReadSize);
      DIB := GlobalLock(Handle);
      TempReadSize := ReadSize;
      TempDib := Dib;
      while TempReadSize > 0 do
      begin
        if TempReadSize > $8000 then
        begin
          BlockRead(F, TempDIB^, $8000);
          if Ofs(TempDib^) = $8000 then
             TempDib := Ptr(Seg(TempDib^) + 8, 0)
          else
             TempDib := Ptr(Seg(TempDib^), $8000);
        end
        else
          BlockRead(F, TempDIB^, TempReadSize);
        Dec(TempReadSize, $8000);
      end;
      if DIB^.biBitCount = 24 then
        ColorTableSize := 0
      else
        ColorTableSize := LongInt(1) shl DIB^.biBitCount * SizeOf(TRGBQuad);
      Bits := Ptr(Seg(DIB^), Ofs(DIB^) + DIB^.biSize + ColorTableSize);
      Close(F);
      DC := GetDC(Window);
      DibPal := CreateBIPalette(DIB);
      if DibPal = 0 then
      begin
        SelectPalette(DC, DibPal, false);
        RealizePalette(DC);
      end;
      BitMap := CreateDIBitMap(DC, DIB^, cbm_Init, Bits, PBitMapInfo(Dib)^,
        dib_RGB_Colors);
      Height := DIB^.biHeight;
      Width := DIB^.biWidth;
      ReleaseDC(Window, DC);
      GlobalUnLock(Handle);
      GlobalFree(Handle);
      LoadBMP := BitMap;
      SetCursor(OldCursor);
    end;

    end.

[Back to WIN-OS2 SWAG index] [Back to Main SWAG index] [Original]