'*********************************************************************
'             Facut de Crisan Ovidiu (cod_x@geocities.com)
'                             Aprilie 1999
'*********************************************************************
' Modul mCloseX (CloseX.bas)
'*********************************************************************
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" _
    Alias "Shell_NotifyIconA" _
    (ByVal dwMessage As enm_NIM_Shell, pnid As NOTIFYICONDATA) As Boolean


Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNORMAL = 1

Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONUP = &H205

Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2

Public Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Public Enum enm_NIM_Shell
    NIM_ADD = &H0
    NIM_MODIFY = &H1
    NIM_DELETE = &H2
    NIF_MESSAGE = &H1
    NIF_ICON = &H2
    NIF_TIP = &H4
    WM_MOUSEMOVE = &H200
End Enum

Type POINTAPI
        X As Long
        Y As Long
End Type

Public nidProgramData As NOTIFYICONDATA


'*********************************************************************
' Forma frmCloseX (CloseX.frm)
'*********************************************************************
Dim bExit As Boolean
Dim hWin As Long
Dim hWin2Find As Long
Dim punct As POINTAPI
Dim nume As String * 255



Private Sub chkMarcaj_Click()
If chkMarcaj = vbChecked Then
SetCapture Me.hwnd
Me.MousePointer = vbCustom
Me.MouseIcon = LoadResPicture(101, vbResCursor)
Else
Me.MousePointer = vbDefault
ReleaseCapture
End If
cmdClose.SetFocus
End Sub

Private Sub chkMarcaj_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.MousePointer = vbDefault
Label2.FontSize = 10
Label2.FontBold = False
End Sub

Private Sub chkOnTop_Click()
If chkOnTop.Value = vbChecked Then
chkOnTop.Caption = "V"
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Else
chkOnTop.Caption = "^"
SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End If
cmdClose.SetFocus
End Sub

Private Sub cmdAdauga_Click()
If txtCaption <> vbNullString Then lstCaption.AddItem txtCaption
txtCaption = ""
txtCaption.SetFocus
End Sub

Private Sub cmdClose_Click()
If lstCaption.ListIndex <> -1 Then lstCaption_DblClick
End Sub

Private Sub cmdClose_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.MousePointer = vbDefault
Label2.FontSize = 10
Label2.FontBold = False
End Sub

Private Sub cmdExit_Click()
bExit = True
Unload Me
End Sub

Private Sub cmdExit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.MousePointer = vbDefault
Label2.FontSize = 10
Label2.FontBold = False
End Sub

Private Sub cmdModifica_Click()
If lstCaption.ListIndex <> -1 Then
    txtCaption = lstCaption
    lstCaption.RemoveItem lstCaption.ListIndex
End If
txtCaption.SetFocus
txtCaption.SelStart = 0
txtCaption.SelLength = Len(txtCaption)
End Sub

Private Sub cmdSterge_Click()
If lstCaption.ListIndex <> -1 Then
    If vbYes = MsgBox("Sinteti sigur ca doriti stergerea ?", vbSystemModal + vbYesNo + vbQuestion, "Atentie") Then
        lstCaption.RemoveItem lstCaption.ListIndex
    End If
End If
txtCaption.SetFocus
End Sub


Private Sub cmdStergeLista_Click()
lstCaption.Clear
End Sub

Private Sub Form_Load()
If App.PrevInstance Then
    MsgBox "Deja programul a fost lansat !", vbCritical + vbOKOnly + vbApplicationModal, "Atentie"
    w = FindWindow(vbNullString, "CloseX v1.0 (c) Crisan Ovidiu '99")
        If w Then
        X = ShowWindow(w, SW_SHOWNORMAL)
        SetForegroundWindow (w)
        End If
    End
End If
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE

If Dir$(App.Path & "\CloseX.ini") = "" Then
Open App.Path & "\CloseX.ini" For Output As #1
Print #1, "[OPTIUNI]"
Print #1, ";;;; Optiuni generale ;;;;"
Print #1, " "
Print #1, "Interval_de_timp=0"
Print #1, "Nr_ferestre=0"
Print #1, " "
Print #1, "[FERESTRE_DE_INCHIS]"
Print #1, ";;;; Caption-ul ferestrelor care trebuie inchise automat ;;;;"
Print #1, " "
Close #1
End If

Dim ValIni$
Dim nr As Integer
ValIni = Space$(256)

GetPrivateProfileString "OPTIUNI", "Interval_de_timp", "***", ValIni, Len(ValIni), App.Path & "\CloseX.ini"
If Left$(ValIni, 3) <> "***" Then
tmrVerifica.Interval = 1000 * CInt(ValIni)
txtTimp.Text = ValIni
End If

GetPrivateProfileString "OPTIUNI", "Nr_ferestre", "***", ValIni, Len(ValIni), App.Path & "\CloseX.ini"
If Left$(ValIni, 3) <> "***" And Val(ValIni) <> 0 Then
nr = Val(ValIni)
For i = 1 To nr
GetPrivateProfileString "FERESTRE_DE_INCHIS", "Caption" & CStr(i), "***", ValIni, Len(ValIni), App.Path & "\CloseX.ini"
If ValIni <> vbNullString And Left$(ValIni, 3) <> "***" Then lstCaption.AddItem ValIni
Next
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.MousePointer = vbDefault
Label2.FontSize = 10
Label2.FontBold = False
Select Case X
    Case WM_LBUTTONUP
        Me.Show
    Case WM_RBUTTONUP
        Me.PopupMenu mnuPopup
End Select
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim l As Long
punct.X = X
punct.Y = Y
ClientToScreen Me.hwnd, punct
hWin = WindowFromPoint(punct.X, punct.Y)
While GetParent(hWin) <> 0
hWin = GetParent(hWin)
Wend
If hWin <> Me.hwnd Then
l = GetWindowText(hWin, nume, 255)
If l <> 0 Then lstCaption.AddItem Left$(nume, l)
End If
chkMarcaj.Value = vbUnchecked
End Sub

Private Sub Form_Unload(Cancel As Integer)
If Not bExit Then
    With nidProgramData
        .cbSize = Len(nidProgramData)
        .hwnd = Me.hwnd
        .uId = vbNull
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        'mesajul WM_MOUSEMOVE apare cind se intimpla ceva cu icon-ul
        .uCallbackMessage = WM_MOUSEMOVE
        .hIcon = Me.Icon
        .szTip = "CloseX (c)Crisan Ovidiu '99" & vbNullChar
    End With
    Shell_NotifyIcon NIM_ADD, nidProgramData
    Me.Hide
    Cancel = True 'Nu iese
Else
    Cancel = False 'Iese
    Shell_NotifyIcon NIM_DELETE, nidProgramData
    WritePrivateProfileString "OPTIUNI", "Interval_de_timp", CStr(tmrVerifica.Interval \ 1000), App.Path & "\CloseX.ini"
    WritePrivateProfileString "OPTIUNI", "Nr_ferestre", CStr(lstCaption.ListCount), App.Path & "\CloseX.ini"
    If lstCaption.ListCount > 0 Then
    For i = 0 To lstCaption.ListCount - 1
    WritePrivateProfileString "FERESTRE_DE_INCHIS", "Caption" & CStr(i + 1), lstCaption.List(i), App.Path & "\CloseX.ini"
    Next
    End If
End If
End Sub

Private Sub Label2_Click()
ShellExecute Me.hwnd, "open", "http://www.geocities.com/SiliconValley/Hills/4377", vbNullString, vbNullString, SW_MAXIMIZE
End Sub

Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Labelul cu adresa de Internet
Label2.FontSize = 8
Label2.FontBold = True
Me.MousePointer = vbCustom
Me.MouseIcon = LoadResPicture(101, vbResCursor)
End Sub

Private Sub lstCaption_DblClick()
hWin2Find = FindWindow(vbNullString, lstCaption & vbNullChar)
If hWin2Find <> 0 Then
AppActivate lstCaption
SendKeys "%({F4})"
End If
End Sub

Private Sub mnuExit_Click()
bExit = True
Unload Me
End Sub

Private Sub mnuOpen_Click()
Me.Show
End Sub

Private Sub tmrVerifica_Timer()
For i = lstCaption.ListCount - 1 To 0 Step -1
lstCaption.ListIndex = i
lstCaption_DblClick
Next
End Sub

Private Sub txtCaption_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then cmdAdauga_Click
End Sub

Private Sub txtTimp_Change()
If IsNumeric(txtTimp) Then tmrVerifica.Interval = CInt(txtTimp.Text) * 1000
End Sub