3Dフォームを作成する方法

◆概要


このホームページは、Visual Basic 6.0で3Dフォームを作成する方法について記載しています。


立体的な3Dフォームを作成する方法をご紹介します。

◆手順


フォームモジュールに以下のコードを記述します。

Option Explicit
Public Sub ThreeDForm(frmForm As Form)
    Const cPi = 3.1415926       '円周率
    Dim intLineWidth As Integer '線幅の変数
    intLineWidth = 5            '線幅の変数に5を代入
    
    Dim intSaveScaleMode As Integer 'スケールモードを格納する変数
    '現在のスケールモードを記憶
    intSaveScaleMode = frmForm.ScaleMode
    
    'フォームのスケールモードを3(ピクセル)に設定
    frmForm.ScaleMode = 3
    
    Dim intScaleWidth As Integer    'フォーム幅を格納する変数
    Dim intScaleHeight As Integer   'フォーム高さを格納する変数
    'フォームの幅を変数に格納する
    intScaleWidth = frmForm.ScaleWidth
    'フォームの高さを変数に格納する
    intScaleHeight = frmForm.ScaleHeight
    
    frmForm.Cls '現在のフォームを消す
    
    '線を引く
    frmForm.Line (0, intScaleHeight)-(intLineWidth, 0), &HFFFFFF, BF
    frmForm.Line (0, intLineWidth)-(intScaleWidth, 0), &HFFFFFF, BF
    
    frmForm.Line (intScaleWidth, 0)-(intScaleWidth - intLineWidth, _
        intScaleHeight), &H808080, BF
    frmForm.Line (intScaleWidth, intScaleHeight - intLineWidth)-(0, _
        intScaleHeight), &H808080, BF
        
    Dim intCircleWidth As Integer
    intCircleWidth = Sqr(intLineWidth * intLineWidth + intLineWidth _
        * intLineWidth)
    frmForm.FillStyle = 0
    frmForm.FillColor = QBColor(15)
    frmForm.Circle (intLineWidth, intScaleHeight - intLineWidth), _
        intCircleWidth, QBColor(15), -3.1415926, -3.90953745777778
    frmForm.Circle (intScaleWidth - intLineWidth, intLineWidth), _
        intCircleWidth, QBColor(15), -0.78539815, -1.5707963
    frmForm.Line (0, intScaleHeight)-(0, 0), 0
    
    frmForm.Line (0, 0)-(intScaleWidth - 1, 0), 0
    frmForm.Line (intScaleWidth - 1, 0)-(intScaleWidth - 1, _
        intScaleHeight - 1), 0
    frmForm.Line (0, intScaleHeight - 1)-(intScaleWidth - 1, _
        intScaleHeight - 1), 0
        
    'フォームのスケールモードを元に戻す
    frmForm.ScaleMode = intSaveScaleMode
    
End Sub

Private Sub Command1_Click()
    '次のMeを3Dフォームにしたいフォーム名にします。
    'ただし、そのフォームは事前に表示されている必要があります。
    ThreeDForm Me
End Sub

Private Sub Form_Resize()
    'フォームがリサイズしたときに3Dフォームを適用する
    ThreeDForm Me
End Sub
  

◆実行結果


3Dフォーム

▼ページトップへ