1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
|
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private dx As Integer, dy As Integer, dwn As Integer
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Sub Command3_Click()
End
End Sub
Private Sub Form_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
dx = X
dy = Y
dwn = True
If button = 2 Then
PopupMenu mnuflotant
End If
End Sub
Private Sub Form_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
If dwn Then
Move Left + (X - dx), Top + (Y - dy)
u% = DoEvents
End If
End Sub
Private Sub Form_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
dwn = False
End Sub
Private Sub cmdbt_Click()
Command1.Visible = True
DG.Visible = True
Me.Height = 3435
cmdcach.Visible = True
cmdbt.Visible = False
End Sub
Private Sub cmdcach_Click()
Command1.Visible = False
DG.Visible = False
Me.Height = 1110
cmdbt.Visible = True
cmdcach.Visible = False
End Sub
Private Sub cmdexe_Click()
On Error GoTo err
Dim varbookmarks As Variant
larecherche = txtch
varbookmarks = Adodc1.Recordset.Bookmark
Adodc1.Recordset.Find "Nom='" & larecherche & "'"
If Adodc1.Recordset.EOF Or Adodc1.Recordset.BOF Then
Adodc1.Recordset.Bookmark = varbookmarks
If opt.Value = 0 Then
Label1.Caption = "C:\Program Files\"
Label3 = txtch & "\"
Label1.Caption = Label1 & Label3 & txtch & Label2
Else
Adodc1.Recordset.Update
End If
Shell (Label1)
Exit Sub
Else
Shell (txtchemin)
End If
txtch = ""
txtch.SetFocus
opt.Value = 0
Adodc1.Refresh
Exit Sub
err:
MsgBox "Veuillez définir le chemain correctement !!", vbInformation, "Aide"
End Sub
Private Sub Command1_Click()
On Error Resume Next
Adodc1.Recordset.Delete
End Sub
Private Sub Command2_Click()
If Command2.Caption = ">" Then
Me.Width = 300
Me.Left = Screen.Width - Me.Width
Command2.Caption = "<"
Else
Me.Width = 4140
Me.Left = Screen.Width - Me.Width
Command2.Caption = ">"
End If
txtch.SetFocus
End Sub
Private Sub Form_Load()
Me.Left = Screen.Width - Me.Width
Me.Width = 4140
End Sub
Private Sub Label1_Change()
If opt.Value = 1 Then
txtchemin.Text = Label1.Caption
End If
End Sub
Private Sub mnupro_Click()
MsgBox "Ce programme a été realisé par Islem", vbInformation, "A propos"
End Sub
Private Sub mnuquit_Click()
End
End Sub
Private Sub Opt_Click()
If opt.Value = 0 Then
cmdpar.Enabled = False
txtch.SetFocus
Adodc1.Refresh
Else
cmdpar.Enabled = True
Adodc1.Recordset.AddNew
txtch = ""
txtch.SetFocus
End If
End Sub
Private Sub cmdpar_Click()
cd.InitDir = "\Program Files"
cd.Filter = "Fichers(*.exe)|*.exe"
cd.ShowOpen
Label1 = cd.FileName
End Sub
Private Sub txtch_Change()
If opt.Value = 1 Then
txtnom = txtch
End If
End Sub |