freebitmap.pas

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

  // resampling
  begin
    dy := lutY[y];
    x1 := 0;
    x3 := 0;
    for x := 0 to w do  // loop through row
    begin
      dx:= lutX[x];
      iRed:= 0;
      iGrn:= 0;
      iBlu:= 0;
      RowSource := RowSourceStart;
      for iy := 1 to dy do
      begin
        pt := PRGB24(RowSource + x1);
        for ix := 1 to dx do
        begin
          iRed := iRed + pt.R;
          iGrn := iGrn + pt.G;
          iBlu := iBlu + pt.B;
          inc(pt);
        end;
        RowSource := RowSource + iSrc;
      end;
      iRatio := 65535 div (dx * dy);
      pt1 := PRGB24(RowDest + x3);
      pt1.R := (iRed * iRatio) shr 16;
      pt1.G := (iGrn * iRatio) shr 16;
      pt1.B := (iBlu * iRatio) shr 16;
      x1 := x1 + 3 * dx;
      inc(x3,3);
    end;
    RowDest := RowDest + iDst;
    RowSourceStart := RowSource;
  end; // resampling

  if FreeImage_GetHeight(DestBmp) >= 3 then
  // Sharpening...
  begin
    s1 := integer(FreeImage_GetScanLine(DestBmp, 0));
    iDst := integer(FreeImage_GetScanLine(DestBmp, 1)) - s1;
    ny1 := Integer(s1);
    ny2 := ny1 + iDst;
    ny3 := ny2 + iDst;
    for y := 1 to FreeImage_GetHeight(DestBmp) - 2 do
    begin
      for x := 0 to FreeImage_GetWidth(DestBmp) - 3 do
      begin
        x1 := x * 3;
        x2 := x1 + 3;
        x3 := x1 + 6;

        c1 := pRGB24(ny1 + x1)^;
        c2 := pRGB24(ny1 + x3)^;
        c3 := pRGB24(ny2 + x2)^;
        c4 := pRGB24(ny3 + x1)^;
        c5 := pRGB24(ny3 + x3)^;

        r := (c1.R + c2.R + (c3.R * -12) + c4.R + c5.R) div -8;
        g := (c1.G + c2.G + (c3.G * -12) + c4.G + c5.G) div -8;
        b := (c1.B + c2.B + (c3.B * -12) + c4.B + c5.B) div -8;

        if r < 0 then r := 0 else if r > 255 then r := 255;
        if g < 0 then g := 0 else if g > 255 then g := 255;
        if b < 0 then b := 0 else if b > 255 then b := 255;

        pt1 := pRGB24(ny2 + x2);
        pt1.R := r;
        pt1.G := g;
        pt1.B := b;
      end;
      inc(ny1, iDst);
      inc(ny2, iDst);
      inc(ny3, iDst);
    end;
  end; // sharpening

  if SrcBmp <> FDib then
    FreeImage_Unload(SrcBmp);
  DestBitmap.Replace(DestBmp);
end;

function TFreeBitmap.PasteSubImage(Src: TFreeBitmap; Left, Top,
  Alpha: Integer): Boolean;
begin
  if FDib <> nil then
  begin
    Result := FreeImage_Paste(FDib, Src.Dib, Left, Top, Alpha);
    Change;
  end else
    Result := False;
end;

function TFreeBitmap.Replace(NewDib: PFIBITMAP): Boolean;
begin
  Result := False;
  if NewDib = nil then Exit;

  if FDib <> nil then
    FreeImage_Unload(FDib);

  FDib := NewDib;
  Result := True;
  Change;
end;

function TFreeBitmap.Rescale(NewWidth, NewHeight: Integer;
  Filter: TFreeStretchFilter; Dest: TFreeBitmap): Boolean;
const
  cFilter: array [TFreeStretchFilter] of FREE_IMAGE_FILTER = (
    FILTER_BOX,
    FILTER_BICUBIC,
    FILTER_BILINEAR,
    FILTER_BSPLINE,
    FILTER_CATMULLROM,
    FILTER_LANCZOS3
  );
var
  Bpp: Integer;
  DstDib: PFIBITMAP;
begin
  Result := False;

  if FDib <> nil then
  begin
    Bpp := FreeImage_GetBPP(FDib);

    if Bpp < 8 then
      if not ConvertToGrayscale then Exit
    else
    if Bpp = 16 then
    // convert to 24-bit
      if not ConvertTo24Bits then Exit;

    // perform upsampling / downsampling
    DstDib := FreeImage_Rescale(FDib, NewWidth, NewHeight, cFilter[Filter]);
    if Dest = nil then
      Result := Replace(DstDib)
    else
      Result := Dest.Replace(DstDib)
  end
end;

function TFreeBitmap.Rotate(Angle: Double): Boolean;
var
  Bpp: Integer;
  Rotated: PFIBITMAP;
begin
  Result := False;
  if IsValid then
  begin
    Bpp := FreeImage_GetBPP(FDib);
    if Bpp in [1, 8, 24, 32] then
    begin
      Rotated := FreeImage_RotateClassic(FDib, Angle);
      Result := Replace(Rotated);
    end
  end;
end;

function TFreeBitmap.RotateEx(Angle, XShift, YShift, XOrigin,
  YOrigin: Double; UseMask: Boolean): Boolean;
var
  Rotated: PFIBITMAP;
begin
  Result := False;
  if FDib <> nil then
  begin
    if FreeImage_GetBPP(FDib) >= 8 then
    begin
      Rotated := FreeImage_RotateEx(FDib, Angle, XShift, YShift, XOrigin, YOrigin, UseMask);
      Result := Replace(Rotated);
    end
  end;
end;

function TFreeBitmap.Save(const FileName: string; Flag: Integer): Boolean;
var
  fif: FREE_IMAGE_FORMAT;
  CanSave: Boolean;
  ImageType: FREE_IMAGE_TYPE;
  Bpp: Word;
begin
  Result := False;

  // try to guess the file format from the file extension
  fif := FreeImage_GetFIFFromFilename(PChar(Filename));
  if fif <> FIF_UNKNOWN then
  begin
    // check that the dib can be saved in this format
    ImageType := FreeImage_GetImageType(FDib);
    if ImageType = FIT_BITMAP then
    begin
      // standart bitmap type
      Bpp := FreeImage_GetBPP(FDib);
      CanSave := FreeImage_FIFSupportsWriting(fif)
                 and FreeImage_FIFSupportsExportBPP(fif, Bpp);
    end
    else // special bitmap type
      CanSave := FreeImage_FIFSupportsExportType(fif, ImageType);

    if CanSave then
      Result := FreeImage_Save(fif, FDib, PChar(FileName), Flag)
  end
end;

function TFreeBitmap.SaveToHandle(fif: FREE_IMAGE_FORMAT; IO: PFreeImageIO;
  Handle: fi_handle; Flag: Integer): Boolean;
var
  CanSave: Boolean;
  ImageType: FREE_IMAGE_TYPE;
  Bpp: Word;
begin
  Result := False;

  if fif <> FIF_UNKNOWN then
  begin
    // check that the dib can be saved in this format
    ImageType := FreeImage_GetImageType(FDib);
    if ImageType = FIT_BITMAP then
    begin
      // standart bitmap type
      Bpp := FreeImage_GetBPP(FDib);
      CanSave := FreeImage_FIFSupportsWriting(fif)
                 and FreeImage_FIFSupportsExportBPP(fif, Bpp);
    end
    else // special bitmap type
      CanSave := FreeImage_FIFSupportsExportType(fif, ImageType);

    if CanSave then
      Result := FreeImage_SaveToHandle(fif, FDib, IO, Handle, Flag)
  end
end;

function TFreeBitmap.SaveToMemory(fif: FREE_IMAGE_FORMAT;
  MemIO: TFreeMemoryIO; Flag: Integer): Boolean;
var
  CanSave: Boolean;
  ImageType: FREE_IMAGE_TYPE;
  Bpp: Word;
begin
  Result := False;

  if fif <> FIF_UNKNOWN then
  begin
    // check that the dib can be saved in this format
    ImageType := FreeImage_GetImageType(FDib);
    if ImageType = FIT_BITMAP then
    begin
      // standart bitmap type
      Bpp := FreeImage_GetBPP(FDib);
      CanSave := FreeImage_FIFSupportsWriting(fif)
                 and FreeImage_FIFSupportsExportBPP(fif, Bpp);
    end
    else // special bitmap type
      CanSave := FreeImage_FIFSupportsExportType(fif, ImageType);

    if CanSave then
      Result := MemIO.Write(fif, FDib, Flag)
  end
end;

function TFreeBitmap.SetChannel(Bitmap: TFreeBitmap;
  Channel: FREE_IMAGE_COLOR_CHANNEL): Boolean;
begin
  if FDib <> nil then
  begin
    Result := FreeImage_SetChannel(FDib, Bitmap.FDib, Channel);
    Change;
  end
  else
    Result := False
end;

function TFreeBitmap.SetFileBkColor(BkColor: PRGBQuad): Boolean;
begin
  Result := FreeImage_SetBackgroundColor(FDib, BkColor);
  Change;
end;

procedure TFreeBitmap.SetHorizontalResolution(Value: Integer);
begin
  if IsValid then
  begin
    FreeImage_SetDotsPerMeterX(FDib, Value * 100);
    Change;
  end;
end;

function TFreeBitmap.SetPixelColor(X, Y: Cardinal;
  Value: PRGBQUAD): Boolean;
begin
  Result := FreeImage_SetPixelColor(FDib, X, Y, Value);
  Change;
end;

function TFreeBitmap.SetPixelIndex(X, Y: Cardinal; Value: PByte): Boolean;
begin
  Result := FreeImage_SetPixelIndex(FDib, X, Y, Value);
  Change;
end;

function TFreeBitmap.SetSize(ImageType: FREE_IMAGE_TYPE; Width, Height,
  Bpp: Integer; RedMask, GreenMask, BlueMask: Cardinal): Boolean;
var
  Pal: PRGBQuad;
  I: Cardinal;
begin
  Result := False;

  if FDib <> nil then
    FreeImage_Unload(FDib);

  FDib := FreeImage_Allocate(Width, Height, Bpp, RedMask, GreenMask, BlueMask);
  if FDib = nil then Exit;

  if ImageType = FIT_BITMAP then
  case Bpp of
    1, 4, 8:
    begin
      Pal := FreeImage_GetPalette(FDib);
      for I := 0 to FreeImage_GetColorsUsed(FDib) - 1 do
      begin
        Pal.rgbBlue := I;
        Pal.rgbGreen := I;
        Pal.rgbRed := I;
        Inc(Pal, SizeOf(RGBQUAD));
      end;
    end;
  end;

  Result := True;
  Change;
end;

procedure TFreeBitmap.SetTransparencyTable(Table: PByte; Count: Integer);
begin
  FreeImage_SetTransparencyTable(FDib, Table, Count);
  Change;
end;

procedure TFreeBitmap.SetVerticalResolution(Value: Integer);
begin
  if IsValid then
  begin
    FreeImage_SetDotsPerMeterY(FDib, Value * 100);
    Change;
  end;
end;

function TFreeBitmap.SplitChannels(RedChannel, GreenChannel,
  BlueChannel: TFreeBitmap): Boolean;
begin
  if FDib <> nil then
  begin
    RedChannel.FDib := FreeImage_GetChannel(FDib, FICC_RED);
    GreenChannel.FDib := FreeImage_GetChannel(FDib, FICC_GREEN);
    BlueChannel.FDib := FreeImage_GetChannel(FDib, FICC_BLUE);
    Result := RedChannel.IsValid and GreenChannel.IsValid and BlueChannel.IsValid;
  end
  else
    Result := False  
end;

function TFreeBitmap.Threshold(T: Byte): Boolean;
var
  dib1: PFIBITMAP;
begin
  if FDib <> nil then
  begin
    dib1 := FreeImage_Threshold(FDib, T);
    Result := Replace(dib1);
  end
  else
    Result := False
end;

{ TFreeWinBitmap }

function TFreeWinBitmap.CaptureWindow(ApplicationWindow,
  SelectedWindow: HWND): Boolean;
var
  XScreen, YScreen, XShift, YShift, Width, Height: Integer;
  R: TRect;
  dstDC, srcDC, memDC: HDC;
  BM, oldBM: HBITMAP;
begin
  Result := False;

  // get window size
  GetWindowRect(SelectedWindow, R);

  // check if the window is out of screen or maximized
  XShift := 0;
  YShift := 0;
  XScreen := GetSystemMetrics(SM_CXSCREEN);
  YScreen := GetSystemMetrics(SM_CYSCREEN);
  if R.Right > XScreen then
    R.Right := XScreen;
  if R.Bottom > YScreen then
    R.Bottom := YScreen;
  if R.Left < 0 then
  begin
    XShift := -R.Left;
    R.Left := 0;
  end;
  if R.Top < 0 then
  begin
    YShift := -R.Top;
    R.Top := 0;
  end;

  Width := R.Right - R.Left;
  Height := R.Bottom - R.Top;

  if (Width <= 0) or (Height <= 0) then Exit;

  // hide the application window
  ShowWindow(ApplicationWindow, SW_HIDE);

  // bring the window at the top most level
  SetWindowPos(SelectedWindow, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

  // give enough time to refresh the window
  Sleep(500);

  // prepare the DCs
  dstDc := GetDC(0);
  srcDC := GetWindowDC(SelectedWindow); //full window (GetDC(SelectedWindow) = clientarea)
  memDC := CreateCompatibleDC(dstDC);

  // copy the screen to the bitmap
  BM := CreateCompatibleBitmap(dstDC, Width, Height);
  oldBM := HBITMAP(SelectObject(memDC, BM));
  BitBlt(memDC, 0, 0, Width, Height, srcDC, XShift, YShift, SRCCOPY);

  // redraw the application window
  ShowWindow(ApplicationWindow, SW_SHOW);

  // restore the position
  SetWindowPos(SelectedWindow, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
  SetWindowPos(ApplicationWindow, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);

  // convert the HBITMAP to FIBITMAP
  CopyFromBitmap(BM);

  // free objects