Gestion de l'accès au mdichild à l'aide d'onglet

Soyez le premier à donner votre avis sur cette source.

Vue 6 080 fois - Téléchargée 750 fois

Description

Après avoir pas mal chercher comment gérer l'accès par onglet aux écrans MDIChild d'une application sans avoir à rajouter du code sur chaque MDIChild créé, je vous montre un prototype de ce que j'ai fait.

Je me suis inspiré de sources présentent sur le net (j'ai mis les références dans le Main.pas du projet).

Dans la source on aborde les points suivants :
1- Création de classe
2- Création d'événement
3- Création de type
4- Comment accrocher sa propre procédure d'event en runtime sans perdre
le lien avec la procédure existant avant
5- Enregistrement d'objet dans un TSTringList et utilisation de ces derniers
6- Gestion Drag & Drop
7- Définition de constructeur
etc...

Bref on s'amuse et en plus c'est utile (enfin je l'espère).

Source / Exemple :


{
  AVERTISSEMENT !!
    Ce code est donné tel quel et il peut sans doute être amélioré et/ou contenir des BUGS.

  Sources d'inspiration
  ---------------------
      > Composante  TdsTaskBar trouvée sur le site www.torry.net

      > Article de Zarko Gajic (en anglais) sur le site delphi.about.com
            http://delphi.about.com/od/delphitips2009/qt/delphi-mdi-child-prevent-on-create-resize-animation.htm

  Création :
  --------
      > 27-10-2009 : Création du projet

  Modifications :
  -------------
      > 28-10-2009 : 1 - Remet la procédure d'origine WindowProc du Form à la Destruction
                         de l'objet TMDILink (cf Destructor)

                     2 - Auto destruction de l'objet TMDILink si le form qui lui est lié est détruit
}

unit MAIN;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
     StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
     ActnList, ToolWin, ImgList, Tabs, cfOptionsList;

type
  { On défini nos événements sur le MDIChild }
  TMDIChangeOp = (mdiCaption, mdiDestroy);

  { On défini notre propre struture d'Event }
  TOnMDIChange = procedure(aForm: TForm; aTabIndex: Integer;
    aMDIChangeOp: TMDIChangeOp) of object;

  { **************************************************************

  • Cet objet va nous permettre d'identifier de manière unique *
  • 1 - un MDIChild *
  • 2 - les message qui en arrivent *
  • 3 - la procédure WindowProc d'origine du MDIChild *
                                                                                                                            • }
TMDILink = Class(TObject) private fForm : TForm; fTabIndex : Integer; fOldFormWindowProc : TWndMethod; fOnMDIChange : TOnMDIChange; procedure MonWindowProc(var Message: TMessage); // Ma propre Procédure WindowProc procedure SetTabIndex(const Value: Integer); public constructor Create(aForm: TForm; aTabIndex : Integer); destructor Destroy; override; property Form : TForm read fForm; property TabIndex : Integer read fTabIndex write SetTabIndex; property OnMDIChange : TOnMDIChange read fOnMDIChange write fOnMDIChange; end; TMainForm = class(TForm) MainMenu1: TMainMenu; File1: TMenuItem; FileNewItem: TMenuItem; FileOpenItem: TMenuItem; FileCloseItem: TMenuItem; Window1: TMenuItem; Help1: TMenuItem; N1: TMenuItem; FileExitItem: TMenuItem; WindowCascadeItem: TMenuItem; WindowTileItem: TMenuItem; WindowArrangeItem: TMenuItem; HelpAboutItem: TMenuItem; OpenDialog: TOpenDialog; FileSaveItem: TMenuItem; FileSaveAsItem: TMenuItem; Edit1: TMenuItem; CutItem: TMenuItem; CopyItem: TMenuItem; PasteItem: TMenuItem; WindowMinimizeItem: TMenuItem; StatusBar: TStatusBar; ActionList1: TActionList; EditCut1: TEditCut; EditCopy1: TEditCopy; EditPaste1: TEditPaste; FileNew1: TAction; FileSave1: TAction; FileExit1: TAction; FileOpen1: TAction; FileSaveAs1: TAction; WindowCascade1: TWindowCascade; WindowTileHorizontal1: TWindowTileHorizontal; WindowArrangeAll1: TWindowArrange; WindowMinimizeAll1: TWindowMinimizeAll; HelpAbout1: TAction; FileClose1: TWindowClose; WindowTileVertical1: TWindowTileVertical; WindowTileItem2: TMenuItem; ToolBar2: TToolBar; ToolButton1: TToolButton; ToolButton2: TToolButton; ToolButton3: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; ToolButton6: TToolButton; ToolButton9: TToolButton; ToolButton7: TToolButton; ToolButton8: TToolButton; ToolButton10: TToolButton; ToolButton11: TToolButton; ImageList1: TImageList; tsMDIList: TTabSet; actOuvreMonEcran: TAction; actMonEcranMonConstruteur: TAction; N2: TMenuItem; OuvrelcrandeTest1: TMenuItem; OuvrelcrandeTestavecnotreconstructeur1: TMenuItem; procedure FileNew1Execute(Sender: TObject); procedure FileOpen1Execute(Sender: TObject); procedure HelpAbout1Execute(Sender: TObject); procedure FileExit1Execute(Sender: TObject); procedure FormCreate(Sender: TObject); procedure tsMDIListChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); procedure tsMDIListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure tsMDIListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure tsMDIListDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure tsMDIListDragDrop(Sender, Source: TObject; X, Y: Integer); procedure actOuvreMonEcranExecute(Sender: TObject); procedure actMonEcranMonConstruteurExecute(Sender: TObject); private { Déclarations privées } fOldActiveFormChange : TNotifyEvent; // Garde le lien avec l'evénement actuel procedure CreateMDIChild(const Name: string); procedure MonActiveFormChange(Sender: TObject); // Mon propre événement procedure MyMDIChange(aForm: TForm; aTabIndex: Integer; aMDIChangeOp: TMDIChangeOp); public { Déclarations publiques } end; var MainForm: TMainForm; implementation {$R *.dfm} uses CHILDWIN, about, FileCtrl, foEcranTestU; procedure TMainForm.CreateMDIChild(const Name: string); var Child: TMDIChild; begin { crée une nouvelle fenêtre enfant MDI } Child := TMDIChild.Create(Application); Child.Caption := Name; if FileExists(Name) then Child.Memo1.Lines.LoadFromFile(Name); end; procedure TMainForm.FileNew1Execute(Sender: TObject); begin CreateMDIChild('NONAME' + IntToStr(MDIChildCount + 1)); end; procedure TMainForm.FileOpen1Execute(Sender: TObject); begin if OpenDialog.Execute then CreateMDIChild(OpenDialog.FileName); end; procedure TMainForm.HelpAbout1Execute(Sender: TObject); begin AboutBox.ShowModal; end; procedure TMainForm.FileExit1Execute(Sender: TObject); begin Close; end; procedure TMainForm.FormCreate(Sender: TObject); begin { *************************************************************************
  • Pour détecter les nouvelles MDI Child Créer et le changement d'écran, *
  • on détourne l'événement OnActiveFormChange de l'objet Screen *
                                                                                                                                                  • }
{ 1 - On garde le lien vers l'événement actuel pour le rappeler ensuite } fOldActiveFormChange := Screen.OnActiveFormChange; { 2 - On affecte notre propre procédure à lévénement } Screen.OnActiveFormChange := MonActiveFormChange; { ** Initialise le TabSet ** } tsMDIList.Tabs.Clear; // Efface tous les Tab en cours tsMDIList.Visible := False; // Masque le TabSet end; procedure TMainForm.MonActiveFormChange(Sender: TObject); var i : Integer; F : TForm; TmpMDILink : TMDILink; begin { On Récupère le nouveau Form Actif } F := Screen.ActiveForm; { On ne traite que les Form de Type MDIChild } if (Assigned(F)) and // Vérifie que'il y a bien un Form actif (F.FormStyle = fsMDIChild) then // Vérifie que c'est bien un MDIChild begin { Initialise la Variable } i := 0; { Recherche si le form a déjà été détecté } while (i < tsMDIList.Tabs.Count) and (tsMDIList.Tabs.Objects[i] <> Nil) and (tsMDIList.Tabs.Objects[i] is TMDILink) and (TMDILink(tsMDIList.Tabs.Objects[i]).Form <> F) do inc(i); { Vérifie si le Form a été trouvé /!\ les index de Tab comme à 0 donc si i = Tabs.Count j'ai dépassé le dernier Tab } if (i = tsMDIList.Tabs.Count) then begin { Crée un Tab avec le caption du Form } i := tsMDIList.Tabs.Add(F.Caption); { Crée l'objet MDILink pour garder le lien avec le MDIChild } TmpMDILink := TMDILink.Create(F, i); { Affecte l'evénement en cas de changement sur MDIChild } TmpMDILink.OnMDIChange := MyMDIChange; { Affecte le TMDILink comme objet du Tab } tsMDIList.Tabs.Objects[i] := TmpMDILink; { Sélectionne le Nouveau Tab comme Tab Actif } tsMDIList.TabIndex := i; end else { Le form a été trouvé - on sélécetionne le Tab qui lui est associé } tsMDIList.TabIndex := i; { On s'assure que le TabSet est visible dés qu'il a au moins un Tab de créé } tsMDIList.Visible := (tsMDIList.Tabs.Count > 0); end; { On appel l'événement qu'il y avait avant le notre } if (Assigned(fOldActiveFormChange)) then // On vérifie tout de même qu'il y avait bien un Evénement avant le notre fOldActiveFormChange(Sender); end; { TMDILink } constructor TMDILink.Create(aForm: TForm; aTabIndex : Integer); begin { Vérifie qu'on a bien Form en entrée } if (aForm = Nil) then Raise Exception.Create('Le Form ne peut-être Null'); { Garde le Form en Mémoire } fForm := aForm; { Garde l'ancienne WindowProc en Mémoire } fOldFormWindowProc := Form.WindowProc; { Affecte la Nouvelle Procédure } Form.WindowProc := MonWindowProc; { Garde l'index du Tab correspondant } SetTabIndex(aTabIndex); { Initialise les Events } fOnMDIChange := Nil; end; destructor TMDILink.Destroy; begin { Remet la procedure WindowProc d'origine } if (Assigned(fOldFormWindowProc)) then Form.WindowProc := fOldFormWindowProc; inherited; end; procedure TMDILink.MonWindowProc(var Message: TMessage); begin { Appel l'ancienne Procédure du Form } fOldFormWindowProc(Message); { Détecte le Type de Changement } case Message.Msg of { Changement du caption } WM_SETTEXT: if (Assigned(fOnMDIChange)) then fOnMDIChange(Form, TabIndex, mdiCaption); { Destruction de la Fenêtre } WM_DESTROY: begin { Exécute l'événement OnMDICHange } if (Assigned(fOnMDIChange)) then fOnMDIChange(Form, TabIndex, mdiDestroy); { S'auto-détruit car cet objet n'a plus lieu d'être } Self.Free; end; { WM_DESTROY } end; end; procedure TMDILink.SetTabIndex(const Value: Integer); begin { Garde l'index dans localement à l'objet } fTabIndex := Value; end; procedure TMainForm.MyMDIChange(aForm: TForm; aTabIndex: Integer; aMDIChangeOp: TMDIChangeOp); var i : Integer; begin { Met à jour les TabSet en fonction du Changement du MDIChild } case aMDIChangeOp of { Changement de Caption - Et réduit les noms de fichier trop long } mdiCaption : begin { Vérifie qu'il s'agisse bien d'un nom de fichier } if (ExtractFileDrive(aForm.Caption) <> '') then tsMDIList.Tabs[aTabIndex] := MinimizeName(aForm.Caption, Self.Canvas, 250) else tsMDIList.Tabs[aTabIndex] := aForm.Caption; end; { Destruction de la Fenêtre } mdiDestroy : begin { Efface le Tab associé au Form } tsMDIList.Tabs.Delete(aTabIndex); { Remet à jour les Index des MDILink } for i := aTabIndex to tsMDIList.Tabs.Count - 1 do begin if (tsMDIList.Tabs.Objects[i] <> Nil) and (tsMDIList.Tabs.Objects[i] is TMDILink) then TMDILink(tsMDIList.Tabs.Objects[i]).TabIndex := i; end; { for i := aTabIndex to tsMDIList.Tabs.Count - 1 do... } { Masque le TabSet s'il n'y a plus de Tab } tsMDIList.Visible := (tsMDIList.Tabs.Count > 0); end; { mdiDestroy } end; end; procedure TMainForm.tsMDIListChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); begin { Si aucun Tab Sélectionné, ne Fait rien } if (NewTab = -1) then Exit; { Vérifie qu'il y a bien un TMDILink et un Form associé à ce Tab } if (tsMDIList.Tabs.Objects[NewTab] is TMDILink) and (TMDILink(tsMDIList.Tabs.Objects[NewTab]).Form <> Nil) then begin { /!\ ** D'après un article de Zarko Gajic sur delphi.about.com ** évite les animation pour l'affichage du Child s'il est Minimize} SendMessage(ClientHandle, WM_SETREDRAW, 0, 0) ; try with (TMDILink(tsMDIList.Tabs.Objects[NewTab]).Form) do begin { Donne le Focus au Form } SetFocus; { Amène le Form devant } BringToFront; { Si le Form est minimisé, rétabli le Form } if WindowState = wsMinimized then WindowState := wsNormal; //OldWindowState; end; { with (TMDILink(tsMDIList.Tabs.Objects[NewTab]).Form) do... } finally { Relance le Dessin du MainForm pour voir les changements } SendMessage(ClientHandle, WM_SETREDRAW, 1, 0) ; { Para rapport à l'article j'ai ajouté le Flag RDW_ERASE qui manquait } RedrawWindow(ClientHandle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE or RDW_ALLCHILDREN or RDW_NOINTERNALPAINT) end; end; { if (tsMDIList.Tabs.Objects[NewTab] is TMDILink) and (TMDILink(tsMDIList.Tabs.Objects[NewTab]).Form <> Nil) then... } end; procedure TMainForm.tsMDIListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin { Prépare le Mode Drag&Drop a démarrer dés que la souris est bougée } if (ssLeft in Shift) then tsMDIList.BeginDrag(False); end; procedure TMainForm.tsMDIListMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin { Stopppe le mode Drag&Drop si il est activé } if (tsMDIList.Dragging) then tsMDIList.EndDrag(True); end; procedure TMainForm.tsMDIListDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin { Accepte le Drag&Drop si : } Accept := (Sender = Source) and // sur le même Composant (tsMDIList.ItemAtPos(Point(X, Y)) > -1) and // un tab est détecté sous la souris (tsMDIList.ItemAtPos(Point(X, Y)) <> tsMDIList.TabIndex); // la futur position n'est pas la mêmeque la position actuelle end; procedure TMainForm.tsMDIListDragDrop(Sender, Source: TObject; X, Y: Integer); var i : Integer; begin { Récupère l'index du Tab sous la souris } i := tsMDIList.ItemAtPos(Point(X, Y)); { Déplace le Tab vers sa nouvelle place si un tab a été détecté sous la souris } if (i > -1) then begin { Place l'onglet courant à la place de celui sous la souris } tsMDIList.Tabs.Move(tsMDIList.TabIndex, i); { Vérifie que l'onglet déplacé est toujours l'onglet actif } tsMDIList.TabIndex := i; { Remet à jour les Index des MDILink } for i := 0 to tsMDIList.Tabs.Count - 1 do TMDILink(tsMDIList.Tabs.Objects[i]).TabIndex := i; end; { if (i > -1) then... } end; procedure TMainForm.actOuvreMonEcranExecute(Sender: TObject); begin { Création du MDIChild avec le constructeur par défaut } TfoEcranTest.Create(Self); end; procedure TMainForm.actMonEcranMonConstruteurExecute(Sender: TObject); begin { Création du MDIChild avec le constructeur qu'on a implémenté } TfoEcranTest.MonCreate(Self, FormatDateTime('dd/mm/YYYY HH:MM:SS', Now)); end; end.

Conclusion :


Pour aller plus loin on pourrais en faire une composante réutilisable mais je ne sais pas si j'irais jusque là.

Cette source est ma première donc merci de votre indulgence et je pense l'avoir pas mal commentée.

Amicalement

Codes Sources

A voir également

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.