S.13　Globe

　球の作図です。地球の緯線・経線に相当する線で描きます。プログラムは原本[3]によりましたが、隠れ線処理がやや特殊ですので、メタファイルからの再描画はうまくいきません。

Public Sub Proc13() ' Globe
    Const hankei = 200#
    Const r2 = 200# * 199
    Dim rad, x, y, z, x2, y2, degy, degz, idraw, insideFlg, n
    Dim icol As Long
    rad = pie / 180
    n = 1
    If Ivar > 1 Then n = 2
    Dperas
    Dpwind 0, 0, 640
'------------------
    If n = 1 Then
        For degz = -90 To 90 Step 10
            x = hankei * Cos(degz * rad)
            y = hankei * Sin(degz * rad)
            For degy = 0 To 360
                x2 = x * Cos(degy * rad)
                z = x * Sin(degy * rad)
                y2 = y * Cos(30 * rad) + z * Cos(60 * rad)
                Dpoint x2, y2, 0
            Next
        Next
    Else
        For degz = 90 To -90 Step -10
            x = hankei * Cos(degz * rad)
            y = hankei * Sin(degz * rad)
            For degy = -90 To 90 Step 0.5
                x2 = x * Cos(degy * rad)
                z = x * Sin(degy * rad)
                y2 = y * Cos(30 * rad) + z * Cos(60 * rad)
                If degz >= -50 Then
                    icol = Icolor   'save current color code
                    Icolor = QBColor(15)
                    Dpmove -x2, y2
                    Dpdraw x2, y2
                    Icolor = icol   'restore former color code
                End If
                Dpoint x2, y2, 0
                Dpoint -x2, y2, 0
            Next
        Next
    End If
'-----------------
    For degy = 0 To 180 Step 10
        idraw = True: insideFlg = True
        
        For degz = -90 To 270 Step 0.5
            x = hankei * Cos(degz * rad)
            y = hankei * Sin(degz * rad)
            x2 = x * Cos(degy * rad)
            z = x * Sin(degy * rad)
            y2 = y * Cos(30 * rad) + z * Cos(60 * rad)
            If n = 1 Then
                Dpoint x2, y2, 0
            Else
                If (x2 * x2 + y2 * y2) >= r2 Then
                    If insideFlg = True Then idraw = Not idraw
                    insideFlg = False
                Else
                    insideFlg = True
                End If
                If idraw = True Or insideFlg = False Then
                    Dpoint x2, y2, 0
                End If
            End If
        Next
    Next
End Sub