ピクチャーボックスの画像の特定色を透過にしてクリップボードへコピーするには？
解決毎々お世話になっております。
電子印鑑をVB6.0にて作成しておりますが、ピクチャーボックスに作った画像の特定色を透過にし、クリップボードへコピー出来るのでしょうか？
また、VB6.0では技術的に無理であれば、.NETなら出来たりするのでしょうか？
どなたか助言頂けるとありがたいです。
ＧＩＦ画像で保存する。ってのは出来ますよ。
クリップボードにコピーして、その先はどうなるんですか？
┌─┐
│①│
└─┘
印鑑が①として、画像イメージが 500 * 500 くらいのとき、
NOT ① の部分を透明色に指定したい。
クリップボードに画像のパス登録するだけで、貼り付け先で
その画像が貼り付けられるのか、画像ファイルパスが貼り付け
られるのかはやってみないと、というか、それは調査しないと
わかりませんが、調査しました？？
結果はどうでした？
左の動いているやしの木を右クリックコピーして、ペイントに
貼り付ける（キャンバスは予め黒にしておいてね）と白い枠の
やしの木が貼り付けられるので、おそらく画像としては、BMP
形式で持っているものと思われます。透明色が何色か、までは
持ってなさそうです。
左のやしの木をデスクトップに保存して、ペイントでこの画像を
開く。灰色の透明色を背景に持った動かないやしの木が確認でき
る。
デスクトップのやしの木をエクスプローラ上で選択、C-Cでコピー、
ペイントを開いて貼り付け。ペイントのキャンバス上でC-Vすると
クリップボードの上の画像は認識するようだが、画像ファイルパス
は認識せず。
ってことで、クリップボード中に固有画像データとして保持する
のは無理なんじゃないかなぁ、と。全部BMPになると思われるので
透明色は指定できない、という結論です。
他の方のアドバイスでコロリと変わるかもしれませんがｗ
> クリップボードへコピー出来るのでしょうか？
そのデータを、どのように利用する予定なのか、にもよりますよね。
自作ソフト同士でのデータ交換なら、RegisterClipboardFormat で
独自形式のデータとしてコピーする手法もあるでしょうし。
で、たとえば Office ソフト等に貼ることを予定しているのであれば、
さしあたり、メタファイル形式で出力してみてはいかがでしょうか。
画像をメタファイル化する部分は、API に頼ることになるでしょうけども。
> RegisterClipboardFormat で独自形式のデータとして
ん。何か日本語が変だったかも。
RegisterClipboardFormat で、独自形式のクリップボード形式を登録し、
その形式を使って、任意形式のデータをやり取りするようにすれば、
自作アプリ同士で、背景透過な印鑑画像を受け渡すことが可能です。
この場合、標準の Clipboard オブジェクトだけでは機能不足なので、
下記のように、API ベースで処理する必要があるでしょう。
http://www.microsoft.com/japan/msdn/vbasic/migration/tips/Clipboard/
独自形式を使わず、先のメタファイル案で運用するのであれば、
標準の Clipboard.SetData だけでもいけるでしょう。
(もっとも、メタファイル化の部分はやはり、API 処理になりますけど)
> また、VB6.0では技術的に無理であれば、.NETなら出来たりするのでしょうか？
.NET の方が、今回の目的では楽だと思いますが、
技術的な面だけで見るのであれば、どちらでも実装は可能です。
クリップボードまわりに関して言えば、先述のとおり API で制御できますし、
.NET で使用される Graphics クラスにしても、それ自体は GDI+ の
ラッパーなので、元となる GDI+ API を VB6 から直接 Declare で
呼び出すことで、.NET と同等の画像処理を VB6 で実装できるかと。
助言ありがとうございます。
今回で行くと、Office等の他アプリに貼り付ける事がメインとなっておりますので、メタファイル化と言うのを採用したいと思います。
Sub Sub_Copy(objA As PictureBox, objB As PictureBox)
Dim lngTransparentColor As Long
Dim lngPictureWidth As Long
Dim lngPictureHeight As Long
Dim lngResult As Long
' 透過色に白色を指定
lngTransparentColor = RGB(255, 255, 255)
' 転送元画像の幅と高さを計算
With objA
lngPictureWidth = _
.Width \ Screen.TwipsPerPixelX
lngPictureHeight = _
.Height \ Screen.TwipsPerPixelY
End With
With objB
.Picture = LoadPicture()
' 継続表示属性を設定
.AutoRedraw = True
' ビットマップを転送
lngResult = _
TransparentBlt( _
.hDC, _
0, _
0, _
.Width \ Screen.TwipsPerPixelX, _
.Height \ Screen.TwipsPerPixelY, _
objA.hDC, _
0, _
0, _
lngPictureWidth, _
lngPictureHeight, _
lngTransparentColor)
' 再描画
.Refresh
Clipboard.Clear
Clipboard.SetData objB.Image, 2
' 継続表示属性を解除
.AutoRedraw = False
End With
End Sub
現状の処理ですとこんな感じになっています。
この間にメタファイルを作成する処理を追加すべくもう少し調べてみようと思います。
お世話になっております。
挫けました＿|‾|○ il||li
メタファイルを生成し、クリップボードに貼り付ける事は出来たのですが、
Dim filename As String
Dim hdc As Long
Dim hemf As Long
Dim rect1 As RECT
filename = "syokuin.emf" 'ファイル名
'拡張メタファイルのデバイスコンテキスト作成
hdc = CreateEnhMetaFile(0, filename, 0&, "")
'-----------------------------------
' メタファイルのハンドル取得
'-----------------------------------
With rect1
.top = 0
.left = 0
.bottom = lngPictureHeight
.right = lngPictureWidth
End With
'メタファイルハンドル取得
hemf = CloseEnhMetaFile(hdc)
'-----------------------------------
'クリップボードに設定
'-----------------------------------
OpenClipboard fhdc
EmptyClipboard
SetClipboardData CF_ENHMETAFILE, hemf
CloseClipboard
'-----------------------------------
'後処理
'-----------------------------------
DeleteEnhMetaFile hemf
肝心のピクチャーボックスの内容を特定色を透過にし、メタファイル化する方法が分かりません。
度々で申し訳ありませんがご助言頂けると大変有難いです。
度々こんにちは。
本件が解決しましたので以下に記述します。
'呼び出し元
'ピクチャボックス"picbox1"の画像をbmpに保存
SavePicture picbox1.Image, App.Path & "\aaa.bmp"
Call TransparentPicture( _
stdole.LoadPicture(App.Path & "\aaa.bmp"), _
RGB(255, 255, 255), _
Me.hwnd)
Function TransparentPicture( _
ByVal pic As stdole.IPictureDisp, _
ByVal TransColor As Long, fhdc As Long)
Const HIMETRIC_PER_INCH = 2540
Const HIMETRIC_PER_HALFINCH = HIMETRIC_PER_INCH \ 2
Dim IID_IPictureDisp As GUID
Dim pd As PICTDESC_EMF
Dim rc As RECT
Dim picResult As stdole.IPictureDisp
Dim PixWidth As Long
Dim PixHeight As Long
Dim WinWidth As Long
Dim WinHeight As Long
Dim DevWidthMM As Long
Dim DevHeightMM As Long
Dim DevWidthPix As Long
Dim DevHeightPix As Long
Dim DevDpiX As Long
Dim DevDpiY As Long
Dim hdc As Long
Dim hdcMeta As Long
Dim hbmp As Long
Dim hbmpOld As Long
Dim hemf As Long
If pic Is Nothing Then Exit Function
If pic.Type <> PICTYPE_BITMAP Then Exit Function
hbmp = pic.Handle
If hbmp = 0 Then Exit Function
rc.Right = pic.Width
rc.Bottom = pic.Height
hdc = CreateCompatibleDC(0)
If hdc = 0 Then Exit Function
DevDpiX = GetDeviceCaps(hdc, LOGPIXELSX)
DevDpiY = GetDeviceCaps(hdc, LOGPIXELSY)
DevWidthMM = GetDeviceCaps(hdc, HORZSIZE)
DevHeightMM = GetDeviceCaps(hdc, VERTSIZE)
DevWidthPix = GetDeviceCaps(hdc, HORZRES)
DevHeightPix = GetDeviceCaps(hdc, VERTRES)
PixWidth = (rc.Right * DevDpiX + HIMETRIC_PER_HALFINCH) _
\ HIMETRIC_PER_INCH
PixHeight = (rc.Bottom * DevDpiY + HIMETRIC_PER_HALFINCH) _
\ HIMETRIC_PER_INCH
WinWidth = (PixWidth * DevWidthMM * 100) \ DevWidthPix
WinHeight = (PixHeight * DevHeightMM * 100) \ DevHeightPix
hdcMeta = CreateEnhMetaFile(0, vbNullString, rc, vbNullString)
If hdcMeta Then
SetMapMode hdcMeta, MM_ANISOTROPIC
SetWindowExtEx hdcMeta, WinWidth, WinHeight, ByVal 0&
SetViewportExtEx hdcMeta, rc.Right, rc.Bottom, ByVal 0&
hbmpOld = SelectObject(hdc, hbmp)
TransparentBlt hdcMeta, 0, 0, PixWidth, PixHeight, _
hdc, 0, 0, PixWidth, PixHeight, _
TransColor
SelectObject hdc, hbmpOld
hemf = CloseEnhMetaFile(hdcMeta)
End If
DeleteDC hdc
If hemf = 0 Then Exit Function
With pd
.cbSizeofstruct = Len(pd)
.picType = PICTYPE_ENHMETAFILE
.hemf = hemf
End With
IIDFromStrPtr StrPtr("{7BF80981-BF32-101A-8BBB-00AA00300CAB}"), _
IID_IPictureDisp
If OleCreatePictureIndirect(pd, IID_IPictureDisp, _
1, picResult) >= 0 Then
Set TransparentPicture = picResult
OpenClipboard fhdc
EmptyClipboard
SetClipboardData CF_ENHMETAFILE, hemf
CloseClipboard
Else
DeleteEnhMetaFile hemf
End If
End Function
これでbmpを透過メタファイルにしてクリップボードへコピーできました。
助言頂いた方々ありがとうございました。
今後とも宜しくお願い致します。
| ツイート |  |