|
PRÉSENTATION :
Composant permettant de gérer des raccourcis quelconques au niveau de l'application.
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: String; Var Touche: Longint): Boolean;
Procedure Register;
Implementation
// Définition compémentaire du type TTouche
Const
Touches: Array[0..137] Of 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: String; Var 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.
|
| |
