Soyez le premier à donner votre avis sur cette source.
Vue 7 515 fois - Téléchargée 967 fois
Option Explicit Private mbLoaded As Boolean 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 Public Function ToujoursVisible(frm As Form) 'permet de garder la form en avant plan (uniquement avec le programme compilé) Dim Resultat As Long Const Flags = &H2 Or &H1 Or &H40 Or &H10 Resultat = SetWindowPos(frm.hwnd, -1, 0, 0, 0, 0, Flags) End Function Private Sub LoadKeyboard() Dim lCpt As Long Dim lCurr As Long Dim lRow As Long Dim lCol As Long Dim lTemp As Long Dim sTemp As String On Error GoTo Erreur 'création ou redimensionnement du clavier cmdBtn(0).Width = Me.ScaleWidth / 20 cmdBtn(0).Height = (Me.ScaleHeight - 100) / 5 lTemp = 0 sTemp = "" 'touches normales For lCpt = 1 To 59 sTemp = "" Select Case lCpt Case 1: lCol = 1 lRow = 1 lTemp = 38 sTemp = "&&" Case 2: lTemp = 233 Case 3: lTemp = 64 Case 4: lTemp = 39 Case 5: lTemp = 35 Case 6: lTemp = 40 Case 7: lTemp = 232 Case 8: lTemp = 33 Case 9: lTemp = 231 Case 10: lTemp = 123 Case 11: lTemp = 224 Case 12: lTemp = 125 Case 13: lTemp = 41 Case 14: lTemp = 176 Case 15: lTemp = 45 Case 16: lTemp = 95 Case 17: lRow = 2 lCol = 1 lTemp = 97 Case 18: lTemp = 122 Case 19: lTemp = 101 Case 20: lTemp = 114 Case 21: lTemp = 116 Case 22: lTemp = 121 Case 23: lTemp = 117 Case 24: lTemp = 105 Case 25: lTemp = 111 Case 26: lTemp = 112 Case 27: lTemp = 91 Case 28: lTemp = 93 Case 29: lTemp = 42 Case 30: lTemp = 36 Case 31: lTemp = 92 Case 32: lRow = 3 lCol = 1 lTemp = 113 Case 33: lTemp = 115 Case 34: lTemp = 100 Case 35: lTemp = 102 Case 36: lTemp = 103 Case 37: lTemp = 104 Case 38: lTemp = 106 Case 39: lTemp = 107 Case 40: lTemp = 108 Case 41: lTemp = 109 Case 42: lTemp = 37 Case 43: lTemp = 60 Case 44: lTemp = 62 Case 45: lTemp = 43 Case 46: lRow = 4 lCol = 1 lTemp = 119 Case 47: lTemp = 120 Case 48: lTemp = 99 Case 49: lTemp = 118 Case 50: lTemp = 98 Case 51: lTemp = 110 Case 52: lTemp = 63 Case 53: lTemp = 44 Case 54: lTemp = 46 Case 55: lTemp = 59 Case 56: lTemp = 58 Case 57: lTemp = 47 Case 58: lTemp = 61 Case 59: lRow = 5 lCol = 1 lTemp = 32 End Select If Not mbLoaded Then Load cmdBtn(lCpt) If Trim$(sTemp) <> "" Then cmdBtn(lCpt).Caption = sTemp Else cmdBtn(lCpt).Caption = Chr(lTemp) End If cmdBtn(lCpt).Width = Me.ScaleWidth / 20 cmdBtn(lCpt).Height = (Me.ScaleHeight - 100) / 5 Select Case lRow Case 1: cmdBtn(lCpt).Move (lCol * 10) + (cmdBtn(0).Width * (lCol - 1)), 10 Case 2: cmdBtn(lCpt).Move (lCol * 10) + (cmdBtn(0).Width * (lCol - 1)) + (cmdBtn(0).Width * 0.5), 20 + cmdBtn(0).Height Case 3: cmdBtn(lCpt).Move (lCol * 10) + (cmdBtn(0).Width * (lCol - 1)) + cmdBtn(0).Width, 30 + (cmdBtn(0).Height * 2) Case 4: cmdBtn(lCpt).Move (lCol * 10) + (cmdBtn(0).Width * (lCol - 1)) + (cmdBtn(0).Width * 1.5), 40 + (cmdBtn(0).Height * 3) Case 5: cmdBtn(lCpt).Move (lCol * 10) + (cmdBtn(0).Width * (lCol - 1)) + (cmdBtn(0).Width * 2), 50 + (cmdBtn(0).Height * 4), cmdBtn(0).Width * 10 End Select cmdBtn(lCpt).Tag = "C" & lTemp cmdBtn(lCpt).Visible = True lCol = lCol + 1 Next 'touches numériques lCurr = 0 For lCpt = 60 To 70 If Not mbLoaded Then Load cmdBtn(lCpt) cmdBtn(lCpt).Caption = lCurr cmdBtn(lCpt).Tag = "C" & Asc(CStr(lCurr)) Select Case lCurr Case 0: cmdBtn(lCpt).Move Me.ScaleWidth - 20 - (cmdBtn(0).Width * 2), (cmdBtn(0).Height * 3) + 40 Case 1: cmdBtn(lCpt).Move Me.ScaleWidth - 30 - (cmdBtn(0).Width * 3), (cmdBtn(0).Height * 2) + 30 Case 2: cmdBtn(lCpt).Move Me.ScaleWidth - 20 - (cmdBtn(0).Width * 2), (cmdBtn(0).Height * 2) + 30 Case 3: cmdBtn(lCpt).Move Me.ScaleWidth - 10 - cmdBtn(0).Width, (cmdBtn(0).Height * 2) + 30 Case 4: cmdBtn(lCpt).Move Me.ScaleWidth - 30 - (cmdBtn(0).Width * 3), cmdBtn(0).Height + 20 Case 5: cmdBtn(lCpt).Move Me.ScaleWidth - 20 - (cmdBtn(0).Width * 2), cmdBtn(0).Height + 20 Case 6: cmdBtn(lCpt).Move Me.ScaleWidth - 10 - cmdBtn(0).Width, cmdBtn(0).Height + 20 Case 7: cmdBtn(lCpt).Move Me.ScaleWidth - 30 - (cmdBtn(0).Width * 3), 10 Case 8: cmdBtn(lCpt).Move Me.ScaleWidth - 20 - (cmdBtn(0).Width * 2), 10 Case 9: cmdBtn(lCpt).Move Me.ScaleWidth - 10 - cmdBtn(0).Width, 10 End Select cmdBtn(lCpt).Width = Me.ScaleWidth / 20 cmdBtn(lCpt).Height = (Me.ScaleHeight - 100) / 5 cmdBtn(lCpt).Visible = True lCurr = lCurr + 1 Next 'touches de fonction 'backspace lCpt = lCpt + 1 If Not mbLoaded Then Load cmdBtn(lCpt) cmdBtn(lCpt).Caption = "<---" cmdBtn(lCpt).Tag = "F" & 9 cmdBtn(lCpt).Move cmdBtn(59).Left + cmdBtn(59).Width + cmdBtn(0).Width, cmdBtn(59).Top, cmdBtn(0).Width * 3, (Me.ScaleHeight - 100) / 5 cmdBtn(lCpt).Visible = True 'enter lCpt = lCpt + 1 If Not mbLoaded Then Load cmdBtn(lCpt) cmdBtn(lCpt).Caption = "ENTER" cmdBtn(lCpt).Tag = "F" & 13 cmdBtn(lCpt).Move cmdBtn(lCpt - 1).Left + cmdBtn(lCpt - 1).Width + cmdBtn(0).Width, cmdBtn(lCpt - 1).Top, cmdBtn(0).Width * 3, (Me.ScaleHeight - 100) / 5 cmdBtn(lCpt).Visible = True 'shift lCpt = lCpt + 1 If Not mbLoaded Then Load cmdBtn(lCpt) cmdBtn(lCpt).Caption = "MAJ" cmdBtn(lCpt).Tag = "S" cmdBtn(lCpt).Move 10, cmdBtn(lCpt - 1).Top, cmdBtn(59).Left - (cmdBtn(0).Width / 2), (Me.ScaleHeight - 100) / 5 cmdBtn(lCpt).Visible = True Fin: Exit Sub Erreur: Resume Fin End Sub Private Sub cmdBtn_Click(Index As Integer) Dim sAPP As String On Error GoTo Erreur Me.Enabled = False sAPP = "Sans titre - Bloc-notes" If Left(cmdBtn(Index).Tag, 1) <> "S" Then cmdBtn(Index).BackColor = vbWhite AppActivate sAPP DoEvents If Left(cmdBtn(Index).Tag, 1) = "C" Then If Asc(cmdBtn(Index).Caption) > 96 And Asc(cmdBtn(Index).Caption) < 123 Then If cmdBtn(74).BackColor = vbWhite Then SendKeys "+" & "{" & cmdBtn(Index).Caption & "}" Else SendKeys "{" & cmdBtn(Index).Caption & "}" End If Else SendKeys "{" & Chr(Val(Right(cmdBtn(Index).Tag, Len(cmdBtn(Index).Tag) - 1))) & "}" End If Else If Left(cmdBtn(Index).Tag, 1) = "F" Then If cmdBtn(Index).Caption = "ENTER" Then SendKeys "{ENTER}" Else SendKeys "{BACKSPACE}" End If End If End If DoEvents cmdBtn(Index).BackColor = -2147483633 Else If cmdBtn(Index).BackColor = vbWhite Then cmdBtn(Index).BackColor = -2147483633 Else cmdBtn(Index).BackColor = vbWhite End If End If Fin: If Index <> 74 Then cmdBtn(Index).BackColor = -2147483633 Me.Enabled = True Exit Sub Erreur: MsgBox Err.Number & " : " & Err.Description Resume Fin End Sub Private Sub Form_Load() mbLoaded = False LoadKeyboard ToujoursVisible Me mbLoaded = True End Sub Private Sub Form_Resize() LoadKeyboard End Sub
9 avril 2006 à 10:32
7 avril 2006 à 11:20
etil possible de l'utilise avec explorer
stp
4 sept. 2004 à 17:06
il est pas beau, il sert à rien....
mais j'adore l'idée!!! :)
allez 8/10
3 nov. 2003 à 15:15
DU CALME ET RESPECT ENVERS LES PERSONNES !
3 nov. 2003 à 13:22
Le but de ce site est de donner des exemples et de s'entraider.
La source donnée fonctionne car déjà réutilisée par quelques utilisateurs de ce site.
J'ai néanmoins ajouté un ZIP avec la source du code et l'exécutable afin que les plus feinéants ne recopient pas simplement le code de cette page.
Le temps est peut-être précieux mais le respect l'est tout autant.
Met seulement une source pour rire, SITU ... on verra ce qu'en pensera la communauté.
Et si mon article mérite une si basse note, il a au moins eu le mérite de débloquer des gens et de faire découvrir des gens comme toi qui ne savent pas ce qu'est le respect!
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.