Discussion :

[edam]

Je sais si j'ai l'erreur de moi, mais quand je click sur une boutton et je déplace ma forme, le fond de l'écran s'efface,

[edam]

Je ne sais pas si l'erreur de moi, mais quand je click sur une boutton et je déplace ma forme, le fond de l'écran s'efface,
mais vraiment c'est géniale, et j'ai toujour voulut savoir comment le faire, waskol, tu doit surement ajoute ce code avotre site, car toujour je fait une visite pour touvé du neuf, comme ce géniale nono40, passé lui mes chére salut,

[LadyWasky]

Je sais si j'ai l'erreur de moi, mais quand je click sur une boutton et je déplace ma forme, le fond de l'écran s'efface,

Oui, il n'y a pas de raffraichissement lors des actions utilisateurs.
Pendant l'animation, tu es censé ne rien faire, juste regarder

[edam]

Pendant l'animation, tu es censé ne rien faire, juste regarder

bien j'attend jusqu'à ce que je reçoit un

{edit} en peut pas le faire avec modification de pallette ??

[LadyWasky]

bien j'attend jusqu'à ce que je reçoit un

{edit} en peut pas le faire avec modification de pallette ??

y'a pas de palette en "True Color" 32bits

[jambonstar]

Re me suis permis d'améliorer tout ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Déclarations privées }
    OriginalBitmap,BitmapToDraw: TBitmap;
    function GetDesktopBitmap : TBitmap;
    Procedure ConvertToGray(var Original,New : TBitmap;PercentGrayed:integer);
    procedure Grise;
    procedure Colorise;
    procedure PaintFond(Sender: TObject);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
  formFond:tform;
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  grise;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  colorise;
end;
 
Procedure TForm1.ConvertToGray(var Original,New : TBitmap;PercentGrayed:integer);
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [Byte] of TRGBTriple;
var
  Gray   :  INTEGER;
  i      :  INTEGER;
  j      :  INTEGER;
  rowRGB :  pRGBTripleArray;
  rowGray:  pRGBTripleArray;
  k1,k2:double;
begin
  k2:=PercentGrayed/100;
  k1:=1-k2;
  for j := Original.Height-1 Downto 0 do
  begin
    rowRGB := Original.Scanline[j];
    rowGray:= New.Scanline[j];
    for i := Original.Width-1 downto 0 do
    begin
      // Intensité = (R + G + B) div 3
      with rowRGB[i] do
      begin
        Gray := (rgbtRed + rgbtGreen + rgbtBlue) div 3;
        
        Gray := Gray -80;
        if Gray < 0 then Gray := 0;
         
        rowGray[i].rgbtRed   := round(k1*rgbtRed+k2*Gray);
        rowGray[i].rgbtGreen := round(k1*rgbtGreen+k2*Gray);
        rowGray[i].rgbtBlue  := round(k1*rgbtBlue+k2*Gray);
      end;
    end;
  end;
end;
 
// Création d'un bitmap pf24bit contenant l'image du desktop
function TForm1.GetDesktopBitmap : TBitmap;
var DeskTopBitmap : TBitMap;
begin
  DesktopBitmap := TBitmap.Create;
  DesktopBitmap.PixelFormat := pf24bit;
  with DesktopBitmap do begin
    Width := Screen.Width;
    Height := Screen.Height;
  end;
  BitBlt(DesktopBitmap.Canvas.Handle,
         0,0,Screen.Width,Screen.Height,
         GetDC(GetDesktopWindow),0,0,SrcCopy);
  result := DesktopBitmap;
end;

procedure TForm1.PaintFond;
begin
  formFond.Canvas.Draw(0,0,BitmapToDraw);
end;
 
procedure TForm1.Grise;
var i:integer;
begin
  formFond.Show;
  formFond.Canvas.Draw(0,0,BitmapToDraw);

  Self.BringToFront;
 
  for i:=0 to 10 do
  begin
    ConvertToGray(OriginalBitmap,BitmapToDraw,i*10);
    formFond.Canvas.Draw(0,0,BitmapToDraw);
    Application.ProcessMessages;
    Sleep(200);
  end; 
end;
 
procedure TForm1.Colorise;
var i:integer;
begin
    //Si on veut aussi coloriser la fiche de l'application
   Self.BringToFront;
   for i:=10 downto 0 do
   begin
     ConvertToGray(OriginalBitmap,BitmapToDraw,i*10);
     formFond.Canvas.Draw(0,0,BitmapToDraw);
     Application.ProcessMessages;
     Sleep(200);
   end;
   formFond.hide;
   Self.BringToFront;
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  formFond := TForm.Create(Application);
  formFond.BorderStyle := bsNone;
  formfond.Height := Screen.Height;
  formFond.Width := Screen.Width;
  // JBS : on affecte l'évenement onpaint.
  formFond.OnPaint := PaintFond;  
  formFond.DoubleBuffered := True; // selon les pc, cela evite le scintillement
  //Si on veut aussi griser la fiche de l'application, placer ces 2 lignes dans le OnActivate, parce qu'ici, Form1 n'est pas encore affichée donc pas prise en photo
  OriginalBitmap := GetDesktopBitmap;
  BitmapToDraw:=GetDesktopBitmap;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  OriginalBitmap.Free;
  BitmapToDraw.Free;
end;
 
end.

Dans l'ordre :

• J'ai foncé un peu plus les gris, car je ne trouvais pas ça assez fort :

Dans ConvertToGray :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
        Gray := (rgbtRed + rgbtGreen + rgbtBlue) div 3;
        
        Gray := Gray -80;
        if Gray < 0 then Gray := 0;
         
        rowGray[i].rgbtRed   := round(k1*rgbtRed+k2*Gray);

• J'ai inversé les downto et to de tes boucles, et oui, personne n'a osé te le dire, mais c'était dans le mauvais sans...
• J'ai ajouter la surcharge de l'évenement OnPaint, comme ça on obtient la percistance du fond gris. Ca c'est pour edam..

Voilà. Encore joli boulot.
Ah si j'oublié même avec la modif apporté par ebastien, l'image saute entre le Show et le premier dessin...

[LadyWasky]

inversé les downto et to de tes boucles, et oui, personne n'a osé te le dire, mais c'était dans le mauvais sans...

Je t'ai eu heu, nananèreuuu....
Parce qu'entre temps, j'ai corrigé mon codeuuuuuuuuuu



Sinon, pour le reste, tu as vraiment fait quelque chose de sympa

[jambonstar]

Je t'ai eu heu, nananèreuuu....
Parce qu'entre temps, j'ai corrigé mon codeuuuuuuuuuu

Et pour le premier affichage de la formFond. T'as rien trouvé c'est ça...

waskol := whisky + alcool; // ?

[LadyWasky]

Et pour le premier affichage de la formFond. T'as rien trouvé c'est ça...

Bah, en fait, il y a mieux
Pourquoi ne pas dessiner directement sur le canvas de l'écran

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Screen.canvas.draw(0,0,BitmapGrisé)

Ca éviterais de se trimballer une fiche supplémentaire comme formfond

[jambonstar]

Voilà une idée fabuleuse digne d'un vendredi !
Dommage que Borland n'est pas pensé à prévoir un Canvas pour le TScreen..

Est-si on allait manger plutot que de refaire le monde à notre sauce..
Bon app

[LadyWasky]

Voilà une idée fabuleuse digne d'un vendredi !
Dommage que Borland n'est pas pensé à prévoir un Canvas pour le TScreen..

Ouaiiiiiiis, tu chipotes là :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.Button1Click(Sender: TObject);
var ScreenCanvas:TCanvas;
begin
  ScreenCanvas:=TCanvas.Create;
try
  //Obtention d'un contexte de périphérique pour l'écran
  ScreenCanvas.Handle:=GetDC(0);
 
  //Dessin direct
  screenCanvas.Font.Size:=48;
  ScreenCanvas.TextOut(0,0,'Tu vois bien que ça marche !');
finally
  ScreenCanvas.Free;
end;
end;

Haa, on se marre moins là, hein ?

[jambonstar]

Bon, là j'avoue que c'est possible, de plus j'avais déjà effectuer ce type de création pour dessiner sur un activex qui diffusait de la vidéo.

Mais, on revient au même point, celui de la persistance du dessin.
Et là c'est même pire, on accede completement à tous les autres controles présent sur l'écran.

En tout cas, tu m'a montré que tu avais un plus gros code que moi.

[LadyWasky]

Bon, là j'avoue que c'est possible, de plus j'avais déjà effectuer ce type de création pour dessiner sur un activex qui diffusait de la vidéo.

Mais, on revient au même point, celui de la persistance du dessin.
Et là c'est même pire, on accede completement à tous les autres controles présent sur l'écran.

En tout cas, tu m'a montré que tu avais un plus gros code que moi.

J'ai essayé d'en faire quelque chose de mon ScreenCanvas, et j'avoue, c'est à ch....
Bref ton code est PARFAIT
FormFond, c'est très très bien finalement

[jambonstar]

Je me suis permis de rajouter :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

formFond.DoubleBuffered := True

Pour diminuer les scintillement. Est-ce vraiment efficace...

Et puis si un jour j'ai la force, j'éssaye de transformer tout ça en composant non visuel. Du genre, si on pose ce truc sur une fiche. Lorsque l'on affiche la fiche, automatiquement l'arriere se grise. Ca commencera à bien ressembler au code de Thierry d'ailleurs.... C'est tellement bon de réinventer la roue

[Thierry Laborde]

Très beau boulôt en tout cas ce que vous avez fait. Et chapeau à Waskol en particulier, mais je savais déjà qu'il assurait de ce côté là.

[LadyWasky]

Juste une remarque selon moi à propos des manques de la VCL, celà vaut aussi bien pour les évènement de TForm que pour ceux des autres composants.

Je trouve que l'implémentation des évènements est incomplête est mal définie, franchement mal même...

Je m'explique, on a à notre disposition pour nos composants viuels ou non des évènements de type OnClose, OnPaint, OnClick, etc...

Je dis "super !" mais :
1) c'est évènements ont ils lieux Avant, Après où pendant le moment où le code de la VCL agit ?
Par exemple, le OnPaint d'une fiche TFormà lieu après le dessin de la fiche, et le [B]nPaint d'un TPaintBox "au moment où ça doit se faire" (ce qui est beaucoup plus logique par rapport au nom de l'évènement), et parfois mêmes pour certains compos, avant le dessin (permettant de changer la couleur de la police d'un item par exemple).
2) Du coup l'implémentation du OnPaint pour la TForm est du coup ET fausse, ET incomplête. Fausse, parce que le OnPaint devrait s'appeler OnAfterPaint, et incomplête parce qu'un OnBeforePaint serait le bienvenu et faciliterait grandement le dessin en "Transparence" (c'est un exemple).

Si on prend les composants de type TDataSet(TTable, TQuery,...), cette logique est très très bien respectée : OnBeforePost, OnAfterPost,OnBeforeScroll, etc.... et offre, je trouve, beaucoup plus de souplesse et de possibilités.

Voyez vous ce que je veux dire ?


Dans notre cas, Un simple OnBeforePaint, permettrais très simplement de capturer l'image du bureau avant même que la fiche elle-même soit redessinée par-dessus, permettant ainsi, de prendre un screenshot du bureau sans notre fiche et nous permettant ainsi d'utiliser une image de fond "à jour" beaucoup plus facilement.
En l'absence d'un tel évènement, nous sommes obligés d'intercepter le message windows WM_Paint avant que le code de la VCL ne s'en saisisse (ce que nous avons yous négligés de faire, non pas faute de savoir comment le faire, mais plutôt parce que nous avons eu la flemme de le faire )

Voilà, j'ai ça sur le coeur depuis Delphi 1, el il faudrait qu'un jour, quelqu'un prenne le temps de le relayer à Borland /Codegear parce que c'est vraiment casse " bip bip bip bip "
Je ne l'ai jamais fait en me disant que, de toute façon, une telle idée venant d'un petit développeur lambda comme ma pomme, celle-ci ne les intéresserait pas, et qu'ils auraient surement le bon sens de changer ça un jour. Je crois que j'ai eu tord...

[jambonstar]

Allez du calme Waskol; tu vas nous peter une durite.

Tu as tout à fait raison concernant l'acces aux événements, il manque beaucoup d'acces de base concernant les procedures d'affichage.

Mais comme tu le soulignes également, nous avons toujours un acces aux messages. Ce n'est pas si lourds que ça tout de même.
Lorsque que l'on prend l'habitude de les surcharger.
Mais si l'envie te prend un jour de réécrire la VCL pour faire apparaitre le OnBeforePaint un peu partout, je suis sur que je ne serai pas le dernier à te supporter..

Allez, on compte tous sur toi ! Tu peux le faire

[LadyWasky]

Je reviens sur ce fil de discussion pour apporter un élément nouveau au sujet de la façon de "fabriquer" du gris à partir du RGB.

Par exemple, lorsque l'on regarde un film en noir et blanc (gris, donc ), un rouge moyen ne se traduira pas par le même gris qu'un bleu moyen.

En fait, ici, ce que l'on a fait pour fabriquer du gris, c'est de mélanger les trois composantes RGB de la même façon. En gros, on a appliqué cette formule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

X:=R/3+G/3+B/3

Et il n'y a pas longtemps je suis tombé sur un article (ou il s'agissait de convertir un signal RGB en signal composite noir et blanc), que :
- la sensibilité de l'oeil humain n'est pas constante selon les couleurs (on y vientt, on y vient...)
- Du coup, "qu'il a été démontré que" (je ne sais pas par qui...), que la bonne formule à utilisér était celle-ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Y:=0.30*R+0.59*B+0.11*G

Voilà, à partir de tout les codes que l'on a écrit ici, et cette formule, vous allez pouvoir vous en donner à coeur joie dans des styles grisés du plus bel effet

[LadyWasky]

J'ai amélioré l'effet (plus de saccade au début, petit curseur d'attente en plus, et dégradés de gris plus "naturels" )

Donc pour ce projet, il vous faut une fiche vide et vous associez
les méthodes FormCreate à OnCreate, FormDestroy à OnDestroy et FormClose à OnClose. (par contre, laissez FormPaint tel que !)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Déclarations privées }
    OriginalAvecFiche,OriginalSansFiche,OriginalAvecFicheGris,OriginalSansFicheGris,BitmapToDraw: TBitmap;
    function GetDesktopBitmap : TBitmap;
    Procedure ConvertToGray(var Original,New : TBitmap;PercentGrayed:integer);
    Procedure Transition(var Depart,Arrivee,Intermediaire : TBitmap;Percent:integer);
    procedure Grise;
    procedure Colorise;
    procedure Cache;
    procedure FormFondPaint(Sender: TObject);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
  formFond:tform;
implementation
 
{$R *.dfm}
 
Procedure TForm1.ConvertToGray(var Original,New : TBitmap;PercentGrayed:integer);
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [Byte] of TRGBTriple;
var
  Gray   :  INTEGER;
  i      :  INTEGER;
  j      :  INTEGER;
  rowRGB :  pRGBTripleArray;
  rowGray:  pRGBTripleArray;
  k1,k2:double;
begin
  k2:=PercentGrayed/100;
  k1:=1-k2;
  for j := Original.Height-1 Downto 0 do
  begin
    rowRGB := Original.Scanline[j];
    rowGray:= New.Scanline[j];
    for i := Original.Width-1 downto 0 do
    begin
      // Intensité = 0.30*R+0.59*B+0.11*G
      with rowRGB[i] do
      begin
        Gray := round(0.3*rgbtRed + 0.11*rgbtGreen + 0.59*rgbtBlue);
        rowGray[i].rgbtRed   := round(k1*rgbtRed+k2*Gray);
        rowGray[i].rgbtGreen := round(k1*rgbtGreen+k2*Gray);
        rowGray[i].rgbtBlue  := round(k1*rgbtBlue+k2*Gray);
      end;
    end;
  end;
end;
 
Procedure TForm1.Transition(var Depart,Arrivee,Intermediaire : TBitmap;Percent:integer);
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [Byte] of TRGBTriple;
var
  i      :  INTEGER;
  j      :  INTEGER;
  rowRGB1,rowRGB2 :  pRGBTripleArray;
  rowGray:  pRGBTripleArray;
  k1,k2:double;
begin
  k2:=Percent/100;
  k1:=1-k2;
  for j := Depart.Height-1 Downto 0 do
  begin
    rowRGB1 := Depart.Scanline[j];
    rowRGB2 := Arrivee.Scanline[j];
    rowGray:= Intermediaire.Scanline[j];
    for i := Depart.Width-1 downto 0 do
    begin
        rowGray[i].rgbtRed   := round(k1*rowRGB1[i].rgbtRed+k2*rowRGB2[i].rgbtRed);
        rowGray[i].rgbtGreen := round(k1*rowRGB1[i].rgbtGreen+k2*rowRGB2[i].rgbtGreen);
        rowGray[i].rgbtBlue  := round(k1*rowRGB1[i].rgbtBlue+k2*rowRGB2[i].rgbtBlue);
    end;
  end;
end;
 
// Création d'un bitmap pf24bit contenant l'image du desktop
function TForm1.GetDesktopBitmap : TBitmap;
var DeskTopBitmap : TBitMap;
begin
  DesktopBitmap := TBitmap.Create;
  DesktopBitmap.PixelFormat := pf24bit;
  with DesktopBitmap do begin
    Width := Screen.Width;
    Height := Screen.Height;
  end;
  BitBlt(DesktopBitmap.Canvas.Handle,
         0,0,Screen.Width,Screen.Height,
         GetDC(GetDesktopWindow),0,0,SrcCopy);
  result := DesktopBitmap;
end;
 
procedure TForm1.Grise;
var i:integer;
begin
  ConvertToGray(OriginalAvecFiche,BitmapToDraw,0);
  formFond.Show;
  for i:=0 to 10 do
  begin
    ConvertToGray(OriginalAvecFiche,BitmapToDraw,i*10);
    formFond.Repaint;
    Application.ProcessMessages;
    Sleep(50);
  end;
end;
 
procedure TForm1.Colorise;
var i:integer;
begin
   for i:=10 downto 0 do
   begin
     ConvertToGray(OriginalSansFiche,BitmapToDraw,i*10);
     formFond.Repaint;
     Application.ProcessMessages;
     Sleep(50);
   end;
end;
 
procedure TForm1.Cache;
var i:integer;
begin
   for i:=0 to 10 do
   begin
     Transition(OriginalAvecFicheGris,OriginalSansFicheGris,BitmapToDraw,i*10);
     formFond.Repaint;
     Application.ProcessMessages;
     Sleep(50);
   end;
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  formFond := TForm.Create(Application);
  formFond.DoubleBuffered := True;
  formFond.BorderStyle := bsNone;
  formfond.Height := Screen.Height;
  formFond.Width := Screen.Width;
  formFond.OnPaint:=FormFondPaint;
  formfond.Cursor:=crHourGlass;
  OriginalSansFiche := GetDesktopBitmap;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 
  OriginalSansFiche.Free;
 
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  OriginalAvecFiche := GetDesktopBitmap;
  BitmapToDraw:=GetDesktopBitmap;
  OriginalAvecFicheGris:=GetDesktopBitmap;
  OriginalSansFicheGris:=GetDesktopBitmap;
  try
  Cursor:=crHourGlass;
  ConvertToGray(OriginalAvecFiche,OriginalAvecFicheGris,100);
  ConvertToGray(OriginalSansFiche,OriginalSansFicheGris,100);
 
  grise;
  cache;
  colorise;
  finally
  OriginalAvecFicheGris.Free;
  OriginalSansFicheGris.Free;
  OriginalAvecFiche.Free;
  BitmapToDraw.Free;
  Cursor:=crDefault;
  end;
end;
 
procedure TForm1.FormFondPaint(Sender: TObject);
begin
  FormFond.Canvas.Draw(0,0,BitmapToDraw);
end;
 
end.