投稿時間：2006/10/30(Mon) 17:19
投稿者名：Edward
Ｅメール：
ＵＲＬ ：
タイトル：Re: ラバーバンドの応用（質問内容を簡素にしました）
Renardさんからも有りましたととおりPictureでは.Clsを呼ぶだけでよいと思うのですが。
線分等を書き込んでいるのならば、こんな物を作ってみました。
PictureBoxが小さい時は快適に動くのですが
図面を表示するとの事ですから、きっと全画面表示に近いくらいの大きさになるのでは
ないかと思いますが。その位の大きさになると文字列がちらつきますのでMouseMoveの度に
文字列で隠れてしまう範囲だけを保存・貼付・解放を繰り返すようにすると使用メモリも
少なくよいのかもしれませんが。
何方かチャレンジしてみて下さい。
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 SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
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 Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Const STRETCH_DELETESCANS = 3
Private Const STRETCH_HALFTONE = 4
Dim g_hMemoryDC As Long
Dim g_hBitmap As Long
Dim g_hOldBitmap As Long
Dim g_Mode As Boolean
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
g_Mode = True
Call PictureCopy(Picture1, 1)
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If g_Mode = True And Button = 1 Then
Call PictureCopy(Picture1, 2)
Picture1.ForeColor = RGB(255, 0, 0)
Picture1.PSet (X, Y)
Picture1.Print " X=" & X & ",Y=" & Y
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
g_Mode = False
Call PictureCopy(Picture1, 2)
Call PictureCopy(Picture1, 3)
End Sub
Private Sub Form_Load()
Dim i As Integer
With Picture1
.AutoRedraw = True
.ScaleMode = vbPixels
Set .Picture = LoadPicture("C:\WINNT\グリーン ストーン.bmp")
For i = 0 To 10
Picture1.Line (0, 0)-(Picture1.Width, Picture1.Height * (i / 10))
Next i
End With
End Sub
Private Sub PictureCopy(Pic1 As PictureBox, WorkNo As Integer)
Dim Ret As Long
With Pic1
If WorkNo = 1 Then
g_hMemoryDC = CreateCompatibleDC(.hdc)
g_hBitmap = CreateCompatibleBitmap(.hdc, .ScaleWidth, .ScaleHeight)
g_hOldBitmap = SelectObject(g_hMemoryDC, g_hBitmap)
BitBlt g_hMemoryDC, 0&, 0&, .ScaleWidth, .ScaleHeight, .hdc, 0&, 0&, SRCCOPY
ElseIf WorkNo = 2 Then
Ret = SetStretchBltMode(.hdc, STRETCH_DELETESCANS)
StretchBlt .hdc, 0&, 0&, .ScaleWidth, .ScaleHeight, g_hMemoryDC, 0&, 0&, .ScaleWidth, .ScaleHeight, SRCCOPY
Ret = SetStretchBltMode(.hdc, Ret)
.Refresh
ElseIf WorkNo = 3 Then
DeleteDC g_hMemoryDC
DeleteObject g_hBitmap
End If
End With
End Sub
|