TRIUMVIRAT
cs_cantador
Messages postés
4720
Date d'inscription
dimanche 26 février 2006
Statut
Modérateur
Dernière intervention
31 juillet 2021
-
24 déc. 2006 à 16:57
cincap Messages postés 460 Date d'inscription dimanche 5 décembre 2004 Statut Membre Dernière intervention 6 avril 2009 - 12 janv. 2011 à 16:16
cincap Messages postés 460 Date d'inscription dimanche 5 décembre 2004 Statut Membre Dernière intervention 6 avril 2009 - 12 janv. 2011 à 16:16
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/40845-triumvirat
https://codes-sources.commentcamarche.net/source/40845-triumvirat
12 janv. 2011 à 16:16
@ Cantador, parceque c'est ta source et que je n'ai pas trouvé le moyen de déposer un zip.
@+,
Cincap
12 janv. 2011 à 15:21
Pourquoi ne pas déposer cette source ?
cordialement
7 janv. 2011 à 11:30
Voici un effet de neige tombante adapter à la source de Cantador que je salue au passage.
Le background passe par un Timage et est resizé en tenant compte de la résolution de l'écran.
Il y a certainement des améliorations à faire je n'en doute pas.
Un petit bitmap représentant un flocon de neige est nécessaire.
{TriumVirat par cantador}
unit Unitanimation;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, Math, Spin;
type
TFTriumvirat = class(TForm)
Timer1: TTimer;
LBDelphiProg: TLabel;
LBFoxi: TLabel;
LBCirec: TLabel;
edlargeur: TSpinEdit;
edhauteur: TSpinEdit;
Image1: TImage;
PaintBox1: TPaintBox;
Panel1: TPanel;
Button1: TButton;
Label1: TLabel;
Edit1: TEdit;
TrackBar1: TTrackBar;
CheckBox1: TCheckBox;
ImaFloc: TImage;
Timer2: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
end;
var
FTriumvirat: TFTriumvirat;
BmpImage1, BmpImage2, BmpImage3, BmpFond, BmpInvisible: TBitmap;
W, H: integer;
NewRect1, OldRect1, NewRect2, OldRect2, NewRect3, OldRect3: TRect;
X1, Y1, X2, Y2, X3, Y3: integer;
xx1, yy1, xx2, yy2, xx3, yy3, vx1, vy1, vx2, vy2, vx3, vy3: single;
UnionR: Trect;
implementation
{$R *.DFM}
Const
MaxFloc = 100;
Vent: TPoint = (X: -4; Y: 10);
ZoomRatio: Array[1..20] Of Byte =
(2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 7, 8, 9, 10);
Type
TFloc = Class
FIma: TBitmap;
Zoom: Integer;
PosX: Single;
PosY: Single;
RIma: TRect;
Constructor Create;
Procedure MoveIt;
End;
Var
AFloc: Array[1..MaxFloc] Of TFloc;
{----------------------------------------------------------------}
{ Création d'un flocon }
{----------------------------------------------------------------}
Constructor TFloc.Create;
Begin
Zoom := ZoomRatio[RandomRange(1, 20)];
FIma := TBitmap.Create;
FIma.Width := Round(FTriumvirat.ImaFloc.Width * (Zoom / 100));
FIma.Height := Round(FTriumvirat.ImaFloc.Height * (Zoom / 100));
FIma.PixelFormat := pf24bit;
FIma.Transparent := True;
FIma.Canvas.StretchDraw(FIma.Canvas.ClipRect, FTriumvirat.ImaFloc.Picture.Bitmap);
PosY := RandomRange(0, FTriumvirat.ClientHeight);
PosX := RandomRange(0, FTriumvirat.ClientWidth);
RIma.Left := Round(PosX);
RIma.Top := Round(PosY);
RIma.Right := RIma.Left + FIma.Width;
RIma.Bottom := RIma.Top + FIma.Height;
End;
{----------------------------------------------------------------}
{ Restaure, déplace et déssine un flocon }
{----------------------------------------------------------------}
Procedure TFloc.MoveIt;
Begin
FTriumvirat.Canvas.CopyRect(RIma, FTriumvirat.ImaFloc.Picture.Bitmap.Canvas, RIma);
PosX := PosX + ((Vent.X * RandomRange(3, 5 * Zoom)) / 30);
PosY := PosY + ((Vent.Y * RandomRange(3, 5 * Zoom)) / 30);
RIma.Left := Round(PosX);
RIma.Top := Round(PosY);
RIma.Right := RIma.Left + FIma.Width;
RIma.Bottom := RIma.Top + FIma.Height;
FTriumvirat.Canvas.StretchDraw(RIma, FIma);
If (PosY > FTriumvirat.ClientHeight) And (Vent.Y > 0) Then
Begin
PosX := RandomRange(0, FTriumvirat.ClientWidth);
PosY := -FIma.Height;
End
ELse
If (PosY < FIma.Height) And (Vent.Y < 0) Then
Begin
PosX := RandomRange(0, FTriumvirat.ClientWidth);
PosY := FTriumvirat.ClientHeight;
End;
If (PosX > FTriumvirat.ClientWidth) And (Vent.X > 0) Then
PosX := -FIma.Width
Else
If (PosX < FIma.Width) And (Vent.X < 0) Then
PosX := FTriumvirat.ClientWidth;
End;
procedure CleanPositionOf(var OldRect: TRect);
begin
{Effacement des anciennes positions}
BmpInvisible.Canvas.CopyRect(OldRect, bmpFond.canvas, OldRect);
end;
procedure FusionPositionOf(var UnionR, OldRect, NewRect: TRect);
begin
{Union des positions anciennes et nouvelles}
UnionRect(UnionR, OldRect, NewRect);
FTriumVirat.PaintBox1.Canvas.CopyRect(UnionR, BmpInvisible.Canvas, UnionR);
OldRect := NewRect;
end;
procedure NewPositionOf(var vx, vy, xx, yy: single; var x, y: integer; var RNew: TRect; Bmp: TBitmap);
begin
{ rebonds }
if (x < 0) or (x > Bmpfond.width - W) then
vx := -vx;
if (y < 0) or (y > Bmpfond.height - H) then
vy := -vy;
xx := xx + vx;
yy := yy + vy;
x := trunc(xx);
y := trunc(yy);
RNew := bounds(x, y, W, H);
BmpInvisible.Canvas.Draw(x, y, Bmp);
end;
procedure TFTriumvirat.FormCreate(Sender: TObject);
var
HH :HDC;
largeur:integer;
hauteur:integer;
BMPLoaded : boolean;
NewH, NewW, OldSBM : integer;
begin
HH:=getdc(GetDesktopWindow);
largeur:=GetDeviceCaps(HH,HORZRES);
hauteur:=GetDeviceCaps(HH,VERTRES);
edlargeur.value := largeur;
edhauteur.Value := hauteur;
{ initialisation }
BMPLoaded := false;
BmpFond := TBitmap.Create;
BmpFond.LoadFromFile('fond3.bmp');
BMPLoaded := true;
{ si BMP est prét }
if BMPLoaded then
begin
NewW:=Edlargeur.value ;
NewH:=Edhauteur.value ;
end;
{ enfin on vas injecter BMP dans le bitmap de Image1 (autosize = true) }
with image1.picture.bitmap do
begin
{ on definit les nouvelles dimensions }
width := NewW;
height := NewH;
{ on travail en couleurs 24bpc }
pixelformat := pf24bit;
{ on sauvegarde l'ancien mode de redimension du canvas }
OldSBM := GetStretchBltMode(Canvas.Handle);
{ et on le definit en mode HALFTONE }
SetStretchBltMode(Canvas.Handle, HALFTONE);
{ on dessine l'image }
StretchBlt( Canvas.Handle, 0, 0, NewW, NewH,
BMPfond.Canvas.Handle, 0, 0, BMPfond.Width, BMPfond.Height,
SRCCOPY);
{ on restaure le mode de redimensionnement du canvas }
SetStretchBltMode(Canvas.Handle, OldSBM);
BMPfond.Assign(image1.picture.bitmap);
image1.refresh;
BmpInvisible := TBitmap.Create;
BmpInvisible.Canvas.StretchDraw(BmpInvisible.Canvas.ClipRect,BmpFond);
BmpImage1 := TBitmap.Create;
BmpImage2 := TBitmap.Create;
BmpImage3 := TBitmap.Create;
BmpInvisible.Assign(Bmpfond);
BmpImage1.LoadFromFile('foxirond.bmp');
BmpImage2.LoadFromFile('delphiprogrond.bmp');
BmpImage3.LoadFromFile('cirecrond.bmp');
W := Bmpimage1.width;
H := Bmpimage1.height;
BmpImage1.Transparent := true;
BmpImage1.TransParentColor := BmpImage1.canvas.pixels[1, 1];
BmpImage2.Transparent := True;
BmpImage2.TransParentColor := BmpImage2.canvas.pixels[1, 1];
BmpImage3.Transparent := True;
BmpImage3.TransParentColor := BmpImage3.canvas.pixels[1, 1];
// initialisation
xx1 := 1;
yy1 := 1;
x1 := trunc(xx1);
y1 := trunc(yy1);
vx1 := 1.5;
vy1 := 0.5;
NewRect1 := bounds(x1, y1, W, H);
OldRect1 := NewRect1;
xx2 := 200;
yy2 := 200;
x2 := trunc(xx2);
y2 := trunc(yy2);
vx2 := 1.5;
vy2 := 0.5;
NewRect2 := bounds(x2, y2, W, H);
OldRect2 := NewRect2;
xx3 := 80; yy3 := 80;
x3 := trunc(xx3);
y3 := trunc(yy3);
vx3 := 1.5;
vy3 := 0.5;
NewRect3 := bounds(x3, y3, W, H);
OldRect3 := NewRect3;
LBDelphiProg.Hint := 'Ben celle-là vous me la copierez..';
LBFoxi.Hint := 'Même à mon niveau, j''aurai jamais fais un truc pareil..';
LBCirec.Hint := 'Dis-donc, faudrait p''tet mettre quelque chose dans le zip..';
end;
end;
procedure TFTriumvirat.FormDestroy(Sender: TObject);
begin
BmpFond.free;
BmpInvisible.free;
BmpImage1.Free;
BmpImage2.Free;
BmpImage3.Free;
end;
procedure TFTriumvirat.FormPaint(Sender: TObject);
begin
// PaintBox1.Canvas.Draw(0, 0, Bmpfond);
BMPfond.Assign(image1.picture.bitmap);
end;
procedure TFTriumvirat.Button1Click(Sender: TObject);
begin
close;
end;
procedure TFTriumvirat.Timer1Timer(Sender: TObject);
var
n: integer;
begin
for n := 1 to trackbar1.position do { boucle de répétition d'affichage }
begin
CleanPositionOf(OldRect1);
CleanPositionOf(OldRect2);
CleanPositionOf(OldRect3);
NewPositionOf(vx1, vy1, xx1, yy1, x1, y1, NewRect1, BmpImage1);
NewPositionOf(vx2, vy2, xx2, yy2, x2, y2, NewRect2, BmpImage2);
NewPositionOf(vx3, vy3, xx3, yy3, x3, y3, NewRect3, BmpImage3);
FusionPositionOf(UnionR, OldRect1, NewRect1);
FusionPositionOf(UnionR, OldRect2, NewRect2);
FusionPositionOf(UnionR, OldRect3, NewRect3);
end;
end;
procedure TFTriumvirat.TrackBar1Change(Sender: TObject);
begin
Edit1.text := inttostr(trackbar1.position);
end;
procedure TFTriumvirat.FormResize(Sender: TObject);
begin
BmpFond.Width := image1.Width;
BmpFond.Height := image1.Height;
end;
procedure TFTriumvirat.CheckBox1Click(Sender: TObject);
var
Cpt: Tpoint;
begin
//Timer1.Enabled := not (Timer1.Enabled);
LBDelphiProg.Visible := not (Timer1.Enabled);
LBFoxi.Visible := not (Timer1.Enabled);
LBCirec.Visible := not (Timer1.Enabled);
if not (Timer1.Enabled) then
begin
LBFoxi.Left := x1;
LBFoxi.Top := y1 ;
LBDelphiProg.Left := x2;
LBDelphiProg.Top := y2;
LBCirec.Left := x3;
LBCirec.Top := y3;
Application.HintPause := 10;
Application.HintHidePause := 5000;
randomize;
case RandomRange(2, 5) of
2:
begin
Cpt := Point(LBDelphiProg.Width div 2, LBDelphiProg.Height div 2);
Cpt := LBDelphiProg.ClientToScreen(Cpt);
SetCursorPos(Cpt.X, Cpt.Y);
end;
3:
begin
Cpt := Point(LBFoxi.Width div 2, LBFoxi.Height div 2);
Cpt := LBFoxi.ClientToScreen(Cpt);
SetCursorPos(Cpt.X, Cpt.Y);
end;
4:
begin
Cpt := Point(LBCirec.Width div 2, LBCirec.Height div 2);
Cpt := LBCirec.ClientToScreen(Cpt);
SetCursorPos(Cpt.X, Cpt.Y);
end;
end;
sleep(1000);
CheckBox1.SetFocus;
end;
end;
procedure TFTriumvirat.FormActivate(Sender: TObject);
Var
i, j: Integer;
R, G, B: Byte;
Begin
Randomize;
{ Création des flocons }
For i := 1 To MaxFloc Do
AFloc[i] := TFloc.Create;
Application.ProcessMessages;
{ Sauvegarde de l'arrière-plan avant animation }
ImaFloc.Picture.Bitmap.Width := Width;
ImaFloc.Picture.Bitmap.Height := Height;
ImaFloc.Picture.Bitmap.Canvas.CopyRect(ClientRect, Canvas, ClientRect);
{ Mise en route de l'animation }
Timer1.Enabled := True ;
Timer2.Enabled := True ;
end;
procedure TFTriumvirat.Timer2Timer(Sender: TObject);
Var
i: Integer;
Begin
{ Mouvements des flocons }
For i := 1 To MaxFloc Do AFloc[i].MoveIt;
{ Sortie du programme }
If (GetActiveWindow <> Handle) Then Close;
end;
end.
3 janv. 2007 à 17:08
Merci cantador, j'ai beaucoup ri
2 janv. 2007 à 12:40
bonne année à tous.
il nous manque juste le petit mot de foxi..
2 janv. 2007 à 02:40
1 janv. 2007 à 22:18
{bon je vais me faire tout petit moi... y a que des 'grand' développeur dans le coin}
1 janv. 2007 à 22:15
Bonne année.
1 janv. 2007 à 18:54
Mais en réalité, ça se dit pas..."TABOU".
Autres expressions pour l'occasion :
Prosit Neu Jahr in deutsch en levant son verre
Gueti rutsch ins Neje en alsacien : bonne glissade vers la nouvelle Année.
C'est mon dernier mot !
31 déc. 2006 à 20:27
en Alsacien ça se corse un petit peut : net z'viel suffa ... lol
Mais Dediars en a certainement une autre version ...
Je vous souhaite pleins de bonnes choses a vous tous pour la nouvelle année
31 déc. 2006 à 18:18
Good and merry new year with all and all.
Feliz Año Nuevo buena y con todos y todos.
Buon e nuovo anno felice con tutti e tutti.
Ano novo bom e feliz com tudo e o tudo.
Je crois bien que la moitié de la planète arrivera à comprendre, en dehors des asiatiques (sorry for you).
Pour les petits français (ceux du bon côté du Rhin, lol) : bonne et joyeuse nouvelle année à tous et à toutes !
Euh...Debiars, comment dit-on "avec modération" en Alsacien ? ;o)
Allez une dernière, spécialement pour les picards : buonne é joyeuce nouvel anné à tous é pi à tout'
31 déc. 2006 à 13:52
Damned ! ich habe mich trahi !
Bonne fin d'année à todos !
31 déc. 2006 à 12:25
"Langue allemande... langue difficile"
(merci google)
mais me réfère à la 2eme partie de ton intervention pour dire :
"Nunc est bibendum",
sed
"Uti, non abuti" !
(merci Larousse, les pages roses)
Bon réveillon ! ;-)
30 déc. 2006 à 17:02
"Deutsche Sprache .. Schwierige Sprache""
Moi pas comprendre. Toi Japee traduire in latinum ?
Bon réveillon à tous et ne finissez pas tous ronds...
28 déc. 2006 à 16:02
Je présume que tu fais le rapprochement de 8 heures avec Acht Uhr qui veut dire la même chose en allemand. Mais Acht signifie également "attention" comme dans "Achtung" ce qui ajoute un second degré à l'expression. Méfiance donc.
N'empêche que j'aimerai en savoir plus...
28 déc. 2006 à 15:52
A propos de RandomRange, effectivement c'est une erreur, il s'agit bien en fait de RandomFrom..
euh, c'est quand ton passage à D7 ?
28 déc. 2006 à 14:16
Sinon tu vas te faire appeler Arthur (8 heures, quoi...)
Avec un clin d'oeil amical à Caribensila qui nous a dévoilé l'origine de cette expression, sur le forum.
28 déc. 2006 à 14:05
A moins qu'il ne s'agisse d'une évolution de RandomRange() qu'on m'aurait cachée (D6 ->) ? C'est vrai, quoi, on ne me dit jamais rien, à moi...
Faut dire que sous D4, je n'ai que Random(), que je cuisine à toutes les sauces... ^^
28 déc. 2006 à 12:18
J'utilise souvent RandomRange avec les tableaux et là ça marche :
ex: un tableau "TABL" de 5 valeurs [12,7,5,65,1]
le randomRange(TABL) te donne toutes les valeurs possibles..
a+
28 déc. 2006 à 09:32
27 déc. 2006 à 23:03
R := RandomRange(2, 5);
La limite supérieure n'est pas incluse, contrairement à ce qui est dit dans l'aide en ligne de Delphi.
27 déc. 2006 à 22:56
En dépannage, tu peux faire :
case Random(3) + 2 of
Là, Cirec aura sa chance, lol ^^
27 déc. 2006 à 22:29
En revanche, je ne comprends pas bien pourquoi
RandomRange(2, 4) sort de temps en temps 3 sur un point d'arrêt, mais qu'à l'exécution cela ne sort pas.
si bien que l'avatar de cirec est privé de sa citation..
??
27 déc. 2006 à 20:13
A+
25 déc. 2006 à 22:59
25 déc. 2006 à 17:35
Joyeux Nowël @ TOUS !!
25 déc. 2006 à 16:13
Joyeux Noël et Bonne Année les petits.
Franky, sur le e le tréma...:-)
25 déc. 2006 à 11:09
Ouep Japee: a mon avis la vengeance va etre terrible.
Joyeux Noël à tous : que le papa Nöel nous apporte plein de beaux sources
24 déc. 2006 à 23:12
joyeux Noël JAPEE !
24 déc. 2006 à 17:44
Et joyeux Noël à tous :)
24 déc. 2006 à 16:57