Amélioration d'une procédure d'effet Amboss sous D6

**cincap** · 28/09/2019, 10h07

Bonjour à toutes et à tous,

Avec cette ancienne procédure d'effet Amboss, j'estime que le résultat n'est pas au top car peu prononcé même en ajustant la valeur de départ qui est 1 pour mon test.

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
 
procedure Emboss(ABitmap : TBitmap; AMount : Integer);
var
  x, y, i : integer;
  p1, p2: PByteArray;
begin
  for i := 0 to AMount do
  begin
    for y := 0 to ABitmap.Height-2 do
    begin
      p1 := ABitmap.ScanLine[y];
      p2 := ABitmap.ScanLine[y+1];
      for x := 0 to ABitmap.Width do
      begin
        p1[x*3] := (p1[x*3]+(p2[(x+3)*3] xor $FF)) shr 1;
        p1[x*3+1] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
        p1[x*3+2] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
      end;
    end;
  end;
 end;

Utilisation :

Code :

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

1
2
3
 
emboss(Image1.Picture.bitmap,eb.value); //eb = TSpinEdit
image1.Refresh;

Mon image de départ est au format .jpg donc conversion vers Bitmap puis effet.

Si vous avez une idée de modification, je suis preneur.

En vous remerciant d'avance.

@+,

cincap

**Charly910** · 28/09/2019, 18h58

Bonjour,

cette procédure applique un filtre sur les pixels de 2 lignes. Normalement le noyau du filtre a une dimension de 3 x 3 avec pour un filtre d'embossage classique :
-2 -1 0
-1 0 1
0 1 2

On retouche donc le pixel central en fonction des 9 pixels concernés.

je vais essayer de regarder ce que je peux faire avec la méthode classique

A+
Charly

**cincap** · 29/09/2019, 09h52

Bonjour à toutes et à tous,

@ Charly910, merci de te préocuper sur mon problème, en attache un .zip qui permet de faire des effets et l'effet souhaité qui se nomme "Relief".

Cordialement,

cincap

**Cirec** · 29/09/2019, 14h58

Bonjour,

j'ai tenté le coup et voici le code
il y a:
procedure Emboss(ABitmap : TBitmap; AMount : Integer);.
qui se rapproche le plus de ton code de départ
procedure Emboss2(ABitmap : TBitmap; AMount : Integer);.
une variante qui donne de beau résultat ...
et
procedure BmpRelief(SBmp, DBmp: TBitmap; MedianGrayValue: Integer = 128);.
qui est tiré du dernier zip que tu as fourni.

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
procedure Emboss(ABitmap : TBitmap; AMount : Integer);
var
  x, y, i : integer;
  p1, p2: PByteArray;
begin
  ABitmap.PixelFormat := pf24bit;
  for i := 0 to AMount-1 do
  begin
    for y := 0 to ABitmap.Height-2 do
    begin
      p1 := ABitmap.ScanLine[y];
      p2 := ABitmap.ScanLine[y+1];
      for x := 0 to ABitmap.Width do
      begin
        p1[x*3] := (p1[x*3]+(p2[Abs((x-3)*3)] xor $FF)) shr 1;
        p1[x*3+1] := (p1[x*3+1]+(p2[Abs((x-3)*3+1)] xor $FF)) shr 1;
        p1[x*3+2] := (p1[x*3+1]+(p2[Abs((x-3)*3+1)] xor $FF)) shr 1;
//
        p1[x*3] := (p1[x*3] * 29 + p1[x*3+1] * 150 + p1[x*3+2] * 77) shr 8;
        p1[x*3+1] := p1[x*3];
        p1[x*3+2] := p1[x*3];
      end;
    end;
  end;
 end;
 
procedure Emboss2(ABitmap : TBitmap; AMount : Integer);     
var
  x, y, i : integer;
  p1, p2: PByteArray;
begin
  ABitmap.PixelFormat := pf24bit;
  for i := 0 to AMount-1 do
  begin
    for y := 0 to ABitmap.Height-2 do
    begin
      p1 := ABitmap.ScanLine[y];
      p2 := ABitmap.ScanLine[y+1];
      for x := 0 to ABitmap.Width do
      begin
        p1[x*3] := (p1[x*3]+(p2[x*3] xor $FF)) shr 1;
        p1[x*3+1] := (p1[x*3+1]+(p2[x*3+1] xor $FF)) shr 1;
        p1[x*3+2] := (p1[x*3+1]+(p2[x*3+1] xor $FF)) shr 1;
 
        p1[x*3] := (p1[x*3] * 29 + p1[x*3+1] * 150 + p1[x*3+2] * 77) shr 8;
        p1[x*3+1] := p1[x*3];
        p1[x*3+2] := p1[x*3];
      end;
    end;
  end;
 end;
 
procedure TForm10.Button1Click(Sender: TObject);
begin
  if Opd1.Execute then
    Image1.Picture.LoadFromFile(Opd1.FileName);
end;
 
procedure BmpRelief(SBmp, DBmp: TBitmap; MedianGrayValue: Integer = 128);
const
 {// NTSC and PAL uses 0.299 * red + 0.587 * green + 0.114 * blue}
  //RP = 0.2989;
  //GP = 0.5866;
  //BP = 1 - RP - GP;
 {// ITU-R Recommendation BT.709, "Basic Parameter Values for the Studio and for International
  // Programme Exchange (1990) [formerly CCIR Rec. 709]
  // source : http://paulbourke.net/miscellaneous/imageprocess/}
  RP = 0.2125;
  GP = 0.7154;
  BP = 0.0721;
var
  X, Y: Integer;
  P   : TColor;
  r,g,b : byte;
  light1,light2,vlight : Integer;
begin
   DBmp.Assign(SBmp);
   For y := 0 to SBmp.height do
   begin
     For x :=0 to SBmp.width do
     begin
 
       P := SBmp.Canvas.Pixels[X-3, Y-3];
       r := (P and $0000FF);
       g := (P and $00FF00) shr 8;
       b := (P and $FF0000) shr 16;
       light1 := trunc (r * RP + g * GP + b * BP);
 
       P := SBmp.Canvas.Pixels[X, Y];
       r := (P and $0000FF);
       g := (P and $00FF00) shr 8;
       b := (P and $FF0000) shr 16;
       light2 := trunc (r * RP + g * GP + b * BP);
 
       vlight := (MedianGrayValue + light2 - Light1);
 
       if vlight < 0 then vlight := 0;
       if vlight > 255 then vlight := 255;
       DBmp.Canvas.Pixels[X, Y] := vlight * $010101;
     end;
  end;
end;
 
procedure TForm10.Button2Click(Sender: TObject);
begin
  if Opd1.Execute then
  begin
    Image1.Picture.Bitmap.LoadFromFile(Opd1.FileName);
    Image2.Picture.Assign(Image1.Picture);
    Emboss(Image2.Picture.Bitmap, 1);
    Image2.Invalidate;
 
    Image3.Picture.Assign(Image1.Picture);
    Emboss2(Image3.Picture.Bitmap, 1);
    Image3.Invalidate;
 
    Image4.Picture.Assign(Image1.Picture);
    BmpRelief(Image1.Picture.Bitmap, Image4.Picture.Bitmap);
    Image4.Invalidate;
  end;
end;

Image1 contient l'image originale
et Image2 à Image4 les différents résultats

Cordialement,

@+

**cincap** · 29/09/2019, 17h45

@ Cirec, merci de ton intervention, je testerai tantôt.

Pour le reste, j'ai tenté de le compiler et niet toujours erreur "[Erreur fatale] Impossible de créer le fichier de sortie 'Cirec\VCLReplaceMethode_2\Demo.exe'".

Je n'ai pas mis le chemin complet.

@+,

cincap

**Cirec** · 29/09/2019, 18h44

Envoyé par cincap

@ Cirec, merci de ton intervention, je testerai tantôt.

Pour le reste, j'ai tenté de le compiler et niet toujours erreur "[Erreur fatale] Impossible de créer le fichier de sortie 'Cirec\VCLReplaceMethode_2\Demo.exe'".

Je n'ai pas mis le chemin complet.

@+,

cincap

j'ai encore quelques modifs à faire pour l'Emboss

mais pour l'autre le code il fonctionne parfaitement j'ai même téléchargé un D6 perso pour m'en assurer

c'était juste un peu de cosmétique :
retirer "Variants" des uses, réaligner le TMemo à alBottom et recréer le *.res
c'est tout

tu peux donc le re-télécharger (le lien reste le même) et enfin tester ... tout y est

Cordialement,

@+

**cincap** · 29/09/2019, 18h46

@ Cirec,

J'ai testé et les deux premières méthodes sont plus rapide que la dernière car je les utilises avec des photos de 1920 x 1080 mais celle ci a un meilleur résultat.

Pour le reste c'est ok à la compilation et j'ai testé plusieurs formats photos sous D6 et Windows 10.

Mais, j'ai du remettre les composants sur la forme car pas à leur place sur mon Delphi 6.

Encore merci,

P. S. nos messages se sont croisés, je n'avais pas retéléchargé la version, encore bravo pour cette démo.

@+,

cincap

**Cirec** · 29/09/2019, 23h13

Envoyé par cincap

@ Cirec,

J'ai testé et les deux premières méthodes sont plus rapide que la dernière car je les utilises avec des photos de 1920 x 1080 mais celle ci a un meilleur résultat.

...
cincap

Alors celle-ci devrait faire ton bonheur

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
procedure BmpRelief2(SBmp, DBmp: TBitmap; BottomStart: Boolean = False; Dist: Integer = -3;
  MedianGrayValue: Integer = 128);
const
 {// NTSC and PAL uses 0.299 * red + 0.587 * green + 0.114 * blue}
  //RP = 0.2989;
  //GP = 0.5866;
  //BP = 1 - RP - GP;
 {// ITU-R Recommendation BT.709, "Basic Parameter Values for the Studio and for International
  // Programme Exchange (1990) [formerly CCIR Rec. 709]
  // source : http://paulbourke.net/miscellaneous/imageprocess/}
  RP           = 0.2125;
  GP           = 0.7154;
  BP           = 0.0721;
var
  X, Y, X2, Y2 : Integer;
  PixelSize, LineSize: Integer;
  Direction    : Integer;
  SourcePos, DestPos: Cardinal;
  OffsetPixel  : TRGBQuad;
  OffsetPos,
    Light1, Light2, VLight: Integer;
begin
  SBmp.PixelFormat := pf32bit;
  DBmp.PixelFormat := pf32bit;
  PixelSize := 4;
  LineSize := SBmp.width * PixelSize;
  if BottomStart then
  begin
    SourcePos := Cardinal(SBmp.ScanLine[SBmp.Height - 1]);
    DestPos := Cardinal(DBmp.ScanLine[DBmp.Height - 1]);
    Direction := 1;
  end
  else
  begin
    SourcePos := Cardinal(SBmp.ScanLine[0]);
    DestPos := Cardinal(DBmp.ScanLine[0]);
    Direction := -1;
  end;
  for Y := 0 to SBmp.Height - 1 do
  begin
    Y2 := Y + Dist;
    for X := 0 to SBmp.Width - 1 do
    begin
      X2 := X + Dist;
      OffsetPos := X * PixelSize + Direction * (Y * LineSize);
      with PRgbQuad(OffsetPos + SourcePos)^ do
        Light2 := Trunc(rgbRed * RP + rgbGreen * GP + rgbBlue * BP);
      if (((X2 or Y2) < 0) or ((X2 > SBmp.Width - 1) or (Y2 > SBmp.Height - 1))) then
        Integer(OffsetPixel) := -1
      else
        OffsetPixel := PRgbQuad((X2 * PixelSize + Direction * (Y2 * LineSize)) + SourcePos)^;
      with OffsetPixel do
        Light1 := Trunc(rgbRed * RP + rgbGreen * GP + rgbBlue * BP);
 
      vlight := (128 + light2 - Light1);
 
      if VLight < 0 then VLight := 0;
      if VLight > 255 then VLight := 255;
      Integer(PRgbQuad(OffsetPos + DestPos)^) := VLight * $010101;
    end;
  end;
end;

en changeant BottomSart (True/False) et Dist (-3..3) ça joue sur l'impression de profondeur

sinon pour un résultat à l'identique à BmpRelief
il suffit de laisser ces paramètres par défaut: BmpRelief2(SBmp, DBmp);

Cordialement,

@+

**cincap** · 30/09/2019, 08h37

Bonjour à toutes et à tous,

@ Cirec, merci pour cette amélioration plus rapide mais j'obtiens un résultat surprenant avec une photo .bmp de 1920 x 1080 (en attache).

Par contre je ne saurai pas l'utiliser dans mon projet car je télécharge un fichier .jpg et est convertit en Bitmap afin de faire des effets et donc je n'ai que la variable "Bmp" à utiliser puisque dans le Timage c'est le fichier .jpg.

Avec les procédures "Amboss et Amboss2" il n'y a pas de problème car je n'ai qu'à mettre dans le processus Bmp à la place de image1.picture.bitmap.

@+,

cincap

**cincap** · 30/09/2019, 08h55

@ Cirec,

Rectification cela fonctionne bien dans mon projet, j'ai modifié comme ceci :

Code :

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

1
2
 
if Ckb4.Checked then BmpRelief2(Image1.Picture.Bitmap, bmp);

Et aussi dans le projet test en modifiant ceci :

Code :

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

1
2
 
 BmpRelief2(Image1.Picture.Bitmap, Image4.Picture.Bitmap); //J'avais mis  BmpRelief2(Image4.Picture.Bitmap, Image4.Picture.Bitmap);

Topic fermé haut la main.

@ tous, merci de votre participation.

@+,

cincap

**Charly910** · 30/09/2019, 11h33

Bonjour,

je poste quand même ma solution, même si elle est surement moins bonne que celle de Cirec.

J'applique un filtre de convolution de taille 3x3 à l'image originale. cela conserve quelques couleurs dans l'image résultantes.

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
{ ==================================================================== }
CONST
  PixelCountMax = 65536;
Type
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = ARRAY[0..PixelCountMax-1] of TRGBTriple;
{ ======================================================================= }
procedure TF_Princ.Btn_EmbossageClick(Sender: TObject);
Var
  Bmp : TBitmap ;
begin
  if (not Assigned(Image1.Picture.Graphic)) or (Image1.Picture.Graphic.Empty) then
    Begin
      Showmessage('Charger d''abord une image') ;
      Exit ;
    End ;
  Bmp := TBitmap.Create ;
  Bmp.Assign(Image1.Picture.Bitmap);
  Embossage( Bmp );
  Image1.Picture.Bitmap.Assign(Bmp);
  Bmp.Free ;
end;
{ ================================================================== }
Procedure TF_Princ.Embossage( Var bmp1 : TBitmap ) ;
var
  x2, y2 : integer;    // Lignes et colonnes du bitmap - x1, y1 : Pixel à traiter par le filtre
  x1, y1 : integer;
  x0, y0 : integer;
  scanrows0 : array[0..4000] of pRGBTripleArray ;      // Image originale
  row0 : PRGBTripleArray;      //  3 lignes utilisées par le filtre
  row1 : PRGBTripleArray;
  row2 : PRGBTripleArray;
  j, i : integer;
//  R, G, B : integer;
  VR , VG, VB : Integer  ;     //  compoisante du pixel x1, y1
  Imagebmp : TBitMap ;
  Ascanrows0 : array[0..4000] of pRGBTripleArray;     // Image transformée par le filtre
  Arow1 : PRGBTripleArray;                            // Ligne du bitmap transformée
  a : array[0..2, 0..2] of Real ;  //  coefficients du noyau du filtre
  K : Real ;                       //  pondération du filtre  ( = 1 en general)
  Somme : Real ;                   //  Somme des termes du noyau du filtre
 
begin
  if bmp1.height > 4000 then exit; // bitmap trop grand (à voir ?)
  if bmp1.Width > 4000 then exit; // bitmap trop grand
 
  K := 1 ;   // Cas général sinon on peut forcer avec une valeur supérieure
 
  a[0,0 ] := -2 * K ;
  a[0,1 ] := -1 * K ;
  a[0,2 ] :=  0 * K ;
  a[1,0 ] := -1 * K ;
  a[1,1 ] :=  0 * K ;
  a[1,2 ] :=  1 * K ;
  a[2,0 ] :=  0 * K ;
  a[2,1 ] :=  1 * K ;
  a[2,2 ] :=  2 * K ;
 
  Somme := 0  ;
  For i := 0 to 2 Do
  For j := 0 To 2 Do
    Somme := Somme + a[i, j] ;
 
  Bmp1.PixelFormat := pf24bit	 ;
 
  Imagebmp := Tbitmap.create;
  Imagebmp.pixelformat := pf24bit;
  ImageBmp.Width  := Bmp1.Width;
  ImageBmp.Height := Bmp1.Height;
  ImageBmp.Assign(bmp1);
  for y0 := 0 to ImageBMP.height-1 do Ascanrows0[y0] := ImageBmp.scanline[y0];
 
  for y0 := 0 to Bmp1.height-1 do scanrows0[y0] := bmp1.scanline[y0];
 
  // Traitement par le filtre
  For y1 := 1 To bmp1.height-2 Do
    Begin
      y0 := y1 - 1 ;
      Row0  :=  Scanrows0[y0];
      Row1  :=  Scanrows0[y1];
      ARow1  :=  AScanrows0[y1];
      y2 := y1 + 1 ;
      Row2  :=  Scanrows0[y2];
      For x1 := 1 To bmp1.Width-2 Do
        Begin
          X0 := x1 -1 ;
          x2 := X1 + 1 ;
          VR := Round(Row0[x0].rgbtRed * a[0 , 0] +
                Row0[x1].rgbtRed * a[0 , 1] +
                Row0[x2].rgbtRed * a[0 , 2] +
                Row1[x0].rgbtRed * a[1 , 0] +
                Row1[x1].rgbtRed * a[1 , 1] +
                Row1[x2].rgbtRed * a[1 , 2] +
                Row2[x0].rgbtRed * a[2 , 0] +
                Row2[x1].rgbtRed * a[2 , 1] +
                Row2[x2].rgbtRed * a[2 , 2] ) ;
          If Somme = 0 Then VR := VR + 128
                       Else VR := Round(VR / Somme) ;
          If VR < 0 Then VR := 0 ;
          If VR > 255 Then VR := 255 ;
          ARow1[x1].rgbtRed := VR ;
 
          VG := Round(Row0[x0].rgbtGreen * a[0 , 0] +
                Row0[x1].rgbtGreen * a[0 , 1] +
                Row0[x2].rgbtGreen * a[0 , 2] +
                Row1[x0].rgbtGreen * a[1 , 0] +
                Row1[x1].rgbtGreen * a[1 , 1] +
                Row1[x2].rgbtGreen * a[1 , 2] +
                Row2[x0].rgbtGreen * a[2 , 0] +
                Row2[x1].rgbtGreen * a[2 , 1] +
                Row2[x2].rgbtGreen * a[2 , 2])  ;
          If Somme = 0 Then VG := VG + 128
                       Else VG := Round(VG / Somme) ;
          If VG < 0 Then VG := 0 ;
          If VG > 255 Then VG := 255 ;
          ARow1[x1].rgbtGreen := VG ;
 
          VB := Round(Row0[x0].rgbtBlue * a[0 , 0] +
                Row0[x1].rgbtBlue * a[0 , 1] +
                Row0[x2].rgbtBlue * a[0 , 2] +
                Row1[x0].rgbtBlue * a[1 , 0] +
                Row1[x1].rgbtBlue * a[1 , 1] +
                Row1[x2].rgbtBlue * a[1 , 2] +
                Row2[x0].rgbtBlue * a[2 , 0] +
                Row2[x1].rgbtBlue * a[2 , 1] +
                Row2[x2].rgbtBlue * a[2 , 2])   ;
          If Somme = 0 Then VB := VB + 128
                       Else VB := Round(VB / Somme) ;
          If VB < 0 Then VB := 0 ;
          If VB > 255 Then VB := 255 ;
          ARow1[x1].rgbtBlue := VB ;
        End ;
    End ;
  // Recopie du bitmap transformé dans le bitmap original
  Bmp1.Assign(ImageBMP);
  ImageBmp.Free ;
end;
{ ========================================================================= }

Avec cette méthode on peut tester d'autres filtres en modifiant le noyau du filtre a[i, j].

A+
Charly

PS : une conversion préalable en niveaux de gris avec Gray := Round(0.2125 * RgbtRed + 0.7154 * RgbtGreen + 0.0721 * RgbtBlue)
permet d'obtenir une image proche de celle du relief de Cirec

**cincap** · 30/09/2019, 17h59

@ Charly910, merci d'avoir cherché à modifier le code afin d'une amélioration malgré que le topic était fermé.

Après test, le résultat est meilleur que la procédure énoncée au 1er poste et moins bon que la modification faite par Cirec (légère trace de couleurs mais cela tu le savais).

Dans mon test j'ai utilisé les 4 procédures et c'est "Bmprelief2" que j'ai retenue.

Encore merci de ton aide.

@+,

cincap

Amélioration d'une procédure d'effet Amboss sous D6

Delphi

Discussions similaires

Partager

Partager