VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト]
[新規投稿]
[新着記事]
[ワード検索]
[過去ログ]
[管理用]
| 投稿日 | ： 2003/07/21(Mon) 05:17 |
| 投稿者 | ： おじん |
| ＵＲＬ | ： |
| タイトル | ： Re^6: BitBltの使い方 |
ありがとうございました。長くなりますが、作成中のソースを添付します。
FormにPicture1:256 x 256 Pixels 元画像を配置
Picture2:256 x 256 Pixels コピー先
Picture3: 64 x 64 Pixels 切り取った画像
Picture4: 64 x 64 Pixels 作業用
いずれも、scalemode=vbPixels
autoredraw=true
'------------------------------------------------
' 万華鏡もどき KaleidoScope
'------------------------------------------------
Option Explicit
'------------------------------------------------
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
Const SRCERASE = &H440328
Const SRCINVERT = &H660046
Dim x0!, y0!
Dim w&, h& 'Picture3の高さ・幅
Private Sub Form_Load()
w = Picture3.ScaleWidth
h = Picture3.ScaleHeight
End Sub
'------------------------------------------------
Private Sub Picture1_MouseDown( _
Button As Integer, Shift As Integer, _
X As Single, Y As Single)
'または
'Private Sub Picture1_MouseMove( _
' Button As Integer, Shift As Integer, _
' X As Single, Y As Single)
'Picture１のカーソルの周りを切り取りPicture3に貼り付ける
x0 = X - 16: y0 = Y - 16 'カーソルの初期値 -16は少しずらすための調整
Call Draw3_sub '正三角形→正六角形
' Call Draw4_sub '正四角形（ソースは割愛）
End Sub
Private Sub Draw3_sub()
Dim n!, m!, c&, a, x1!, y1!, x2!, y2!
a = 1.732 ' 対称軸 y=ax andor y=-ax の係数
picture1.Scale (0, 256)-(256, 0)
picture2.Scale (-256, 256)-(256, -256) '意味ないかも？
picture3.Scale (-32, 32)-(32, -32) 'Picture１を切り取った位置と
' 正三角形の左半分 表示相対位置が反転しているようだ
For n = 0 To 16 Step 0.5
For m = 0 To 1.732 * n
c = picture1.Point(x0 + n, y0 + m)
picture3.PSet (n, m), c 'カーソルの位置
x1 = (-2 * n + 3.464 * m) / 4
y1 = (3.464 * n + 2 * m) / 4
picture3.PSet (x1, y1), c 'y=axに対象
x2 = (-2 * x1 - 3.464 * y1) / 4
y2 = (-3.464 * x1 + 2 * y1) / 4
picture3.PSet (x2, y2), c 'y=-axに対象
picture3.PSet (x2, -y2), c 'ｙ軸に対象
x1 = (-2 * x2 - 3.464 * y2) / 4
y1 = (3.464 * x2 - 2 * y2) / 4
picture3.PSet (x1, y1), c 'y=-axに対象
picture3.PSet (n, -m), c 'ｘ軸に対象
Next m
Next n
' 正三角形の右半分
For n = 16 To 32 Step 0.5
For m = 0 To 1.732 * (32 - n)
c = picture1.Point(x0 + n, y0 + m)
picture3.PSet (n, m), c 'カーソルの位置
x1 = (-2 * n + 3.464 * m) / 4
y1 = (3.464 * n + 2 * m) / 4
picture3.PSet (x1, y1), c 'y=axに対象
x2 = (-2 * x1 - 3.464 * y1) / 4
y2 = (-3.464 * x1 + 2 * y1) / 4
picture3.PSet (x2, y2), c 'y=-axに対象
picture3.PSet (x2, -y2), c 'X軸に対象
x1 = (-2 * x2 - 3.464 * y2) / 4
y1 = (3.464 * x2 - 2 * y2) / 4
picture3.PSet (x1, y1), c 'y=-axに対象
picture3.PSet (n, -m), c 'x軸に対象
Next m
Next n
'上で切り取った正六角形をタイル敷きする
' +-の数値はきれいにしくための調整数（試行錯誤）
' もっときれいに並べる方法＝関係式があるような！！
picture2.Cls
'
'今回の質問は以下の部分が上手くいかないためです
'解決法としては、SplitDrawのBitBlt部分を修正する必要があるようです
'
For n = 0 To 3
' 最初の部分はPicture2より左に少しはみだして貼り付けたい
SplitDraw picture2, picture3, picture4, 0, n * h * 0.85 - 8
SplitDraw picture2, picture3, picture4, w + 28, n * h * 0.85 - 8
' SplitDraw picture2, picture3, picture4, 3 * w + 28, n * h * 0.85 - 8
' 正六角形を少しだけ下にずらして貼り付ける
SplitDraw picture2, picture3, picture4, 46, n * h * 0.85 - 8 - 8
SplitDraw picture2, picture3, picture4, 2 * w + 28, n * h * 0.85 - 8
Next n
'picture2.Refresh
End Sub
'------------------------------------------------
' 透過画像を合成描画
'------------------------------------------------
Private Sub SplitDraw( _
pic1 As Object, pic2 As Object, pic3 As Object, _
X As Long, Y As Long)
Dim i As Long
Dim j As Long
Dim lngRet As Long
Dim a1 As Long, a2 As Long, a3 As Long
Dim p1 As Long, p2 As Long, p3 As Long
For i = 0 To pic2.ScaleWidth - 1
For j = 0 To pic2.ScaleHeight - 1
'マスク色（白色）部分以外を描画
If pic2.Point(i, j) <> vbWhite Then
pic3.PSet (i, j), vbBlack
End If
Next
Next
'
'場合によって、pic3の0,0を＋数値（ずらせたい値）に変える
' Width,Heightも要変更
lngRet = BitBlt(pic1.hDC, X, Y, _
pic3.ScaleWidth, pic3.ScaleHeight, _
pic3.hDC, 0, 0, SRCERASE)
lngRet = BitBlt(pic1.hDC, X, Y, _
pic2.ScaleWidth, pic2.ScaleHeight, _
pic2.hDC, 0, 0, SRCINVERT)
'画面に表示
pic1.Refresh
End Sub
'------------------------------------------------
- 関連一覧ツリー
（★ をクリックするとツリー全体を一括表示します）
- 返信フォーム
（この記事に返信する場合は下記フォームから投稿して下さい）