● 透過フォームを作成する ●

フォームが透ける。ちょっと嬉しいけど、何の役にも立たないところが素敵。

'長方形リージョンを作成する
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

'2つのリージョンを結合する
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long

'ウインドウリージョンを作成する
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long

'オブジェクトを破棄する
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Const RGN_AND = 1
Private Const RGN_OR = 2       '結合
Private Const RGN_XOR = 3
Private Const RGN_DIFF = 4     'くり抜く
Private Const RGN_COPY = 5

Private Const GDI_ERROR = &HFFFF
Private Const NULLREGION = 1     'リージョンは空
Private Const SIMPLEREGION = 2   'リージョンは単一の長方形
Private Const COMPLEXREGION = 3  'リージョンは単一の長方形より複雑

'---------------------------------------------------------------------------
' 関数名 : GlassForm
' 機  能 : タイトルバーを透過する
' 引  数 : (in)SrcForm … 対象フォーム
' 返り値 : タイトルバーの文字列
'---------------------------------------------------------------------------
Public Sub SetGlassForm(ByVal SrcForm As Form)
  Dim newFormRgnhWnd As Long
  Dim newClientRgnhWnd As Long
  Dim newCombineRgn As Long
  Dim eWidth&, eHeight As Long
  Dim frmWidth&, frmHeight As Long
  Dim DefScaleMode As Integer

  'ScaleMode を保存
  DefScaleMode = SrcForm.ScaleMode
  SrcForm.ScaleMode = vbPixels

  With SrcForm
      frmWidth = .Width \ Screen.TwipsPerPixelX
      frmHeight = .Height \ Screen.TwipsPerPixelY

      'フォーム全体のリージョンを作成
      newFormRgnhWnd = CreateRectRgn(0, 0, frmWidth, frmHeight)

      'フォーム全体−クライアント領域より半端な部分(ウインドウの縁)の幅、高さを取得
      '2で除算しているのは縁は、右・左、上・下にそれぞれ2つあるから
      eWidth = (frmWidth - .ScaleWidth) \ 2
      eHeight = frmHeight - .ScaleHeight - eWidth
      'eHeight = (frmHeight - .ScaleHeight) \ 2
      '↑
      'キャプションが無い場合は eHeight = (frmHeight - .ScaleHeight) \ 2 でよいが
      'キャプションが有ると、frmHeight はタスクバーの高さも含んでしまうので、縁の幅
      'が求められない。よって、eWidth を利用している

      'クライアント領域のリージョンを作成
      newClientRgnhWnd = CreateRectRgn(eWidth, eHeight, frmWidth - eWidth, frmHeight - eWidth)

      'メインとなる(=描画用)リージョンを作成
      newCombineRgn = CreateRectRgn(0, 0, 0, 0)

      'リージョン結合(フォーム全体からクライアント領域をくりぬき、作成したメイン領域に描画)
      Call CombineRgn(newCombineRgn, newFormRgnhWnd, newClientRgnhWnd, RGN_DIFF)

      'リージョン設定->再描画
      Call SetWindowRgn(.hWnd, newCombineRgn, True)
  End With

  'ScaleMode を元に戻す
  SrcForm.ScaleMode = DefScaleMode

  'リージョンのハンドル削除
  Call DeleteObject(newFormRgnhWnd)
  Call DeleteObject(newClientRgnhWnd)
  Call DeleteObject(newCombineRgn)

End Sub

あとはこんな感じで呼び出せばいい
Private Sub Form_Resize()
    Call SetGlassForm(Me)
End Sub

フォーム上のコントロールを除いて透過したい場合は、SetWindowRgn の前で以下のような処理をすればよろしい。

Dim objCtrl As Control
For Each objCtrl In SrcForm.Controls
    If objCtrl.Container Is SrcForm Then
        '1.コントロール座標を取得
        '2.コントロール領域のリージョンを作成(CreateRectRgn)
        '3.描画用領域にコントロール領域を結合(CombineRgn)
        '4.作成したリージョンを破棄(DeleteObject)
    End If
Next ctl

よく分からなかったら、Google で GlassForm と CreateRectRgn をキーワードにして検索してみれば?

戻る