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!
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.