Petit pense bete tres simple, mais pratique ( se met dans le systray)

Télécharger le projet
Commenter

Description

Petit pense bete sympa, j'ai un peu copie sur une application de Linux Mandrake 10, mais la c pas un bloc note, il n'y a qu'un seul fichier ouvert et toujours le meme, pour mettre vos mot de passe et login a retenir, ou des adresse ou numeros de telephone important.....etc, enfin libre cour a votre imagination.

Plus une application sympa qu'une source interressante.

@+, j'atten les critiques

Source / Exemple : 


#### FRMMAIN ####

Option Explicit
Dim intLauch As Integer

Private Sub Form_Load()
  ' Initialisation du titre de la fenetre
  lblTitre.Caption = " Le " & Date & " à " & Time
  ' Charge le pense bete
  ChargePenseBete
  ' Initialise la variable blnShow
  blnShow = False
  App.TaskVisible = False
  
  intLauch = 0
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Static rec As Boolean, msg As Long
  
  'Se produit lorsque l'utilisateur agit avec la souris sur
  'l'icône placée dans le système tray
  
  msg = X / Screen.TwipsPerPixelX
  If rec = False Then
    rec = True
    Select Case msg
      Case DOUBLE_CLICK_GAUCHE:
      Case BOUTON_GAUCHE_POUSSE:
      Case BOUTON_GAUCHE_LEVE:
        ' Verifie si la fenetre est visible ou non
        If blnShow = False Then
          ' Affiche la fenetre
          Timer2.Enabled = True
        Else
          lblFerme_Click (0)
        End If
      Case DOUBLE_CLICK_DROIT:
      Case BOUTON_DROIT_POUSSE:
      Case BOUTON_DROIT_LEVE:
        PopupMenu frmMenu.menu, , , , frmMenu.mnuAffiche
    End Select
    rec = False
  End If
End Sub

Private Sub lblFerme_Click(Index As Integer)
  If Index = 0 Then
    ' Enregistre le pense bete
    EnregPenseBete
    ' Cache la fenetre
    Timer2.Enabled = True
    
  ElseIf Index = 1 Then
    MsgBox A_PROPOS, vbInformation, "A propos"
  End If
End Sub

Private Sub lblFerme_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  ' Si le bouton est appuyer il devient Rouge
  lblFerme(Index).ForeColor = vbRed
End Sub

Private Sub lblFerme_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  ' Si le bouton est relacher il devient Noir
  lblFerme(Index).ForeColor = vbBlack
End Sub

Private Sub lblTitre_DblClick()
  lblFerme_Click (0)
End Sub

Private Sub Timer1_Timer()
  ' Affiche l'heure et la date dans la barre de titre
  lblTitre.Caption = " Le " & Date & " à " & Time
End Sub

Private Sub Timer2_Timer()
  If intLauch = 0 Then
    Me.Top = Screen.Height - Me.Height + Me.Height
    Me.Show
    intLauch = 1
  End If
  
  If blnShow = False Then
    If Me.Top >= Screen.Height - Me.Height - 399 Then
      Me.Move Me.Left, Me.Top - 82
    Else
      Timer2.Enabled = False
      blnShow = True
      frmMenu.mnuAffiche.Caption = MNUAFFICHE_CAPTION_CACHE
    End If
  Else
    If Me.Top <= Screen.Height - Me.Height + Me.Height Then
      Me.Move Me.Left, Me.Top + 82
    Else
      Timer2.Enabled = False
      blnShow = False
      frmMenu.mnuAffiche.Caption = MNUAFFICHE_CAPTION_AFFICHE
    End If
  End If
End Sub

#### FRMMENU ####
Private Sub mnuAffiche_Click()
  ' Verifie sur la fenetre et visible ou pas
  If blnShow = False Then
    frmMain.Timer2.Enabled = True
  Else
    EnregPenseBete
    frmMain.Timer2.Enabled = True
  End If
End Sub

Private Sub mnuFerme_Click()
  ' Ferme complement l'application
  EnregPenseBete
  EnleveDuSystray
  End
End Sub

Private Sub mnuLoad_Click()
  Dim strm As TextStream
  
  On Error Resume Next
  
  CD.DialogTitle = "Ouvrir un Fichier Texte"
  CD.Filter = "Fichier Texte (*.txt)|*.txt"
  CD.ShowOpen
  ' Si l'utilisateur a bien choisi un fichier,
  ' ouverture et lecture de celui-ci
  If CD.FileName <> "" Then
    Set strm = fso.OpenTextFile(CD.FileName) ' Ouverture
    With strm
      frmMain.Text1.Text = .ReadAll ' Lit et inscrit dans txtSaisie
      .Close ' Fermeture
    End With
  End If
  EnregPenseBete
End Sub

Private Sub mnuSave_Click()
  Dim strm As TextStream
  Dim fnew As String
  
  ' Les erreurs seront ignorées
  On Error Resume Next
  
  CD.Filter = "Fichier Texte (*.txt)|*.txt"
  CD.ShowSave
  If CD.FileName <> "" Then
    With fso
      ' Crée le nouveau fichier
      fnew = .BuildPath(.GetParentFolderName(CD.FileName), _
      CD.FileTitle)
      Set strm = .CreateTextFile(fnew, True)
    End With
  End If
  
  With strm
    ' Ecrit le texte dans le fichier
    .Write frmMain.Text1.Text
    .Close
  End With
End Sub

#### MODULE1 ####
Option Explicit

' Déclarations d'API
Public Declare Sub 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)
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As IconeTray) As Boolean
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

' Types
Public Type IconeTray
    cbSize As Long     ' Taille de l'icone (en octets)
    hWnd As Long       ' Handle de la fenêtre qui va recevoir les messages envoyés lors des évènements sur l'icone (clique-droite, double-clique...)
    uID As Long        ' Identificateur de l'icône
    uFlags As Long
    uCallbackMessage As Long    ' Messages à renvoyer
    hIcon As Long               ' Handle de l'icône qui apparaitra dans le systray
    szTip As String * 64        ' Texte à mettre dans l'info bulle de l'icone
End Type
Public ISystray As IconeTray

' Constantes
Public Const HWND_TOPMOST = -&H1 ' Affiche en 1er plan
Public Const HWND_NOTOPMOST = -&H2 ' Affiche pas en 1er plan
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2

Public Const AJOUT = &H0
Public Const MODIF = &H1
Public Const SUPPRIME = &H2
Public Const MOUSEMOVE = &H200
Public Const MESSAGE = &H1
Public Const Icone = &H2
Public Const TIP = &H4

Public Const DOUBLE_CLICK_GAUCHE = &H203
Public Const BOUTON_GAUCHE_POUSSE = &H201
Public Const BOUTON_GAUCHE_LEVE = &H202
Public Const DOUBLE_CLICK_DROIT = &H206
Public Const BOUTON_DROIT_POUSSE = &H204
Public Const BOUTON_DROIT_LEVE = &H205

Public Const MNUAFFICHE_CAPTION_CACHE = "Cacher le Pense Bête"
Public Const MNUAFFICHE_CAPTION_AFFICHE = "Afficher le Pense Bête"
Public Const A_PROPOS = "Pense Bete" & vbCrLf & "Editeur : Julien"

' Variables

' Pour activer la référence "FileSystemObject" :
' Projet / Référence... / Cocher "Microsoft Scripting Runtime"
Public fso As New FileSystemObject

Public blnShow As Boolean

Sub Main()
  ' Met la fenetre au 1er plan
  SetWindowPos frmMain.hWnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, (SWP_NOSIZE Or SWP_NOMOVE)
  MetDansLeSystray
  
  ' Initialise la taille et la position de la fenetre
  With frmMain
    .Width = .Text1.Width
    .Height = .Text1.Height + .Picture1.Height
    .Top = Screen.Height - .Height - 400
    .Left = Screen.Width - .Width
  End With
  
  ' Cache la fenetre
  frmMain.Hide
End Sub

Public Function MetDansLeSystray()
  ' Initialisation de ISystray
  ISystray.cbSize = Len(ISystray)
  ISystray.hWnd = frmMain.hWnd
  ISystray.uID = 1&
  ISystray.uFlags = Icone Or TIP Or MESSAGE
  ISystray.uCallbackMessage = MOUSEMOVE
  ISystray.hIcon = frmMain.Icon
  ISystray.szTip = "Pense Bête" & Chr$(0)
    
  ' Appel de l'api pour que l'icone se mette dans le systray
  Shell_NotifyIcon AJOUT, ISystray
End Function

Public Function EnleveDuSystray()
  ' Preparation de ISystray
  ISystray.cbSize = Len(ISystray)
  ISystray.hWnd = frmMain.hWnd
  ISystray.uID = 1&
  
  ' Retire l'icone du systray
  Shell_NotifyIcon SUPPRIME, ISystray
End Function

Public Function SystemDirectory() As String
  ' Retourne le chemin du répertoire système (ex: C:/WINDOWS/System32/)
  Dim stTmp As String, lgTmp As Long
  
  stTmp = Space$(250)
  lgTmp = 251
  GetSystemDirectory stTmp, lgTmp
  SystemDirectory = Split(stTmp, Chr$(0))(0)
End Function

Public Function EnregPenseBete()
  Dim strm As TextStream
  Dim fnew As String
  
  ' Les erreurs seront ignorées
  On Error Resume Next
  
  ' Cree un nouveau fichier dans le dossier system pour ne pas le perdre
  With fso
    fnew = .BuildPath(SystemDirectory, "PenseBete.dat")
    Set strm = .CreateTextFile(fnew, True)
  End With
        
  ' Ecrit la valeur de Text1
  With strm
    .Write (frmMain.Text1.Text)
    .Close
  End With
End Function

Public Function ChargePenseBete()
  Dim strm As TextStream
  
  ' Les erreurs seront ignorées
  On Error Resume Next
  
  ' Ouvre le fichier
  Set strm = fso.OpenTextFile(SystemDirectory & "\PenseBete.dat")
  
  ' Affecte la valeur du fichier a Text1
  With strm
    frmMain.Text1.Text = .ReadAll
    .Close
  End With
End Function
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_wolfcyber)