freebitmap.pas

最棒的三大计算机视觉、图像图形函数库之一

  DeleteObject(SelectObject(memDC, oldBM));
  DeleteObject(memDC);

  Result := True;
end;

function TFreeWinBitmap.CopyFromBitmap(HBmp: HBITMAP): Boolean;
var
  bm: BITMAP;
  DC: HDC;
  Success: Integer;
begin
  Result := False;

  if HBmp <> 0 then
  begin
    // get information about the bitmap
    GetObject(HBmp, SizeOf(BITMAP), @bm);

    // create the image
    SetSize(FIT_BITMAP, bm.bmWidth, bm.bmHeight, bm.bmBitsPixel);

    // create the device context for the bitmap
    DC := GetDC(0);

    // copy the pixels
    Success := GetDIBits(DC,                       // handle to DC
                         HBmp,                     // handle to Bitmap
                         0,                        // first scan line
                         FreeImage_GetHeight(Dib), // number of scan lines to copy
                         FreeImage_GetBits(Dib),   // array for bitmap bits
                         FreeImage_GetInfo(Dib^)^, // bitmap data buffer
                         DIB_RGB_COLORS            // RGB
    );

    ReleaseDC(0, DC);

    if Success = 0 then
      raise Exception.Create('Error: GetDIBits failed')
    else
      Result := True;
  end;
end;

function TFreeWinBitmap.CopyFromHandle(HMem: THandle): Boolean;
var
  Data: PByte;
  bmih: PBitmapInfoHeader;
  Palette: PRGBQuad;
  Bits: PByte;
  BitFields: array [0..2] of DWORD;
  MaskSize: Longint;
begin
  Result := False;
  Palette := nil;
  BitFields[0] := 0; BitFields[1] := 0; BitFields[2] := 0;

  // get a pointer to the bitmap
  Data := GlobalLock(HMem);

  // get a pointer to the bitmap header
  bmih := PBitmapInfoHeader(Data);

  // get a pointer to the palette
  if bmih.biBitCount < 16 then
  begin
    Palette := PRGBQUAD(bmih);
    Inc(PByte(Palette), SizeOf(BITMAPINFOHEADER));
  end;

  // get a pointer to the pixels
  Bits := PByte(bmih);
  Inc(Bits, SizeOf(BITMAPINFOHEADER) + SizeOF(RGBQUAD) * bmih.biClrUsed);

  if bmih.biCompression = BI_BITFIELDS then
  begin
    // take into account the color masks that specify the red, green and blue
    // components (16- and 32-bit)
    MaskSize := 3 * SizeOf(DWORD);
    CopyMemory(@BitFields[0], Bits, MaskSize);
    Inc(Bits, MaskSize);
  end;

  if Data <> nil then
  begin
    // allocate a new FIBITMAP
    if not SetSize(FIT_BITMAP, bmih.biWidth, bmih.biHeight, bmih.biBitCount,
                   BitFields[2], BitFields[1], BitFields[0]) then
    begin
      GlobalUnlock(HMem);
      Exit;
    end;

    // copy the bitmap header
    CopyMemory(FreeImage_GetInfoHeader(Dib), bmih, SizeOf(BITMAPINFOHEADER));

    // copy the palette
    CopyMemory(FreeImage_GetPalette(Dib), Palette, bmih.biClrUsed * SizeOf(RGBQUAD));

    // copy the bitmap
    CopyMemory(FreeImage_GetBits(Dib), Bits, FreeImage_GetPitch(Dib) * FreeImage_GetHeight(Dib));

    GlobalUnlock(HMem);
  end;
end;

function TFreeWinBitmap.CopyToBitmapH: HBITMAP;
var DC : HDC;
begin
  Result:=0;
  if IsValid then
  begin
    DC:=GetDC(0);
    Result:=CreateDIBitmap(DC,
                           FreeImage_GetInfoHeader(Dib)^,
                           CBM_INIT,
                           PAnsiChar(FreeImage_GetBits(Dib)),
                           FreeImage_GetInfo(Dib^)^,
                           DIB_RGB_COLORS);
    ReleaseDC(0,DC);
  end;
end;

function TFreeWinBitmap.CopyToClipBoard(NewOwner: HWND): Boolean;
var
  HDib: THandle;
begin
  Result := False;
  HDib := CopyToHandle;

  if OpenClipboard(NewOwner) and EmptyClipboard then
  begin
    if SetClipboardData(CF_DIB, HDib) = 0 then
    begin
      MessageBox(NewOwner, 'Unable to set clipboard data', 'FreeImage', MB_ICONERROR);
      CloseClipboard;
      Exit;
    end;
  end;
  CloseClipboard;
  Result := True;
end;

function TFreeWinBitmap.CopyToHandle: THandle;
var
  DibSize: Longint;
  ADib, pdib: PByte;
  bmih: PBITMAPINFOHEADER;
  Pal: PRGBQuad;
  Bits: PByte;
begin
  Result := 0;
  if IsValid then
  begin
    // get equivalent DIB size
    DibSize := SizeOf(BITMAPINFOHEADER);
    Inc(DibSize, FreeImage_GetColorsUsed(Dib) * SizeOf(RGBQUAD));
    Inc(DibSize, FreeImage_GetPitch(Dib) * FreeImage_GetHeight(Dib));

    // allocate a DIB
    Result := GlobalAlloc(GHND, DibSize);
    ADib := GlobalLock(Result);

    FillChar(Result, DibSize, 0);

    pdib := ADib;

    // copy the BITMAPINFOHEADER
    bmih := FreeImage_GetInfoHeader(Dib);
    CopyMemory(pdib, bmih, SizeOf(BITMAPINFOHEADER));
    Inc(pdib, SizeOf(BITMAPINFOHEADER));

    // copy the palette
    Pal := FreeImage_GetPalette(Dib);
    CopyMemory(pdib, Pal, FreeImage_GetColorsUsed(Dib) * SizeOf(RGBQUAD));
    Inc(pdib, FreeImage_GetColorsUsed(Dib) * SizeOf(RGBQUAD));

    // copy the bitmap
    Bits := FreeImage_GetBits(Dib);
    CopyMemory(pdib, Bits, FreeImage_GetPitch(Dib) * FreeImage_GetHeight(Dib));

    GlobalUnlock(Result);
  end;
end;

constructor TFreeWinBitmap.Create(ImageType: FREE_IMAGE_TYPE; Width,
  Height, Bpp: Integer);
begin
  inherited Create(ImageType, Width, Height, Bpp);

  FDisplayDib := nil;
  FDeleteMe := False;
end;

destructor TFreeWinBitmap.Destroy;
begin
  if FDeleteMe then
    FreeImage_Unload(FDisplayDib);
  inherited;
end;

procedure TFreeWinBitmap.Draw(DC: HDC; Rect: TRect);
begin
  DrawEx(DC, Rect);
end;

procedure TFreeWinBitmap.DrawEx(DC: HDC; Rect: TRect; UseFileBkg: Boolean;
  AppBkColor: PRGBQuad; Bg: PFIBITMAP);
var
  ImageType: FREE_IMAGE_TYPE;
  HasBackground, Transparent: Boolean;
  DibDouble: PFIBITMAP;
begin
  if not IsValid then Exit;
  
  // convert to standart bitmap if needed
  if FDeleteMe then
  begin
    FreeImage_Unload(FDisplayDib);
    FDisplayDib := nil;
    FDeleteMe := False;
  end;

  ImageType := FreeImage_GetImageType(FDib);
  if ImageType = FIT_BITMAP then
  begin
    HasBackground := FreeImage_HasBackgroundColor(Dib);
    Transparent := FreeImage_IsTransparent(Dib);

    if not Transparent and not HasBackground then
      // copy pointer
      FDisplayDib := Dib
    else
    begin
      // create the transparent / alpha blended image
      FDisplayDib := FreeImage_Composite(Dib, UseFileBkg, AppBkColor, Bg);
      // remember to delete FDisplayDib
      FDeleteMe := True;
    end
  end
  else
  begin
    // convert to standart dib for display
    if ImageType <> FIT_COMPLEX then
      FDisplayDib := FreeImage_ConvertToStandardType(Dib, True)
    else
    begin
      // convert to type FIT_DOUBLE
      DibDouble := FreeImage_GetComplexChannel(Dib, FICC_MAG);
      FDisplayDib := FreeImage_ConvertToStandardType(DibDouble, True);
      // free image of type FIT_DOUBLE
      FreeImage_Unload(DibDouble);
    end;
    // remember to delete FDisplayDib
    FDeleteMe := True;
  end;


  // Draw the DIB
  SetStretchBltMode(DC, COLORONCOLOR);
  StretchDIBits(DC, Rect.Left, Rect.Top,
    Rect.Right - Rect.Left, Rect.Bottom - Rect.Top,
    0, 0, FreeImage_GetWidth(FDisplayDib), FreeImage_GetHeight(FDisplayDib),
    FreeImage_GetBits(FDisplayDib), FreeImage_GetInfo(FDisplayDib^)^, DIB_RGB_COLORS, SRCCOPY);
end;

function TFreeWinBitmap.PasteFromClipBoard: Boolean;
var
  HDib: THandle;
begin
  Result := False;
  if not IsClipboardFormatAvailable(CF_DIB) then Exit;

  if OpenClipboard(0) then
  begin
    HDib := GetClipboardData(CF_DIB);
    CopyFromHandle(HDib);
    Result := True;
  end;
  CloseClipboard;
end;

{ TFreeMultiBitmap }

procedure TFreeMultiBitmap.AppendPage(Bitmap: TFreeBitmap);
begin
  if IsValid then
    FreeImage_AppendPage(FMPage, Bitmap.FDib);
end;

function TFreeMultiBitmap.Close(Flags: Integer): Boolean;
begin
  Result := FreeImage_CloseMultiBitmap(FMPage, Flags);
  FMPage := nil;
end;

constructor TFreeMultiBitmap.Create(KeepCacheInMemory: Boolean);
begin
  FMemoryCache := KeepCacheInMemory;
end;

procedure TFreeMultiBitmap.DeletePage(Page: Integer);
begin
  if IsValid then
    FreeImage_DeletePage(FMPage, Page);
end;

destructor TFreeMultiBitmap.Destroy;
begin
  if FMPage <> nil then Close;
  inherited;
end;

function TFreeMultiBitmap.GetLockedPageNumbers(var Pages,
  Count: Integer): Boolean;
begin
  Result := False;
  if not IsValid then Exit;
  Result := FreeImage_GetLockedPageNumbers(FMPage, Pages, Count)
end;

function TFreeMultiBitmap.GetPageCount: Integer;
begin
  Result := 0;
  if IsValid then
    Result := FreeImage_GetPageCount(FMPage)
end;

procedure TFreeMultiBitmap.InsertPage(Page: Integer; Bitmap: TFreeBitmap);
begin
  if IsValid then
    FreeImage_InsertPage(FMPage, Page, Bitmap.FDib);
end;

function TFreeMultiBitmap.IsValid: Boolean;
begin
  Result := FMPage <> nil
end;

procedure TFreeMultiBitmap.LockPage(Page: Integer; DestBitmap: TFreeBitmap);
begin
  if not IsValid then Exit;

  if Assigned(DestBitmap) then
  begin
    DestBitmap.Replace(FreeImage_LockPage(FMPage, Page));
  end;
end;

function TFreeMultiBitmap.MovePage(Target, Source: Integer): Boolean;
begin
  Result := False;
  if not IsValid then Exit;
  Result := FreeImage_MovePage(FMPage, Target, Source);
end;

function TFreeMultiBitmap.Open(const FileName: string; CreateNew,
  ReadOnly: Boolean): Boolean;
var
  fif: FREE_IMAGE_FORMAT;
begin
  Result := False;

  // try to guess the file format from the filename
  fif := FreeImage_GetFIFFromFilename(PChar(FileName));

  // check for supported file types
  if (fif <> FIF_TIFF) and (fif <> FIF_ICO) then
    Exit;

  // open the stream
  FMPage := FreeImage_OpenMultiBitmap(fif, PChar(FileName), CreateNew, ReadOnly, FMemoryCache);

  Result := FMPage <> nil;  
end;

procedure TFreeMultiBitmap.UnlockPage(Bitmap: TFreeBitmap;
  Changed: Boolean);
begin
  if IsValid then
  begin
    FreeImage_UnlockPage(FMPage, Bitmap.FDib, Changed);
    // clear the image so that it becomes invalid.
    // don't use Bitmap.Clear method because it calls FreeImage_Unload
    // just clear the pointer
    Bitmap.FDib := nil;
    Bitmap.Change;
  end;
end;

{ TFreeMemoryIO }

function TFreeMemoryIO.Acquire(var Data: PByte;
  var SizeInBytes: DWORD): Boolean;
begin
  Result := FreeImage_AcquireMemory(FHMem, Data, SizeInBytes);
end;

constructor TFreeMemoryIO.Create(Data: PByte; SizeInBytes: DWORD);
begin
  inherited Create;
  FHMem := FreeImage_OpenMemory(Data, SizeInBytes);
end;

destructor TFreeMemoryIO.Destroy;
begin
  FreeImage_CloseMemory(FHMem);
  inherited;
end;

function TFreeMemoryIO.GetFileType: FREE_IMAGE_FORMAT;
begin
  Result := FreeImage_GetFileTypeFromMemory(FHMem)
end;

function TFreeMemoryIO.IsValid: Boolean;
begin
  Result := FHMem <> nil
end;

function TFreeMemoryIO.Read(fif: FREE_IMAGE_FORMAT;
  Flag: Integer): PFIBITMAP;
begin
  Result := FreeImage_LoadFromMemory(fif, FHMem, Flag)
end;

function TFreeMemoryIO.Seek(Offset: Longint; Origin: Word): Boolean;
begin
  Result := FreeImage_SeekMemory(FHMem, Offset, Origin)
end;

function TFreeMemoryIO.Tell: Longint;
begin
  Result := FreeImage_TellMemory(FHMem)
end;

function TFreeMemoryIO.Write(fif: FREE_IMAGE_FORMAT; dib: PFIBITMAP;
  Flag: Integer): Boolean;
begin
  Result := FreeImage_SaveToMemory(fif, dib, FHMem, Flag)
end;

end.