unit BmpClip;

{ Windows Clipboard Bitmap Transfer,
  Copr. 1994 Matthias K"oppe

  $Id: bmpclip.pas 1.3 1999/02/09 10:44:49 mkoeppe Exp $
 
  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Library General Public
  License as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This library is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  Library General Public License for more details.

  You should have received a copy of the GNU Library General Public
  License along with this library; if not, write to the Free
  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

}

interface

uses WinRes;

function GetBitmapFromClip: PBitmap;
procedure PutBitmapToClip(Bitmap: PBitmap);

implementation

uses Clipbrd;

function GetBitmapFromClip: PBitmap;
var
  size, bit, lead: LongInt;
  p, Buf: pointer;
  Bmp: PBitmap;
Begin
  GetBitmapFromClip := nil;
  size := GetClipboardDataSize(cf_Bitmap);
  If size = 0 then Exit;
  GetMem(Buf, size);
  GetClipboardData(cf_Bitmap, Buf^);
  New(Bmp);
  GetBitmapFromClip := Bmp;
  Move(Buf^, Bmp^, SizeOf(TBitmap) -
    (SizeOf(pointer {TBitmap.bmPalette}) + SizeOf(Word {TBitmap.bmChunks})));
  asm mov bx, 0 end;			{ for a *very* silly reason }
  with Bmp^ do Begin
    bmPalette := nil;
    bmChunks := 0;
    lead := PChar(bmBits) - PChar(Buf); 	{ leading bytes }
    FreeMemAlign(Buf, lead, false, false);
    bit := abs(bmHeight)*bmWidthBytes*bmPlanes;
    If size > lead + bit then Begin
      p := PChar(bmBits) + bit;
      FreeMemAlign(p, size - lead - bit, true, true)
    End;
  End;
End;

procedure PutPalette(Bitmap: PBitmap);
{ not functional since WINOLDAP's palette transfer is buggy...
}
var
  Buf: PLogPalette;
  bitcount, memsize: Word;
Begin
  with Bitmap^ do
    If bmPalette <> nil then Begin
      bitcount := bmBitsPixel * bmPlanes;
      memsize := SizeOf(TLogPalette) - SizeOf(TPaletteEntry)
	+ SizeOf(TPaletteEntry) shl bitcount;
      GetMem(Buf, memsize);
      with Buf^ do Begin
	palVersion := $300;
	palNumEntries := 1 shl bitcount;
	Move(bmPalette^, palPalEntry, SizeOf(TPaletteEntry) shl bitcount)
      End;
      SetClipboardData(cf_Palette, buf^, memsize);
    End
End;

procedure PutBitmapToClip(Bitmap: PBitmap);
var
  Buffer: PChar;
  size: Word;
Begin
  with Bitmap^ do Begin
    size := bmWidthBytes * abs(bmHeight) * bmPlanes + 22;
    GetMem(buffer, size);
    If Buffer = nil then Exit;
    FillChar(Buffer^, 22, 0);
    Move(Bitmap^, buffer^, SizeOf(TBitmap) - 4);
    with PBitmap(buffer)^ do
      bmBits := buffer + 22;
    Move(bmBits^, (Buffer+22)^, size - 22);
  End;
  SetClipboardData(cf_Bitmap, buffer^, size);
  {PutPalette(Bitmap)}
End;

end.
