사각형 그래프.

자뻑인것같지만... 생각보다 쉽네... alpha버전은 2시간만에 끝냈으니...ㅋ

다운로드 : SqareGraph.exe




코드 --------------------------------------------------------------------------------------------------------

Option Explicit

Private Color(4)
Private Where(4) As Integer
Private Sum As Double

Sub Draw()
    Sum = 0
    Dim i As Integer
    Dim j As Integer
    Where(0) = 0
    For i = 0 To 4
        Sum = Sum + Val(txtPin(i).Text)
    Next i
    For i = 0 To 4
        lblPercent(i).Caption = Round(Val(txtPin(i).Text) / Sum * 100) & "%"
        For j = Where(i) To Where(i) + Round(Val(txtPin(i).Text) / Sum * 100 - 1)
            If j >= 100 Then
                Exit For
            End If
            shpG(j).BackColor = Color(i)
        Next j
        If i = 4 Then
            Exit For
        End If
        Where(i + 1) = Round(Where(i) + Val(txtPin(i).Text) / Sum * 100)
    Next i
End Sub

Private Sub cmdDraw_Click()
    Draw
    txtPin(0).Text = "데"
    txtPin(1).Text = "이"
    txtPin(2).Text = "터"
    txtPin(3).Text = "입"
    txtPin(4).Text = "력"
End Sub

Private Sub Form_Load()
    MsgBox ("Welcome to SWBSW SqareGraph Program Beta!")
    Dim i As Integer
    Dim j As Integer
    Dim WLeft As Integer
    Dim WTop As Integer
    WLeft = 250
    WTop = 700
    shpG(0).Move WLeft, WTop
    WLeft = WLeft + shpG(0).Width
    For i = 0 To 9
        For j = 0 To 9
            If i * 10 + j = 0 Then
                j = j + 1
            End If
            Load shpG(i * 10 + j)
            shpG(i * 10 + j).Move WLeft, WTop
            WLeft = WLeft + shpG(i * 10 + j).Width
            shpG(i * 10 + j).Visible = True
        Next j
        WTop = WTop + shpG(i * 10 + j - 1).Height
        WLeft = 250
    Next i
    For i = 0 To 4
        Color(i) = QBColor(i + 9)
    Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Form1.Hide
    MsgBox ("Bye!")
End Sub

Private Sub mnuCol_Click(Index As Integer)
    Dim j As Integer
    On Error Resume Next
    cdlColor.DialogTitle = "사각형 그래프의 " & Index & "번 항목의 색상 변경하기"
    cdlColor.Color = Color(Index)
    cdlColor.Flags = cdlCCRGBInit
    cdlColor.ShowColor
    If Not Err.Number = cdlCancel Then
        Color(Index) = cdlColor.Color
    End If
    For j = Where(Index) To Where(Index + 1) - 1
        If j >= 100 Then
            Exit For
        End If
        shpG(j).BackColor = Color(Index)
    Next j
End Sub

Private Sub mnuEnd_Click()
    End
End Sub

Private Sub mnuHelp_Click()
    Dim a
    a = MsgBox("세상에서 가장 도움 안돼는 도움말을 보시겠습니까???", vbYesNo + vbQuestion, "도무지 도움이 않돼는 도움말")
    If a = vbYes Then
        a = MsgBox("진짜 도움 안됄겁니다. 후회 않하실거예요???", vbYesNo + vbQuestion, "진짜 보실껴???")
        If a = vbYes Then
            MsgBox ("진짜 도움 안돼죠??? Windows 도움말이란게 다 이런거죠...ㅋ" & vbCrLf & "머 정 모르시겠으면 이 프로그램 쓰지 마세요...ㅋ")
        Else
            MsgBox ("생각 잘하셨어...ㅋ")
        End If
    Else
        MsgBox ("머, 아님 말구...ㅋ")
    End If
End Sub

Private Sub txtPin_GotFocus(Index As Integer)
    txtPin(Index).Text = ""
End Sub

Function Round(Data)
    Round = Int(Data + 0.5)
End Function

by 해파리 | 2008/08/15 18:52 | 정보영재 숙제 | 트랙백 | 덧글(0)

트랙백 주소 : http://jellynote.egloos.com/tb/708307
☞ 내 이글루에 이 글과 관련된 글 쓰기 (트랙백 보내기) [도움말]

:         :

:

비공개 덧글

◀ 이전 페이지          다음 페이지 ▶