デスクトップへの描画について

タグの編集
投稿者 ju  (学生) 投稿日時 2009/8/9 21:08:17
はじめまして.juと申します.
Visual Basic6.0を使っています.


デスクトップに簡単なアニメーションを表示したいと思っています.

 ペンによる描画 → 消す → 位置を変えてペンによる描画

を繰り返し,アニメーションを作りたいのですが,
『消す』部分をどのようにすれば分かりませんでした.


Visual Basic 6.0 中級講座 第6回 「ペンとブラシ」を参考にしたのですが,
消す部分の記述はなかったように思いますので質問させて頂きました.
どうぞよろしくお願いします.

投稿者 るきお  (社会人) 投稿日時 2009/8/10 06:09:40
こんにちは。
たぶんWindows APIのSendMessage関数でWM_PAINTを投げるか、ValidateRectを使用すれば消せると思いますが、アニメーションが目的ならばこの方法はあまりうまくないように思います。
書く→消す→書く→消すの流れが目に見えてしまうので、ユーザーにはちらちらと(点滅するかのように)映るのではないでしょうか。
(やってみないと分かりませんが。意外とうまく見えるかもしれません…)

それから、10年以上前のVB6を使用されているようですので、VB2008の使用をお勧めします。
Express Editionであれば無償であるうえプログラム言語としてのVisual Basic の機能は100%使用することができます。
投稿者 ju  (学生) 投稿日時 2009/8/11 06:03:53
回答ありがとうございます.
いろいろ試した見たのですがうまくいきませんでした.


テストを兼ねて
Command1をクリック → デスクトップの中心に点を描く
Command2をクリック → 消す
というものを作ろうとしています.


Private Sub Command2_Click()

End Sub

にどのように記述すればよいのか教えて頂けませんか?
できることなら,SendMessage関数でWM_PAINTを投げる方法,ValidateRectを使用する方法の
両方について知りたいです.

うまくいかないようであればVB2008の使用も考えたいと思います.
アドバイスありがとうございます.
投稿者 るきお  (社会人) 投稿日時 2009/8/11 06:21:11
回答ではないです。ごめんなさい。

私はできるだけ具体的なコードを書いて示すのが最もわかりやすくてよいと思うのですが、
今回の件は私にはちょっと手間なうえ、
これができてもアニメーションという目的を達成できないと思うと徒労感があるため、
具体的なコードを提示できません。
※さらに、先日HDDがクラッシュしてしまい、VB2008はインストールしたのですが、
VB6をインストールしておらずその手間もあります。

どなたか具体的なコード例で示すことができる親切な方がいらっしゃればよろしくお願いします。

少しでもレスがつきやすくするにはCommand1に書いたプログラムを載せたほうがよいです。
Command2のプログラムを書く人の苦労を考えれば参考になるものがあったほうがよいはずです。

※だとしても、Command2のプログラムを書く手間をかけてくれる人がいるかわかりませんが
投稿者 ju  (学生) 投稿日時 2009/8/11 06:52:28
るきおさん,ありがとうござます.
面倒なことをお願いしてすみませんでした.

自分でも,もう少し調べてみます.

以下にコードを書いておきます.といってもほとんどVisual Basic 6.0 中級講座 第6回の写しですが
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hWnd As LongAs Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As LongByVal x As LongByVal y As LongAs Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As LongByVal hdc As LongAs Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As LongByVal x As LongByVal y As Long, lpPoint As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As LongByVal hObject As LongAs Long
Private Declare Function CreatePenIndirect Lib "gdi32" (lpLogPen As LOGPEN) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As LongAs Long

Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Type LOGPEN
        lopnStyle As Long
        lopnWidth As POINTAPI
        lopnColor As Long
End Type

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type


Dim hDesktopWnd As Long
Dim hDesktopDC As Long
Dim rDesktop As RECT


'########################## 
'##  Command1のクリック  ## 
'########################## 
Private Sub Command1_Click()
    Dim hNewPen As Long
    Dim hOldPen As Long
    Dim NewPen As LOGPEN
    
    hDesktopWnd = GetDesktopWindow()            'デスクトップのハンドルを取得 
    hDesktopDC = GetWindowDC(hDesktopWnd)       'デスクトップのデバイスコンテキストを取得 
    Call GetWindowRect(hDesktopWnd, rDesktop)   'デスクトップの大きさを取得 
    
    'ペンの作成 
    NewPen.lopnColor = vbRed
    NewPen.lopnWidth.x = Form1.Text1
    hNewPen = CreatePenIndirect(NewPen)
    
    'ペンを持ち替える 
    hOldPen = SelectObject(hDesktopDC, hNewPen)
    
    Call MoveToEx(hDesktopDC, rDesktop.Right / 2, rDesktop.Bottom / 2, 0)         'カレントポジションを中央 
    Call LineTo(hDesktopDC, rDesktop.Right / 2, rDesktop.Bottom / 2) '線を引く 
    

    '元のペンに戻す 
    hNewPen = SelectObject(hDesktopDC, hOldPen)
    Call DeleteObject(hNewPen)                  '不要になったペンを開放する 
    
    
    Call ReleaseDC(hDesktopWnd, hDesktopDC)     'デバイスコンテキストを開放する 
End Sub


'########################## 
'##  Command2のクリック  ## 
'########################## 
Private Sub Command2_Click()

End Sub


具体的なコードではなく,簡単な内容のアドバイスでもよいのでお願いします.
投稿者 neptune  (社会人) 投稿日時 2009/8/11 08:23:12

簡単な方だけ応援。

検証はしてませんけど。
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                    (ByVal hwnd As Long, _
                    ByVal wMsg As Long, _
                    ByVal wParam As Long, _
                    lParam As Any) As Long

Private Const WM_PAINT = &HF


Private Sub Command1_Click()
    'hWndはデスクトップウィンドウのHWND 
    SendMessage hwnd, WM_PAINT, 0&, 0&
End Sub


ValidateRect関数については以下の解説を読んでやってみて下さい。
http://www.winapi-database.com/Graphics/Draw/ValidateRect.html
投稿者 cupud  (社会人) 投稿日時 2009/8/12 08:18:53
線図で良いならVB6機能で出来ます。
DrawMode = 7 で2度書きすると、消えるという機能です。

Private Sub ComGo_Click()
   Dim prTb(360) As Integer
   Dim iyTb(360) As Integer
   Dim ii As Integer, ix As Integer, iy As Integer, iw As Long
   Dim aa As Single, pi As Single
   serSec = Timer
   canFlg = 0
   MousePointer = 11
 '-  -
   Me.ForeColor = RGB(200, 80, 40)
   Me.ScaleMode = 3
   Me.DrawMode = 7
   aa = 100#
   pi = 3.1415927
   For ii = 0 To 180
     For ix = 0 To 360
       iy = aa * Sin(4# * ix * pi / 180# - 2# * ii * pi / 180#) _
               * Sqr((360 - ix * 0.8) / 360)
       iyTb(ix) = iy + aa + 50
     Next ix
   '-  -
     If 0 < ii Then
        Me.PSet (10, prTb(0))
        For ix = 1 To 360
          Me.Line -(ix + 10, prTb(ix)) '←DrawMode=7が関係
        Next ix
     End If
   '-  -
     Me.PSet (10, iyTb(0))
     For ix = 1 To 360
       Me.Line -(ix + 10, iyTb(ix))
     Next ix
   '-  -
     For ix = 0 To 360
       prTb(ix) = iyTb(ix)
     Next ix
   '-  -
     Call subWait(iw)
     Label1.Caption = "ii=" & CStr(ii) & " (" & CStr(iw) & ")"
     Label1.Refresh   '←無くても良いか?
     DoEvents         '←注意と言われる
     If canFlg = 1 Then Exit For
   Next ii
   MousePointer = 0
End Sub

Private Sub subWait(argCnt As Long)
  Dim locCnt As Long, locTim As Single
  Do
    locCnt = locCnt + 1
    locTim = Timer
     If serSec + 0.1 < locTim Then Exit Do
     If 1000000 < locCnt Then Exit Do
  Loop
  serSec = locTim
  argCnt = locCnt
End Sub

ただ、VB6では塗りつぶしができないので、そうする時はWinAPIが必須です。
しかし今更そんなので苦労するなら、VB2005以降が良いですね。
投稿者 cupid  (社会人) 投稿日時 2009/8/12 08:23:51
共通変数を書き忘れていました。
Formモジュールの頭の方で下記を宣言して置きます。

Dim serSec As Single
Dim canFlg As Integer
投稿者 ju  (学生) 投稿日時 2009/8/13 01:30:47
neptuneさん,cupidさんありがとうございます.

neptuneさん
書いて頂いたコードを試してみましたがうまくいきませんでした.
いろいろと試してみてはいますが,なかなか難しいです.

ValidateRect関数について解説も読んでみました.そのなかに
 >Windowsは無効領域を持っているウィンドウに対してWM_PAINTを発行し、再描画をうながす。
とあったのですが,デスクトップを無効領域としてやれば自動的に再描画が行われ,描いたもの消すことができるということなのでしょうか??


cupidさん
formなどでのアニメーションではなく,デスクトップへ直接描いたり消したりすることでアニメーションを表示したいと思っています.
質問の説明不足でした,すみません.
しかし,DrawMode = 7 で2度書きで消えるというのは面白いですね.今後参考にしたいと思います.
投稿者 cupid  (社会人) 投稿日時 2009/8/13 03:59:10
> デスクトップへ直接描いたり消したりする...

ああ、これは失礼。早とちりでした。
しかし、それならますますドットネットですね。
VB2005以降には、ControlPaint.DrawReversibleLineメソッドというものがあり、
これはずばり、PC画面上を、他のアプリなど無視して、線を描いたり消したりします。

しかし、前提がVB6なら、これ以上言いませんが、少しだけ、
VB2005以降は言語仕様はVB6に似てますが、グラフィック表示などは全く異なるので、
すぐに移行すると言うのはやや面倒かもしれません。
投稿者 cupid  (社会人) 投稿日時 2009/8/13 17:11:05
たびたび続けてですが、ControlPoint.DrawReversibleLineは、どちらかと言えば、
ラバーバンド風に表示する為の機能の様ですから、アニメに向くとは言えないかもしれず、
その点、補足しておきます。
一般的に、線を消すのは背景色で再描画という手法と思いますが、どうでしょうか。
投稿者 ju  (学生) 投稿日時 2009/8/14 18:29:08
cupidさん,ありがとうございます.

なかなか実現が難しいようなのでVB2008の使用も考えたいと思っています.
しかしVB6でもできることだと思うので,両方の勉強をしていきたいと思います.
投稿者 neptune  (社会人) 投稿日時 2009/8/15 01:44:16
私は殆ど描画関係は知らないので、詳しくはわからないのですが、多分という事で
読んで下さい。

>デスクトップを無効領域としてやれば自動的に再描画が行われ,
>描いたもの消すことができるということなのでしょうか??
そういうことだと思います。

第二引数をNULLにすれば、hWnd下のクライアントウィンドウがすべて無効化され
WM_PAINTがhWndに送られ、再描画される(既定のもの以外は消えてしまう)
という理屈だと思います。

投稿者 ju   (学生)   投稿日時 2009/08/10 21:52:28 
にアップされている処理だとValidateRectでいけるとは思うんですが。。?
・・・やってみてはいません。

cupidさんのおっしゃるように、vb2008の方が描画関係についてはAPIを取り込んで
強化され且つ、楽チンになっていますからそちらの方をお勧めします。

>VB6でもできることだと思うので,両方の勉強をしていきたいと思います.
まぁVB6なら文法そのものはVBAでも使えますし、それはそれで良いんですが、
APIゴリゴリとなると、C言語の基礎的な部分だけでも知っておかないと何かと不便です。
私なんか基礎的なことすら危ないですけどね。

なので、APIゴリゴリは必要ないなら避けたほうが良いのでは?
投稿者 neptune  (社会人) 投稿日時 2009/8/15 07:14:02
UPされているソースを検証してみました。

結果ですが、
hDesktopWnd = GetDesktopWindow()            'デスクトップのハンドルを取得 
デスクトップのハンドルを取得するのではまずいのではないかと思います。
Debug.Print hDesktopWnd
とやると、65556 が返ってきますが、
実際描画されるのは最前面のwindowのようです。
私のWindows XP起動直後の草原の絵のwindowのHWNDは65692でした。SPY++で確認。

従って、SendMessage、ValidateRectでも処理するWindowが違っているから
想定した動作が行われない見たいです。

Private Sub EraseLines(phWnd As Long)
Dim ret As Long
    'hWndはデスクトップウィンドウのHWND 
'    ret = SendMessage(phWnd, WM_PAINT, 0&, 0&) 
    ret = ValidateRect(phWnd, Null)
End Sub


従って、解決策は
1.描画を行うWindowを正しく取得する
2.リージョンを使う
3.自前でWindowを作成しそれに描画する
とかの方法になるような気がします。

1以外は難易度が一気に上がるのでお勧めしません。
投稿者 ju  (学生) 投稿日時 2009/8/16 13:14:57
neptuneさん,ありがとうございます.
アドバイスだけでなく検証までしていただいて本当に感謝しています.

>処理するWindowが違っているから想定した動作が行われない見たいです
ようやく問題が分かりました.
教えて頂くと本当に単純な理由ですが,気づくことができませんでした.
自分の知識のなさと痛感しました.

>APIゴリゴリは必要ないなら避けたほうが良いのでは? 
その通りだと思います.
C言語に関してはほとんど知識がありませんので,わからないまま使うのは何かと不安が多いです.


しかし,これで先に進める気がします.
本当にありがとうございました.
投稿者 matsu  (社会人) 投稿日時 2009/8/28 02:05:27
もう解決しているのかも知れませんが。
丁度、VB6でアニメーションを実現しているところなので
私が使用している手順を示します。
基本的には、Form にピクチャーボックスを2個用意(pic_front,pic_back)し、
pic_front:実際に見えるPictureBox
pic_back:作業用PictureBox
何方かが指定していましたが、pic_frontに描画するとちらつきがあるので
一旦、pic_backに描画し、API関数のBitBlt()を使用してメモリを高速でコピーすることで
実現しています。
すみません、具体的なソースコードを書けばいいのですが
では。