円形のフォーム・コマンドボタンを作成する
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
円形のフォーム及びコントロールを作成する   　　　　　　（０２６）
　　　　　　 Option Explicit　　 'SampleNo=026　WindowsXP VB6.0(SP5) 2002.04.27

'指定の領域をウィンドウ領域として設定する(P335)
Private Declare Function SetWindowRgn Lib "user32" _
　　(ByVal hWnd As Long, ByVal hRgn As Long, _
　　 ByVal bRedraw As Boolean) As Long

'円形・楕円形の領域を作成する(P321)
'X1=左上隅のX座標 Y1=同Y座標 X2=右下隅のX座標　Y2=同Y座標
Private Declare Function CreateEllipticRgn Lib "gdi32" _
　　(ByVal X1 As Long, ByVal Y1 As Long, _
　　 ByVal X2 As Long, ByVal Y2 As Long) As Long

'グラフィックオブジェクトを削除しシステムリソースを解放する(P261)
Private Declare Function DeleteObject Lib "gdi32" _
　　(ByVal hObject As Long) As Long


Private Sub Form_Load()
　　Dim MaruSet As Long
　　Dim Result　As Long
　　　Form1.Move 700, 200, 4400, 5000
    Command1.Move 750, 1125, 1000, 1000
    Command2.Move 2325, 1125, 1000, 1000
    Command3.Move 1455, 3225, 1215, 315
    Command4.Move 1875, 1935, 390, 915
　　'丸い領域を作る（）内の数値を変えると楕円や円の大きさが変わります
　　MaruSet = CreateEllipticRgn(20, 50, 270, 300)
　　Result = SetWindowRgn(Me.hWnd, MaruSet, True)
　　'Command1 を円形に（左眼）
　　MaruSet = CreateEllipticRgn(10, 10, 60, 60)
　　Result = SetWindowRgn(Command1.hWnd, MaruSet, 1)
　　'Command2 を円形に（右目）
　　MaruSet = CreateEllipticRgn(10, 10, 60, 60)
　　Result = SetWindowRgn(Command2.hWnd, MaruSet, 1)
　　'オブジェクトを削除しシステムリソースを解放する
　　Result = DeleteObject(MaruSet)
End Sub


  　　実行結果
　　　
　　
円形のピクチャーコントロールを表示する
　　　 Option Explicit　　　　 'SampleNo=026　WindowsXP VB6.0(SP5) 2002.04.27

'指定の領域をウィンドウ領域として設定する(P335)
Private Declare Function SetWindowRgn Lib "user32" _
　　(ByVal hWnd As Long, ByVal hRgn As Long, _
　　 ByVal bRedraw As Boolean) As Long

'円形・楕円形の領域を作成する(P321)
'X1=左上隅のX座標 Y1=同Y座標 X2=右下隅のX座標　Y2=同Y座標
Private Declare Function CreateEllipticRgn Lib "gdi32" _
　　(ByVal X1 As Long, ByVal Y1 As Long, _
　　 ByVal X2 As Long, ByVal Y2 As Long) As Long

'グラフィックオブジェクトを削除しシステムリソースを解放する(P261)
Private Declare Function DeleteObject Lib "gdi32" _
　　(ByVal hObject As Long) As Long


Private Sub Form_Load()
　　Me.Move 700, 200, 4600, 4500
　　Picture1.Move 135, 45, 3800, 3800
　　'別途PictureBoxには画像等を表示しておいて下さい。
　　Dim MaruSet As Long
　　Dim Result　As Long
　　' 丸い領域を作る（）内の数値を変えると楕円や円の大きさが変わります
　　MaruSet = CreateEllipticRgn(20, 20, 250, 250)
　　Result = SetWindowRgn(Picture1.hWnd, MaruSet, True)
　　'オブジェクトを削除しシステムリソースを解放する
　　Result = DeleteObject(MaruSet)
End Sub

　　　実行結果
　　　
多角形のフォーム及びコントロールを作成する　　　　　（０２６）
　　 ほぼ、上記と同様ですが、円形か、多角形を作成するかの違いです。
サンプルは、フォームの上にほぼ同じ大きさのコマンドボタンを貼り付けてフォームと
コマンドボタンが重なった状態で作成しています。塗りつぶしモードに　１ を指定すると
中抜きの領域が選択できます。

Option Explicit　　　　 'SampleNo=026　WindowsXP VB6.0(SP5) 2002.04.27

'指定の領域をウィンドウ領域として設定する(P335)
Private Declare Function SetWindowRgn Lib "user32" _
　　(ByVal hWnd As Long, ByVal hRgn As Long, _
　　 ByVal bRedraw As Boolean) As Long

'円形・楕円形の領域を作成する(P321)
'X1=左上隅のX座標 Y1=同Y座標 X2=右下隅のX座標　Y2=同Y座標
Private Declare Function CreateEllipticRgn Lib "gdi32" _
　　(ByVal X1 As Long, ByVal Y1 As Long, _
　　 ByVal X2 As Long, ByVal Y2 As Long) As Long

'多角形の領域を作成する(P322)
Private Declare Function CreatePolygonRgn Lib "gdi32" _
　　(lpPoint As POINTAPI, ByVal nCount As Long, _
　　 ByVal nPolyFillMode As Long) As Long

'グラフィックオブジェクトを削除しシステムリソースを解放する（P261)
Private Declare Function DeleteObject Lib "gdi32" _
　　(ByVal hObject As Long) As Long

Private Type POINTAPI
　　X As Long　 '多角形の頂点のx座標
　　Y As Long　 '　　同　　　　y座標
End Type

Private Const WINDING = 2　 '全域塗りつぶしモード


Private Sub Form_Load()
　　Dim hRgn　　As Long
　　Dim lppt(4) As POINTAPI
　　Dim nCount　As Long
　　Dim Result　As Long
　　Me.Move 5000, 0, 6100, 5000
　　Command1.Move 150, 105, 4215, 5640
　　'Command1.Style =1 'プロパティで設定して下さい
　　Command1.BackColor = vbRed
　　nCount = 5　'多角形の頂点の数
　　'星形の頂点の座標
　　lppt(0).X = 180:　lppt(0).Y = 100
　　lppt(1).X = 80:　 lppt(1).Y = 270
　　lppt(2).X = 300:　lppt(2).Y = 150
　　lppt(3).X = 60:　 lppt(3).Y = 150
　　lppt(4).X = 270:　lppt(4).Y = 270
　　'関数を実行して領域のハンドルを取得
　　hRgn = CreatePolygonRgn(lppt(0), nCount, WINDING)
　　'ウィンドウ領域として設定する
　　Result = SetWindowRgn(Me.hWnd, hRgn, True)
　　'オブジェクトを削除しシステムリソースを解放する
　　Result = DeleteObject(hRgn)
End Sub


　　　　実行結果
　　　




2003/06/03