ANIMER UNE FORM (REDIMENTIONNEMENT) OUVERTURE/FERMETURE MENU COMME UNE PORTE
cs_Delphiprog
Messages postés
4297
Date d'inscription
samedi 19 janvier 2002
Statut
Membre
Dernière intervention
9 janvier 2013
-
7 mai 2004 à 22:04
lola_fleur Messages postés 1 Date d'inscription vendredi 28 juillet 2006 Statut Membre Dernière intervention 1 octobre 2006 - 1 oct. 2006 à 05:37
lola_fleur Messages postés 1 Date d'inscription vendredi 28 juillet 2006 Statut Membre Dernière intervention 1 octobre 2006 - 1 oct. 2006 à 05:37
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/22610-animer-une-form-redimentionnement-ouverture-fermeture-menu-comme-une-porte
https://codes-sources.commentcamarche.net/source/22610-animer-une-form-redimentionnement-ouverture-fermeture-menu-comme-une-porte
1 oct. 2006 à 05:37
8 mai 2004 à 17:17
ton code à l'origine etait stable dans son utilisation ressources, c'est à dire debutait à 5% utilisation processeur et atteint les 30% d'une façon stable (à un interval constant).
quand j'ai désactivé l'apel à ProcessMessages, la variation du processeur est devenu brusque, et a comencé à 20% et fini à 24% d'une façon instantané (en notant aussi que le contenu de la form ne saffiche que lorsque le XoR ait fini son travail, est qui est logique).
ça me parrait unpeu logique cette attitude, par contre je reste confus, car je me demande si le timer n'a pas une optimisation spéciale pour une utilisation briève sous Delphi...
cependant, je rajoutte aussi que si je ne desactive pas le Timer après qu'il ait fini son code, l'attitude des ressources reste la meme! comme quoi, le timer n'est gourmand que lorsqu'il execute un code et non pas lorsqu'il est actif...
en tout cas je vous remercie tous les 2 pour vos explications assez constructifs pour un code assez simple et basique ;)
8 mai 2004 à 13:55
exemple (pure api histoire de corser le truc !)
Program Fenanim ;
{$APPTYPE GUI}
Uses Windows, messages;
Var WinClass: WndClass;
Inst: HINST;
hWindow: HWND;
hbutton: HWND;
TheMessage: Msg;
Windowwidth,windowheigth, windowx,windowy : integer ;
Tag : boolean;
const
MinWidth = 300;
MaxWidth = 546;
procedure windowmetrics;
var
Pl : TWindowPlacement;
R: TRect;
begin
Pl.Length := SizeOf(TWindowPlacement);
GetWindowPlacement(hwindow, @Pl);
R := Pl.rcNormalPosition;
WindowWidth := R.Right-R.Left;
WindowHeigth := R.Bottom-R.Top;
WindowX := R.Left;
WindowY := R.Top;
end;
procedure toto;
begin
if tag = false then begin
if windowwidth < maxwidth then
begin
windowwidth := windowwidth+2;
movewindow(hwindow, Windowx, Windowy, Windowwidth, Windowheigth, true);
end
else
begin
tag:= not(tag);
SendMessage(hbutton,WM_SETTEXT, 0, lParam(pChar('<<<<')));
killtimer(hwindow,1);
end;
end
else
if windowwidth > minwidth then
begin
windowwidth := windowwidth-2;
movewindow(hwindow, Windowx, Windowy, Windowwidth, Windowheigth, true);
end
else
begin
killtimer(hwindow,1);
tag:= not(tag);
SendMessage(hbutton,WM_SETTEXT, 0, lParam(pChar('>>>>')));
end;
end;
function WindowProc(hWindow: HWnd; Message,wParam,lParam: Integer): Integer; stdcall;
begin
Result := 0;
case Message of
WM_CREATE:
begin
tag:= false;
end;
WM_TIMER:
begin
toto;
end;
WM_DESTROY:
begin
postquitmessage(0);
end;
WM_COMMAND:
begin
if HWND(lParam) = hbutton then begin
Windowmetrics;
Settimer(hwindow,1,2,nil);
end;
end;
else
Result := DefWindowProc(hWindow, Message, wParam, lParam);
end;
end;
begin
Inst := hInstance;
with WinClass do
begin
style := cs_hRedraw Or cs_vRedraw;
lpfnWndProc := @WindowProc;
hInstance := Inst;
hbrBackground := color_btnface + 1;
lpszClassname := 'MyWindowClass';
hIcon := LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
end;
RegisterClass(WinClass);
hWindow :=CreateWindowEx(WS_EX_WINDOWEDGE, 'MyWindowClass','Et hop !',
WS_OVERLAPPEDWINDOW or WS_VISIBLE,
190,128,545,426,0, 0, Inst, nil);
Hbutton := CreateWindow('Button','>>>>',WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT or WS_TABSTOP,
100,16,75,25, hWindow, 0, Inst, nil);
UpdateWindow(hWindow);
while GetMessage(TheMessage,0,0,0) do begin
if not IsDialogMessage(hWindow,TheMessage) then begin
TranslateMessage(TheMessage);
DispatchMessage(TheMessage);
end;
end;
end.
see ya
Clan
8 mai 2004 à 09:05
procedure TForm1.Button2Click(Sender: TObject);
var
Test1: integer;
Test2: longint;
Test3: int64;
T1, T2, T3, T4, T5: DWord;
b: boolean;
i: integer;
const
NbTests = 10000000;
begin
//initialisations
Test1 := 0;
Test2 := 0;
Test3 := 0;
//Test sur les entiers
T1 := GetTickCount;
for i := 0 to NbTests do
Test1 := Test1 xor 1;
T1 := GetTickCount - T1;
//Test sur les longint
T2 := GetTickCount;
for i := 0 to NbTests do
Test2 := Test2 xor 1;
T2 := GetTickCount - T2;
//Test sur les Int64
T3 := GetTickCount;
for i := 0 to NbTests do
Test3 := Test3 xor 1;
T3 := GetTickCount - T3;
T4 := GetTickCount;
for i := 0 to NbTests do
Tag := Tag xor 1;
T4 := GetTickCount - T4;
T5 := GetTickCount;
for i := 0 to NbTests do
b := b xor true;
T5 := GetTickCount - T5;
//Affichage des résultats
Refresh;
Canvas.TextOut(10, 10, 'Test entier : ' + IntToStr(T1));
Canvas.TextOut(10, 30, 'Test longint : ' + IntToStr(T2));
Canvas.TextOut(10, 50, 'Test Int64 : ' + IntToStr(T3));
Canvas.TextOut(10, 70, 'Test Tag : ' + IntToStr(T4));
Canvas.TextOut(10, 90, 'Test boolean : ' + IntToStr(T5));
end;
Constatations :
1- Il apparait que les Int64 et l'affectation de la propriété Tag sont pénalisés dans ce type d'opération avec un facteur de performance divisé par 10 environ (sur 10 millions d'opérations, tout de même).
Si on peut admettre que les processeurs 32 bits aient du mal à traiter des entiers 64 bits, en revanche, on a du mal à s'expliquer l'écart constaté entre les Longint et la propriété Tag (pourtant de type Longint aussi). Cela est probablement dû à un temps de lecture de la VMT pour trouver l'adresse de la méthode à utiliser pour affecter une propriété. Encore que, dans le cas de la propriété Tag, on accède directement à la zone de stockage en mode écriture.
2- Occupation du processeur : le moniteur utilisé (System Mechanic 4 pro) n'enregistre pas de variation significative quelque soient les opérations réalisées avec le code ci-dessus.
Et j'insiste sur le fait que j'ai dû pousser le nombre d'affectations à 10 millions pour obtenir des écarts visibles.
Alors, une petite boucle de 200 affectations dans le cas de ton code source ne devrait pas entrainer de dégradations visible.
A ce stade, comme nous ne manipulons que des entiers, le type de processeur ne devrait pas jouer (Pentium IV ou autres).
Ce qui peut faire la différence entre nos deux codes, ce sont les appels à Application.ProcessMessages qui obligent Windows à traiter les messages en attente et donc à pratiquer de fréquents basculements de l'état des registres. Le type et la quantité de mémoire cache installée sur ta machine peut creuser un écart.
Peux-tu réessayer le premier code que j'ai donné en désactivant ces appels à Application.ProcessMessages et nous indiquer si tu constates toujours une occupation du processeur supérieure de 20 à 30 % ?
8 mai 2004 à 09:04
Meme si processmessage permet de continuer à envoyer les autres messages à l'application sans la geler, le processeur est très solicité...
Pour t'en convaincre, crée une application avec une commande sleep (10000) liée au click sur un bouton et regardes en direct evoluer les ressources de ton processeur...
C'est très parlant....
Clandestino
7 mai 2004 à 23:01
j'avais pensé à ta solution en utilisant un XoR, mais je me suis dit que les ordis d'aurjoud'hui sont assez puissant pour décider de ne pas mettre des timers.
par contre j'aimerai te demander un truc, j'ai remarqué en utilisant le XoR (plus précisement ta méthode) l'utilisation du processeur atteint les 30% (entre 20% et 30%)
tandis qu'en utilisant un timer, l'utilisation processeur ne dépasse pas les 10%.
j'ai quand meme un Barton 2800+ qui est loin d'etre faible, donc je me demandais pourquoi cette difference?
car je sais que les timers sont gourmands, mais ce cas là me rend confus :?
Merci pour une explication si disponible
7 mai 2004 à 22:04
Il existe cependant une solution simple qui ne les utilise pas :
procedure TForm1.Button1Click(Sender: TObject);
const
MinWidth = 346;
MaxWidth = 480;
begin
Button1.Tag := Button1.Tag xor 1;
if Button1.Tag = 0 then
begin
while Width > MinWidth do
begin
Width := Width - 2;
Application.ProcessMessages;
Sleep(2);
end;
button1.Caption := '-->';
end
else
begin
while Width < MaxWidth do
begin
Width := Width + 2;
Application.ProcessMessages;
Sleep(2);
end;
button1.Caption := '<--';
end;
end;
L'effet produit est le même.