Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre éprouvé
    Profil pro
    Inscrit en
    janvier 2006
    Messages
    1 882
    Détails du profil
    Informations personnelles :
    Âge : 66
    Localisation : Belgique

    Informations forums :
    Inscription : janvier 2006
    Messages : 1 882
    Points : 1 161
    Points
    1 161
    Par défaut Amélioration d'une procédure d'effet Amboss sous D6
    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

  2. #2
    Membre chevronné
    Avatar de Charly910
    Homme Profil pro
    Ingénieur TP
    Inscrit en
    décembre 2006
    Messages
    1 483
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur TP
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : décembre 2006
    Messages : 1 483
    Points : 2 235
    Points
    2 235
    Par défaut
    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

  3. #3
    Membre éprouvé
    Profil pro
    Inscrit en
    janvier 2006
    Messages
    1 882
    Détails du profil
    Informations personnelles :
    Âge : 66
    Localisation : Belgique

    Informations forums :
    Inscription : janvier 2006
    Messages : 1 882
    Points : 1 161
    Points
    1 161
    Par défaut
    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
    Fichiers attachés Fichiers attachés

  4. #4
    Membre éclairé
    Avatar de Cirec
    Profil pro
    Inscrit en
    octobre 2010
    Messages
    351
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : octobre 2010
    Messages : 351
    Points : 824
    Points
    824
    Par défaut
    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,

    @+

  5. #5
    Membre éprouvé
    Profil pro
    Inscrit en
    janvier 2006
    Messages
    1 882
    Détails du profil
    Informations personnelles :
    Âge : 66
    Localisation : Belgique

    Informations forums :
    Inscription : janvier 2006
    Messages : 1 882
    Points : 1 161
    Points
    1 161
    Par défaut
    @ 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

  6. #6
    Membre éclairé
    Avatar de Cirec
    Profil pro
    Inscrit en
    octobre 2010
    Messages
    351
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : octobre 2010
    Messages : 351
    Points : 824
    Points
    824
    Par défaut
    Citation Envoyé par cincap Voir le message
    @ 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,

    @+

  7. #7
    Membre éprouvé
    Profil pro
    Inscrit en
    janvier 2006
    Messages
    1 882
    Détails du profil
    Informations personnelles :
    Âge : 66
    Localisation : Belgique

    Informations forums :
    Inscription : janvier 2006
    Messages : 1 882
    Points : 1 161
    Points
    1 161
    Par défaut
    @ 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

  8. #8
    Membre éclairé
    Avatar de Cirec
    Profil pro
    Inscrit en
    octobre 2010
    Messages
    351
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : octobre 2010
    Messages : 351
    Points : 824
    Points
    824
    Par défaut
    Citation Envoyé par cincap Voir le message
    @ 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,

    @+

  9. #9
    Membre éprouvé
    Profil pro
    Inscrit en
    janvier 2006
    Messages
    1 882
    Détails du profil
    Informations personnelles :
    Âge : 66
    Localisation : Belgique

    Informations forums :
    Inscription : janvier 2006
    Messages : 1 882
    Points : 1 161
    Points
    1 161
    Par défaut
    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
    Images attachées Images attachées  

  10. #10
    Membre éprouvé
    Profil pro
    Inscrit en
    janvier 2006
    Messages
    1 882
    Détails du profil
    Informations personnelles :
    Âge : 66
    Localisation : Belgique

    Informations forums :
    Inscription : janvier 2006
    Messages : 1 882
    Points : 1 161
    Points
    1 161
    Par défaut
    @ 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

  11. #11
    Membre chevronné
    Avatar de Charly910
    Homme Profil pro
    Ingénieur TP
    Inscrit en
    décembre 2006
    Messages
    1 483
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur TP
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : décembre 2006
    Messages : 1 483
    Points : 2 235
    Points
    2 235
    Par défaut
    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

  12. #12
    Membre éprouvé
    Profil pro
    Inscrit en
    janvier 2006
    Messages
    1 882
    Détails du profil
    Informations personnelles :
    Âge : 66
    Localisation : Belgique

    Informations forums :
    Inscription : janvier 2006
    Messages : 1 882
    Points : 1 161
    Points
    1 161
    Par défaut
    @ 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

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 5
    Dernier message: 06/10/2010, 20h07
  2. Réponses: 14
    Dernier message: 14/01/2009, 16h59
  3. Appel d'une procédure stockée sous VB 6
    Par Polux000 dans le forum VB 6 et antérieur
    Réponses: 1
    Dernier message: 11/01/2006, 10h21
  4. Réponses: 4
    Dernier message: 12/12/2005, 18h25
  5. Pb pour executer une procédure sous SQL PLUS
    Par rabddoul dans le forum Oracle
    Réponses: 4
    Dernier message: 21/10/2005, 16h40

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo