古代VBプログラマ質問スレ(Ver.6.0 まで) part65 [転載禁止]©2ch.net (835レス)
古代VBプログラマ質問スレ(Ver.6.0 まで) part65 [転載禁止]©2ch.net http://mevius.5ch.net/test/read.cgi/tech/1440930335/
上
下
前次
1-
新
通常表示
512バイト分割
レス栞
抽出解除
必死チェッカー(本家)
(べ)
自ID
レス栞
あぼーん
リロード規制
です。10分ほどで解除するので、
他のブラウザ
へ避難してください。
783: デフォルトの名無しさん [sage] 2023/05/09(火) 16:11:08.45 ID:WGtTQQBV >>781 これでどうでしょうか? フォーム上に Picture1 と Command1 を置きました。 Picture1 上には任意の Image を置いてください。 ※ Picture1 の ScaleMode プロパティは、「3 - ピクセル」に設定してください。 http://mevius.5ch.net/test/read.cgi/tech/1440930335/783
784: デフォルトの名無しさん [sage] 2023/05/09(火) 16:11:45.13 ID:WGtTQQBV Option Explicit Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long Private Const SRCCOPY = &HCC0020 Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Const CF_BITMAP As Long = 2 Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function SetClipboardData Lib "user32" (ByVal uFormat As Long, ByVal hData As Long) As Long http://mevius.5ch.net/test/read.cgi/tech/1440930335/784
785: デフォルトの名無しさん [sage] 2023/05/09(火) 16:12:13.61 ID:WGtTQQBV Private Sub Command1_Click() Dim hDC As Long Dim hBitmap As Long Dim hBitmapOld As Long hDC = CreateCompatibleDC(Picture1.hDC) hBitmap = CreateCompatibleBitmap(Picture1.hDC, Picture1.ScaleWidth, Picture1.ScaleHeight) hBitmapOld = SelectObject(hDC, hBitmap) BitBlt hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hDC, 0, 0, SRCCOPY If OpenClipboard(Me.hWnd) Then If (EmptyClipboard()) Then SetClipboardData CF_BITMAP, hBitmap End If CloseClipboard End If SelectObject hDC, hBitmapOld 'DeleteObject hBitmap DeleteDC hDC End Sub http://mevius.5ch.net/test/read.cgi/tech/1440930335/785
786: デフォルトの名無しさん [sage] 2023/05/09(火) 16:12:29.38 ID:WGtTQQBV 全 Image を Picture1 に BitBlt する必要な無いみたいです。 VB6 の Clipboard オブジェクトを使用する場合は、StdPicture にする必要があるみたいですが、 hBitmap を StdPicture に変換するより Clipboard API を使用して hBitmap を渡す方が簡単だと思ったので この様にしました。 http://mevius.5ch.net/test/read.cgi/tech/1440930335/786
メモ帳
(0/65535文字)
上
下
前次
1-
新
書
関
写
板
覧
索
設
栞
歴
スレ情報
赤レス抽出
画像レス抽出
歴の未読スレ
AAサムネイル
Google検索
Wikipedia
ぬこの手
ぬこTOP
0.027s