Delphi Programming / Object Pascal
[掲載 2005年03月25日] [更新 2022年01月16日] Delphi サンプルプログラム集
370_スクリーンキャプチャー ( アプリケーション )
動作確認等
Windows 7 U64(SP1) + Delphi XE Pro
Windows 2000 以前では正常に動作しない
370_ScreenCapture1.zip [1,6 MB] 2022年01月18日(EXE 同梱)
2011年12月16日
編集中の記事を手違いでUPしてしまったため,スクリーンキャプチャーのアプリケーションとして整備してあわてて更新
2017年08月11日 (これより前の履歴は省略)
キャプチャ本体のソースコードの添付を中止
プレビュー表示を別アプリにした.このソースコードは添付
独自作成のマウスカーソルのアルファチャンネルの処理に不具合があたのを修正
別のアプリでプレビューする際,起動中の時は貼り付け ([Ctrl] + [V]) を実行する方式に変更した.[Ctrl] + [V] の機能を実装していないアプリでは動作しない
2022年01月16日
Windows 10 の可変サイズのマウスカーソルをキャプチャできるようにした
このページには,常駐アプリの参考としてのスクリーンキャプチャのコードを掲載していましたが,サンプルとしてはコードが長く,あまり整備されていないコードでした.
そこで,いっそのことアプリケーションとしてのスクリーンキャプチャとして整備して掲載することにしました.キャプチャした画像を編集する機能は一切ありません.画像処理機能を除けば,一般の方にも利用可能な,キャプチャとしての基本的な機能は実装しています.いくつかの制限や仕様上の問題がありますが,以下で説明していきます.
このページの画像は全てこのプログラムでキャプチャしたものです.
Delphi の IDE 等,管理者権限で起動しているアプリのウィンドウをキャプチャするには管理者権限で実行 (管理者として実行) する必要あります.
[備考]
スクリーンキャプチャと呼ばれるアプリケーションの多くはキャプチャした画像の編集や加工の機能が実装されいます.本プログラムはキャプチャした画像をビットマップとして取得するだけの機能しかありません.
また,キャプチャの範囲や種類によって別々にホットキーを設定するアプリがあります.本プログラムはホットキーは固定で,キャプチャの範囲 (種類) を切り換えるる方式になっています.
これは,主に筆者がサイトの記事に掲載する画像を作成するために作成した結果です.記事に掲載する画像は,アクティブウインドウや矩形範囲のキャプチャを頻繁に切り換えるとことがあります.そのためにこの仕様になっています.
図1
実行開始画面
(1) このプログラム,plScreenCapture.exe を起動
(2) キャプチャに目的に応じて[キャプチャの範囲] をコンボボックスから選択
(3) ホットキーで設定してあるキーまたはキーの組み合わせを押す
(4) キャプチャした画像がプレビュー表示される
(5) [マウスカーソル下のウィンドウ] と [矩形範囲指定],[矩形範囲指定 (固定サイズ)] のキャプチャは少し操作が違う
(6) 使い終わったら,[終了] ボタンを押して終了する
という手順で操作します.必要な時に起動するようにしてください.起動したままだとホットキーが有効になったままになってしまいます.特に [PrintScreen] キーをホットキーにしてあると,システム本来の [PrintScreen] が機能しないことになります.
また,システムのアニメーション効果 ([ウィンドウを最大化や最小化するときにアニメーションで表示する]) を有効にしていると,正常にキャプチャできない場合があります.
各々の項目の意味や操作内容については,各項目の説明で確認してください.
定義したいキーの組み合わせを設定します.
入力欄をクリックした後,該当キーの組み合わせを押します.押したら [ホットキー更新] ボタンを押して,システムの設定を変更します.既に他にアプリ等で定義してあるキーの組み合わせの時は,ダイアログが表示され,設定できません.
OS は当然ですが,アプリケーションでもホットキーが定義されているものがあります.重複を避けるために,ホットキーの種類は [PrintScreen] キーと [その他] の 2 つだけとしています.
常駐アプリにする場合は,キャプチャの範囲ごとにホットキーを設定し,利用者がそのホットキーを覚えておかなければなりません.この意味も含めて常駐アプリにはしていません.
キャプチャの対象によっては,ホットキーが機能しない場合があります.そこで,ホットキーを変更できるようにしています.
筆者の環境と用途では,全て [PrintScreen] キーだけで間に合っています.
[備考 1]
管理者権限で起動しているアプリがアクティブな状態の場合,[PrintScreen] キーはホットキーとしては機能しません.
例えば Delphi は管理者権限での実行が必要なアプリケーションです.したがって,[PrintScreen] キーでは,Delphi の IDE の各ウィンドウはキャプチャできません.
そのような状態でも [PrintScreen] キーをホットキーとして使用するには,本アプリ自身も管理者権限で起動しておく必要があります.管理者権限で起動するには,ファイルのメニューから [管理者として実行] で起動します.
[備考 2]
アプリケーションには多くのホットキーやショートカットキーが実装されています.しかし筆者の頭脳では覚えきれません,誤操作することもよくあります.使用可能なホットキーを少なくしたり,常駐アプリにしない理由の 1 つです.
キャプチャの範囲 - [ アクティブウィンドウ ]
キャプチャするウィンドウをアクティブにして,ホットキーを押します.このアプリには,ウィンドウの隠れた部分もキャプチャする機能はありません.
オプションの [背景色] の指定には注意が必要です.アプリケーションが複数のウィンドウを開いていると,下図のように,後ろのウィンドウと重なっている部分が背景としてキャプチャされます.これを避けるには,対象のウィンドウを他の場所に移動してからキャプチャします.
[備考]
アプリケーションによっては,オプションの [アプリケーション] を有効にしていると,単一のウィンドウのアプリケーションであっても,対象のアプリケーションのウィンドウ以外の範囲もキャプチャしてしまうことがあります.その場合は,オプションの [アプリケーション] のチェックを外してキャプチャしてください.
図2
複数ウィンドウ表示のアプリ例
Form1 から Form2 を表示しているアプリ
キャプチャしたいのは Form2 とする
図3
Form2 をキャプチャした結果
後ろのウィンドウと重なっている部分はそのウィンドウが背景となってしまう
マルチモニタの場合,仮想画面全体をキャプチャします.仮想画面とは,全てのモニタの画面を含む画面全体のことです.
シングルモニタの場合は,次項の [デスクトップ (モニタ単位)] と同じ結果になります.
下図は,解像度が異なる 2 つのモニタを左右に配置した状態でのキャプチャ結果です.タスクバーが表示されている左側のディスプレイがプライマリのモニタです.
図4
下図は,上の図をキャプチャした時のモニタ (ディスプレイ) の設定です.
図5
モニタ (ディスプレイ) の設定
キャプチャの範囲 - [ デスクトップ ( モニタ単位 ) ]
キャプチャ開始時時 (ホットキー押下時) にマウスカーソルがあるモニタの (タスクバーを含む) 画面全体をキャプチャします.
図6
デスクトップのキャプチャ例
キャプチャの範囲 - [ ワークエリア ( モニタ単位 ) ]
キャプチャ開始時時 (ホットキー押下時) にマウスカーソルがあるモニタの (タスクバーを除いた) 画面をキャプチャします.
マルチモニタの場合,メインディスプレイ以外のモニタでは,そのモニタの画面全体となります.
図7
ワークエリアのキャプチャ例
キャプチャの範囲 - [ マウスカーソル下のウィンドウ ]
ホットキーを押下すると,キャプチャ開始となり,マウスカーソルの下のウィンドウの周囲に赤い枠が表示されます.マウスを移動すると別のウィンドウが同じように赤い枠で囲まれます.
キャプチャ中でも Windows の操作が可能です.必要に応じてウィンドウを開く等してキャプチャすることができます.[アクティブウィンドウ] とは違い,子ウィンドウもキャプチャできます.
[Pause] キーまたはホットキーでキャプチャ終了となります.
キャプチャのキャンセルは [ESC] キーです.
[備考 1]
[マウスカーソル下のウィンドウ] は,画面上のウインドウの矩形領域を切り取るだけです.実際のウィンドウを取得するわけではありません.
したがって,他のウィンドウに隠れている部分は,他のウィンドウの画像となります.また,背景の色も設定できません.
[備考 2]
[マウスカーソル下のウィンドウ] は,ウインドウハンドルを持つコントロールを検出します.ウィンドウハンドルは,Windows というプラットフォーム特有の機能です.
マルチデバイス (マルチプラットフォーム) 用の FireMonkey のコントロールの多くはウィンドウハンドルがありません.例えば,VCL の TButton は検出できますが,FireMonkey の TButton は検出できません.
図8
マウスカーソル下のウィンドウ
図9
キャプチャ例 1
図10
キャプチャ例 2
[ツールチップス] のチェックなしの場合
たとえツールチップスが表示されていもキャプチャに含まれない
ツールチップはキャプチャしたくないが,ツールチップが消えるまで待てない忙しい方のための仕様
キャプチャの範囲 - [ マウスカーソル下のオブジェクト ]
ホットキーを押すと,スクリーン上のマウス位置のオブジェクトが赤い枠線で囲まれます.
再度ホットキーを押すと,この赤い線で囲まれた部分をキャプチャします.キャプチャ操作中もマウス操作ができます.プルダウンやポップアップメニューを表示して,それらをキャプチャできます.
オブジェクトそのものをキャプチャするわけではありません.したがって,矩形領域に他のオブジェクトが重なっていると,その部分もキャプチャ画像の一部となります.
下図のように,マウスカーソルとツールチップを含めたキャプチャもできます.
キャプチャのキャンセルは [ESC] キーです.
図11
マウスカーソル下のオブジェクトのキャプチャ例
[マウスカーソル] と [ツールチップス] をチェックした場合
キャプチャの範囲 - [ ポップアップメニュー ( ツールチップス ) ]
プルダウンメニュー,ポップアップメニューまたはツールチップスだけをキャプチャします.
ツールチップスだけをキャプチャしたい場合は,[オプション] の [ツールチップス] をチェックしておきます.
表示されるポップアップメニューもツールチップスも 1 つだけです.したがって,ポップアップメニュー,またはツールチップスが表示されている状態でホットキーを押せばキャプチャ終了です.
図12
キャプチャ例 1
図13
キャプチャ例 2
図14
キャプチャ例 3
キャプチャの範囲 - [ 矩形範囲指定 ]
[ 矩形範囲 ( 前回の指定範囲 ) ]
(1) ホットキーを押す
(2) マウスカーソル位置に黒い十字線が表示される
(3) その周囲を拡大表示するウィンドウも現れる
(4) マウス左ボタンクリック,または [Enter] でキャプチャ範囲の最初の座標決定
(5) マウスカーソルを終点位置まで移動し,左ボタンをクリックするか [Enter] キー押下でキャプチャ終了
(6) 位置の微調整は [←] [→] [↑] [↓] キーで行う
(7) 赤線の 1 ドット分もキャプチャの範囲
(8) キャンセルは [ESC] キー.始点を決定している場合は,始点の決定前の状態となる
マウスクリックの際,微妙に位置が変化することがあります.矢印キーで位置の微調整を行えばこれを避けることができます.
拡大表示のウィンドウ (フォーム) のサイズは固定となっていて,変更できません.拡大率も内部で設定していて変更できません.このあたりの実装は,技術的内容よりも,仕様上,解決しなければならないことがあり実装していません.移動は可能です.
この [矩形範囲指定] の後,[矩形範囲指定 (前回の指定範囲)] でキャプチャーすると,同じ範囲のキャプチャーができます.
図15
キャプチャ中の例
キャプチャの範囲 - [ 矩形範囲指定 ( 固定サイズ ) ]
(1) ホットキーを押す
(2) マウスカーソル位置に指定したサイズの赤い枠線が表示される
(3) 枠線の中心の周囲を拡大表示したウィンドウも現れる
(4) マウス左ボタンクリック,または [Enter] でキャプチャ終了
(5) 位置の微調整は [←] [→] [↑] [↓] キーで行う
(6) 赤線の1ドット分もキャプチャの範囲
(7) キャンセルは [ESC] キー
マウスクリックの際,微妙に位置が変化することがあります.矢印キーで位置の微調整を行えばこれを避けることができます.
拡大表示のウィンドウ (フォーム) のサイズは固定となっていて,変更できません.拡大率も内部で設定していて変更できません.このあたりの実装は,技術的内容よりも,仕様上,解決しなければならないことがあり実装していません.移動は可能です.
固定サイズは,[固定矩形範囲] のラジオボタンで選択しておきます.
この[矩形範囲指定 (固定サイズ)] の後,[矩形範囲指定 (前回の指定範囲)] でキャプチャーすると,同じ範囲のキャプチャーができます.
図16
キャプチャ中の例
キャプチャの範囲 - [ タスクバーのサムネイル画像 ]
Windows Vista と Windows 7 だけで使用可能です.
タスクバー上にマウスカーソルを移動すると現れる,アプリケーションのサムネイル画像だけをキャプチャする機能です.このキャプチャでは背景色は指定できません.
サムネイル画像が表示されている状態でホットキーを押せば,キャプチャ終了です.
図17
キャプチャ例 1
デスクトップの背景でキャプチャ
筆者はデスクトップの背景を単色で使用している
図18
キャプチャ例 2
ディスクトップの背景色を白してキャプチャ
実際には,表示中のエクスプローラをタスクバーまで移動して,それを背景にしてキャプチャした
このチェックボックスがチェックされていると,キャプチャ開始と同時に,このキャプチャアプリケーションを最小化し,タスクバーにも表示しなくなります.
この機能は,以前実装していたのですが,2013年09月24日の更新で再実装しました.最小化してキャプチャすると,ツールチップがキャプチャできないことがあります.
アニメーション効果 ([ウィンドウを最大化や最小化するときにアニメーションで表示する]) が有効になっていると,ツールチップを含めたキャプチャは,ほとんど失敗します.
Windows 7 で Delphi を起動している時に,[Shift] [Ctrl] や [Alt] キーを押すと,ツールチップが消えてしまうことがあります.これは,IDE がアクティブの状態の場合に発生します.すると,開発状態の時に,ツールチップを含めたキャプチャができません.
そこで,この機能を追加しました.設定した時間秒後にキャプチャを開始します.チェックボックスにチェックが入っていない時は,この機能は働きません.
アプリケーション独自のツールチップはキャプチャできません.
マウスカーソルをキャプチャ画像に含めるかの指定です.マウスポインタの下に影が表示されている場合は影も含めてキャプチャします.独自作成のマウスカーソルもキャプチャします.
Windows ではデフォルトでマウスカーソルに影が表示されますが,種類によっては影を表示しないカーソルもあります.また,独自作成のカーソルは Windows の設定では影を表示しませんが,影付きのマウスカーソルとして作成されている場合もあります.
図19
マウスカーソルを含めたキャプチャ
図20
独自のマウスカーソルも含めたキャプチャ
エクスプローラ等のファイル名のところにマウスカーソルを移動すると,ファイルの情報のツールチップスが表示されます.システムの既定値では 5 秒程で消えます.このツールチップスを同時にキャプチャはしたくないが,消えるまで待てないという忙しい方のためのオプションです.
ここのチェックをしなければ,ツールチップスはキャプチャしません.
ワードやエクセル等,アプリケーション独自のツールチップスは制御できません.
[ キャプチャ時最小化 ] にしているとキャプチャできないことがあります.
図21
ツールチップもキャプチャ
ツールチップスの部分も範囲を拡大してキャプチャする
ポップアップメニュー,プルダウンメニューの場合も同じ
図22
ツールチップをキャプチャしない
オプション - [ ウィンドウまたはメニューの下の影領域 ]
影の部分をキャプチャ範囲に含めるかどうかの指定です.システムの影の表示設定を変更するものではありません.
Windows Vista 以降では,正確な名称は知りませんが,シャドウウィンドウの部分も含めてキャプチャできますので,プレゼンテーション用には体裁が良いのかも知れません.
このオプションを OFF にすると,ウィンドウの影はキャプチャしません.ただし,Windows Vista ではこの設定に関係なく影も含んだキャプチャなります.
[備考]
ウィンドウの下に「影」が描画されるのは,Windows Vista, 以降です.Windows 8 では描画されなくなりましたか,Windows 10 では再び影が表示されるようになりました.
「影」を描画しないようにすると,メニューにも影が描画されなくなり,メニュー部分の境界が分かりにくくなります.
図23
背景色を指定したキャプチャ
図24
影の領域を含まないキャプチャ
図25
上の図の拡大図
Windows 7 の場合,パフォーマンスオプションで,[ウィンドウの下に影を表示する] のチェックを外すとウィンドウ下の影が非表示となります.メニュー類の影も非表示となります.
下図は,この設定にしてキャプチャした例です.Vistaにはこの設定はありません.
図26
影を非表示にしたキャプチャ例
[パフォーマンスオプション] で,[ウィンドウの下の影を表示する] のチェックを外してキャプチャした場合
アプリケーションで開いているウィンドウを同時に全てキャプチャする機能です.
アプリケーションから,システム関係のダイアログを表示しても,そのダイアログはアプリケーションのウィドウには含まれません.この機能でキャプチャできるのは,同じプロセスIDを持つウィンドウだけです.
アプリケーションから,システム関係のダイアログを表示した場合,このダイアログはそのアプリケーションには含まれません.
[備考]
アプリケーションによっては,オプションの [アプリケーション] を有効にしていると,単一のウィンドウのアプリケーションであっても,対象のアプリケーションのウィンドウ以外の範囲もキャプチャしてしまうことがあります.その場合は,オプションの [アプリケーション] のチェックを外してキャプチャしてください.
図27
ワードのウィンドウの例
ウィンドウの背景色の指定です.ここまでの説明図にもありますので,参考にしてください.
アプリケーションが複数のウィンドウを表示していて,その中の1つをキャプチャする場合,ウィンドウが重なっていると,後ろのウィンドウが背景としてキャプチャされます.そのような場合,別のアプリのウィンドウの上に移動してキャプチャすると設定した背景色でキャプチャできることがあります.また,アプリケーションによっては背景色指定のキャプチャが正常に動作しない場合もあります.
このアプリでは,キャプチャするサイズと同じサイズのフォームを作成し,それを背景色で塗り潰した上に目的のウィンドウを重ねてキャプチャしています.この処理のため,半透明のウィンドウは正常にキャプチャできません.
同じアプリケーションが複数のウィンドウを開いている場合,重なった部分の背景が同じアプリケーションのウィンドウとなってしまうことがあります.アプリケーション内のコントロールにもZオーダーはもちろんあるわけですが,アプリケーションの特定のウィンドウだけを,システム全体の Z オーダーとして変更することはできません.
背景の色を clNone にする,背景をアルファチャンネル付きでキャプチャします.下図はキャプチャした画像を付属のプレビュー画面で表示しています.背景が透過している状態が確認できます.
背景色を clNone した場合も,半透明のウィンドウは正常にキャプチャできません.
図28
背景を透明にしたキャプチャ
[ アクティブウィンドウ ] のキャプチャ結果
オプションの [アプリケーション] をチェックしてキャプチャしている
Windows Vista と Windows 7 には [パフォーマンスオプション] の設定があります.このダイアログを表示します.この中の [ウィンドウの下に影を表示する] のチェックを外すと,ウィンドウの周囲と,メニュー類の影を表示しなくなります.この設定項目は,Vista にはありませんが,参考用に表示するようにしています.
筆者のように,ウィンドウの下の影の部分はキャプチャしたくないが,影を表示したままだと,隅 (角)の部分に影もキャプチャされ,体裁がよくないと思う場合,この項目のチェックを外してキャプチャすれば体裁がよくなります.
図29
[パフォーマンスオプション]
実際にウィンドウの下の影を表示しないでキャプチャした例です.
図30
キャプチャ例 1
オプションの [影の領域] をチェックして背景色を指定したキャプチャ
図31
キャプチャ例 2
[影の領域] を含めないで,背景色は上の図と同じ場合
図32
上の図の拡大図
キャプチャ画像表示 - [ 付属のプレビュー画面 ]
キャプチャした画像を,付属のプレビューフォームで表示します.
付属のプレビューフォームは,画像のビットマップ保存,クリップボードへのコピーと貼り付けの機能しか実装していません.
付属のプレビュー用プログラムの EXE 名は [ViewApp] フォルダ内の plCaptureView.exe です.クラス名は
TplFormCaptureView
となっています.本アプリはこのプログラムを検索して,そこにキャプチャしたビットマップ画像をプロセス間通信の機能わ使用して表示します.
キャプチャ画像表示 - [ クリップボードにコピー ]
キャプチャした画像を,クリップボードにコピーします.
コピーした画像を何かのアプリケーションに貼り付けて使用する場合に設定します.
キャプチャ画像表示 - [ 以下のアプリを使用 ]
画像の表示や加工が可能なアプリケーションを指定すると,キャプチャーした画像を,そのアプリケーションで表示することができます.
複数の画像を扱えるアプリケーションを使用する場合,最初はここで指定したアプリケーションで表示し,2 つ目以降は [クリップボードにコピー] でクリップボードにコピーして貼り付ければ,同じアプリを複数起動しないで操作できます.
ソースコード - [ キャプチャ画像表示用プログラム ]
確認用に,キャプチャした画像をプレビュー表示するためのプログラムです.画像処理関係のコードは一切実装していません.キャプチャした画像の確認のためだけに使用しています.
このプログラムのソースコードだけを添付しています.スクリーンキャプチャ本体のソースコードは添付していません.
図33
画像の編集や加工の機能は全くない
リスト1
キャプチャした画像をプレビューするためのプログラムのコード
copy code
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 .