Visual Basic 6으로 만들어진 추첨기 코드
조금 오래전에 만든 추첨기의 코드입니다. 프로젝트 폴더를 정리하다가 추첨기 프로젝트가 있길래 올렸습니다.
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Sub Command5_Click()
List1.Clear
End Sub
Private Sub Command6_Click()
List2.Clear
End Sub
Private Sub Command7_Click()
Dim Tmp As String
CommonDialog1.Filter = "텍스트문서(*.txt)|*.txt"
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
List1.Clear
Open CommonDialog1.FileName For Input As #1
Do While Not EOF(1)
Line Input #1, Tmp
List1.AddItem Tmp
Loop
Close #1
End If
End Sub
Private Sub Label8_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long
If Button = 1 Then
Call ReleaseCapture
lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
Private Sub Command1_Click()
Dim i As Integer
If Text1 = "" Then
MsgBox "리스트에 공백이 올수 없습니다.", vbExclamation, "경고"
Else
If Option1.Value = False Then
List1.AddItem Text1
Text1 = ""
Text1.SetFocus
Else
For i = 0 To List1.ListCount
If List1.List(i) = Text1.Text Then
List1.RemoveItem i
End If
Next i
List1.AddItem Text1
Text1 = ""
Text1.SetFocus
End If
End If
End Sub
Private Sub Command2_Click()
If List1.ListIndex = -1 Then
MsgBox "리스트를 선택하여 주세요!", vbCritical, "알림"
Else
List1.RemoveItem List1.ListIndex
End If
End Sub
Private Sub Command3_Click()
Dim j As Integer
If Text4 > 1000 Then MsgBox "반복 횟수는 1000번을 넘을 수 없습니다.", vbCritical, "에러": Exit Sub
If Text2 = "0" Or Text2 = "" Then
MsgBox "당첨자 수를 입력해주세요.", vbCritical, "알림"
Else
If Text2 > List1.ListCount Then
MsgBox "당첨자 수가 리스트의 수보다 더 많습니다.", vbCritical, "에러"
Else
For j = 1 To Int(Text4.Text)
Random_List
Next j
End If
End If
End Sub
Private Sub Command4_Click()
If Text3.Text = "" Then
MsgBox "파일 이름을 입력해주세요.", vbCritical, "에러"
Text3.SetFocus
Exit Sub
End If
If List2.ListCount = 0 Then
MsgBox "당첨 리스트가 존재하지 않습니다.", vbCritical, "에러"
Exit Sub
End If
Dim FF As Integer, i As Integer, Temp As String
FF = FreeFile
For i = 0 To List2.ListCount - 1
Temp = Temp & List2.List(i) & vbCrLf
Next i
Temp = Mid(Temp, 1, Len(Temp) - 1)
Open App.Path & "\" & Text3.Text & ".txt" For Output As #FF
Print #FF, Temp
Close #FF
MsgBox "파일이 성공적으로 추출되었습니다!", vbInformation, "파일 추출"
End Sub
Private Sub Form_Load()
Option2.Value = True
Text3.Text = "추첨기"
Text4.Text = 1
End Sub
Private Sub Label6_Click()
Form1.WindowState = 1
End Sub
Private Sub Label7_Click()
Unload Me
End Sub
Private Sub Option1_Click()
Option2.Value = False
End Sub
Private Sub Option2_Click()
Option1.Value = False
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Call Command1_Click
End Sub
Private Sub Text2_Change()
Text2 = Val(Text2)
Text2.SelStart = Len(Text2)
End Sub
Private Sub Text4_Change()
Text4 = Val(Text4)
Text4.SelStart = Len(Text4)
End Sub
Private Sub Random_List()
Dim Temp() As String, i As Integer, j As Integer, k As Integer
ReDim Temp(List1.ListCount - 1)
For i = 0 To List1.ListCount - 1
Temp(i) = List1.List(i)
Next i
List2.Clear
For i = 1 To Text2
j = Int(Rnd * (List1.ListCount))
List2.AddItem List1.List(j)
' --
If Option1.Value Then List1.RemoveItem j
Next i
List1.Clear
For i = 0 To UBound(Temp)
List1.AddItem Temp(i)
Next i
End Sub
'소스 관련' 카테고리의 다른 글
| 비주얼 베이직 6.0 멀티파트 관련 클래스 모듈 (0) | 2013.02.14 |
|---|---|
| C# 네이버 메일 이미지 업로드 코드 (0) | 2013.02.09 |
| 웹 관련 함수 생성기 (1) | 2013.01.20 |
| 정규 표현식 테스터(Regular Expression Tester) (3) | 2013.01.03 |
| 헤더를 VB6 코드로 쉽게 변환! (HEADER -> VB6 CODE CONVERTER) (2) | 2013.01.02 |
추첨기.zip