Discussion :

[LadyWasky]

Bon, attend un peu...

Edit1 :
Voilà la méthode que je te préconise :
1) créer un bitmap de la taille du "bandeau de texte" que tu va dessiner sur ton image
2) dessiner ton texte et le fond dans ce bitmap intermédiaire
3) dessiner ce bitmap intermédiaire en semi-transparence sur l'image

Je reviens dans qques minutes...

[LadyWasky]

Bon, voilà, alors tout d'abord une petite unité

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
197
198
199
200
unit BandeauGraphique;
 
interface
uses windows,graphics;
type
  TAlignementVertical=(alVTop,alVCenter,alVBottom);
  TAlignementHorizontal=(alHLeft,alHCenter,alHRight);
  TJustification=(JustLeft,JustCenter,JustRight);
 
  TParametresTexteMultiligne=record
       RectangleTexteDansBandeau:TRect;
       AlignementHorizontal:TAlignementHorizontal;
       AlignementVertical:TAlignementVertical;
       TextJustification:TJustification;
  end;
 
  TParametresBandeau=record
       RectangleBandeau:TRect;
       CouleurBandeau:TColor;
       Transparence:integer; //(de 0 à 100)
       TexteMultiligne:TParametresTexteMultiligne;
  end;
Procedure DessineTexte(Texte:string;BitMapDestination:TBitmap;Bandeau:TParametresBandeau);
 
implementation
uses Types;
 
Function TextSize(Phrase : string; Police : TFont = nil) : TPoint;
var
  DC: HDC;
  X: Integer;
  Rect: TRect;
  C : TBitmap;
begin
  C := TBitmap.create;
  if police <> nil then  C.canvas.Font := police;
 
    Rect.Left := 0;
    Rect.Top:=0;
    Rect.Right:=0;
    Rect.Bottom:=0;
    DC := GetDC(0);
    C.Canvas.Handle := DC;
    DrawText(C.Canvas.Handle, PChar(Phrase), -1, Rect, (DT_EXPANDTABS or DT_CALCRECT));
    C.Canvas.Handle := 0;
    ReleaseDC(0, DC);
    result.X:=Rect.Right-Rect.Left;
    result.Y:=Rect.Bottom-Rect.Top;
    C.Free;
end;
 
//Notre procedure d'affichage de texte multiligne
procedure DessineTexteMultiligne(AString: string;ACanvas:TCanvas;ARect: TRect;
                       AlignementHorizontal:TAlignementHorizontal;
                       AlignementVertical:TAlignementVertical;
                       TextJustification:TJustification);
var
  AHeight,AWidth:integer;
  Rect,oldClipRect:TRect;
  ATop,ALeft,H,W:Integer;
  AText:string;
  JustificationDuTexte:Integer;
  MyRgn:HRGN;
begin
  with ACanvas do
  begin
    Lock;
    AHeight:=ARect.Bottom-ARect.Top;
 
    AWidth:=ARect.Right-ARect.Left;
    //on calcule la taille du rectangle dans lequel va tenir le texte
    W:=TextSize(AString,ACanvas.Font).X;
    H:=TextSize(AString,ACanvas.Font).Y;
 
    //on calcule la position (Haut,Gauche) du rectangle dans lequel va tenir le texte
    //en fonction de l'alignement horizontal et vertical choisi
    ATop:=ARect.Top;
    ALeft:=ARect.Left;
 
 
    case AlignementVertical of
      alVBottom : ATop:=ARect.Bottom-H;
      alVCenter : ATop:=ARect.Top+((AHeight-H) div 2);
      alVTop    : ATop:=ARect.Top;
    end;
 
    case AlignementHorizontal of
      alHLeft  : ALeft:=ARect.Left;
      alHCenter: ALeft:=ARect.Left+(AWidth-W) div 2;
      alHRight : ALeft:=ARect.Right-W;
    end;
 
    //Fin du calcul du rectangle, on met le resultat dans Rect
    Rect:=Bounds(ALeft,ATop,W,H);
 
    //On remplit le rectangle de la zone sinon on voit le texte que delphi à dessiné
    FillRect(ARect);
 
    //On détermine les paramètres de justification à passer à Windows
    case TextJustification of
      JustLeft  : JustificationDuTexte:=DT_LEFT;
      JustCenter: JustificationDuTexte:=DT_CENTER;
      JustRight : JustificationDuTexte:=DT_RIGHT;
    end;
 
    //Si le texte est plus grand que notre zone, on prend cette précaution (Clipping)
    with ARect do MyRgn :=CreateRectRgn(Left,Top,Right,Bottom);
    SelectClipRgn(Handle,MyRgn);
 
    //On dessine le texte
    DrawText(Handle,PChar(AString),-1,Rect,JustificationDuTexte or DT_NOPREFIX or DT_WORDBREAK );
 
    //On a plus besoin de la zone de clipping
    SelectClipRgn(Handle,0);
    DeleteObject(MyRgn);
    Unlock;
  end;
end;
 
Procedure DessineTexte(Texte:string;BitMapDestination:TBitmap;Bandeau:TParametresBandeau);
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [Byte] of TRGBTriple;
var
  ABitmap:TBitmap;
  i      :  INTEGER;
  j      :  INTEGER;
  rowRGB1,rowRGB2 :  pRGBTripleArray;
  RedV,BlueV,GreenV:byte;
  rowMixed:  pRGBTripleArray;
  k1,k2:double;
  Arect:TRect;
  AColor1,AColor2:tcolor;
begin
  ABitmap:=TBitmap.Create;
  try
    //Etape 1 : on créé le bandeau
 
    //Préparation du Bitmap intermédiaire
    with Bandeau.RectangleBandeau do
    begin
      ABitmap.Width:=Right-Left+1;
      ABitmap.Height:=Bottom-Top+1;
      ABitmap.PixelFormat:=pf24bit;
    end;
    with ABitmap.Canvas do
    begin
      Font.Assign(BitMapDestination.Canvas.Font);
      Brush.Color:=Bandeau.CouleurBandeau;
      Brush.Style:=bsSolid;
      Rectangle(0,0,ABitmap.Width,ABitmap.Height);
    end;
 
    //enfin on dessine le Texte
 
    with Bandeau.TexteMultiligne do
    begin
      DessineTexteMultiligne(Texte,ABitmap.Canvas,
                             RectangleTexteDansBandeau,
                             AlignementHorizontal,
                             AlignementVertical,
                             TextJustification);
 
    end;
    //Etape 2 : Dessin du Bandeau semi-transparent
    k1:=Bandeau.Transparence/100;
    k2:=1-k1;
    AColor1:=BitMapDestination.Canvas.font.Color;
    with Bandeau.RectangleBandeau do
    for j := Top to Bottom do
    begin
      rowRGB1 := ABitmap.Scanline[j-Top];
      rowRGB2 := BitMapDestination.Scanline[j];
      for i := Left to Right do
      begin
         //(ColorToRGB())
         RedV   := round(k1*rowRGB1[i-Left].rgbtRed+k2*rowRGB2[i].rgbtRed);
         GreenV := round(k1*rowRGB1[i-Left].rgbtGreen+k2*rowRGB2[i].rgbtGreen);
         BlueV  := round(k1*rowRGB1[i-Left].rgbtBlue+k2*rowRGB2[i].rgbtBlue);
         AColor2:=ABitmap.Canvas.Pixels[i-Left,j-Top];
         if AColor1<>AColor2
         then begin
                rowRGB2[i].rgbtRed   := RedV;
                rowRGB2[i].rgbtGreen := GreenV;
                rowRGB2[i].rgbtBlue  := BlueV;
              end
         else begin
                rowRGB2[i].rgbtRed   := rowRGB1[i-Left].rgbtRed;
                rowRGB2[i].rgbtGreen := rowRGB1[i-Left].rgbtGreen;
                rowRGB2[i].rgbtBlue  := rowRGB1[i-Left].rgbtBlue;
              end;
      end;
  end;
  finally
    ABitmap.Free;
  end;
 
 
end;
end.

Voir La FAQ suivante pour le dessin de texte multiligne :
http://delphi.developpez.com/faq/?pa...ignedanscanvas


Puis un exemple :
vous placez dans une fiche,
- un Timage,
- un Tmemo (dans lequel on écrira le message à faire apparaître dans l'image (n'oubliez pas d'en mettre une à la conception)

Et un bouton codé comme ceci dans son OnClick :

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
procedure TForm1.Button1Click(Sender: TObject);
var Bandeau:TParametresBandeau;
    WBandeau,HBandeau,HImage:integer;
begin
   with Image1.Picture.Bitmap do
   begin
     //on dessinera le texte en vert et en gras
     Image1.Picture.Bitmap.Canvas.Font.Name:='Arial';
     Image1.Picture.Bitmap.Canvas.Font.Color:=clLime;
     Image1.Picture.Bitmap.Canvas.Font.style:=[fsbold];
 
     //Le bandeau prendra toute la largeur de l'image
     WBandeau:=Image1.Picture.Bitmap.Width;
     //et fera trois lignes de texte de haut
     HBandeau:=3*Image1.Picture.Bitmap.Canvas.TextHeight('H');
     //On récupère la hauteur de la fenètre (on placera le bandeau en bas)
     HImage:=Image1.Picture.Bitmap.Height;
   end;
   with Bandeau do
   begin
     RectangleBandeau:=Rect(0,HImage-HBandeau-1,WBandeau-1,HImage-1);
     CouleurBandeau:=clRed;
     Transparence:=50;
     with TexteMultiligne do
     begin
       RectangleTexteDansBandeau:=Rect(0,0,WBandeau,HBandeau);
       AlignementVertical:=alVCenter;
       AlignementHorizontal:=alHCenter;
       TextJustification:=JustCenter;
     end;
   end;
   DessineTexte(Memo1.Text,Image1.Picture.Bitmap,Bandeau);
   image1.Refresh;
end;

ne pas oublier le :

Code :

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

uses BandeauGraphique;

...qui va bien

[cincap]

Bonjour à toutes et à tous,

@ Waskol, excellente solution et très bien documentée en plus, il me reste à l'adapter avec le reste du code.

Le test avec ton unité est conforme à ma demande, le fond du message est translucide.

Sauf erreur de ma part, la taille du texte influence la taille du bandeau et peut être génant à l'utilisation, comme tel le texte est petit.

Encore merci @ Waskol pour cette solution présentée sur un plat d'argent.

@+,

Cincap

[LadyWasky]

Sauf erreur de ma part, la taille du texte influence la taille du bandeau et peut être génant à l'utilisation, comme tel le texte est petit.

Hé oui, erreur, Les dimensions du bandeau son déterminé par
RectangleBandeau (ce sont les coordonnées relatives à l'image), alors que
RectangleTexteDansBandeau ce sont les coordonnées du rectangle dans lequel s'inscrit le texte, (coordonnées relatives prises par rapport au bandeau).

J'ai choisi ici effectivement une hauteur de bandeau en fonction de la taille du texte :

Code :

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

HBandeau:=3*Image1.Picture.Bitmap.Canvas.TextHeight('H');

Mais rien ne t'empêche de mettre une valeur fixée de, par exemple, 50 pixels de haut.

Code :

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

HBandeau:=50;

voili voilou...

[cincap]

@ Waskol, Bien voila, ta procédure a été adaptée à mon code et cela fonctionne correctement avec même un redimensionnement de la fonte ainsi que l'accès aux paramètres prédéfinis que l'on peut modifier.

Encore un grand merci pour cette solution prête à l'emploi. .

Bon week-end à toutes et à tous,

@+,

Cincap