Animer une form (redimentionnement) ouverture/fermeture menu comme une porte

Soyez le premier à donner votre avis sur cette source.

Vue 5 758 fois - Téléchargée 1 007 fois

Description

ce code n'est pas dur à réaliser, mais je pense que ça peut amener à certaines personnes une idée pour animer et donner un look sympa à une form sans encombrer la fenetre et sans ke l'utilisateur puisse changer la taille.

Conclusion :


je me suis inspiré d'un logiciel que j'ai qui fait ça, et j'ai trouvé ça original, c'est pour ça je l'ai fait sous delphi.

soyez imaginatifs, le code n'est pas dur à comprendre

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
1
Date d'inscription
vendredi 28 juillet 2006
Statut
Membre
Dernière intervention
1 octobre 2006

salut tt le monde j'ai besoin d'un code qui me fixe la eur de l'agrandir)merci c urgent
Messages postés
44
Date d'inscription
mercredi 23 juillet 2003
Statut
Membre
Dernière intervention
13 décembre 2004

suite à ta demande Delphiprog, j'ai re-testé ton code en commentant Application.ProcessMessages et j'ai eu un resultat similaire, mais different dans sont attitude:

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 ;)
Messages postés
16
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
11 novembre 2004

Et pourquoi ne pas simplement utiliser un boolean nommé tag et la fonction tag := not(tag) ....

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
Messages postés
4580
Date d'inscription
samedi 19 janvier 2002
Statut
Modérateur
Dernière intervention
9 janvier 2013
28
Ta question a suscité ma curiosité et je me suis livré à un petit test comparatif :
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 % ?
Messages postés
16
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
11 novembre 2004

Sauf erreur de ma part, je pense que ce qui mange des ressources processeur dans l'exemple de delphiprog, c'est tout simplement la fonction sleep, qui n'est pas du tout une commande demandant de ne rien faire, mais en réalité une commande de boucle qui mange du processeur pendant le temps demandé...
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
Afficher les 7 commentaires

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.