円形のフォーム・コマンドボタンを作成する
                                                         玄関へお回り下さい。
円形のフォーム及びコントロールを作成する         (026)
       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

   実行結果
   

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

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