Resizetool - classe permettant de redimensionner automatiquement les controles enfants d'un twincontrol

Soyez le premier à donner votre avis sur cette source.

Vue 6 510 fois - Téléchargée 406 fois

Télécharger le projet
Commenter

Description

Ben voila, c'est une petite Class qui permet de redimensionner automatiquement et proportionnelement tous les controles enfants d'un TWinControle, et leurs propres enfants s'il y a lieu, et ainsi de suite

Il n'y a pas de limite dans le nombre de parentées (enfants des enfants des enfants.... etc) car c'est une procedure recursive

Contrairement a d'autres outils qui font a peu pres la meme chose, il n'y a pas a implementer l'evenement OnResize du parent, c'est testé sur un timer, de meme pour la destruction de controles ou de Parents, donc la seule chose a faire c'est d'appeler la methode RegisterChildrenControls ou RegisterSingleControl

cette Class publie 2 methodes et 2 propriétés :
- Procedure RegisterChildrenControls(AParent : TWinControl; VertResize, HrzResize : Boolean)
Permet d'inscrire tous les controles enfants d'un TWinControl

- Procedure RegisterSingleControl(AControl : TControl; VertResize, HrzResize : Boolean)
Permet d'inscrire un controle seul

- property ResizeRealTime : Boolean read FResizeRealTime write SetResizeRealTime;
Definit si le Resize des controles est appliqué pendant tout le redimensionnement ou seulemet a la fin

- property CheckInterval : integer read FCheckInterval write SetCheckInterval default 100;
definit l'intervalle du Timer sur lequel on teste le redimensionnement des Parents

exemple inclus dans le zip

Source / Exemple :

unit uCustTools;
 
interface
 
uses Classes, Controls,ExtCtrls, forms ;
 
Type ControlProperties = Record
  Height, Width, Top, Left, ParentHeight, ParentWidth : integer;
  VertResize, HrzResize : Boolean;
  end;
 
Type ParentControlProperties = Record
  Height, Width : integer;
  Resizing : Boolean;
  end;
 

Type TResizeTool = class
  private

    FCheckInterval : Integer;
    FResizeRealTime: Boolean;
    Procedure SetCheckInterval(Value : Integer);
    procedure SetResizeRealTime(const Value: Boolean);

    procedure INIT;
    procedure RecursiveChildrenResize(AParent: TWinControl);
    procedure UnregControl(Sender : TObject);
    Procedure CheckParentResize(Sender : TObject);
    Procedure CleanControlTables;
    procedure CleanParentControlTable;
    Function ControlExists(AParent : TComponent; AControl : TControl) : Boolean;

  Published

    Procedure RegisterChildrenControls(AParent : TWinControl; VertResize, HrzResize : Boolean);
    Procedure RegisterSingleControl(AControl : TControl; VertResize, HrzResize : Boolean);


  public
    property ResizeRealTime : Boolean  read FResizeRealTime write SetResizeRealTime;
    property CheckInterval : integer read FCheckInterval write SetCheckInterval default 100;

  end;
 
Var
   ResizeTool : TResizeTool;
   
   FirstRun : Boolean = True;
   TableOfControls : Tlist;
   TableOfParentControls : TList;
   TableOfParentControlsProperties : Array of ParentControlProperties;
   TableOfControlsProperties : Array of ControlProperties;
   CheckTimer : TTimer;
 
 
 
implementation
 
uses SysUtils;
 
{ TResizeTool }
 
 
 
 
 
procedure TResizeTool.CheckParentResize(Sender: TObject);                  {On verifie si les ParentControls inscrits on été redimensionné (sur un timer)}
  var i : integer;
      AParent : TWinControl;
begin
  CheckTimer.Enabled := false;
  CleanParentControlTable;              
  CleanControlTables;                     {//| on va desinscrire les controles et les parents qui ont été supprimés}

  for i := 0 to TableOfParentControls.Count - 1 do
  begin
    AParent := TableOfParentControls[i];
    if TableOfParentControlsProperties[i].Resizing then
    begin
      if ResizeRealTime then RecursiveChildrenResize(AParent);       {si RealTime on applique le resize pendant le redimensionnement du parent}

                                                                     {Sinon on attend la fin du redimmensionnement du parent}

      if (AParent.Height = TableOfParentControlsProperties[i].Height) AND (AParent.Width = TableOfParentControlsProperties[i].Width) then
      begin
        RecursiveChildrenResize(AParent);
        TableOfParentControlsProperties[i].Resizing := False;
      end
      else
      begin
        TableOfParentControlsProperties[i].Height := AParent.Height;
        TableOfParentControlsProperties[i].Width := AParent.Width;
        TableOfParentControlsProperties[i].Resizing := true;
      end;
    end
    else
    begin
      if (AParent.Height <> TableOfParentControlsProperties[i].Height) or (AParent.Width <> TableOfParentControlsProperties[i].Width) then
      begin
        TableOfParentControlsProperties[i].Height := AParent.Height;
        TableOfParentControlsProperties[i].Width := AParent.Width;
        TableOfParentControlsProperties[i].Resizing := true;
      end;
    end;
  end;
  CheckTimer.Enabled  := True;
end;
 
procedure TResizeTool.CleanControlTables;
  var i : integer;
begin
  i := 0;
  while i < TableOfControls.count do             {On teste l'existence des controles dans l'application}
  begin
    if TableOfControls[i] <> nil then
    begin
      if not ControlExists((Application as TComponent), TableOfControls[i]) then
      begin
        UnregControl(TableOfControls[i]);       {Si le controle n'existe plus on le desinscrit}
        i := i - 1;
      end;
    end;
    i := i + 1
  end;
end;
 
procedure TResizeTool.CleanParentControlTable;
  var i,j : integer;
begin
  i := 0;
  while i < TableOfParentControls.count do        { on teste l'existence des ParentControls}
  begin
    if TableOfParentControls[i] <> nil then
    begin
      if not ControlExists((Application as TComponent), TableOfParentControls[i]) then
      begin
                                                  {Si le ParentControl n'existe plus on le desinscrit}

        for j := (i + 1) to length(TableOfParentControlsProperties) - 1 do
        begin
          TableOfParentControlsProperties[j - 1] := TableOfParentControlsProperties[j];
        end;
        SetLength(TableOfParentControlsProperties, length(TableOfParentControlsProperties) - 1);
        TableOfParentControls.Delete(i);
        i := i - 1;
      end;
    end;
    i := i + 1
  end;
 
end;
 
function TResizeTool.ControlExists(AParent : TComponent; AControl : TControl): Boolean;
  var i : integer;
begin                                           { Procedure recursive permettant de tester l'existence d'un controle dans l'application}

{$O-}                                            {pour un raison aussi mysterieuse qu'etrange, si on desactive pas la directive de compilation d'optimisation, delphi trouve quand meme des controles qui ont été detruits, donc ca provoque des violations d'acces, si quelqu'un a un explication????}
  for i := 0 to AParent.ComponentCount - 1 do
  begin
    if AParent.Components[i] = AControl then
    begin
      Result := True;
      Break;
    end
    else if ControlExists(AParent.Components[i],AControl) then
    begin
      Result := True;
      Break;
    end
    else
    begin
      Result := False;
    end;
 
  end;
 
end;
 
procedure TResizeTool.INIT;
begin                                          { creation et intialisation du timer permettant de tester le redimensionnement des ParentControl}
  ResizeRealTime := false;
  CheckTimer := TTimer.Create(nil);
  CheckInterval := 100;
  CheckTimer.OnTimer := CheckParentResize;
  CheckTimer.Enabled := True;
 

end;

procedure TResizeTool.RecursiveChildrenResize(AParent: TWinControl);
  var i : integer;
      index : Integer;
begin                                         {Procedure permettant de redimensionner les controles proportionellement par rapport a leur parent}

  for i := 0 to ((AParent as TWinControl).ControlCount - 1) do            {on balaye tous les controles enfants du parent}
  begin
    if TableOfParentControls.IndexOf(AParent) <> -1 then                        {si le Parent est inscrit dans TableOfParentControls}
    begin
      index := TableOfControls.IndexOf((AParent as TWinControl).Controls[i]);
      if index <> -1 then                                                       {et si le controle[i] est inscrit dans TableOfControls}
      begin
        if TableOfControlsProperties[index].HrzResize then                      {on applique le redimensionnement proportionnel horizontal si necessaire}
        begin
          (AParent as TWinControl).Controls[i].Width := round(TableOfControlsProperties[index].Width*AParent.Width/TableOfControlsProperties[index].ParentWidth);
          (AParent as TWinControl).Controls[i].Left := round(TableOfControlsProperties[index].Left*AParent.Width/TableOfControlsProperties[index].ParentWidth);
        end;
        if TableOfControlsProperties[index].VertResize then                     {et le redimensionnement proportionnel vertical si necessaire}
        begin
          (AParent as TWinControl).Controls[i].Height := round(TableOfControlsProperties[index].Height*AParent.Height/TableOfControlsProperties[index].ParentHeight);
          (AParent as TWinControl).Controls[i].Top := round(TableOfControlsProperties[index].Top*AParent.Height/TableOfControlsProperties[index].ParentHeight);
        end;
      end;
      if (AParent as TWinControl).Controls[i] is TWinControl then               { si le controle est un controle fenetré, il peut contenir d'autres controles}
      begin
        RecursiveChildrenResize((AParent as TWinControl).Controls[i] as TWinControl);   { alors on applique la procedure recursivement}
      end;
    end;
  end;
end;
 
procedure TResizeTool.RegisterChildrenControls(AParent : TWinControl; VertResize, HrzResize : Boolean);
  var i : integer;
      index : Integer;
      ParentIndex : integer;
 
                                { Procedure permettant d'inscrire les controles enfants d'un parent}
begin
 
  if AParent is TWinControl then   { on teste que le parent est bien un controle fenetré}
  begin
    for i := 0 to (AParent as TWinControl).ControlCount - 1 do                  { on balaye tous ses enfants}
    begin
      index := TableOfControls.IndexOf((AParent as TWinControl).Controls[i]);
      if index = -1 then
      begin
        index := TableOfControls.Add((AParent as TWinControl).Controls[i]);          { si le controle[i] n'existe pas dans TableOfControls on l'ajoute}
        SetLength(TableOfControlsProperties, length(TableOfControlsProperties) + 1);
 
        if TableOfParentControls.IndexOf(AParent) = -1 then
        begin                                                                        { si le parent de ce controle n'existe pas dans TableOfParentControls on l'ajoute}
          ParentIndex := TableOfParentControls.Add(AParent);
          SetLength(TableOfParentControlsProperties, length(TableOfParentControlsProperties) + 1);
          TableOfParentControlsProperties[ParentIndex].Height := AParent.Height;
          TableOfParentControlsProperties[ParentIndex].Width := AParent.Width;
          TableOfParentControlsProperties[ParentIndex].Resizing := false;
        end;
      end;

{ on memorise les propriétés de taille et de position du controle, les propriétés de taille du parent, et s'il faut effectuer le resize vertical et horizontal}

      TableOfControlsProperties[index].Top := (AParent as TWinControl).Controls[i].Top;          
      TableOfControlsProperties[index].Left := (AParent as TWinControl).Controls[i].Left;
      TableOfControlsProperties[index].Height := (AParent as TWinControl).Controls[i].Height;
      TableOfControlsProperties[index].Width := (AParent as TWinControl).Controls[i].Width;
      TableOfControlsProperties[index].ParentHeight := AParent.Height;
      TableOfControlsProperties[index].ParentWidth := AParent.Width;
      TableOfControlsProperties[index].VertResize := VertResize;
      TableOfControlsProperties[index].HrzResize := HrzResize;
      if (AParent as TWinControl).Controls[i] is TWinControl then                   { si le controle[i] est un controle fenetré, il peut contenir d'autres controles}
      begin
        RegisterChildrenControls(((AParent as TWinControl).Controls[i] as TWinControl), VertResize, HrzResize);   {alors on applique la procedure recursivement}
      end;
    end;
  end;
end;
 
procedure TResizeTool.RegisterSingleControl(AControl: TControl; VertResize,
  HrzResize: Boolean);
  var index : Integer;
      ParentIndex : integer;
begin                                                {Procedure permettant d'inscrire un controle seul}

    index := TableOfControls.IndexOf(AControl);
    if index = -1 then                                {si le controle n'existe pas dans TableOfControls on l'ajoute}
    begin
      index := TableOfControls.Add(AControl);
      SetLength(TableOfControlsProperties, length(TableOfControlsProperties) + 1);
 
      if TableOfParentControls.IndexOf(AControl.Parent) = -1 then
      begin
        ParentIndex := TableOfParentControls.Add(AControl.Parent);             { si le parent n'existe pas dans TableOfParentControls on l'ajoute}
        SetLength(TableOfParentControlsProperties, length(TableOfParentControlsProperties) + 1);
        TableOfParentControlsProperties[ParentIndex].Height := AControl.Parent.Height;
        TableOfParentControlsProperties[ParentIndex].Width := AControl.Parent.Width;
        TableOfParentControlsProperties[ParentIndex].Resizing := false;
      end;
    end;
 
{ on memorise les propriétés de taille et de position du controle, les propriétés de taille du parent, et s'il faut effectuer le resize vertical et horizontal}

    TableOfControlsProperties[index].Top := AControl.Top;                   
    TableOfControlsProperties[index].Left := AControl.Left;
    TableOfControlsProperties[index].Height := AControl.Height;
    TableOfControlsProperties[index].Width := AControl.Width;
    TableOfControlsProperties[index].ParentHeight := AControl.Parent.Height;
    TableOfControlsProperties[index].ParentWidth := AControl.Parent.Width;
    TableOfControlsProperties[index].VertResize := VertResize;
    TableOfControlsProperties[index].HrzResize := HrzResize;
 
end;
 
procedure TResizeTool.SetCheckInterval(Value: Integer);
begin
  FCheckInterval := Value;
  CheckTimer.Interval := FCheckInterval;
end;

procedure TResizeTool.SetResizeRealTime(const Value: Boolean);
begin
  FResizeRealTime := Value;
end;

procedure TResizeTool.UnregControl(Sender: TObject);
  var i : integer;                  {procedure permettant de desinscrire un controle}
begin
  if TableOfControls.IndexOf(Sender) <> -1 then
  begin
    for i := (TableOfControls.IndexOf(Sender) + 1) to length(TableOfControlsProperties) - 1 do
    begin
      TableOfControlsProperties[i - 1] := TableOfControlsProperties[i];
    end;
    SetLength(TableOfControlsProperties, length(TableOfControlsProperties) - 1);
    TableOfControls.Delete(TableOfControls.IndexOf(Sender))
  end;
end;
 
initialization
  ResizeTool := TResizeTool.Create;
  TableOfControls := TList.Create;
  TableOfParentControls := TList.Create;
 
  ResizeTool.INIT;
 
finalization
  FreeAndNil(TableOfControls);
  FreeAndNil(TableOfParentControls);
  FreeAndNil(ResizeTool);
 
end.

Conclusion :

Ben voila, c'est la premiere source que je met!
Alors si vous avez des remarques, des suggestions, ou si vous trouvez des bugs, dites moi le!
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaire

Signaler
ni69
Messages postés
1418
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
5 juillet 2010
 9 -
Salut, voici une petite amélioration à apporter : la modification de la police lors de l'agrandissement ou de la réduction des composants

@+
Nico
S'inscrire maintenant

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.

Du même auteur (cs_saib)