Developpez.com - Delphi
X

Choisissez d'abord la catégorieensuite la rubrique :

Nono40.developpez.com
Le petit coin du web de Nono40
SOURCES TESTS DELPHI WIN32 AUTOMATISMES DELPHI .NET QUICK-REPORT
Retour à l'accueil
21 - COMPOSANT RACCOURCI GENERALISE

PRÉSENTATION : Composant permettant de gérer des raccourcis quelconques au niveau de l'application.
ZIP : Téléchargez le zip APERÇUS :

NOTES : Ce composant permet de créer des raccourcis tordus comme CTRL-Z-ClickDroit.

Installation :
Delphi 5 et 6 : installer le composant TRaccourci du fichier URaccourci.pas
Delphi 4 : installer le paquet RaccD4.dpk ( le source est aussi disponible : URaccD4.pas )

Vous pouvez installer le fichier .HLP dans l'aide de Delphi pour que celui-ci réagisse à la touche F1 sur TRaccourci et ses propriétés ( TRaccD4 pour la version Delphi 4 ).
Pour installer le fichier d'aide faire comme suit :
- Dans delphi, choisir Menu Aide->Personnaliser...
- OpenHelp doit normalement s'ouvrir
- Dans OpenHelp choisir l'onglet "Index" puis ajouter le fichier URaccourci.hlp (URaccD4.hlp ) à l'aide du bouton "Ajout de fichiers"
- Dans OpenHelp, enregistrer le projet et fermer OpenHelp.
Voila, c'est tout : maintenant F1 fonctionne !

Utilisation :
Delphi 5 et 6 : il suffit de poser le composant dans une fiche, de définir les propriétés et d'ajouter une action ou un évènement OnRaccourci.
Voir le fichier URaccourci.hlp pour les détails
Delphi 4 : Il suffit aussi de poser les raccourci sur les fiches, mais pour cette version il faut utiliser Application.OnMessage pour appeler une procédure interne de URaccD4.
Voir le fichier URaccD4.hlp pour les détails

L'unité URaccourci donne en plus un exemple d'éditeur de propriété nouveau pour afficher la liste des touches de façon claire.

Utiliser le projet joint pour voir la différence de fonctionnement suivant la propriété Style. L'exemple à été réalisé avec la version Delphi 6.

Je tiens à remercier DelphiProg pour les essais avec Delphi 4 et surtout pour l'aide apportée à la réalisation des fichiers d'aide.

CODE :
{TRaccourci :  raccourci généralisé par Nono40 ( bruno_g40@hotmail.com )}

{Usage libre, sans modification et sans garanties.}

// 03/05/2002 :  Début création composant
// 09/05/2002 :  Création de la versiob pour Delphi4
// 10/05/2002 :  Création des fichiers d'aide

//Utilisation :
{   Ce composant permet de créer des raccourcis utilisant jusqu'a trois
   touches simultanées.}

{   Cette version est compatible avec la version de 5 et 6 de Delphi.
}


{ Merci à DelphiProg ( mailto:delphi@delphiprog.fr.fm) pour son aide précieuse pour
 la réalisation des fichiers d'aide }

Unit URaccourci;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls, AppEvnts,
(*$IfDef VER130*)
  DsgnIntf;
(*$Else*)
  DesignEditors, DesignIntf;
(*$EndIf*)

Type

  {TStyleRaccourci : Définit le style de raccourci.}
  //
  {*srJamais* : le raccourci n'effectue jamais le Action ou le OnRaccourci.
    Néanmoins, Detecte est quand même mis à True}

  //
  {*srNonDetecte*  : Action ou OnRaccourci ne sont appelés que si Detecte=False.}
  //
  {*srUneFois*  :  Action ou OnRaccourci ne sont appelés que quand l'appel précédent
   est terminé. C'est le mode de fonctionnement par défaut.}

  //
  {*srToujours* : Action ou OnRaccourci sont appelés à chaque apparition de
   la combinaison de touches :}

   {*Attention* : rendre la main rapidement dans ce cas ( pas de ShowModal
    ou ShowMessage ). }

  TStyleRaccourci=(srJamais,srNonDetecte,srUneFois,srToujours);

  { Définition du type 'Touche' permettant ensuite l'ajout d'un éditeur
    de propriétés.}

  { TTouche est compatible avec le type Integer.}
  TTouche=0..255;

{*TRaccourci* :  raccourci généralisé par Nono40 ( bruno_g40@hotmail.com )}

// Usage libre, sans modification et _sans garanties_.
//
// *Révisions* :
// 03/05/2002 :  Début création composant
// 08/05/2002 :  Publication sur www.DelpfiFr.com
// 09/05/2002 :  Création de la version pour Delphi4
// 10/05/2002 :  Création des fichiers d'aide

// *Utilisation* :
{   Ce composant permet de créer des raccourics utilisant jusqu'a trois
   touches simultanées.}

{   Cette version est compatible avec la version de 6 de
   Delphi. Les possesseurs de la Version 4 doivent utiliser TRaccD4. Les possesseurs
   de la version 5 doivent utiliser la TRaccD4 ou modifier la clause Uses du
   fichier URaccourci.pas en supprimant "DesignEditors" et "DesignIntf" puis
   en ajoutant "DsgnIntf".
}

//
//
{ Merci à DelphiProg ( Ton adresse ici ? ) pour son aide précieuse pour
 la réalisation des fichiers d'aide }

  TRaccourci = Class(TComponent)
  Private
    { Déclarations privées }
    FUneFois     :Boolean;
    FAction      :TBasicAction;
    FTouche1     :TTouche;
    FTouche2     :TTouche;
    FTouche3     :TTouche;
    FOnRaccourci :TNotifyEvent;
    FDetecte     :Boolean;
    FStyle       :TStyleRaccourci;
    FOwnerActif  :Boolean;
  Protected
    { Déclarations protégées }
    Procedure SetTouche1(Valeur:TTouche);
    Procedure SetTouche2(Valeur:TTouche);
    Procedure SetTouche3(Valeur:TTouche);
    Procedure TestRaccourci;
    Procedure FaitRaccourci;
  Public
    { Déclarations publiques }
    Constructor Create(AOwner:TComponent);Override;
    Destructor  Destroy;Override;
  Published
    { La propriété Action peut être reliée à un TAction d'une TActionList.}
    Property  Action          : TBasicAction     read FAction      write FAction;
    { Première touche du raccourci à 0 ( VK_NONE ) si inutilisée}
    Property  Touche1         : TTouche          read FTouche1     Write SetTouche1;
    { Deuxième touche du raccourci à 0 ( VK_NONE ) si inutilisée}
    Property  Touche2         : TTouche          read FTouche2     Write SetTouche2;
    { Troisième touche du raccourci à 0 ( VK_NONE ) si inutilisée}
    Property  Touche3         : TTouche          read FTouche3     Write SetTouche3;
    { Cette propriété passe à True dés que le raccourci est détecté. L'application
      doit se charger de la mise à zéro. Ceci permet à l'application de savoir
      que le raccourci vient d'être effectué même si aucun évènement n'est associé.}


    { Dans le cas de Style=srNonDetecte, aucun évènement supplémentaire n'est
      déclenché tant que Detecte est à True. }


    { Si OwnerActif=True, alors Detecte n'est pas mis à True si le raccourci est réalisé
      mais que la fiche propriétaire n'est pas visible. Sauf dans le cas de Style=srJamais
      où Detecte est mis à True dans tous les cas.}

    Property  Detecte         : Boolean          read FDetecte     Write FDetecte;
    {Style définit le mode de fonctionnement du raccourci et prend l'une des valeurs
     suivante : srJamais, srNonDetecte, srUneFois, srToujours.}

    Property  Style           : TStyleRaccourci  read FStyle       Write FStyle;
    //OwnerActif  :
    { *True*  : Le contrôle propriétaire du raccourci doit être
             visible pour valider le raccourci.
             Ceci permet d'inhiber des raccourcis sur une fiche non visible.}

    //
    { *False* : Le raccourci est effectué dans tous les cas.}
    Property  OwnerActif      : Boolean          Read FOwnerActif  Write FOwnerActif;
    {Seul évènement du composant, placer les actions à réaliser dans
    ce gestionnaire d'évènement.}

    {example:
      Pour afficher une fenêtre 'A propos' avec les touches A-ClickGauche, il
      faut placer un TRaccD4 sur la fiche principale et associer VK_A à Touche1,
      VK_LBUTTON à Touche2 et VK_NONE à Touche3. Définir ensuite l'appel de la
      fenêtre dans l'évènement OnRaccourci :

      //Dans le cas ou Style=srNonDetecte
      procedure TForm1.Raccourci1Raccourci(Sender: TObject);
      begin
        FormAPropos.ShowModal;
        // ne pas oublié de mettre Detecte à False
        Raccourci1.Detecte:=False;
      end;

      //Dans le cas ou Style=srUneFois
      procedure TForm1.Raccourci1Raccourci(Sender: TObject);
      begin
        FormAPropos.ShowModal;
      end;}

    Property  OnRaccourci     : TNotifyEvent     Read FOnRaccourci Write FOnRaccourci;
  End;

  //Définition de l'éditeur de propriété pour les TTouche.
  //
  {Ce n'est pas indispensable, mais ça évite de connaître les codes de
   touches par coeur. Il sera utilisé automatiquement par Delphi si vous
   créez une propriété de type TTouche dans vos composants.}

  TToucheProperty = Class(TIntegerProperty)
  Public
    {GetAttributes : }
    Function GetAttributes: TPropertyAttributes; override;
    {GetValue : }
    Function GetValue: String; override;
    {GetValues : }
    Procedure GetValues(Proc: TGetStrProc); override;
    {SetValue : }
    Procedure SetValue(Const Value: String); override;
  End;

{Fonction de conversion TTouche <-> String.}
Function ToucheToIdent(Touche: Longint; Var Ident: String): Boolean;
{Fonction de conversion String <-> TTouche.}
Function IdentToTouche(Const Ident: StringVar Touche: Longint): Boolean;

Procedure Register;

Implementation

// Définition compémentaire du type TTouche
Const
  Touches: Array[0..137Of TIdentMapEntry = (
  ( Value:0             ; Name:'VK_NONE'       ),
  ( Value:VK_LBUTTON    ; Name:'VK_LBUTTON'    ),
  ( Value:VK_RBUTTON    ; Name:'VK_RBUTTON'    ),
  ( Value:VK_CANCEL     ; Name:'VK_CANCEL'     ),
  ( Value:VK_MBUTTON    ; Name:'VK_MBUTTON'    ),
  ( Value:VK_BACK       ; Name:'VK_BACK'       ),
  ( Value:VK_TAB        ; Name:'VK_TAB'        ),
  ( Value:VK_CLEAR      ; Name:'VK_CLEAR'      ),
  ( Value:VK_RETURN     ; Name:'VK_RETURN'     ),
  ( Value:VK_SHIFT      ; Name:'VK_SHIFT'      ),
  ( Value:VK_CONTROL    ; Name:'VK_CONTROL'    ),
  ( Value:VK_MENU       ; Name:'VK_MENU'       ),
  ( Value:VK_PAUSE      ; Name:'VK_PAUSE'      ),
  ( Value:VK_CAPITAL    ; Name:'VK_CAPITAL'    ),
  ( Value:VK_KANA       ; Name:'VK_KANA'       ),
  ( Value:VK_HANGUL     ; Name:'VK_HANGUL'     ),
  ( Value:VK_JUNJA      ; Name:'VK_JUNJA'      ),
  ( Value:VK_FINAL      ; Name:'VK_FINAL'      ),
  ( Value:VK_HANJA      ; Name:'VK_HANJA'      ),
  ( Value:VK_KANJI      ; Name:'VK_KANJI'      ),
  ( Value:VK_CONVERT    ; Name:'VK_CONVERT'    ),
  ( Value:VK_NONCONVERT ; Name:'VK_NONCONVERT' ),
  ( Value:VK_ACCEPT     ; Name:'VK_ACCEPT'     ),
  ( Value:VK_MODECHANGE ; Name:'VK_MODECHANGE' ),
  ( Value:VK_ESCAPE     ; Name:'VK_ESCAPE'     ),
  ( Value:VK_SPACE      ; Name:'VK_SPACE'      ),
  ( Value:VK_PRIOR      ; Name:'VK_PRIOR'      ),
  ( Value:VK_NEXT       ; Name:'VK_NEXT'       ),
  ( Value:VK_End        ; Name:'VK_End'        ),
  ( Value:VK_HOME       ; Name:'VK_HOME'       ),
  ( Value:VK_LEFT       ; Name:'VK_LEFT'       ),
  ( Value:VK_UP         ; Name:'VK_UP'         ),
  ( Value:VK_RIGHT      ; Name:'VK_RIGHT'      ),
  ( Value:VK_DOWN       ; Name:'VK_DOWN'       ),
  ( Value:VK_SELECT     ; Name:'VK_SELECT'     ),
  ( Value:VK_PRINT      ; Name:'VK_PRINT'      ),
  ( Value:VK_EXECUTE    ; Name:'VK_EXECUTE'    ),
  ( Value:VK_SNAPSHOT   ; Name:'VK_SNAPSHOT'   ),
  ( Value:VK_INSERT     ; Name:'VK_INSERT'     ),
  ( Value:VK_DELETE     ; Name:'VK_DELETE'     ),
  ( Value:VK_HELP       ; Name:'VK_HELP'       ),
  ( Value:Ord('0')      ; Name:'VK_0'          ),
  ( Value:Ord('1')      ; Name:'VK_1'          ),
  ( Value:Ord('2')      ; Name:'VK_2'          ),
  ( Value:Ord('3')      ; Name:'VK_3'          ),
  ( Value:Ord('4')      ; Name:'VK_4'          ),
  ( Value:Ord('5')      ; Name:'VK_5'          ),
  ( Value:Ord('6')      ; Name:'VK_6'          ),
  ( Value:Ord('7')      ; Name:'VK_7'          ),
  ( Value:Ord('8')      ; Name:'VK_8'          ),
  ( Value:Ord('9')      ; Name:'VK_9'          ),
  ( Value:Ord('A')      ; Name:'VK_A'          ),
  ( Value:Ord('B')      ; Name:'VK_B'          ),
  ( Value:Ord('C')      ; Name:'VK_C'          ),
  ( Value:Ord('D')      ; Name:'VK_D'          ),
  ( Value:Ord('E')      ; Name:'VK_E'          ),
  ( Value:Ord('F')      ; Name:'VK_F'          ),
  ( Value:Ord('G')      ; Name:'VK_G'          ),
  ( Value:Ord('H')      ; Name:'VK_H'          ),
  ( Value:Ord('I')      ; Name:'VK_I'          ),
  ( Value:Ord('J')      ; Name:'VK_J'          ),
  ( Value:Ord('K')      ; Name:'VK_K'          ),
  ( Value:Ord('L')      ; Name:'VK_L'          ),
  ( Value:Ord('M')      ; Name:'VK_M'          ),
  ( Value:Ord('N')      ; Name:'VK_N'          ),
  ( Value:Ord('O')      ; Name:'VK_O'          ),
  ( Value:Ord('P')      ; Name:'VK_P'          ),
  ( Value:Ord('Q')      ; Name:'VK_Q'          ),
  ( Value:Ord('R')      ; Name:'VK_R'          ),
  ( Value:Ord('S')      ; Name:'VK_S'          ),
  ( Value:Ord('T')      ; Name:'VK_T'          ),
  ( Value:Ord('U')      ; Name:'VK_U'          ),
  ( Value:Ord('V')      ; Name:'VK_V'          ),
  ( Value:Ord('W')      ; Name:'VK_W'          ),
  ( Value:Ord('X')      ; Name:'VK_X'          ),
  ( Value:Ord('Y')      ; Name:'VK_Y'          ),
  ( Value:Ord('Z')      ; Name:'VK_Z'          ),
  ( Value:VK_LWIN       ; Name:'VK_LWIN'       ),
  ( Value:VK_RWIN       ; Name:'VK_RWIN'       ),
  ( Value:VK_APPS       ; Name:'VK_APPS'       ),
  ( Value:VK_NUMPAD0    ; Name:'VK_NUMPAD0'    ),
  ( Value:VK_NUMPAD1    ; Name:'VK_NUMPAD1'    ),
  ( Value:VK_NUMPAD2    ; Name:'VK_NUMPAD2'    ),
  ( Value:VK_NUMPAD3    ; Name:'VK_NUMPAD3'    ),
  ( Value:VK_NUMPAD4    ; Name:'VK_NUMPAD4'    ),
  ( Value:VK_NUMPAD5    ; Name:'VK_NUMPAD5'    ),
  ( Value:VK_NUMPAD6    ; Name:'VK_NUMPAD6'    ),
  ( Value:VK_NUMPAD7    ; Name:'VK_NUMPAD7'    ),
  ( Value:VK_NUMPAD8    ; Name:'VK_NUMPAD8'    ),
  ( Value:VK_NUMPAD9    ; Name:'VK_NUMPAD9'    ),
  ( Value:VK_MULTIPLY   ; Name:'VK_MULTIPLY'   ),
  ( Value:VK_ADD        ; Name:'VK_ADD'        ),
  ( Value:VK_SEPARATOR  ; Name:'VK_SEPARATOR'  ),
  ( Value:VK_SUBTRACT   ; Name:'VK_SUBTRACT'   ),
  ( Value:VK_DECIMAL    ; Name:'VK_DECIMAL'    ),
  ( Value:VK_DIVIDE     ; Name:'VK_DIVIDE'     ),
  ( Value:VK_F1         ; Name:'VK_F1'         ),
  ( Value:VK_F2         ; Name:'VK_F2'         ),
  ( Value:VK_F3         ; Name:'VK_F3'         ),
  ( Value:VK_F4         ; Name:'VK_F4'         ),
  ( Value:VK_F5         ; Name:'VK_F5'         ),
  ( Value:VK_F6         ; Name:'VK_F6'         ),
  ( Value:VK_F7         ; Name:'VK_F7'         ),
  ( Value:VK_F8         ; Name:'VK_F8'         ),
  ( Value:VK_F9         ; Name:'VK_F9'         ),
  ( Value:VK_F10        ; Name:'VK_F10'        ),
  ( Value:VK_F11        ; Name:'VK_F11'        ),
  ( Value:VK_F12        ; Name:'VK_F12'        ),
  ( Value:VK_F13        ; Name:'VK_F13'        ),
  ( Value:VK_F14        ; Name:'VK_F14'        ),
  ( Value:VK_F15        ; Name:'VK_F15'        ),
  ( Value:VK_F16        ; Name:'VK_F16'        ),
  ( Value:VK_F17        ; Name:'VK_F17'        ),
  ( Value:VK_F18        ; Name:'VK_F18'        ),
  ( Value:VK_F19        ; Name:'VK_F19'        ),
  ( Value:VK_F20        ; Name:'VK_F20'        ),
  ( Value:VK_F21        ; Name:'VK_F21'        ),
  ( Value:VK_F22        ; Name:'VK_F22'        ),
  ( Value:VK_F23        ; Name:'VK_F23'        ),
  ( Value:VK_F24        ; Name:'VK_F24'        ),
  ( Value:VK_NUMLOCK    ; Name:'VK_NUMLOCK'    ),
  ( Value:VK_SCROLL     ; Name:'VK_SCROLL'     ),
  ( Value:VK_LSHIFT     ; Name:'VK_LSHIFT'     ),
  ( Value:VK_RSHIFT     ; Name:'VK_RSHIFT'     ),
  ( Value:VK_LCONTROL   ; Name:'VK_LCONTROL'   ),
  ( Value:VK_RCONTROL   ; Name:'VK_RCONTROL'   ),
  ( Value:VK_LMENU      ; Name:'VK_LMENU'      ),
  ( Value:VK_RMENU      ; Name:'VK_RMENU'      ),
  ( Value:VK_PROCESSKEY ; Name:'VK_PROCESSKEY' ),
  ( Value:VK_ATTN       ; Name:'VK_ATTN'       ),
  ( Value:VK_CRSEL      ; Name:'VK_CRSEL'      ),
  ( Value:VK_EXSEL      ; Name:'VK_EXSEL'      ),
  ( Value:VK_EREOF      ; Name:'VK_EREOF'      ),
  ( Value:VK_PLAY       ; Name:'VK_PLAY'       ),
  ( Value:VK_ZOOM       ; Name:'VK_ZOOM'       ),
  ( Value:VK_NONAME     ; Name:'VK_NONAME'     ),
  ( Value:VK_PA1        ; Name:'VK_PA1'        ),
  ( Value:VK_OEM_CLEAR  ; Name:'VK_OEM_CLEAR'  ));

Function ToucheToIdent(Touche: Longint; Var Ident: String): Boolean;
Begin
  Result := IntToIdent(Touche, Ident, Touches);
End;

Function IdentToTouche(Const Ident: StringVar Touche: Longint): Boolean;
Begin
  Result := IdentToInt(Ident, Touche, Touches);
End;

// Editeur de propriétés : TToucheProperty
Function TToucheProperty.GetAttributes: TPropertyAttributes;
Begin
  Result := [paMultiSelect, paValueList, paRevertable];
End;

Function TToucheProperty.GetValue: String;
Begin
  If Not ToucheToIdent(TTouche(GetOrdValue), Result) Then Result:=IntToStr(GetOrdValue);
End;

Procedure TToucheProperty.GetValues(Proc: TGetStrProc);
Var i:Integer;
Begin
  For I := Low(Touches) To High(Touches) Do Proc(Touches[I].Name);
End;

Procedure TToucheProperty.SetValue(Const Value: String);
Var
  NewValue: Longint;
Begin
  If IdentToTouche(Value, NewValue) Then
    SetOrdValue(NewValue)
  Else
    Inherited SetValue(Value);
End;

// Partie gestion des données de raccourci
// Cette partie traite la conversion des messages Windows en raccourcis
// suivant les touches demandées
Type

// Type de bloc de données contenant la liste des touches du raccourci
  PRaccourciData=^TRaccourciData;
  TRaccourciData= Record
    rdSuivant   : PRaccourciData;
    rdRaccourci : TRaccourci;
    rdTouches   : Array[TTouche]Of Boolean;
  End;

// On dérive un composant de TApplicationEvents pour obtenir un OnMessage globale
// C'est plus simple que de gérer directement l'API
  TAppEventMaitre=Class(TApplicationEvents)
  Protected
    Procedure TestRaccourcis(Var Msg: TMsg; Var Handled: Boolean);
  Public
    Constructor Create(AOwner:TComponent);Override;
    Destructor Destroy;Override;
  End;

Var
// Pointeur sur le premier groupe de touches
  RaccourciDatas:PRaccourciData;
// Composant servant pour intercepter les messages
  AppEventMaitre:TAppEventMaitre;
// Listes des touches utilisées dans tous les raccourcis de l'application
  TouchesATester:Array[TTouche]Of Boolean;

// Gestion du composant AppEventMaitre
// On ne fait que définir un évènement sur le OnMessage
Constructor TAppEventMaitre.Create(AOwner:TComponent);
Begin
  Inherited Create(AOwner);
  OnMessage:=TestRaccourcis;
End;

Destructor TAppEventMaitre.Destroy;
Begin
  OnMessage:=Nil;
  Inherited Destroy;
End;

// Est appelé sur OnMessage de AppEventMaitre, donc à chaque message de windows
Procedure TAppEventMaitre.TestRaccourcis(Var Msg: TMsg; Var Handled: Boolean);
Var Etat     :Array[TTouche]Of Boolean;
    i        :Integer;
    RaccData :PRaccourciData;
    AFaire   :Boolean;
    Touche   :Integer;
Begin
  Handled:=False;
  // On ne retient que les messages d'appui
  If (Msg.message =WM_LBUTTONDOWN)Or
     (Msg.message =WM_RBUTTONDOWN)Or
     (Msg.message =WM_KEYDOWN    )
  Then Begin
    // Lecture de l'état de toutes les touches ( y compris les boutons )
    For i:=Low(TTouche)+1 To High(TTouche)
      Do Etat[i]:=TouchesATester[i] And ((GetAsyncKeyState(i) And 32768) <> 0);
    Touche:=0;
    If Msg.message = WM_KEYDOWN      Then Touche:=Msg.wParam;
    If Msg.Message = WM_LBUTTONDOWN  Then Touche:=VK_LBUTTON;
    If Msg.Message = WM_RBUTTONDOWN  Then Touche:=VK_RBUTTON;
    // Test des raccourcis
    RaccData:=RaccourciDatas;
    While RaccData<>Nil Do With RaccData^ Do
    Begin
      AFaire:=True;
      // La liste des touches doit correspondre exactement
      For i:=Low(TTouche)+1 To High(TTouche) Do AFaire:=AFaire And (rdTouches[i]=Etat[i]);
      // La dernière touche appuyée doit aussi faire partie de la liste
      If AFaire And Etat[Touche] Then rdRaccourci.TestRaccourci;
      RaccData:=rdSuivant;
    End;
  End;
End;

// Procédure qui liste tous les raccourcis pour en déduire la liste des touches
Procedure CalculTouchesATester;
Var RaccData:PRaccourciData;
Begin
  FillChar(TouchesATester,SizeOf(TouchesATester),#0);
  RaccData:=RaccourciDatas;
  While RaccData<>Nil Do With RaccData^ Do
  Begin
    TouchesATester[rdRaccourci.FTouche1]:=True;
    TouchesATester[rdRaccourci.FTouche2]:=True;
    TouchesATester[rdRaccourci.FTouche3]:=True;
    RaccData:=rdSuivant;
  End;
End;

// Ajout d'un raccourci dans la liste des raccourci...
Procedure AjouteRaccourci(Racc:TRaccourci);
Var RaccData:PRaccourciData;
Begin
  New(RaccData);
  With RaccData^ Do
  Begin
    rdSuivant   := RaccourciDatas;
    rdRaccourci := Racc;
    FillChar(rdTouches,SizeOf(rdTouches),#0);
  End;
  RaccourciDatas:=RaccData;
End;

// ... et suppression
Procedure SupprimeRaccourci(Racc:TRaccourci);
Var RaccData:PRaccourciData;
Begin
  If RaccourciDatas=Nil Then Exit;
  RaccData:=RaccourciDatas;
  If RaccData^.rdRaccourci=Racc
  Then Begin
    RaccourciDatas:=RaccourciDatas^.rdSuivant;
    Dispose(RaccData);
  End
  Else Begin
    While (RaccData^.rdSuivant<>Nil)And(RaccData^.rdSuivant^.rdRaccourci<>Racc) Do RaccData:=RaccData^.rdSuivant;
    If (RaccData^.rdSuivant<>Nil)
    Then Begin
      RaccData^.rdSuivant:=RaccData^.rdSuivant^.rdSuivant;
      Dispose(RaccData^.rdSuivant);
    End;
  End;
  CalculTouchesATester;
End;

// Mise à jour de la liste des touches du raccourci en fonction des évolutions de celui-ci
Procedure CalculRaccourci(Racc:TRaccourci);
Var RaccData:PRaccourciData;
Begin
  If RaccourciDatas=Nil Then Exit;
  RaccData:=RaccourciDatas;
  While (RaccData^.rdSuivant<>Nil)And(RaccData^.rdRaccourci<>Racc) Do RaccData:=RaccData^.rdSuivant;
  If (RaccData^.rdRaccourci=Racc)
  Then With RaccData^ Do Begin
    FillChar(rdTouches,SizeOf(rdTouches),#0);
    rdTouches[Racc.FTouche1]:=True;
    rdTouches[Racc.FTouche2]:=True;
    rdTouches[Racc.FTouche3]:=True;
  End;
  CalculTouchesATester;
End;

//
// Composant TRaccourci
//

// Le contructeur...
Constructor TRaccourci.Create(AOwner:TComponent);
Begin
  Inherited Create(AOwner);
  AjouteRaccourci(Self);
  FDetecte          := False;
  FStyle            := srUneFois;
  FAction           := Nil;
  FOwnerActif       := True;
  FUneFois          := False;
End;

// ... et le destructeur
Destructor TRaccourci.Destroy;
Begin
  SupprimeRaccourci(Self);
  Inherited Destroy;
End;

// Mise à jour des touches
Procedure TRaccourci.SetTouche1(Valeur:TTouche);
Begin
  Valeur:=Valeur And $ff;
  If Valeur<>FTouche1
  Then Begin
    FTouche1:=Valeur;
    CalculRaccourci(Self);
  End;
End;

Procedure TRaccourci.SetTouche2(Valeur:TTouche);
Begin
  Valeur:=Valeur And $ff;
  If Valeur<>FTouche2
  Then Begin
    FTouche2:=Valeur;
    CalculRaccourci(Self);
  End;
End;

Procedure TRaccourci.SetTouche3(Valeur:TTouche);
Begin
  Valeur:=Valeur And $ff;
  If Valeur<>FTouche3
  Then Begin
    FTouche3:=Valeur;
    CalculRaccourci(Self);
  End;
End;

// Exécute les actions demandées sur apparition du raccourci
Procedure TRaccourci.FaitRaccourci;
Begin
  If       (Owner=Nil)
    Or Not FOwnerActif
    Or Not (Owner Is TControl)
    Or TControl(Owner).Visible
  Then Try
    FUneFois:=True;
    FDetecte:=True;
    If Assigned(FOnRaccourci) Then FOnRaccourci(Self);
    If Assigned(FAction)      Then FAction.Execute;
  Finally
    FUneFois:=False;
  End;
End;

// Est appelé par AppEventMaitre en cas de correspondance des touches
Procedure TRaccourci.TestRaccourci;
Begin
  Case FStyle Of
    srJamais      :FDetecte:=True;
    srNonDetecte  :If Not Detecte  Then FaitRaccourci;
    srUneFois     :If Not FUneFois Then FaitRaccourci;
    srToujours    :FaitRaccourci;
  End;
End;

// Enregistrement des classes créées
Procedure Register;
Begin
  RegisterPropertyEditor(TypeInfo(TTouche), Nil'', TToucheProperty);
  RegisterComponents('Exemples', [TRaccourci]);
End;

Initialization
  RegisterIntegerConsts(TypeInfo(TTouche), IdentToTouche, ToucheToIdent);
  RaccourciDatas:=Nil;
// Création du composant maitre, sans propriétaire
  AppEventMaitre:=TAppEventMaitre.Create(Nil);
Finalization
// Owner=Nil donc on doit le détruire nous même.
  AppEventMaitre.Free;
End.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Responsables bénévoles de la rubrique Delphi : Gilles Vasseur - Alcatîz -