{

   This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either
  version 2 of the License, or (at your option) any later version.

  This program 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 General Public License for more details.

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

{*********************************************}
{  This unit is a part of ImageE              }
{  Copyright © 2003-2004 R.Geurts             }
{  See Readme.txt for licence information     }
{*********************************************}

{
  Author William Egge. egge@eggcentric.com
  January 17, 2002
  Compiles with ver 1.2 patch #1 of Graphics32

  This unit will copy and paste Bitmap32 pixels to the clipboard and retain the
  alpha channel.

  The clipboard data will still work with regular paint programs because this
  unit adds a new format only for the alpha channel and is kept seperate from
  the regular bitmap storage.
}

interface
uses
  ClipBrd, Windows, SysUtils, GR32;

procedure CopyBitmap32ToClipboard(const Source: TBitmap32);
procedure PasteBitmap32FromClipboard(const Dest: TBitmap32);
function CanPasteBitmap32: Boolean;

implementation
const
  RegisterName = 'G32 Bitmap32 Alpha Channel';
  GlobalUnlockBugErrorCode = ERROR_INVALID_PARAMETER;

var
  FAlphaFormatHandle: Word = 0;

procedure RaiseSysError;
var
  ErrCode: LongWord;
begin
  ErrCode:= GetLastError();
  if ErrCode <> NO_ERROR then
    raise Exception.Create(SysErrorMessage(ErrCode));
end;

function GetAlphaFormatHandle: Word;
begin
  if FAlphaFormatHandle = 0 then
  begin
    FAlphaFormatHandle:= RegisterClipboardFormat(RegisterName);
    if FAlphaFormatHandle = 0 then
      RaiseSysError;
  end;
  Result:= FAlphaFormatHandle;
end;

function CanPasteBitmap32: Boolean;
begin
  Result:= Clipboard.HasFormat(CF_BITMAP);
end;

procedure CopyBitmap32ToClipboard(const Source: TBitmap32);
var
  H: HGLOBAL;
  Bytes: LongWord;
  P, Alpha: PByte;
  I: Integer;
begin
  Clipboard.Assign(Source);
  if not OpenClipboard(0) then
//    RaiseSysError
  else
  try
    Bytes:= 4 + (Source.Width * Source.Height);
    H:= GlobalAlloc(GMEM_MOVEABLE and GMEM_DDESHARE, Bytes);
    if H = 0 then
      RaiseSysError;
    P:= GlobalLock(H);
    if P = nil then
      RaiseSysError
    else
    try
      PLongWord(P)^:= Bytes - 4;
      Inc(P, 4);
      // Copy Alpha into Array
      Alpha:= Pointer(Source.Bits);
      Inc(Alpha, 3); // Align with Alpha
      for I:= 1 to (Source.Width * Source.Height) do
      begin
        P^:= Alpha^;
        Inc(Alpha, 4);
        Inc(P);
      end;
    finally
      if (not GlobalUnlock(H)) then
        if (GetLastError() <> GlobalUnlockBugErrorCode) then
          RaiseSysError;
    end;
    SetClipboardData(GetAlphaFormatHandle, H);
  finally
    if not CloseClipboard then
      RaiseSysError;
  end;
end;

procedure PasteBitmap32FromClipboard(const Dest: TBitmap32);
var
  H: HGLOBAL;
  ClipAlpha, Alpha: PByte;
  I, Count, PixelCount: LongWord;
begin
  if Clipboard.HasFormat(CF_BITMAP) then
  begin
    Dest.BeginUpdate;
    try
      Dest.Assign(Clipboard);
      if not OpenClipboard(0) then
        RaiseSysError
      else
      try
        H:= GetClipboardData(GetAlphaFormatHandle);
        if H <> 0 then
        begin
          ClipAlpha:= GlobalLock(H);
          if ClipAlpha = nil then
            RaiseSysError
          else
          try
            Alpha:= Pointer(Dest.Bits);
            Inc(Alpha, 3); // Align with Alpha
            Count:= PLongWord(ClipAlpha)^;
            Inc(ClipAlpha, 4);
            PixelCount:= Dest.Width * Dest.Height;
            Assert(Count = PixelCount, 'Alpha count does not match Bitmap pixel count, PasteBitmap32FromClipboard(const Dest: TBitmap32);');

            // Should not happen, but if it does then this is a safety catch.
            if Count > PixelCount then
              Count:= PixelCount;

            for I:= 1 to Count do
            begin
              Alpha^:= ClipAlpha^;
              Inc(Alpha, 4);
              Inc(ClipAlpha);
            end;
          finally
            if (not GlobalUnlock(H)) then
              if (GetLastError() <> GlobalUnlockBugErrorCode) then
                RaiseSysError;
          end;
        end;
      finally
        if not CloseClipboard then
          RaiseSysError;
      end;
    finally
      Dest.EndUpdate;
      Dest.Changed;
    end;
  end;
end;

end.
