シェープの描画速度を早めるには？

める 2003-11-06 20:50:54 No: 80284

お世話になります。

３つのピクチャコントロールに同じイメージを表示させています。
（便宜的にそれぞれをＡ・Ｂ・Ｃとする。）
Ａ上で、マウスをドラッグさせると開始位置を始点とし現在位置までを対角線と
する四角形を描画します。（俗に言う「ラバーバンド」ってやつです。）
Ａに描画すると「同時に」Ｂ・Ｃにも同じ四角形を描画しています。

イメージのサイズが「800*600」程度のものだと、全く問題ないのですが、
「2400*1800」クラスになると、なぜかＡに対するラバーバンドの描画処理が
異常に重たくなります。滑らかに動かない。カクカクで描画する。
しかし、Ｂ・Ｃのコントロールには、マウスの動きに合わせて、
非常に滑らかに描画されます。

何故Ａのコントロールに描画するときだけカクカクになってしまうのでしょうか？
ラバーバンドとしての動作そのものはしているのですが・・・
描画処理（Line(xe,ye)・・・・）は、３つとも同時に行ってます。

どなたか考えられる事ありましたらご教授ください。
宜しくお願いします。

k.k 2003-11-06 22:14:37 No: 80285

Ａの動作をどのようにしてＢ・Ｃに反映させているのかそこんところの
プログラムがみたいですね。

める 2003-11-07 20:48:05 No: 80286

レスありがとうございます。
とりあえずこんな感じなんですが。
(折り返しが見づらいと思いますがご容赦ください。)
MouseMoveイベント内です。
-------------------------------
If ((Button = vbRightButton) Or Button = vbRightButton + vbLeftButton)) And _
(picScanImg.Picture) <> 0 And _
(gRightBtnFlg = True) Then

        flg = True
        '直前の罫線を消す
        If LineDrawFlg = True Then
            With BackPos
                picScanImg.Line (.right, .bottom)-(.left, .top), RGB(255, 0, 0), B
                picACCImg.Line (.right, .bottom)-(.left, .top), RGB(255, 0, 0), B
                picJPEGImg.Line (.right, .bottom)-(.left, .top), RGB(255, 0, 0), B
            End With
        End If

        '現在の罫線を描画
        With RectPos
            picScanImg.Line (X, Y)-(.left, .top), RGB(255, 0, 0), B
            picACCImg.Line (X, Y)-(.left, .top), RGB(255, 0, 0), B
            picJPEGImg.Line (X, Y)-(.left, .top), RGB(255, 0, 0), B
        End With

        '描画フラグを立てる。
        LineDrawFlg = True

        '現在の座標を保持
        BackPos.right = X
        BackPos.bottom = Y
        flg = False
        Exit Sub

    End If
-------------------------------
右クリックで描画を行ってます。

ソース出してるのにナンですが、考察としては、
マウスを動かしている際、ＡにはLine()で描画する処理に加えて、
おびただしい数の、MouseMoveイベントが発行されてます。
その反面、Ｂ・Ｃには、Line()で描画の処理のみ発行されるので、
処理のオーバーヘッド（というんですかね？）が発生するために、
Ａの描画が送れてガクガクになるんでは・・・と思ったのですが・・・
どうなんですかね？

k.k 2003-11-08 04:05:04 No: 80287

ううむ、私のマシンではがくがくすることはないですね。
それに、私のモニターは1280x1024が限度で、この解像度において試してみてもがくがくすることはありませんでした。
コンテナ用ピクチャーボックスを用意して、その中に３つピクチャーボックス
をいれて、擬似的ではありますが2400*1800にしてみてやってみたのですが、
これでもがくがくすることなくスムーズに行えました。
これはマシンのスペックに左右されてしまいますけどね。
私の考察もめるさんの考察と同じです。
ひとつのピクチャーボックスに処理をまとめてしまっているからその分オーバーヘッドが生じていると思われます。
ですので、動くのは確認してますが速度が早くなったのかはわかりませんが、
SendMessageで、Ａに飛んでくるMouseMoveメッセージ（イベント）をＢ・Ｃにも同じパラメータのMoseMoveメッセージを飛ばして、Ａ・Ｂ・Ｃそれぞれの
ウィンドウプロシージャに処理を割り振って見てはいかがでしょうか。
サンプル（RECT構造体は別に3つ用意する必要はないですが一応３つ使用してます）
Option Explicit
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private BackPosA    As RECT
Private BackPosB    As RECT
Private BackPosC    As RECT

Private LineDrawFlg As Boolean
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_MOUSEMOVE = &H200

Private Sub Form_Load()
picScanImg.DrawMode = vbInvert
picScanImg.ScaleMode = vbPixels
picJPEGImg.DrawMode = vbInvert
picJPEGImg.ScaleMode = vbPixels
picACCImg.DrawMode = vbInvert
picACCImg.ScaleMode = vbPixels
End Sub

Private Sub Form_Resize()
With Picture1
    .Left = 0
    .Top = 0
    .Width = Me.ScaleWidth
    .Height = Me.ScaleHeight
End With
With picScanImg
    .Left = 0
    .Top = 0
    .Width = 2400
    .Height = 1800
End With
With picACCImg
    .Left = 0
    .Top = 0
    .Width = 2400
    .Height = 1800
End With
With picJPEGImg
    .Left = 0
    .Top = 0
    .Width = 2400
    .Height = 1800
End With

End Sub

Private Sub picScanImg_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Button
    'Case vbLeftButton

    Case vbRightButton
        LineDrawFlg = True
        With BackPosA
            .Left = X
            .Top = Y
            .Right = X
            .Bottom = Y
        End With
        With BackPosB
            .Left = X
            .Top = Y
            .Right = X
            .Bottom = Y
        End With
        With BackPosC
            .Left = X
            .Top = Y
            .Right = X
            .Bottom = Y
        End With

End Select
End Sub

Private Sub picScanImg_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Button
    Case vbRightButton
        If Not LineDrawFlg Then Exit Sub
        'picScanImgに飛んでくるMouseMoveメッセージと同じ内容のメッセージをpicJPEGImg、PicACCImgにも飛ばす
        SendMessage picJPEGImg.hWnd, WM_MOUSEMOVE, 0, &H10000 * Y + X
        SendMessage picACCImg.hWnd, WM_MOUSEMOVE, 0, &H10000 * Y + X

        '直前の罫線を消す
        With BackPosA
            picScanImg.Line (.Right, .Bottom)-(.Left, .Top), RGB(255, 0, 0), B
        End With

        '現在の罫線を描画
        With BackPosA
            picScanImg.Line (X, Y)-(.Left, .Top), RGB(255, 0, 0), B
        End With

        '現在の座標を保持
        BackPosA.Right = X
        BackPosA.Bottom = Y
End Select

End Sub
Private Sub picJPEGImg_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print X, Y
Select Case Button
    Case vbRightButton
        '直前の罫線を消す
        With BackPosB
            picJPEGImg.Line (.Right, .Bottom)-(.Left, .Top), RGB(255, 0, 0), B
        End With

        '現在の罫線を描画
        With BackPosB
            picJPEGImg.Line (X, Y)-(.Left, .Top), RGB(255, 0, 0), B
        End With

        '現在の座標を保持
        BackPosB.Right = X
        BackPosB.Bottom = Y
End Select

End Sub
Private Sub picACCImg_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Select Case Button
    Case vbRightButton
        '直前の罫線を消す
        With BackPosC
            picACCImg.Line (.Right, .Bottom)-(.Left, .Top), RGB(255, 0, 0), B
        End With

        '現在の罫線を描画
        With BackPosC
            picACCImg.Line (X, Y)-(.Left, .Top), RGB(255, 0, 0), B
        End With

        '現在の座標を保持
        BackPosC.Right = X
        BackPosC.Bottom = Y
End Select

End Sub
Private Sub picScanImg_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
LineDrawFlg = False
End Sub