Soyez le premier à donner votre avis sur cette source.
Vue 6 058 fois - Téléchargée 452 fois
Private Const SWP_NOMOVE = &H2 Private Const SWP_NOSIZE = &H1 Private Const SWP_NOACTIVATE = &H10 Private Const SWP_SHOWWINDOW = &H40 Private Const HWND_TOPMOST = -1 Private Const HWND_NOTOPMOST = -2 Private Const Flags = SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE Private 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 Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Type POINTAPI x As Long y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long Dim Locked As Boolean Dim Handle As Long Dim Rec As RECT Dim CurPosWindow As POINTAPI Dim PrecedentLocked As Boolean Private Const MOD_ALT = &H1 Private Const MOD_CONTROL = &H2 Private Const MOD_SHIFT = &H4 Private Const PM_REMOVE = &H1 Private Const WM_HOTKEY = &H312 Private Type Msg hWnd As Long Message As Long wParam As Long lParam As Long time As Long pt As POINTAPI End Type Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long Private Declare Function WaitMessage Lib "user32" () As Long Private bCancel As Boolean Private Sub Form_Load() SetTopMostWindow Me, True 'Active l'affichage au premier plan Locked = False Me.Caption = App.ProductName 'KPD-Team 2000 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net Dim ret As Long bCancel = False 'register the Ctrl-F hotkey ret = RegisterHotKey(Me.hWnd, &HBFFF&, MOD_CONTROL, vbKeyF) Show 'process the Hotkey messages ProcessMessages On Error Resume Next 'pour éviter l'erreur quand un contrôle n'ayant pas la propriété FONT. On place On Error Resume Next avant le code que l'on juge comme potentiellement cause d'erreur, pour ne pas affecter les lignes ne risquant rien (les lignes ci-dessus, dans certains cas, on à des "fausses erreurs") Dim Ctl As Object For Each Ctl In Me Ctl.Font = "Tahoma" Next Ctl End Sub Private Function SetTopMostWindow(Window As Form, Topmost As Boolean) As Long If Topmost = True Then SetTopMostWindow = SetWindowPos(Window.hWnd, HWND_TOPMOST, 0, 0, 0, 0, Flags) Else SetTopMostWindow = SetWindowPos(Window.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, Flags) End If End Function Private Sub Label1_Click() If Label1.Caption = "Vérouiller (CTRL+F)" Then Label1.Caption = "Déverouiller (CTRL+F)" Locked = True ElseIf Label1.Caption = "Déverouiller (CTRL+F)" Then Label1.Caption = "Vérouiller (CTRL+F)" Locked = False End If End Sub Private Sub Timer1_Timer() Dim Pos As POINTAPI GetCursorPos Pos If Locked = False Then Handle = WindowFromPoint(Pos.x, Pos.y) lblHw.Caption = "Handle : " & Handle Dim MyStr As String MyStr = String(100, Chr$(0)) GetWindowText Handle, MyStr, 100 lblTxt.Caption = "Titre : " & MyStr GetWindowRect Handle, Rec lblX.Caption = "X : " & Rec.Left lblY.Caption = "Y : " & Rec.Top lblW.Caption = "Largeur : " & Rec.Right - Rec.Left lblH.Caption = "Hauteur : " & Rec.Bottom - Rec.Top End If If PrecedentLocked <> Locked Then CurPosWindow.x = Pos.x - Rec.Left CurPosWindow.y = Pos.y - Rec.Top PrecedentLocked = Locked End If If Locked = True Then Dim x As Long Dim y As Long Dim cX As Long Dim cY As Long x = Pos.x - CurPosWindow.x y = Pos.y - CurPosWindow.y cX = Rec.Right - Rec.Left cY = Rec.Bottom - Rec.Top SetWindowPos Handle, HWND_TOP, x, y, cX, cY, SWP_SHOWWINDOW End If PrecedentLocked = Locked End Sub Private Sub ProcessMessages() Dim Message As Msg 'loop until bCancel is set to True Do While Not bCancel 'wait for a message WaitMessage 'check if it's a HOTKEY-message If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then 'MsgBox "" Call Label1_Click End If 'let the operating system process other events DoEvents Loop End Sub Private Sub Form_Unload(Cancel As Integer) bCancel = True 'unregister hotkey Call UnregisterHotKey(Me.hWnd, &HBFFF&) End End Sub
6 janv. 2009 à 01:35
SetWindowPos Handle, HWND_TOP, x, y, cX, cY, SWP_SHOWWINDOW
Mais, où est-ce qu'on est sensé trouvé sa ??
Merci encore !
10 nov. 2005 à 22:32
17 sept. 2004 à 20:33
merci bcp !!!
7 sept. 2004 à 20:40
7 sept. 2004 à 17:49
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.