unit plCaptureViewUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, ExtDlgs, StdCtrls, plSendDataUnit;

type
  TplFormCaptureView = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    PopupSaveToBitmap: TMenuItem;
    N3: TMenuItem;
    PopupClose: TMenuItem;
    SavePictureDialog1: TSavePictureDialog;
    N2: TMenuItem;
    PopupCopyToClipBorad: TMenuItem;
    PopupCopyPaste: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PopupSaveToBitmapClick(Sender: TObject);
    procedure PopupCloseClick(Sender: TObject);
    procedure PopupCopyToClipBoradClick(Sender: TObject);
    procedure PopupCopyPasteClick(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private 宣言 }
    FCaption      : string;
    FImageSaveDir : string;
    FIniFileName  : string;
    FplSendData1  : TplSendData;
    FBitmap       : TBitmap;
    procedure OnSendDataMessage(Sender: TObject; hSendWnd: HWND);
    procedure DisplayImaageToTImage(ABmp: TBitmap);
  public
    { Public 宣言 }
  end;

var
  plFormCaptureView: TplFormCaptureView;

implementation

uses
  IniFiles,
  Clipbrd;

{$R *.dfm}

type
  TDadaKind = (dkBitmap, dkNone);

//=============================================================================
//  フォーム作成時に、フォームの位置とサイズ等をIniファイルから読み出す
//=============================================================================
procedure TplFormCaptureView.FormCreate(Sender: TObject);
const
  MSGFLT_ADD = 1;
var
  LIniFile    : TInifile;
  LWidth      : Integer;
  LHeight     : Integer;
  LDLLHandle  : THandle;
  LFuncFilter : function (msg: Cardinal; dwFlag: DWORD): BOOL; stdcall;
begin
  FCaption := 'キャプチャー画像';
  Caption  := FCaption;
  FIniFileName := ChangeFileExt(Application.ExeName, '.ini');

  LWidth   := 0;
  LHeight  := 0;
  LIniFile := TIniFile.Create(FIniFileName);
  try
    try
      Self.Left     := LIniFile.ReadInteger ('PreviewForm', 'FormLeft ',    0);
      Self.Top      := LIniFile.ReadInteger ('PreviewForm', 'FormTop',      0);
      LWidth        := LIniFile.ReadInteger ('PreviewForm', 'FormWidth',    0);
      LHeight       := LIniFile.ReadInteger ('PreviewForm', 'FormHeight',   0);
      FImageSaveDir := LIniFile.ReadString  ('PreviewForm', 'ImageSaveDir', '');
    except
    end;
  finally
    FreeAndNil(LIniFile);
  end;

  if (LWidth = 0) or (LHeight = 0) then begin
    Self.Position := poMainFormCenter;
    Self.Width    := 500;
    Self.Height   := 400;
  end else begin
    Self.Position := poDesigned;
    Self.Width    := LWidth;
    Self.Height   := LHeight;
  end;

  //プロセス間通信用コンポの生成
  //TplSendDataはフォーム生成時に生成する必要がある
  FplSendData1 := TplSendData.Create(Self);
  FplSendData1.OnMessage := OnSendDataMessage;
  //UIPI対策
  //本アプリでWM_COPYDATAメッセージの受信を可能にする
  if CheckWin32Version(6, 0) then begin
    LDLLHandle := loadLibrary('user32.dll');
    try
      if LDLLHandle > 0 then begin
        @LFuncFilter := GetProcAddress(LDLLHandle, 'ChangeWindowMessageFilter');
        if @LFuncFilter <> nil then begin
          LFuncFilter(WM_COPYDATA, MSGFLT_ADD);
        end;
      end;
    finally
      FreeLibrary(LDLLHandle);
    end;
  end;
end;

//=============================================================================
//  このフォームを閉じる時は、フォームの位置とサイズ等をIniファイルに保存
//=============================================================================
procedure TplFormCaptureView.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  LIniFile : TInifile;
begin
  LIniFile := TIniFile.Create(FIniFileName);
  try
    try
      LIniFile.WriteInteger('PreviewForm', 'FormLeft ',     Left);
      LIniFile.WriteInteger('PreviewForm', 'FormTop',       Top);
      LIniFile.WriteInteger('PreviewForm', 'FormWidth',     Width);
      LIniFile.WriteInteger('PreviewForm', 'FormHeight',    Height);
      LIniFile.WriteString ('PreviewForm', 'ImageSaveDir',  FImageSaveDir);
    except
    end;
  finally
    FreeAndNil(LIniFile);
  end;

  if Assigned(FBitmap) then FreeAndNil(FBitmap);

  //プロセス間通信用コンポの解放処理
  FreeAndNil(FplSendData1);
end;

//-----------------------------------------------------------------------------
//  TplSendDataのOnMessageイベント処理
//  plScreenCapture.exeからキャプチャした画像をプロセス間通信で受信する
//-----------------------------------------------------------------------------
procedure TplFormCaptureView.OnSendDataMessage(Sender: TObject; hSendWnd: HWND);
var
  LDataKind : Cardinal;
begin
  LDataKind := FplSendData1.DataKind;
  if Ord(dkBitmap) = LDataKind then begin
    if Assigned(FBitmap) then FreeAndNil(FBitmap);
    FBitmap := TBitmap.Create;

    FBitmap.LoadFromStream(FplSendData1.ReceiveMemory);
    DisplayImaageToTImage(FBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  TBitmapをTImageに表示
//  Image1のAutoSizeの値をTrueにしている
//-----------------------------------------------------------------------------
procedure TplFormCaptureView.DisplayImaageToTImage(ABmp: TBitmap);
var
  LImgWidth  : Integer;
  LImgHeight : Integer;
begin
  Image1.Left := 0;
  Image1.Top  := 0;

  Image1.Picture.Bitmap := nil;
  Image1.Picture.Bitmap := ABmp;
  Image1.Picture.Bitmap.AlphaFormat := afDefined;
  Image1.Update;

  LImgWidth  := FBitmap.Width;
  LImgHeight := FBitmap.Height;
  Caption := FCaption + '  ' +
             ' 幅 ' + IntToStr(LImgWidth)  + ' X 高 ' + IntToStr(LImgHeight);
end;

//=============================================================================
//  [ビットマップ画像保存]
//=============================================================================
procedure TplFormCaptureView.PopupSaveToBitmapClick(Sender: TObject);
begin
  if not Assigned(FBitmap) then exit;

  SavePictureDialog1.FileName := '';
  if FImageSaveDir = '' then begin
    SavePictureDialog1.InitialDir := ExtractFilePath(ParamStr(0));
  end else begin
    SavePictureDialog1.InitialDir := FImageSaveDir;
  end;
  SavePictureDialog1.Filter     := 'ビットマップ (*.bmp)|*.bmp';
  SavePictureDialog1.DefaultExt := '.bmp';

  if SavePictureDialog1.Execute then begin
    FBitmap.SaveToFile(SavePictureDialog1.FileName);
    FImageSaveDir := ExtractFileDir(SavePictureDialog1.FileName);
  end;
end;

//=============================================================================
//  [クリップボードへコピー]
//=============================================================================
procedure TplFormCaptureView.PopupCopyToClipBoradClick(Sender: TObject);
begin
  if not Assigned(FBitmap) then exit;
  Clipboard.Assign(FBitmap);
end;

//=============================================================================
//  [貼付け]
//=============================================================================
procedure TplFormCaptureView.PopupCopyPasteClick(Sender: TObject);
var
  LHandle : THandle;
begin
  ClipBoard.Open;
  if Clipboard.HasFormat(CF_BITMAP) then begin
    LHandle := Clipboard.GetAsHandle(CF_DIB);
    try
      if Assigned(FBitmap) then FreeAndNil(FBitmap);
      FBitmap := TBitmap.Create;

      FBitmap.Assign(Clipboard);

      FBitmap.PixelFormat := pf32bit;
      FBitmap.AlphaFormat := afDefined;

      DisplayImaageToTImage(FBitmap);
    finally
      GlobalUnlock(LHandle);
    end;
  end;
  Clipboard.Close;
end;

//=============================================================================
//  [閉じる]
//=============================================================================
procedure TplFormCaptureView.PopupCloseClick(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  スクロール
//=============================================================================
procedure TplFormCaptureView.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  Handled := True;
  Self.ScrollBox1.VertScrollBar.Position :=
       Self.ScrollBox1.VertScrollBar.Position - WheelDelta div 5;
end;

end.