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 |