2008년 08월 15일
사각형 그래프.
자뻑인것같지만... 생각보다 쉽네... 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
다운로드 : 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)





☞ 내 이글루에 이 글과 관련된 글 쓰기 (트랙백 보내기) [도움말]