[リストへもどる]
一括表示

投稿時間:2003/12/25(Thu) 14:56
投稿者名:おじん
URL :
タイトル:
BitBltの使い方、他
やりたいこと:
初期Formをスクリーンの中央に表示し、そのFormの背景を「その位置」の
スクリーンの画像にしたい。ただし、Formを動かしたときは、今は考えない。
考えた方法は、スタートアップをSubMainとし、PrintScreenを
使い画像を取り込み、それをPictureBoxを経由してFormに貼り付ける。
PictureBoxを経由したのは、いきなり
Form1.Picture=Clipboard.GetDaTaでは画像が
(0,0)からとなるためです。
以下にソースを添付します。また利用価値のない悪趣味な質問で申し訳ありません。
なおソースにはテスト中のもので冗長な部分がありますことお詫びしておきます。

'Module1
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
Private Declare Sub keybd_event Lib "user32" ( _
        ByVal bVk As Byte, _
        ByVal bScan As Byte, _
        ByVal dwFlags As Long, _
        ByVal dwExtraInfo As Long)
'keybd_event=>特殊キーの状態を設定する
'------------------------------------------------
Sub main()
    Dim x&, y&
    y = (Screen.Height - Form1.Height) \ 2 '下のBitBltに使用
    x = (Screen.Width - Form1.Width) \ 2    'あやしい?
    'Form1.AutoRedraw = True
    Form1.ScaleMode = vbPixels              'ここら辺はよく分からない
    Form1.pic1.AutoSize = True       
    'Form1.pic1.Visible = False       '最終的にはfalse
    'Form1.pic1.AutoRedraw = True
    Form1.pic1.ScaleMode = vbPixels
    
    Clipboard.Clear
    'PrintScreenキーを押すてスクリーン全体をとる
    keybd_event &H2C, 1, 0, 0
    DoEvents
    'ClipboardからPictureBoxへ
    Form1.pic1.Picture = Clipboard.GetData
    'Formへコピー
    BitBlt Form1.hdc, 0, 0, Form1.ScaleWidth, Form1.ScaleHeight, _
           Form1.pic1.hdc, x, y, vbSrcCopy
    'x=0、y=0としてもコピーができない
    Form1.Show  
    
End Sub
'------------------------------------------------
'Form1
Private Sub Form_Load()
  'スクリーンの中央に置く
    Top = (Screen.Height - Form1.Height) \ 2
    Left = (Screen.Width - Form1.Width) \ 2
End Sub
Formには、一つPictureBoxを貼り付けておく。名前はPic1

以上、よろしくお願いいたします。

投稿時間:2003/12/25(Thu) 15:32
投稿者名:魔界の仮面弁士
Eメール:
URL :
タイトル:
Re: BitBltの使い方、他
# 全角・半角の使い分けは適切に。

> 初期Formをスクリーンの中央に表示し、そのFormの背景を「その位置」の
> スクリーンの画像にしたい。
背景を描画するのではなく、本当に「透過」させてしまっても良いならば、
「Layered Window」を使うという手もありますよ。


> ただし、Formを動かしたときは、今は考えない。
とりあえず、MovableプロパティをFalseにしてしまうとか。
他のウィンドウの移動は制限できませんが、少なくとも自フォームだけは動かなくなりますよね。


> PictureBoxを経由したのは、いきなり
> Form1.Picture=Clipboard.GetDaTaでは画像が
> (0,0)からとなるためです。
例えば、
    Form1.PaintPicture Clipboard.GetData(vbCFBitmap), 〜〜〜
のようにしてみるとか。

あるいは、一度 Picture型 か StdPicture型の変数に受けて、
    Dim P As StdPicture
    Set P = Clipboard.GetData(vbCFBitmap)
    Form1.PaintPicture P, 〜〜〜
のように書いても良いかも。


> Private Sub Form_Load()
>   'スクリーンの中央に置く
>     Top = (Screen.Height - Form1.Height) \ 2
>     Left = (Screen.Width - Form1.Width) \ 2
> End Sub
このようなコーディングをせずとも、デザイン時に
StartUpPosition プロパティを設定しておくだけで十分なのでは。

投稿時間:2003/12/25(Thu) 16:00
投稿者名:おじん
URL :
タイトル:
Re^2: BitBltの使い方、他
いつもありがとうございます
> # 全角・半角の使い分けは適切に。
半角カタカナの使用は禁止とは理解しているのですが、?

原点は「透過」を勉強していて、できなかったので、、、。見かけ「透過」の
様になるのではと思いまして。

また新しい言葉を色々と教わりました。
今、頭がオーバーフローしています。ゆっくり挑戦してみます。
ありがとうございました。とりあえずお礼まで。

投稿時間:2003/12/25(Thu) 16:29
投稿者名:花ちゃん
Eメール:
URL :
タイトル:
Re^3: BitBltの使い方、他
> > # 全角・半角の使い分けは適切に。
> 半角カタカナの使用は禁止とは理解しているのですが、?

プログラムのコードのような英数は半角を使用しましょうと言う事です。

>Form1.Picture=Clipboard.GetDaTaでは画像が
>'x=0、y=0としてもコピーができない
等。

投稿時間:2003/12/25(Thu) 18:18
投稿者名:魔界の仮面弁士
Eメール:
URL :
タイトル:
Layered Window その1
>> # 全角・半角の使い分けは適切に。
> 半角カタカナの使用は禁止とは理解しているのですが、?

その点も含めて「適切に」という事です。

特に、花ちゃんさんからのフォローにもあった『プログラムのコード』の場合は、
半角/全角の違いが重要な意味を持つこともあるので、特に理由が無ければ、
基本的には「英数字は半角、カタカナは全角」の方が良いでしょう。


それはさておき、Layered Windowを使った「透過」のサンプルです。
Windows 2000/XP/2003などで動作します。
# Windows Longhorn や MCE2004での動作は未検証。

Option Explicit

Private Declare Function SetWindowLongW Lib "user32" _
   (ByVal hWnd As Long, _
    ByVal Index As Long, _
    ByVal NewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
   (ByVal hWnd As Long, _
    ByVal Key As Long, _
    ByVal Alpha As Byte, _
    ByVal Flag As Long) As Long

Private Const GWL_EXSTYLE As Long = -20&
Private Const WS_EX_LAYERED As Long = &H80000
Private Const LWA_COLORKEY As Long = 1&
Private Const LWA_ALPHA As Long = 2&

Private Sub Form_Load()
    AutoRedraw = True
    BackColor = vbCyan
    ForeColor = vbWhite
    Font.Name = "MS 明朝"
    Font.Size = 32
    Font.Bold = True
    Print "魔界の仮面弁士"

    SetWindowLongW hWnd, GWL_EXSTYLE, WS_EX_LAYERED
    SetLayeredWindowAttributes hWnd, vbCyan, 0&, LWA_COLORKEY
End Sub

投稿時間:2003/12/25(Thu) 18:23
投稿者名:魔界の仮面弁士
Eメール:
URL :
タイトル:
Layered Window その2
今度は、完全に切り抜くのではなく、半透明にするサンプルです。

フォームに、水平スクロールバーコントロールを貼っておいてください。

'====================
Option Explicit

Private Declare Function SetWindowLongW Lib "user32" _
   (ByVal hWnd As Long, _
    ByVal Index As Long, _
    ByVal NewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
   (ByVal hWnd As Long, _
    ByVal Key As Long, _
    ByVal Alpha As Byte, _
    ByVal Flag As Long) As Long

Private Sub Form_Load()
    HScroll1.Min = 0
    HScroll1.Max = 255
    HScroll1.Value = 180
    Caption = "スクロールバーを左端まで移動させると、えらいことになります(泣)"
End Sub

Private Sub Form_Paint()
    Const GWL_EXSTYLE As Long = -20&
    Const WS_EX_LAYERED As Long = &H80000
    Const LWA_ALPHA As Long = 2&
    
    SetWindowLongW hWnd, GWL_EXSTYLE, WS_EX_LAYERED
    SetLayeredWindowAttributes hWnd, 0&, CLng(HScroll1.Value), LWA_ALPHA
End Sub

Private Sub HScroll1_Change()
    Refresh
End Sub

投稿時間:2003/12/26(Fri) 12:01
投稿者名:おじん
URL :
タイトル:
Re: Layered Window その2
魔界の仮面弁士様、色々とありがとうございます。その後、
>例えば、
>    Form1.PaintPicture Clipboard.GetData(vbCFBitmap), 〜〜〜
>
>あるいは、一度 Picture型 か StdPicture型の変数に受けて、
>    Dim P As StdPicture
>    Set P = Clipboard.GetData(vbCFBitmap)
>    Form1.PaintPicture P, 〜〜〜
>
のどちらとも確認させていただきました(当然、OKです)。
次いで、LayeredWindow を調べ、Windows98では不可とのことで
当方のマシンでは確認できませんでした(このご返事をしていません
でしたこと、申し訳ありません)。
先にも申しましたとおり、気ままな興味で、Formの中をくりぬき、
あたかも「ガラス」のようにしたらどうなるか、というのが始まりです。
私事、今日、仕事納めです。明日からは家のマシン。オーバーヒートし
ないように願いながら。よいお年を。