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
| <HTML>
<HEAD>
<TITLE>Deplacer la fenêtre</TITLE>
<HTA:APPLICATION
APPLICATIONNAME="DeplacerForm"
ID="DeplacerForm"
SCROLL="no"
BORDER="none"
INNERBORDER="no"
>
</HEAD>
<SCRIPT language="VBScript">
'Déclarations utilisables dans toute la partie VBScript
Dim Excel, LeHwnD
'----------------------------------------------------------------------------------------------------------------------
Sub Window_Onload()
Dim MeWidth, MeHeight, MeTop, MeLeft, BarT, Cadr
MoveTo -Screen.availWidth,-Screen.availHeight 'place la page HTA hors de l'écran
ResizeTo Screen.availWidth,Screen.availHeight ' Agrandi la page HTA au maximum de la grandeur disponible du bureau
Cadr = screenLeft + Screen.availWidth ' Calcul de l'épaisseur du cadre de la fenêtre HTA
BarT = (screenTop + Screen.availHeight) - Cadr ' Calcule de la hauteur de la barre de titre de la fenêtre HTA
MeHeight = 150: MeWidth = 300
ResizeTo MeWidth, MeHeight ' dimensionnement de la fenêtre HTA (largeur, hauteur)
MeTop = (Screen.availHeight - MeHeight) / 2: MeLeft = (Screen.availWidth-MeWidth)/2
MoveTo MeLeft, MeTop ' Centrage de la fenêtre HTA sur le bureau
On Error Resume Next
Set Excel = CreateObject("Excel.Application")
If Err Then
MsgBox Err.Description,vbcritical,"Excel non présent sur l'ordinateur?"
window.close
Else
LeHwnD = HwndMe("Deplacer la fenêtre") 'Récupération du Handle du présent programme
End If
End Sub
'----------------------------------------------------------------------------------------------------------------------
Sub Window_OnUnload()
Set Excel=NotHing
End Sub
'------------------------------------------------------------------------------------------------------------------
Sub BtFin_onClick()
window.close
End Sub
'------------------------------------------------------------------------------------------------------------------
Function HwndMe(Titre)
Dim FunctionStr
'Titre = "Deplacer la fenêtre" '(<TITLE>) Titre de la fenêtre du programme, sensible à la case
'rédaction de la requête à passer à Excel.ExecuteExcel4Macror, pour récupération du Handle du présent programme
FunctionStr = "CALL(""user32"",""FindWindowA"",""JFF"",""HTML Application Host Window Class"",""" & Titre & """)"
HwndMe = Excel.ExecuteExcel4Macro(FunctionStr)
End Function
'------------------------------------------------------------------------------------------------------------------
Sub DeplaceForm()
Const WM_NCLBUTTONDOWN = &HA1, HTCAPTION = &O2
Dim RedactionAPI
RedactionAPI = "CALL(""user32"",""ReleaseCapture"",""JJ"")"
Excel.ExecuteExcel4Macro(RedactionAPI)
RedactionAPI = "CALL(""user32"",""SendMessageA"",""JJJJJ"",""" & _
LeHwnD & """,""" & _
WM_NCLBUTTONDOWN & """,""" & _
HTCAPTION & """,""0"")"
Excel.ExecuteExcel4Macro(RedactionAPI)
End Sub
'------------------------------------------------------------------------------------------------------------------
Sub MoveForm()
If window.event.button = 1 And window.event.shiftKey Then DeplaceForm 'Bt.: 1 gauche, 2 droit, 4 central
End Sub
'----------------------------------------------------------------------------------------------------------------------
</SCRIPT>
<Body onmousemove="MoveForm"
style="font-family:MS Sans Serif, Arial, Verdana, serif; font-size=14px; font-weight:bold; background-Color:#15CC15" >
Mouse Bt. droit + MAJ
<Input Type="button" name="Fin" id="BtFin" Value="Quitter"
style="position:absolute; left:100px; top:100px; height:22px; width:100px;
background-color:powderblue; Color:#000000">
</Body>
</HTML> |
Partager