Auto speed desk

Télécharger le projet
Commenter

Description

voila un projet que j'ai fait ce soir avant d'aller me coucher....donc...
ca scanne votre program files (ou celui que vou voulez d'ailleurs) ca le liste sa trouve les executables correspondants puis il crée un menu avec autant de bouttons que de programmes et en plus ca les lance !!!
voila si quelqu'un veut recuperer ca...

Source / Exemple : 


désolé pour le module:
le voila .
Option Explicit
 

Type POINTAPI
        X As Long
        Y As Long
End Type
Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long

Private Declare Function CreateRectRgn Lib "GDI32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "GDI32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Const RGN_OR = 2
Declare Function GetDesktopWindow Lib "USER32" () As Long
Private Declare Function DeleteObject Lib "GDI32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "USER32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Declare Sub ReleaseCapture Lib "USER32" ()
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Dim son As Integer
Declare Function GetDC Lib "USER32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "USER32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
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

Public Const SRCCOPY = &HCC0020
Public Const SRCERASE = &H440328
Public Const SRCINVERT = &H660046
Public Const SRCAND = &H8800C6
Public Const SRCPAINT = &HEE0086
Public Const WHITENESS = &HFF0062
Public Const PATCOPY = &HF00021
Public Const PATPAINT = &HFB0A09
Public Const PATINVERT = &H5A0049
Public Const BLACKONWHITE = 1
Public Const MERGECOPY = &HC000CA
Public Const MERGEPAINT = &HBB0226
Public Const DSTINVERT = &H550009
Global iRecursion As Boolean
Global tColor As Long
 Declare Function sndPlaySound Lib "WINMM.DLL" Alias "sndPlaySoundA" _
        (lpszSoundName As Any, ByVal uFlags As Long) As Long
Global SoundBuffer() As Byte
Global Const SND_ASYNC = &H1     ' Jouer de façon asynchrone.
Global Const SND_NODEFAULT = &H2 ' Ne pas utiliser le son par défaut.
Global Const SND_MEMORY = &H4    ' lpszSoundName pointe vers un fichier en mémoire.
Global Const SND_LOOP = &H8

Public Sub MakeTranslucent(Who As Form, Optional tColor As Long)
On Local Error Resume Next
Dim HW As Long
Dim HA As Long
Dim iLeft As Integer
Dim iTop As Integer
Dim iWidth As Integer
Dim iHeight As Integer
If IsMissing(tColor) Or tColor = 0 Then
    tColor = RGB(255, 255, 255)
End If
Who.AutoRedraw = True
Who.Hide
DoEvents
HW = GetDesktopWindow()
HA = GetDC(HW)
iLeft = Who.Left / Screen.TwipsPerPixelX
iTop = Who.Top / Screen.TwipsPerPixelY '+ 25    If using a form With a titlebar (border)...
iWidth = Who.ScaleWidth
iHeight = Who.ScaleHeight
Call BitBlt(Who.hDC, 0, 0, iWidth, iHeight, HA, iLeft, iTop, SRCCOPY) 'iLeft + 4    If using a form With a titlebar (border)...
Who.Picture = Who.Image
Who.Show
Call ReleaseDC(HW, HA)
Who.DrawMode = 9
Who.ForeColor = tColor
Who.Line (0, 0)-(iWidth, iHeight), , BF
Who.AutoRedraw = False
End Sub

Public Function MakeForm(frm As Form, pic As PictureBox)
Dim iX As Long, iY As Long
Dim hRgn As Long, hRgnTemp As Long
Dim lngDummy As Long

frm.Width = frm.ScaleX(pic.Width, vbPixels, vbTwips)
frm.Height = frm.ScaleY(pic.Height, vbPixels, vbTwips)
DoEvents
For iX = 0 To pic.ScaleWidth
    For iY = 0 To pic.ScaleHeight
        If pic.Point(iX, iY) <> vbWhite Then
            If hRgn = 0 Then
                hRgn = CreateRectRgn(iX, iY, iX + 1, iY + 1)
            Else
                hRgnTemp = CreateRectRgn(iX, iY, iX + 1, iY + 1)
                lngDummy = CombineRgn(hRgn, hRgn, hRgnTemp, RGN_OR)
                DeleteObject hRgnTemp
            End If
        End If
    Next
Next
Dim lngTH As Long, lngB As Long

lngDummy = SetWindowRgn(frm.hwnd, hRgn, True)
DoEvents
lngDummy = DeleteObject(hRgn)
End Function

Public Function MoveForm(frm As Form)
ReleaseCapture
SendMessage frm.hwnd, &HA1, 2, 0&
End Function

Conclusion :


ah ! au fait (j'utilise un module moveform ! qui n'est pas de moi...(pour le coté esthetique)
n'hesitez pas a apposer vos commentaires.
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_blindman)