Soyez le premier à donner votre avis sur cette source.
Vue 6 856 fois - Téléchargée 435 fois
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.
9 nov. 2005 à 09:04
@+
Nico
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.