FireMonkeyで画像をクリップボードで処理するには

かちかちやま 2012-01-25 19:16:03 No: 41505

現在Winで作動しているアプリをMacでも動くようにとの希望から、
FireMonkey+XPに移植していますが、従来は画像の処理を
クリップボード経由で行っていました。
具体的にはDBで扱う画像フィールドの入力方法を
「ファイルから」と「クリップボード経由」の２つをしていますが、
クリップボード経由（Jpeg,Bitmapなど）のやり方で躓いてしまいました。
処理の切り口がまったく見当がつきません。
どうすればいいのかご教授お願いします。

DEKO 2012-01-26 02:03:18 No: 41506

Platform 変数の GetClipboard / SetClipboard はテキスト専用ですしね。

[Copying and pasting the contents of a FireMonkey TBitmap (Delphi Haven)]
http://delphihaven.wordpress.com/2011/10/06/copying-and-pasting-the-contents-of-a-firemonkey-tbitmap/

こちらの Bitmap の例を参考にゴリゴリ書くしかないかもです。

# Mac では "ペーストボード" と言うのですね。

かちかちやま 2012-01-29 01:36:29 No: 41507

DEKOさんありがとうございます。
やはり、このHPしかないようですね。
そのまま、やってみてもエラーばかりでしたが、適当にいじっていくと動くようになりました。
でも・・・・本当にこれでいいのかまったく自信がありません。
ソースをすべて書きますので、添削いただければ幸いです。
”<====ORG ”の部分はHPからの元のソースです。

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, Winapi.Windows ,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects ,FMX.Platform ;

// Winapi.Windows の位置に注意が必要みたいですなぜ？？

type
  TForm1 = class(TForm)
    Btn_To_Clip_: TButton;
    Btn_From_Clip_: TButton;
    Image1:  TImage;
    procedure Btn_To_Clip_Click(Sender: TObject);
    procedure Btn_From_Clip_Click(Sender: TObject);
  private
    { private 宣言 }

     function  CanPasteBitmapFromClipboard: Boolean;
     procedure CopyBitmapToClipboard(Bitmap: TBitmap);
     function  PasteBitmapFromClipboard(Bitmap: TBitmap): Boolean;
  public
    { public 宣言 }

end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Btn_To_Clip_Click(Sender: TObject);
var
  MyBitmap:TBitmap;
begin
  MyBitmap := TBitmap.Create(0,0);
  try
    MyBitmap.Assign(Image1.Bitmap);
    CopyBitmapToClipboard(MyBitmap );
  finally
    MyBitmap.Free;
  end;
end;

procedure TForm1.Btn_From_Clip_Click(Sender: TObject);
var
  MyBitMap:TBitMap;
begin
  MyBitmap := TBitmap.Create(0,0);
  try
    PasteBitmapFromClipboard(MyBitMap);
    Image1.Bitmap.Assign(MyBitMap);
  finally
    MyBitMap.Free;
  end;
end;

function TForm1.CanPasteBitmapFromClipboard: Boolean;
begin
Result := IsClipboardFormatAvailable(CF_DIB);
end;

procedure TForm1.CopyBitmapToClipboard(Bitmap: TBitmap);
var
  BitsSize: Integer;
  MemObj  : HGLOBAL;
  Ptr     : PBitmapInfoHeader;
begin
  BitsSize := Bitmap.Width  * Bitmap.Height * 4; //<=====ORG

  MemObj := GlobalAlloc(GMEM_MOVEABLE and GMEM_DDESHARE, SizeOf(TBitmapInfoHeader) + BitsSize);
  if MemObj = 0 then RaiseLastOSError;
  Ptr := GlobalLock(MemObj);
  if Ptr = nil then
  begin
    GlobalFree(MemObj);
    RaiseLastOSError;
  end;
  //fill out the info header
  FillChar(Ptr^, SizeOf(Ptr^), 0);
  Ptr.biSize := SizeOf(TBitmapInfoHeader);
  Ptr.biPlanes := 1;
  Ptr.biBitCount := 32;
  Ptr.biCompression := BI_RGB;
  //Ptr.biWidth := Bitmap.Width;
  //Ptr.biWidth := Bitmap.bmWidth; //<=====ORG
  Ptr.biWidth := Bitmap.Width;

  if Ptr.biWidth <= 0 then Ptr.biWidth := 1;
  //Ptr.biHeight := -Bitmap.Height;
  //Ptr.biHeight := -Bitmap.bmHeight;  //<=====ORG

Ptr.biHeight := -Bitmap.Height;

  if Ptr.biHeight >= 0 then Ptr.biHeight := -1;
  //copy over the image bits
  Inc(Ptr);
  if BitsSize <> 0 then
    Move(Bitmap.StartLine^, Ptr^, BitsSize);   //<======ORG

  GlobalUnlock(MemObj);
  //assign the completed DIB memory object to the clipboard
  OpenClipboard(0);
  try
    EmptyClipboard;
    //if not (SetClipboardData(CF_DIB, MemObj)) then     // <=====ORG
    if (SetClipboardData(CF_DIB, MemObj)=0) then          // <=====????
    //if (SetClipboardData(CF_DIB, MemObj)0) then        // <=====????
    begin
      GlobalFree(MemObj);
      RaiseLastOSError;
    end;
  finally
    CloseClipboard;
  end;
end;

function TForm1.PasteBitmapFromClipboard(Bitmap: TBitmap): Boolean;
var
  Header: TBitmapFileHeader;
  MemObj: HGLOBAL;
  Ptr   : PBitmapInfoHeader;
  Stream: TMemoryStream;
begin
  Ptr := nil;
  Stream := nil;
  OpenClipboard(0);
  try
    MemObj := GetClipboardData(CF_DIB);
    if MemObj = 0 then Exit(False);
    Ptr := GlobalLock(MemObj);
    if Ptr = nil then Exit(False);
    FillChar(Header, SizeOf(Header), 0);
    Header.bfType := $4D42;
    Header.bfSize := SizeOf(Header) + GlobalSize(MemObj);
    Header.bfOffBits := SizeOf(Header) + Ptr.biSize;
    Stream := TMemoryStream.Create;
    Stream.WriteBuffer(Header, SizeOf(Header));
    Stream.WriteBuffer(Ptr^, Header.bfSize - SizeOf(Header));
    Stream.Position := 0;
    Bitmap.LoadFromStream(Stream);    //<=====ORG

    Result := True;
  finally
    if Ptr <> nil then GlobalUnlock(MemObj);
    CloseClipboard;
    Stream.Free;
  end;
end;