Discussion :

[cincap]

Bonjour à toutes et à tous,

Avec une procédure, j'ajoute une frame de couleur en bas et en haut de l'image, j'ai essayé d'ajouter un texte ou la date de couleur qui pourrait être centré ou à gauche ou à droite et je cale.

Il y a peut être une possibilité en modifiant la procédure ?

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
 
{$R *.dfm}
 
type     pLigScan = ^tLigScan;
         tLigScan = array[Word] of TRGBTriple;
 
procedure EncadrementPlatTranspa(const Bmp : tBitMap; cl : tColor; R : tRect; TransPC : single);
//        R = rectangle délimitant le périmètre interne du cadre, TranspaPC = Pourcentage de transparence
var       x,y : Integer; Lig : pLigScan;  pt : tPoint;
begin     bmp.PixelFormat:=pf24bit; while TransPC>1 do TransPC:=TransPC/100;
          for y:=0 to bmp.Height-1 do begin
              Lig := Bmp.ScanLine[y];
              for x :=0 to bmp.Width-1 do begin
                  pt.x:=x; pt.y:=y;
                  if  not ptInRect(R, pt) then begin
                      Lig[x].rgbtRed  :=round(GetRvalue(cl)*(1-TransPC) + Lig[x].rgbtRed*TransPC);
                      Lig[x].rgbtGreen:=round(GetGvalue(cl)*(1-TransPC) + Lig[x].rgbtGreen*TransPC);
                      Lig[x].rgbtBlue :=round(GetBvalue(cl)*(1-TransPC) + Lig[x].rgbtBlue*TransPC);
                  end;
              end;
          end;
end;

Utilisation :

Code :

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

1
2
 
EncadrementPlatTranspa(Bmp,cld1.color,Rect(0,50, Bmp.width -0,Bmp.height-50), sphauteur.value);

Si quelqu'un a une idée, merci d'avance.

@+,

Cincap

[Ph. B.]

Bonjour,

Si quelqu'un a une idée, merci d'avance.

A la sauvage sans tenir compte des couleurs ni du fond sous-jacent , on peut ajouter à votre procédure :

Code :

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

1
2
ch := 'Mon texte';
Bmp.Canvas.TextOut((Bmp.Width - Bmp.Canvas.TextWidth(ch)) div 2, (Bmp.Height - Bmp.Canvas.TextHeight(ch)) div 2, ch);

[cincap]

@ Ph. B. merci de ta réponse, si je l'ajoute à la procédure tel quel, j'avais déjà fait l'essai, le texte se trouve en dehors de la frame du bas !

J'ai une autre procédure, mais elle n'affiche que la frame du bas avec un texte contenu dans un mémo qui pourrait convenir, mais je n'ai pas réussi à ajouter cette fois, la frame du haut.

@+,

Cincap

[Ph. B.]

@ Ph. B. merci de ta réponse, si je l'ajoute à la procédure tel quel, j'avais déjà fait l'essai, le texte se trouve en dehors de la frame du bas !

Il faut adapter ce que j'ai donné !

Code :

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

1
2
3
4
ch := 'Mon texte';
x := (R.Right + R.Left - Bmp.Canvas.TextWidth(ch)) div 2;
y := (Bmp.Height + R.Bottom - Bmp.Canvas.TextHeight(ch))div 2;
Bmp.Canvas.TextOut(x, y, ch);

Mais je ne gère toujours pas la transparence !

[cincap]

@ P.h. B., je vais tester tout à l'heure.

Edit, je viens de tester.

Sinon voici une unité qui gère le texte et l'alignement mais uniquement dans une frame en bas, hors l'idéal serait aussi de dessiner la frame du haut.

Cela peut servir !

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
201
202
203
204
205
206
207
 
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
    //for j := Bottom to top 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.

Utilisation :

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
 
procedure TForm1.Button1Click(Sender: TObject);
var
 
Bandeau:TParametresBandeau;
 
WBandeau,HBandeau,HImage:integer;
 
jpg:TJPEGImage;
bmp:TBitMap;
 
begin
   if cld1.Execute then
   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;
     Image1.Picture.Bitmap.Canvas.Font.size:=8;
     //et fera trois lignes de texte de haut
     HBandeau:= sphauteur.value ;//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:= cld1.color;//clBlue;
     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);
   jpg:=TJPEGImage.Create;
    bmp:=TBitMap.Create;
    Try
      // Le bitmap est lu
      bmp.assign(Image1.Picture.Bitmap);//LoadFromFile(Ouvrir.FileName);
      // La qualité choisie détermine le rendu de l'image et
      // la taille prise sur le disque
      jpg.CompressionQuality:=80;
      // Image en couleur
      jpg.GrayScale:=False;
      // Copie du BMP dans le JPG
      jpg.Assign(bmp);
      // Et sauvegarde du JPG
      jpg.SaveToFile('Test.jpg');
    Finally
      jpg.Free;
      bmp.Free;
    End;
 
   image1.Refresh;
end;

@+,

Cincap

[cincap]

Bonjour à toutes et à tous,

@ Ph. B., voila avec ton code, en le remaniant pour avoir le fond transparent et la couleur du texte en utilisant un Tlabel ou Tmemo.

Code :

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

1
2
3
4
5
6
7
8
9
 
x := (R.Right + R.Left - Bmp.Canvas.TextWidth(ch)) div 2;
y := (Bmp.Height + R.Bottom - Bmp.Canvas.TextHeight(ch))div 2;
 
//ch :=form1.Label1.Caption; 
ch :=form1.memo1.text;
bmp.canvas.Brush.Style := bsClear;
bmp.Canvas.Font.Color := clwhite;
Bmp.Canvas.TextOut(x, y, ch);

Ce post est donc résolut.

Merci @ tous

@+,

Cincap

[Andnotor]

Le calcul de la transparence est inversé : (CouleurPremierPlan *Alpha) + (CouleurFond *(1 -Alpha))

Du texte antialiasé en transparence en GDI, c'est carrément galère. Il faut passer par un bitmap intermédiaire en niveau de gris sur lequel sera écrit le texte. Ces niveaux de gris correspondront au canal alpha. Enfin reporter ce bitmap par Scanline sur celui de destination à l'aide de la formule ci-dessus.

ps: Peut-être temps de passer à GDI+ qui gère parfaitement les couleurs en 32 bits.

[cincap]

@ Andnotor, merci de ta réponse, mais je me limite a des petites applications personnelles, à mon âge.
Ceci étant dit, la procédure pour les frames est de Gilbert.

http://www.developpez.net/forums/d99...bitmap-resolu/

@+,

Cincap