Travailler avec TBitmap et des fichiers bmp sous Linux

**BeanzMaster** · 23/02/2019, 12h29

Envoyé par tourlourou

@Jérôme : je n'ai pas (encore ?) bien compris comment modifier ton code pour automatiser les tests en parcourant une arborescence de fichiers et enregistrant le succès ou l'erreur d'ouverture...
Certaines erreurs (critiques, avec badbitcount.bmp par exemple) affichent une boîte mais ne remontent pas au Viewer dont la CallBack OnBitmapLoadError n'est pas déclenchée ?

Effectivement les erreurs qui ne permettent pas l'affichage ne sont pas remontées dans le CallBack
Pour qu'elles soient remonté il faudrait peut-être remplacé

dans uBMPViewer

dans procedure checkformat vers la ligne 1200 par exemple

Code :

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

1
2
3
4
5
    begin
      Result := False;
      s:= bfType[0] + bfType[1];
      Raise Exception.Create(Format(rsBadSignature,[s]));
    End;

Par

Code :

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

1
2
3
4
5
6
    begin
      Result := False;
      s:= bfType[0] + bfType[1];
      //Raise Exception.Create(Format(rsBadSignature,[s]));
      AddError(Format(rsBadSignature,[s]));
    End;

Mais du coup si le CallBack n'est pas assigné aucune erreur ne sera visible et bien sur rien ne s'affichera. Ce type d'erreur est critique. C'est pour cela que j'ai utilisé Raise et non procedure AddError(Msg:String);La solution pour l'affichage, peut-être, cf plus bas la procedure NotifyUser ?????

Envoyé par tourlourou

Les erreurs permettant quand même l'affichage remontent apparemment, mais peuvent être difficiles à synthétiser : badrle.bmp, par exemple, avec 106580 erreurs identiques 'Données de la compression RLE 8 Bits corrompues'.
Comment savoir si succès autrement qu'en le supposant ?

Oui effectivement c'est compliqué de synthétiser toutes les erreurs au niveau du décodage RLE (entre autres) car elles peuvent survenir n'importe quand.

[EDIT] Pour répondre brièvement à ta question "Comment savoir si succès autrement qu'en le supposant ?" : juste en testant ErrorCount >0 (erreurs d'encodage mais affichage ok)[/EDIT]

Exemple, dans Procedure LoadFromMemory(); vers la ligne 2238

Code :

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

1
2
3
4
5
6
7
8
9
if (Data<FImageDescription.PaletteCount) then
                       begin
                         if (X<FBitmapData.Width) then
                         begin
                           DstLine^.AsInteger:= FImageDescription.PaletteEntries^[Data].AsInteger;
                           IgnoreAlpha := IgnoreAlpha and (DstLine^.alpha = 0);
                           IsOpaque := IsOpaque and (DstColor.alpha = 255);
                         End else AddError(rsBMPRLE8BitDataCorrupted);
                      End else AddError(rsBMPRLE8BitDataCorrupted);

Comme tu peux le voir c'est plutôt compliqué. A mon avis, le plus simple serait de modifié un peu la gestion des erreurs et procedure AddError qui pourrais alors prendre comme paramètre un type énuméré (ou un ID) plutôt qu'une chaine de caractère. Et on pourrait alors choisir le message en fonction. Et grâce a un ensemble, testé si une erreur similaire à déjà été levée et si oui, on n'ajoute pas de nouveau le message;

ce qui pourrait donner un truc dans le genre

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
Type
  TErrorType = (etRLE8BitDataCorrupted, elRLE4BitDataCorrupted, .....);
  TRaisedErrors = set of TErrorType;
 
 
Type 
  TBMPImageLoader = Class 
  private
    // Gestion des erreurs
    FErrorList:   TStringList;
    FErrorCount:  Integer;
    FOnLoadError: TBMPLoadErrorEvent;
    FRaisedErrors : TRaisedErrors;
   // FTotalErrorCount : Integer; pour avoir le nombre de total d'erreur déclenché
 
procedure AddError(Value :TErrorType);
var msg : string;
begin
  if not(Value  in FRaisedErrors) then
  begin
     FRaisedErrors := FRaisedErrors + [Value];
     Inc(FErrorCount);
     Case Value of
         etRLE8BitDataCorrupted : Msg := rsBMPRLE8BitDataCorrupted;
         ....
     End;
     FErrorList.Add(Msg);
 end 
 else Inc(FErrorCount);
end;

Dans ma version originel j'ai commencé avec un truc dans le genre :

Code :

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

1
2
Type
  TBZNotifySeverity = (nsInfo, nsWarning, nsError);

Qui permet d'affiner la gestion des erreurs en fonction de la sévérité de celle-ci

et le code suivant dans une classe parente que je dois mettre à jour (donc c'est du d'avoir un système uniforme commun pour toutes les différentes erreurs suivant le format de fichier avec un seul type énuméré)

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
Procedure TBZCustomImageFileIO.RaiseInvalidImageFile(Msg: String);
begin
  raise EInvalidImageData.Create('Erreur lors du chargement du fichier : '+ExtractFileName(FullFileName)+#13+#10+
                                   'au format '+DataFormatDesc.Name+' - '+DataFormatDesc.Desc+#13+#10+
                                   'Message : '+Msg);
End;
 
Procedure TBZCustomImageFileIO.NotifyUser(Msg: String; Const Severity: TBZNotifySeverity);  // ---> Fonction appelée depuis addError en fonction d'un boolean
Begin
  Case Severity of
    nsInfo :
      begin
       MessageDlg(Msg, mtInformation, [mbOK],0);
        //Adderror(MSq);  ---> A voir si il faut mieux appeler AddError ici plutôt que notifyuser dans AddError
      End;
    nsWarning :
      begin
        MessageDlg(Msg, mtWarning, [mbOK],0);
        //AddError(Msg);
      End;
    nsError :
      begin
        RaiseInvalidImageFile(Msg);
      End;
  End;
End;

La gestion des erreurs est une des parties sur laquelle je dois plancher pour essayer de trouver plus ou moins une méthode simple et universelle. (Dans mon projet mes "Loader" héritent de classes parente, ce qui complique un peu les choses)

Est ce que cela t'aides un peu ?

**BeanzMaster** · 23/02/2019, 12h41

Autre chose à laquelle je viens de penser :

Ajouter une Propriété ou une fonction IsLoaded : Boolean

Code :

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

1
2
3
4
5
6
 begin
      Result := False;
      s:= bfType[0] + bfType[1];
      FIsLoaded := False; //--->Valeur de test si image chargée et affichée ou pas
      Raise Exception.Create(Format(rsBadSignature,[s]));
    End;

[EDIT]

Test dans application ou TBMPViewer ????

Code :

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

1
2
3
4
5
6
If BMPLoader.IsLoaded then
begin
   if BMPLoader.ErrorCount > 0 then ERREUR D'ENCODAGE
   Else IMAGE OK
end
else  IMAGE KO

**tourlourou** · 23/02/2019, 15h57

Effectivement, il y a des pistes pour faire remonter plus d'infos.
Je l'ai joué plus crade

pour obtenir ceci sous CT6.5 Win10 en 64Bits (bientôt sous Ubuntu) :

**tourlourou** · 23/02/2019, 16h36

Et voici sous CT6.4 Ubuntu18.04 64 Bits ; à vue de nez, ça me semble pareil... NB : pas de contrôle visuel : dis-moi quels fichiers cibler si besoin.

**der§en** · 24/02/2019, 00h18

Envoyé par BeanzMaster;10785211
[B

@Dersen : [/B]Bonne nouvelle ! en faisant quelques modifs (sans passer par les routines de Lazarus, en utilisant un TFastBitmap pour un stretch à la mano et en utilisant directement les API de Windows) j'ai pu afficher le bitmap en 64000x18000 du logo de firefox que j'ai mal traité en le redimensionnant à cette dimension (donc si il est aplatie c'est normal

)

Pièce jointe 452435

Bonne fin de journée

J’attends la suite avec impatience

**Jipété** · 24/02/2019, 08h21

Salut salut,

et moi il y a un truc que je ne comprends pas, là :

Envoyé par tourlourou

(bientôt sous Ubuntu)

Envoyé par tourlourou

à vue de nez, ça me semble pareil...

La première phrase laisse penser qu'on va bientôt avoir le résultat de tests similaires exécutés dans un autre environnement, ce que confirmerait la seconde phrase.

Mais quand on compare en vrai après avoir téléchargé les deux fichiers de résultats, on se rend compte avec stupéfaction que la seconde série a utilisé une liste de .bmp complètement différente de la première série et qu'il est donc (pour moi) impossible de comparer quoi que ce soit.

**der§en** · 24/02/2019, 11h27

Envoyé par BeanzMaster

@Dersen : Bonne nouvelle ! en faisant quelques modifs (sans passer par les routines de Lazarus, en utilisant un TFastBitmap pour un stretch à la mano et en utilisant directement les API de Windows) j'ai pu afficher le bitmap en 64000x18000 du logo de firefox que j'ai mal traité en le redimensionnant à cette dimension (donc si il est aplatie c'est normal

)

Je suis quand même curieux de voir comment tu y es arrivés !

**tourlourou** · 24/02/2019, 12h01

Envoyé par Jipété

la seconde série a utilisé une liste de .bmp complètement différente de la première série

Disons plutôt que Windows et Linux ne renvoient pas les fichiers dans le même ordre lors d'un FindAllFiles, ce qui ne favorise pas les comparaisons immédiates !
Pour comparer, il faudrait ajouter les lignes des 2 fichiers à un TStringList en DupIgnore et voir le résultat : si on n'a que les lignes de nouveau répertoire, ça montrera le même résultat.

**Jipété** · 26/02/2019, 00h40

Bonsoir,

Envoyé par Jipété

Bon sang, j'aimerais bien savoir ce qui manque à ce code pour afficher correctement les images.

J'ai enfin trouvé, mais ça aura été passablement laborieux et time consuming, un truc de fou.

Nom : analyse_3x2_2432_v1.png
Affichages : 297
Taille : 83,8 Ko

Cette image a été générée ex nihilo avec The Gimp, en choisissant 6 couleurs aux valeurs faciles à retrouver quand on regarde le fichier avec un éditeur hexa (parce qu'un fichier plein de FF FF FF 00 FF 00 FF FF 00 etc., je vous garantis que vous ne savez plus où vous en êtes...).
Là j'ai fait en sorte d'avoir 18 valeurs différentes, résultat on repère au premier coup d'œil le 4^e byte, l'alpha, dans le fichier pf32, tout comme les bytes de padding (soulignés, en plus) dans le pf24.

Dans le texte qu'on voit en bas j'ai noté depuis un color picker les valeur lues en décimal puis en hexa et, première constatation, il y a bien croisement des bytes R et B, très flagrant avec l'orange qui, dans la vraie vie a beaucoup de rouge (208₁₀ soit D0₁₆, D0 qu'on retrouve en 1^er quand on parle "RGB" dans le texte et en 3^e position dans le rangement des bytes du fichier, vu à l'éditeur hexa).

On confirme également que la 1^re ligne de l'image est bien la dernière dans le fichier, mais rien pour indiquer le passage d'une ligne à l'autre, à part des calculs (ne pas se fier au padding des pf24, il peut être absent ou variable de 1 à 3 -- et comme la couleur noire 0 0 0 est autorisée, ça complique la détection).

Et pourquoi tout ça ?
Parce qu'aller récupérer les datas du RawImage d'un TBitmap pf24bit, c'est curieux, très curieux, et passablement laborieux...

Code :

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

1
2
for i := 0 to bmp.RawImage.DataSize-1 do 
  memo1.Lines.Add(IntToStr(i) +'--'+ IntToStr(bmp.RawImage.Data[i]));

nous donne, avec le pf24 (saut de ligne simple après les pixels, double pour le changement de ligne) :

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
 0--201
 1--186
 2--117
 
 3--133
 4--185
 5--184
 
 6--204
 7--114
 8--156
 
 9--0 padding
10--0 padding
11--0 padding
 
 
12--0 ???
13--0 ???
14--0 ???
 
15--88  orange
16--136
17--208
 
18--170 parme
19--77
20--201
 
21--0 padding
22--0 padding
23--0 padding

Résultat : 3 bytes vides et on a perdu le vert foncé.

Avec le pf32 :

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
 0--201 bleuciel
 1--186
 2--117
 3--255
 
 4--133 beige
 5--185
 6--184
 7--255
 
 8--204 violet
 9--114
10--156
11--255
 
 
12--88  orange
13--136 
14--208
15--255
 
16--170 parme
17--77
18--201
19--255
 
20--100 vertfoncé
21--84
22--28
23--255

tout est correct.

Ici, juste le pf24, balayage de la RowLength avec ajout de l'adresse du pointeur en début de ligne :

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
3086787744
0--201
1--186
2--117
3--133
4--185
5--184
6--204
7--114
8--156
3086787756
0--0
1--0
2--0
3--0
4--0
5--0
6--88
7--136
8--208
 
balayage ligne complète en incluant le padding :
3086787744
0--201
1--186
2--117
3--133
4--185
5--184
6--204
7--114
8--156
9--0
10--0
11--0
3086787756
0--0
1--0
2--0
3--88
4--136
5--208
6--170
7--77
8--201
9--0
10--0
11--0

pas mieux.

Mais en ajoutant le padding à la ligne de création des datas

Code :

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

1
2
// BlockRead(f, pb^, RowLength, amt); // origine
BlockRead(f, pb^, RowLength + pad, amt);

on gagne ça :

Code :

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

Yeeeeeeeeeeeeeeeeeeeeeeeeeeesss !

Voilà.

Alors je ne sais pas s'il y a une opposition entre Windows et Linux ou entre pf24 et pf32, toujours est-il que le code en Delphi5 dont j'ai récemment parlé comporte donc un gros oubli, la prise en compte du padding (mais avec quoi l'auteur a-t-il donc fait ses tests ?) :
calcul du padding des pf24 :

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
  // longueur de la ligne, calcul d'origine
    Rowlength := (BitmapInfoHeader.biWidth
                * BitmapInfoHeader.biBitCount) div 8;
  // ajout calcul padding
    pad := 0;
    fullline := RowLength + pad;
    while (fullline mod 4 <> 0) do begin
      inc(pad);
      fullline := RowLength + pad;
    end;
 
//    for y := 0 to BitmapInfoHeader.biHeight - 1 do begin
// inverser le parcours pour 192x168x24
    for y := BitmapInfoHeader.biHeight - 1 downto 0 do begin
      pb := BitMap.RawImage.GetLineStart(y); {get ^ address of first byte on row - Laz}
//      BlockRead(f, pb^, RowLength, amt);  // tte la ligne est lue d'un coup
      // erreur, corrigée en prenant en compte le padding :
      BlockRead(f, pb^, RowLength + pad, amt);  // tte la ligne est lue d'un coup, padding compris !
    end; // ligne suivante

Je crois que je vais bazarder tout ce code D5 parce que mine de rien, j'aurais passé presque trois jours sur cette blague...
Normal, quand l'affichage part en vrac ou qu'on se récolte des montagnes d'AV, on pense plus à des erreurs dans son propre code que dans celui qu'on a trouvé et qu'on estime correct, sinon il ne serait pas publié, non ?

Que de temps perdu...

Deux images :
montage de deux vues des données de RawImage.Data, celle d'en haut après l'utilisation du code de chargement non modifié, et on voit bien qu'il y a trop de zéros, et dessous les mêmes datas chargées en prenant en compte le padding : ça change la vie, hein ! (les marques en orange sont là pour séparer les 2 lignes de datas.)

Nom : compar_2rawimage.png
Affichages : 266
Taille : 34,2 Ko

Nom : compar_2rawimage.png
Affichages : 266
Taille : 34,2 Ko

Ensuite, une image du code en action et donc pourquoi je vais le balancer :

Nom : rgbtriple_kc.png
Affichages : 266
Taille : 68,0 Ko

en bas à gauche l'agrandissement pour bien voir les couleurs du fichier utilisé, au milieu la série verticale des données RawImage.Data, en surligné les 3 bytes du carré orange, et à droite une loupe dont on voit la cible (le point noir) et l'analyse de la couleur ciblée : correct pour le orange et le bleu-ciel dessus, mais les 4 autres c'est mort, je ne sais pas pourquoi et je n'ai pas envie de passer une semaine là-dessus, surtout que j'ai constaté que ce code ne peut pas correctement ouvrir 127x64, pas plus que 250x250.

Allez, poubelle.
Les deux fichiers 3x2xXX_v1, si qqun veut jouer : 3x2_v1.bmp.zip

**BeanzMaster** · 26/02/2019, 23h18

Envoyé par Jipété

Bonsoir,

Alors je ne sais pas s'il y a une opposition entre Windows et Linux ou entre pf24 et pf32, toujours est-il que le code en Delphi5 dont j'ai récemment parlé comporte donc un gros oubli, la prise en compte du padding (mais avec quoi l'auteur a-t-il donc fait ses tests ?) :

Le code de Delphi n'a rien oublié c'est tout simplement que Delphi ne gère pas les Bitmaps comme un gros bourrin et que son code interne est plus fiable. Ce sont les Devs de Lazarus/FPC qui se sont comliqué la vie, et ça je le dis depuis le départ

Tiens regardes cette enregistrement provenant de Delphi RIO 10.3 pour la gestion des bitmaps

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
  TBitmapData = record
  private
    FPixelFormat: TPixelFormat;
    FWidth: Integer;
    FHeight: Integer;
    function GetBytesPerPixel: Integer;
    function GetBytesPerLine: Integer;
  public
    Data: Pointer;
    Pitch: Integer;
    constructor Create(const AWidth, AHeight: Integer; const APixelFormat: TPixelFormat);
    function GetPixel(const X, Y: Integer): TAlphaColor;
    procedure SetPixel(const X, Y: Integer; const AColor: TAlphaColor);
    procedure Copy(const Source: TBitmapData);
    // Access to scanline in PixelFormat
    function GetScanline(const I: Integer): Pointer;
    function GetPixelAddr(const I, J: Integer): Pointer;
    property PixelFormat: TPixelFormat read FPixelFormat;
    property BytesPerPixel: Integer read GetBytesPerPixel;
    property BytesPerLine: Integer read GetBytesPerLine;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
  end;

Voila comparé au TRawImage

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
  { TRawImageDescription }
 
  TRawImageDescription = object
    Format: TRawImageColorFormat;
    Width: cardinal;
    Height: cardinal;
    Depth: Byte; // used bits per pixel
    BitOrder: TRawImageBitOrder;
    ByteOrder: TRawImageByteOrder;
    LineOrder: TRawImageLineOrder;
    LineEnd: TRawImageLineEnd;
    BitsPerPixel: Byte; // bits per pixel. can be greater than Depth.
    RedPrec: Byte;      // red or gray precision. bits for red
    RedShift: Byte;     // bitshift. Direction: from least to most significant
    GreenPrec: Byte;
    GreenShift: Byte;
    BluePrec: Byte;
    BlueShift: Byte;
    AlphaPrec: Byte;
    AlphaShift: Byte;
 
    // The next values are only valid, if there is a mask (MaskBitsPerPixel > 0)
    // Masks are always separate with a depth of 1 bpp. One pixel can occupy
    // one byte at most
    // a value of 1 means that pixel is masked
    // a value of 0 means the pixel value is shown
    MaskBitsPerPixel: Byte; // bits per mask pixel, usually 1, 0 when no mask
    MaskShift: Byte;        // the shift (=position) of the mask bit
    MaskLineEnd: TRawImageLineEnd;
    MaskBitOrder: TRawImageBitOrder;
 
    // The next values are only valid, if there is a palette (PaletteColorCount > 0)
    PaletteColorCount: Word;   // entries in color palette. 0 when no palette.
    PaletteBitsPerIndex: Byte; // bits per palette index, this can be larger than the colors used
    PaletteShift: Byte;        // bitshift. Direction: from least to most significant
    PaletteLineEnd: TRawImageLineEnd;
    PaletteBitOrder: TRawImageBitOrder;
    PaletteByteOrder: TRawImageByteOrder;
 
    // don't use a constructor here, it will break compatibility with a record
    procedure Init;
 
    // 1-bit mono format
    procedure Init_BPP1(AWidth, AHeight: integer);
 
    // 16-bits formats
    procedure Init_BPP16_R5G6B5(AWidth, AHeight: integer);
 
    // Formats in RGB order
    procedure Init_BPP24_R8G8B8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP24_R8G8B8_BIO_TTB_UpsideDown(AWidth, AHeight: integer);
    procedure Init_BPP32_A8R8G8B8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_R8G8B8A8_BIO_TTB(AWidth, AHeight: integer);
 
    // Formats in Windows pixels order: BGR
    procedure Init_BPP24_B8G8R8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP24_B8G8R8_M1_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_B8G8R8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_B8G8R8_M1_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_B8G8R8A8_BIO_TTB(AWidth, AHeight: integer);
    procedure Init_BPP32_B8G8R8A8_M1_BIO_TTB(AWidth, AHeight: integer);
 
    function GetDescriptionFromMask: TRawImageDescription;
    function GetDescriptionFromAlpha: TRawImageDescription;
 
    //returns indices of channels in four-element array
    procedure GetRGBIndices(out Ridx, Gidx, Bidx, Aidx:Byte);
 
    function BytesPerLine: PtrUInt;
    function BitsPerLine: PtrUInt;
    function MaskBytesPerLine: PtrUInt;
    function MaskBitsPerLine: PtrUInt;
 
    function AsString: string;
    function IsEqual(ADesc: TRawImageDescription): Boolean;
  end;
  PRawImageDescription = ^TRawImageDescription;
 
  // Note: not all devices/images have all parts at any time. But if a part can
  // be applied to the device/image, the 'Description' describes its structure.
 
 
  TRawImagePosition = record
    Byte: PtrUInt;
    Bit: cardinal;
  end;
  PRawImagePosition = ^TRawImagePosition;
 
  { TRawImage }
 
  TRawImage = object
    Description: TRawImageDescription;
    Data: PByte;
    DataSize: PtrUInt;
    Mask: PByte;
    MaskSize: PtrUInt;
    Palette: PByte;
    PaletteSize: PtrUInt;
 
    // don't use a constructor here, it will break compatibility with a record
    procedure Init;
    procedure CreateData(AZeroMem: Boolean);
 
    procedure FreeData;
    procedure ReleaseData;
    procedure ExtractRect(const ARect: TRect; out ADst: TRawImage);
 
    function  GetLineStart(ALine: Cardinal): PByte;
    procedure PerformEffect(const ADrawEffect: TGraphicsDrawEffect; CreateNewData: Boolean = True; FreeOldData: boolean = false);
    function  ReadBits(const APosition: TRawImagePosition; APrec, AShift: Byte): Word;
    procedure ReadChannels(const APosition: TRawImagePosition; out ARed, AGreen, ABlue, AAlpha: Word);
    procedure ReadMask(const APosition: TRawImagePosition; out AMask: Boolean);
    procedure WriteBits(const APosition: TRawImagePosition; APrec, AShift: Byte; ABits: Word);
    procedure WriteChannels(const APosition: TRawImagePosition; ARed, AGreen, ABlue, AAlpha: Word);
    procedure WriteMask(const APosition: TRawImagePosition; AMask: Boolean);
 
    function  IsMasked(ATestPixels: Boolean): Boolean;
    function  IsTransparent(ATestPixels: Boolean): Boolean;
    function  IsEqual(AImage: TRawImage): Boolean;
  end;
  PRawImage = ^TRawImage;

Y'a pas photo

**Jipété** · 27/02/2019, 00h33

Yop !

J'ai commencé à mettre en test ton Bmpviewer/loader stand-alone et ma foi, ça fonctionne

T'en dirai plus plus tard, là c'est juste pour ça (et pour que tu saches que je n'ai pas oublié) :

Envoyé par BeanzMaster

je suis ouvert à toutes suggestions. J'attends vos retours. Et si vous avez des questions pas de problèmes

alors en vrac :

Code :

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

1
2
3
4
Procedure TFastBitmap.Clear(Color : TColor32);
Begin
  FillDWord(FData^,FWidth * FHeight, DWord(Color));
End;

Ça je l'ai reconnue, ça vient de Mitchell, et ce n'est pas un bon nom : Clear c'est Clear et pas Clear(Color) car ça c'est Set ! Donc perso dans le code Mitchell je l'ai renommée SetColor. Tu devrais faire pareil.

LoadFromFile devrait être une fonction retournant True ou False selon que ça s'est bien ou mal passé.
Tu me diras, ça peut être implémenté dans le code de l'ihm.

Un truc pas clair, trouvé dans un de tes exemples :

Code :

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

FastBmp := BmpLoader.FastBitmap.Clone; // On clone, on copie

je tente ça :
BmpL3.FastBitmap := BmpLs.FastBitmap.Clone; --> Error: No member is provided to access property

Ça aussi ce n'est pas clair, dans le code :

Code :

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

1
2
3
4
5
6
Function TFastBitmap.BuildBitmap: Graphics.TBitmap;
Begin
  Result := nil;
  W := FWidth;
  H := FHeight;
  IntfBmp := TLazIntfImage.Create(W,H);  // Obligé de mettre les dimensions à zero. IntfBmp := TLazIntfImage.Create(W,H); --> Leve une exception, plutot bizarre, car dans TGifViewer ce bug n'apparait pas

Quand je vois ces lignes, je n'ai pas l'impression que les dimensions sont mises à zéro...
D'autant que si je rajoute après H := FHeight, la ligne

Code :

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

showmessage(inttostr(w)+'--'+inttostr(h));

j'ai des valeurs différentes de 0, correspondant aux datas de l'image que je travaille et tout va bien.
Tu devrais virer ce commentaire, le bug dont tu parles devait venir d'autre chose.

Une info :

Code :

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

1
2
3
4
5
Constructor TFastBitmap.Create;
Begin
//  Create(1,1);
  Create(0,0);
End;

ça fonctionne.

Envoyé par BeanzMaster

Comme on peux le voir sur cette dernière capture sous LINUX l'agrandissement de l'image est lissé
On le voit clairement avec ton fichier test "3x2x24_vh1.bmp" et si on fait attention la vignette dans l'explorateur est aussi lissé. Je pense qu'il y a moyen d'avoir un zoom non lissé, un paramètre a passé dans le TLazIntfImage avant le passage à la fonction "Canvas.StretchDraw". Le lissage semble être par defaut sous Linux.

J'avoue que je n'ai pas cherché -- pas encore ? Je ne sais pas, le combat contre le code D5 m'a épuisé.

Envoyé par BeanzMaster

Une piste pour éviter le lissage lors de l'affichage c'est de paramétrer BmpViewer.Canvas.AntialiasingMode := amOff; .

Ça va être compliqué, car je ne l'utilise pas : juste le BMPLoader.
J'ai testé le AntialiasingMode à off sur le TImage, c'est pareil.
Bah, ça peut rester comme ça.

Allez, dans l'ensemble c'est très bien !

**Jipété** · 27/02/2019, 10h00

Ola !

Envoyé par BeanzMaster

L'utilisation de TFastBitmap est très proche de l'utilisation du TBitmap de Delphi

1^er cas simple

Code :

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

1
2
3
Var
  BmpLoader : TBMPLoader;
  ...

Ctrl F9 --> Error: Identifier not found "TBMPLoader",

Ça risque de surprendre les newbies,

Envoyé par BeanzMaster

2^e cas on passe par"scanline" et un pointer

Pas testé, et on dirait qu'il y manque l'incrémentation de Y.

Sinon, je suis assez content du reste, une fois toutes les pièces du Meccano assemblées : 1 TButton, 3 TImage, 1 Trackbar, 1 TOpenPictureDialog et ç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
uses 
  ...
  uBMPViewer, uFastBitmap,
  ...;
 
procedure TForm1.Button9Click(Sender: TObject);
Var
  BmpLDst: TBMPImageLoader;
  w, h: integer;
  pColSrc, pColDst: PColor32;
begin
  if not opd.Execute then exit; 
  BmpLSrc := TBMPImageLoader.Create; // déclaré global pour accès par trackbar trkTransp
  BmpLSrc.LoadFromFile(opd.FileName); 
  image1.Picture.Bitmap.Assign(BmpLSrc.FastBitmap.GetBitmap); // témoin chargement
  BmpLDst := TBMPImageLoader.Create;
  BmpLDst.FastBitmap.Width :=BmpLSrc.FastBitmap.Width;
  BmpLDst.FastBitmap.Height:=BmpLSrc.FastBitmap.Height;
  // cœur de la copie
  for h := 0 to BmpLSrc.FastBitmap.Height-1 do begin
    pColSrc := BmpLSrc.FastBitmap.GetScanLine(h);
    pColDst := BmpLDst.FastBitmap.GetScanLine(h);
    for w := 0 to BmpLSrc.FastBitmap.Width-1 do begin
      pColDst^ := pColSrc^;
      inc(pColSrc);
      inc(pColDst);
    end;
  end;
  //
  image2.Picture.Bitmap.Assign(BmpLDst.FastBitmap.GetBitmap); // témoin copie
  FreeAndNil(BmpLDst);
end;
 
procedure TForm1.trkTranspChange(Sender: TObject);
var
  BmpLdst: TBMPImageLoader;
  w, h: integer;
  pColSrc, pColDst: PColor32;
begin
  BmpLdst := TBMPImageLoader.Create;
  BmpLdst.FastBitmap.Width :=BmpLSrc.FastBitmap.Width;
  BmpLdst.FastBitmap.Height:=BmpLSrc.FastBitmap.Height;
  // cœur de la copie
  for h := 0 to BmpLSrc.FastBitmap.Height-1 do begin
    pColSrc := BmpLSrc.FastBitmap.GetScanLine(h);
    pColdst := BmpLDst.FastBitmap.GetScanLine(h);
    for w := 0 to BmpLSrc.FastBitmap.Width-1 do begin
      pColDst[w].Red   := pColSrc[w].Red;
      pColDst[w].Green := pColSrc[w].Green;
      pColDst[w].Blue  := pColSrc[w].Blue;
      pColDst[w].Alpha := trkTransp.Position;
{ ou, avec deux lignes de plus,
      pColDst^.Red   := pColSrc^.Red;
      pColDst^.Green := pColSrc^.Green;
      pColDst^.Blue  := pColSrc^.Blue;
      pColDst^.Alpha := trkTransp.Position;
      inc(pColSrc);
      inc(pColDst);     }
    end;
  // 
  end;
  image3.Picture.Bitmap.Assign(BmpLDst.FastBitmap.GetBitmap); // témoin traficotage pixels, la transparence en l'occurrence
  FreeAndNil(BmpLDst);
end;

Résultat :
Nom : anim_bz.gif
Affichages : 259
Taille : 351,0 Ko

Et si je rajoute que ton code arrive à ouvrir jusqu'à présent tous mes fichiers, ben...

À plus, je vais maintenant voir comment ça s'articule avec les logiciels Delphi de rééchantillonnage, le but final...

**Jipété** · 27/02/2019, 13h05

Envoyé par Jipété

je vais maintenant voir comment ça s'articule avec les logiciels Delphi de rééchantillonnage, le but final...

Alors là je souffre...

Mais commençons simplement avec ça :
Soit

Code :

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

1
2
3
4
5
6
procedure bidon;
var
  col: TColor32;
begin
  col.red := 0;
end;

et après une compilation, en face de col.red j'ai un petit triangle jaune et la souris dessus me dit que local variable "col" does not seem to be initialized et la question est donc : comment initialiser "col" ?

Parce que si je tape col. et que j'attends, il ne vient rien d'intéressant à part Create, et donc si j'essaye col.Create(0,0,0,0); c'est le même petit triangle jaune décourageant...

Merci,

**BeanzMaster** · 27/02/2019, 16h48

Envoyé par Jipété

Yop !

J'ai commencé à mettre en test ton Bmpviewer/loader stand-alone et ma foi, ça fonctionne

T'en dirai plus plus tard, là c'est juste pour ça (et pour que tu saches que je n'ai pas oublié) :

alors en vrac :

Code :

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

1
2
3
4
Procedure TFastBitmap.Clear(Color : TColor32);
Begin
  FillDWord(FData^,FWidth * FHeight, DWord(Color));
End;

Ça je l'ai reconnue, ça vient de Mitchell, et ce n'est pas un bon nom : Clear c'est Clear et pas Clear(Color) car ça c'est Set ! Donc perso dans le code Mitchell je l'ai renommée SetColor. Tu devrais faire pareil.

De Mitchell ou autre possible. Pourquoi "Clear et pas pas Clear(Color) car ça c'est Set ! ?" Clear = Nettoyer (Effacer vrac la couleur en paramètre, sinon transparent par défaut), j'aurais pu choisir Fill ou FillWithColor= remplir, mais je n'ai pas trouvé cela judicieux ici.
SET non car je n'initialise pas de propriété "Color". Libre à toi de la renommé comme tu l'as fait selon tes préférences.

Envoyé par Jipété

LoadFromFile devrait être une fonction retournant True ou False selon que ça s'est bien ou mal passé.
Tu me diras, ça peut être implémenté dans le code de l'ihm.

Bonne idée.

Envoyé par Jipété

Ola !

Ctrl F9 --> Error: Identifier not found "TBMPLoader",

Ça risque de surprendre les newbies,

Mea culpa c'est vrai que dans la discussion j'ai employé BMPLoader au lieu de TBMPImageLoader

Envoyé par Jipété

Un truc pas clair, trouvé dans un de tes exemples :

Code :

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

FastBmp := BmpLoader.FastBitmap.Clone; // On clone, on copie

je tente ça :
BmpL3.FastBitmap := BmpLs.FastBitmap.Clone; --> Error: No member is provided to access property

Normal la propriété "FastBitmap" du Loader est en lecture seule, pas d'intérêt à publier en écriture, vu qu'il est à uniquement pour chargé un fichier BMP

Envoyé par Jipété

Ça aussi ce n'est pas clair, dans le code :

Code :

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

1
2
3
4
5
6
Function TFastBitmap.BuildBitmap: Graphics.TBitmap;
Begin
  Result := nil;
  W := FWidth;
  H := FHeight;
  IntfBmp := TLazIntfImage.Create(W,H);  // Obligé de mettre les dimensions à zero. IntfBmp := TLazIntfImage.Create(W,H); --> Leve une exception, plutot bizarre, car dans TGifViewer ce bug n'apparait pas

Quand je vois ces lignes, je n'ai pas l'impression que les dimensions sont mises à zéro...
D'autant que si je rajoute après H := FHeight, la ligne

Code :

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

showmessage(inttostr(w)+'--'+inttostr(h));

j'ai des valeurs différentes de 0, correspondant aux datas de l'image que je travaille et tout va bien.
Tu devrais virer ce commentaire, le bug dont tu parles devait venir d'autre chose.

Oui, il faut que je vire le commentaire, c'etait une exception qui se levai ici à cause d'un bug dans la manipulation d'un pointer

Envoyé par Jipété

Une info :

Code :

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

1
2
3
4
5
Constructor TFastBitmap.Create;
Begin
//  Create(1,1);
  Create(0,0);
End;

ça fonctionne.

Normal, mais mettre Create(0,0) ne change rien l'image crée fera 1x1

Envoyé par Jipété

Envoyé par BeanzMaster

2eme cas on passe par"scanline" et un pointer

Pas testé, et on dirait qu'il y manque l'incrémentation de Y.

Pourquoi veux tu incrémenter le Y ? , il n'y pas besoin l'adresse du pointer est incrémenté par Inc(PColor); dans l'exemple suivant. Ici balai toute l'image du premier pixel au dernier :

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
begin
   //.....
   Y := 0;
   Repeat
       PColor := FastBmp.GetScanLine(Y);
       X := FastBmp.Width;
       While (X > 0) do
       begin
          PColor^ := PColor^.ToGrayScale;
          Inc(PColor); 
          Dec(X);
       end;
   Until (Y > Pred(FastBmp.Height);
    //...
end;

Envoyé par Jipété

Sinon, je suis assez content du reste, une fois toutes les pièces du Meccano assemblées : 1 TButton, 3 TImage, 1 Trackbar, 1 TOpenPictureDialog et ça :

Code :

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

1
2
3
4
5
6
7
8
uses 
  ...
  uBMPViewer, uFastBitmap,
  ...;
 
procedure TForm1.Button9Click(Sender: TObject);
Var
  BmpLDst: TBMPImageLoader;

Cool

. Par contre je te suggère d'utilisé un TFastBitmap directement pour effectué tes travaux avec BmpLDst au lieu TBMPImageLoader comme ceci

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
procedure TForm1.Button9Click(Sender: TObject);
Var
  BmpLDst: TFastBitmap;
  w, h: integer;
  pColSrc, pColDst: PColor32;
begin
  if not opd.Execute then exit; 
  BmpLSrc := TBMPImageLoader.Create; // déclaré global pour accès par trackbar trkTransp
  BmpLSrc.LoadFromFile(opd.FileName); 
  image1.Picture.Bitmap.Assign(BmpLSrc.FastBitmap.GetBitmap); // témoin chargement
  BmpLDst := TFastBitmap.Create(BmpLSrc.FastBitmap.Width,BmpLSrc.FastBitmap.Height) ;
 
  // OU BmpLDst := TFastBitmap.Create(BmpLSrc.ImageDescription.Width,BmpLSrc.ImageDescription.Height) ;
 
  // cœur de la copie
  for h := 0 to BmpLSrc.FastBitmap.Height-1 do begin
    pColSrc := BmpLSrc.FastBitmap.GetScanLine(h);
    pColDst := BmpLDst.GetScanLine(h);
    for w := 0 to BmpLSrc.FastBitmap.Width-1 do begin
      pColDst^ := pColSrc^;
      inc(pColSrc);
      inc(pColDst);
    end;
  end;
  //
  image2.Picture.Bitmap.Assign(BmpLDst.GetBitmap); // témoin copie
  FreeAndNil(BmpLDst);
end;

Envoyé par Jipété

Alors là je souffre...

Mais commençons simplement avec ça :
Soit

Code :

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

1
2
3
4
5
6
procedure bidon;
var
  col: TColor32;
begin
  col.red := 0;
end;

et après une compilation, en face de col.red j'ai un petit triangle jaune et la souris dessus me dit que local variable "col" does not seem to be initialized et la question est donc : comment initialiser "col" ?

Parce que si je tape col. et que j'attends, il ne vient rien d'intéressant à part Create, et donc si j'essaye col.Create(0,0,0,0); c'est le même petit triangle jaune décourageant...

Merci,

Ce message d'avertissement est récurant pour TOUTES VARIABLES DE TYPE RECORD (plus avec la lazarus 2.0 sauf certain cas avec les apis).
Cela ne pose aucun problème de fonctionnement. Tu peux inhiber ce message soit :
En faisant un clic droit sur la ligne dans la fenêtre de message et tu choisis "Cacher le message en insérant la directive..." ou "Cacher le message en insérant {$warn... "

Pour initialiser un TColor32 soit, comme tous les enregistrements tu fais :

Code :

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

1
2
3
4
5
6
7
8
9
Var
  Col : TColor32;
begin
  col.red := 0;
  col.green := 0;
  col.Blue := 0;
  col.Alpha := 0;
 // ou avec With Col do begin red := 0; ... end; 
end;

ou plus simplement Col.Create(0,0,0,255); pour un couleur RGBA ou Col.Create(0,0,0) pour une couleur RGB (la valeur Alpha est automatiquement initialiser à 255 dans ce cas)

Sinon tu peux rajouté une fonction

Code :

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

1
2
3
4
function CreateColor32(R,G,B : Byte; Const A : Byte = 255) : TColor32;
begin
  Result.Create(R,G,B,A);
end;

Code :

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

1
2
3
4
5
6
Var
  Col : TColor32;
begin
  col := CreateColor32(0,0,0,128);
  //col := CreateColor32(0,0,0);
end;

Merci

A+

**Jipété** · 27/02/2019, 18h36

Je te réponds à l'envers, en partant de tout en bas :

Envoyé par BeanzMaster

Code :

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

1
2
3
4
5
6
Var
  Col : TColor32;
begin
  col := CreateColor32(0,0,0,128);
  //col := CreateColor32(0,0,0);
end;

Error: identifier idents no member "CreateColor32".

Envoyé par BeanzMaster

Sinon tu peux rajouter une fonction

Oui mais le problème est identique,

Envoyé par BeanzMaster

Ce message d'avertissement est récurant pour TOUTES VARIABLES DE TYPE RECORD

Curieux, je ne l'avais jamais remarqué.

Et comme j'ai un gros souci d'utilisation, je cherche partout...

Envoyé par BeanzMaster

Par contre je te suggère d'utiliser un TFastBitmap directement pour effectuer tes travaux avec BmpLDst au lieu TBMPImageLoader comme ceci

Vu.
Donc je devrais pouvoir faire pareil avec mon BmpLSrc qui est un TBMPImageLoader ?
Car sinon, je ne vois pas bien la différence entre les deux...

Envoyé par BeanzMaster

Pourquoi veux-tu incrémenter le Y ?

Parce que trois lignes de ton exemple m'y incitent :

Code :

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

1
2
3
   Y := 0;
   Repeat
       PColor := FastBmp.GetScanLine(Y);

et qu'avec ce genre de construction, habituellement on rencontre plus loin l'incrémentation de Y.
Et comme tu as mis "...", je me suis dit que c'était là-dedans.

Car s'il n'y a pas besoin de l'incrémenter, alors

Code :

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

1
2
   PColor := FastBmp.GetScanLine(0);
     Repeat

serait amplement suffisant.

Envoyé par BeanzMaster

Normal, mais mettre Create(0,0) ne change rien l'image créée fera 1x1

Bon. Mets une note parce que ça surprend, la preuve, je t'en parle.

Vu pour la propriété FastBitmap du Loader, readonly, mais de ton exemple :

Code :

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

1
2
var
  BmpLoader : TBMPLoader;

Error: Identifier not found "TBMPLoader" et c'est ça qui a dû m'embrouiller...

Envoyé par BeanzMaster

Effacer vrac la couleur en paramètre, sinon transparent par défaut),

effacer la couleur en paramètre, ça n'a pas de sens (tu vas effacer une couleur parmi des milliers dans l'image ?) et surtout ce n'est pas ce que ça fait.
Si je fais :

Code :

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

1
2
3
4
5
6
7
8
  ci := TCompactImage.Create(tp.X, tp.Y);
  With CColor Do 
    Begin Red := 250; Green := 240; Blue := 10; // jaune
      Alpha := trkTransp.Position; End; // le trackbar est à 100
  ci.Clear(CColor);
//  et que je fais afficher avec 
  lclci := TLCLCompactImage.Create(ci); 
  img.Picture.Bitmap.Assign(lclci.ImageBitmap);

j'ai bien un beau jaune léger.

Donc l'action réelle et visible de ce "clear" c'est d'attribuer une couleur au TCompactImage.
D'où mon renommage de "Clear" à "SetColor".
Et pour avoir une fonction Clear, on duplique la SetColor en lui forçant l'Alpha à 0 et hop !
Genre

Code :

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

1
2
3
4
5
6
7
8
Procedure TCompactImage.Clear;
var
  EmptyColor: TCompactColor;
Begin
  With EmptyColor Do 
    Begin Red := 0; Green := 0; Blue := 0; Alpha := 0; End;
  FillDWord(FData^, Width*Height, DWord(EmptyColor));
End;

Non testé !

Envoyé par BeanzMaster

De Mitchell ~~ou autre~~ possible.

Tout à fait : tout en bas de CompImages.pas.

Allez, je retourne à mes embrouilles : aucun problème pour charger une image, mais pour la redimensionner, laisse tomber...

**Jipété** · 27/02/2019, 19h26

Envoyé par BeanzMaster

Par contre je te suggère d'utiliser un TFastBitmap directement pour effectuer tes travaux avec BmpLDst au lieu TBMPImageLoader comme ceci

Pourquoi ?
Qu'est-ce que ça apporte ? Code plus lisible ? Performance ? Autre ?

Et en parlant de code lisible et de documentation, je suis tombé sur ça, dans uFastBitmap :

Code :

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

1
2
3
4
Type
  { TFastBitmapDrawMode : Mode d'Affichage pour la fonction PutImage de TFastBitmap }
  { TFastBitmapDrawMode : Display Mode for the PutImage Function of TFastBitmap }
  TFastBitmapDrawMode = ( dmSet, dmAlpha, dmAlphaCheck);

qui m'a moyennement amusé (tu me diras, ce n'est pas de ta faute, tout le monde fait pareil)

Sauf que moi, quand je vois les 3 paramètres entre parenthèses, je suis comme une poule qui a trouvé un couteau :
ça fait quoi, "dmSet" ?
et "dmAlpha" ?
Et le check de "dmAlphaCheck", qu'est-ce qu'il teste ?

Au final, face à ça je ne sais pas quoi utiliser...

Tu vois le truc ?

**BeanzMaster** · 27/02/2019, 23h50

Envoyé par Jipété

Je te réponds à l'envers, en partant de tout en bas :

Error: identifier idents no member "CreateColor32".

Oui mais le problème est identique,

Ok bref laisse tombé le "Warning" ce n'est pas bien grave

Envoyé par Jipété

Vu.
Donc je devrais pouvoir faire pareil avec mon BmpLSrc qui est un TBMPImageLoader ?
Car sinon, je ne vois pas bien la différence entre les deux...

Envoyé par Jipété

Pourquoi ?
Qu'est-ce que ça apporte ? Code plus lisible ? Performance ? Autre ?

Ce sont 2 classes distinctes. Le "métier" des classes est différente ; TBMPImageLoader contient un TFastBitmap qui sert à charger un fichier BMP dans celui-ci. Mais cette classe (TBMPImageLoader) n'est pas faite pour manipuler un bitmap directement. C'est d'ailleurs pour cela que la propriété FastBitmap" est en lecture seule. Tu pourrais la comparer au "TFPReaderBMP" de Lazarus en quelque sorte. Mieux vaut faire une copie (Clone) du FastBitmap contenu dans le TBMPImageLoader pour travailler dessus. Ou faire comme tu l'as fait tu t'en sert pour lire les données, mais pas pour écrire. C'est juste un question de logique (enfin pour moi.)

Envoyé par Jipété

Parce que trois lignes de ton exemple m'y incitent :

Code :

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

1
2
3
   Y := 0;
   Repeat
       PColor := FastBmp.GetScanLine(Y);

et qu'avec ce genre de construction, habituellement on rencontre plus loin l'incrémentation de Y.
Et comme tu as mis "...", je me suis dit que c'était là-dedans.

Car s'il n'y a pas besoin de l'incrémenter, alors

Code :

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

1
2
   PColor := FastBmp.GetScanLine(0);
     Repeat

serait amplement suffisant.

Tu as raison, j'ai carrément zappé cet après-midi (je suis rentré, j'ai répondu, je suis reparti)

J'avais en fait en tête la structure que tu peux voir dans la procedure MakeOpaque

Envoyé par Jipété

Bon. Mets une note parce que ça surprend, la preuve, je t'en parle.

Oui, le pire c'est que dans mon gros projet je l'ai notifié

Envoyé par Jipété

effacer la couleur en paramètre, ça n'a pas de sens (tu vas effacer une couleur parmi des milliers dans l'image ?) et surtout ce n'est pas ce que ça fait.

Oups

effacer avec la couleur en paramètre

mais bon

Code :

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

1
2
 { Efface le bitmap avec la couleur "Color" / Clear bitmap with Color }
    procedure Clear(Color : TColor32);

Envoyé par Jipété

Donc l'action réelle et visible de ce "clear" c'est d'attribuer une couleur au TCompactImage.
D'où mon renommage de "Clear" à "SetColor".
Et pour avoir une fonction Clear, on duplique la SetColor en lui forçant l'Alpha à 0 et hop !
Genre

Code :

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

1
2
3
4
5
6
7
8
Procedure TCompactImage.Clear;
var
  EmptyColor: TCompactColor;
Begin
  With EmptyColor Do 
    Begin Red := 0; Green := 0; Blue := 0; Alpha := 0; End;
  FillDWord(FData^, Width*Height, DWord(EmptyColor));
End;

Non testé !

Plus simple, juste faire ceci :

Dans l'interface
procedure clear(); overload;Dans l'implementation

Code :

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

1
2
3
4
procedure clear();
begin
  Clear(clrTransparent);
end;

Envoyé par Jipété

Allez, je retourne à mes embrouilles : aucun problème pour charger une image, mais pour la redimensionner, laisse tomber...

1) Le FastBitmap est retaillé lui même

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
 
function Clamp(const V,Min,Max : integer) : integer;
begin
  Result := V;
  if Result > Max then begin result := Max; exit; end;
  if Result < Min then result := Min;
end; 
 
procedure TFastBitmap.Stretch(var NW, NH : Integer; const KeepRatio : Boolean = false);
Var
  TmpBmp: TfastBitmap;
  SrcW, SrcH, DstW, DstH, X, Y, UX, UY: Integer;
  Dx, Dy, uvx, uvy: Single;
  DstPtr, SrcPtr: PColor32;
  AColor: TColor32;
 
  Procedure KeepAspectRatio(Const aSrcW, aSrcH: Integer; Var NewWidth, NewHeight: Integer);
  Var
    w, h: Integer;
  Begin
    W := NewWidth;
    H := newHeight;
    if ( aSrcW > 1) and ( aSrcH > 1) then // On calcul le ratio par rapport aux dimensions du buffer d'affichage
    begin
      H:=Trunc((aSrcH*W) / aSrcW);
      if (H>=NewHeight) then
      begin
        H:=NewHeight;
        W:=Trunc((aSrcW*H) / aSrcH);
      end;
      NewWidth := W;
      NewHeight := H;
    end;
  end;
 
Begin
  SrcW := Self.Width;
  SrcH := Self.Height;
  If (NW = SrcW) And (NH = SrcH) Then exit;
  If KeepRatio Then KeepAspectRatio(SrcW, SrcH, NW, NH);
  TmpBmp := TFastBitmap.Create;
  TmpBmp.SetSize(NW, NH);
  DstW := NW - 1;
  DstH := NH - 1;
  Dx := SrcW / DstW;
  Dy := SrcH / DstH;
  DstPtr := TmpBmp.GetScanLine(0);
  UvY :=0;
  For y := 0 To DstH Do
  Begin
    UY := Clamp(Trunc(UvY), 0, Self.Height-1);
    SrcPtr := Self.GetScanLine(UY);
    UvX := 0;
    For X := 0 To DstW Do
    Begin
      UX := Clamp(Trunc(UvX), 0, Self.Width-1);
      AColor := PColor32(SrcPtr + UX)^;
      DstPtr^ := AColor;
      Inc(DstPtr);
      UvX := UvX + DX;
    End;
    UvY := UvY + DY;
  End;
  Self.Assign(TmpBmp);
  FreeAndNil(TmpBmp);
End;

2) Le FastBitmap est retaillé vers un autre FastBitmap (on conserve donc celui d'origine)

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
 
function TFastBitmap.StretchTo(var NW, NH : Integer; const KeepRatio : Boolean = false) : TFastBitmap;
Var
  TmpBmp: TfastBitmap;
  SrcW, SrcH, DstW, DstH, X, Y, UX, UY: Integer;
  Dx, Dy, uvx, uvy: Single;
  DstPtr, SrcPtr: PColor32;
  AColor: TColor32;
 
  Procedure KeepAspectRatio(Const aSrcW, aSrcH: Integer; Var NewWidth, NewHeight: Integer);
  Var
    w, h: Integer;
  Begin
    W := NewWidth;
    H := newHeight;
    if ( aSrcW > 1) and ( aSrcH > 1) then // On calcul le ratio par rapport aux dimensions du buffer d'affichage
    begin
      H:=Trunc((aSrcH*W) / aSrcW);
      if (H>=NewHeight) then
      begin
        H:=NewHeight;
        W:=Trunc((aSrcW*H) / aSrcH);
      end;
      NewWidth := W;
      NewHeight := H;
    end;
  end;
 
Begin
  SrcW := Self.Width;
  SrcH := Self.Height;
  If (NW = SrcW) And (NH = SrcH) Then exit;
  If KeepRatio Then KeepAspectRatio(SrcW, SrcH, NW, NH);
  TmpBmp := TFastBitmap.Create;
  TmpBmp.SetSize(NW, NH);
  DstW := NW - 1;
  DstH := NH - 1;
  Dx := SrcW / DstW;
  Dy := SrcH / DstH;
  DstPtr := TmpBmp.GetScanLine(0);
  UvY :=0;
  For y := 0 To DstH Do
  Begin
    UY := Clamp(Trunc(UvY), 0, Self.Height-1);
    SrcPtr := Self.GetScanLine(UY);
    UvX := 0;
    For X := 0 To DstW Do
    Begin
      UX := Clamp(Trunc(UvX), 0, Self.Width-1);
      AColor := PColor32(SrcPtr + UX)^;
      DstPtr^ := AColor;
      Inc(DstPtr);
      UvX := UvX + DX;
    End;
    UvY := UvY + DY;
  End;
  Result := TmpBmp;
End;

ou sinon tu rajoutes un "var BmpDst : TFastBitmap" ce qui donnerai

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
procedure TFastBitmap.Stretch(var BmpDst : TFastBitmap; var NW, NH : Integer; const KeepRatio : Boolean = false);
Var
  SrcW, SrcH, DstW, DstH, X, Y, UX, UY: Integer;
  Dx, Dy, uvx, uvy: Single;
  DstPtr, SrcPtr: PColor32;
  AColor: TColor32;
 
  Procedure KeepAspectRatio(Const aSrcW, aSrcH: Integer; Var NewWidth, NewHeight: Integer);
  Var
    w, h: Integer;
  Begin
    W := NewWidth;
    H := newHeight;
    if ( aSrcW > 1) and ( aSrcH > 1) then // On calcul le ratio par rapport aux dimensions du buffer d'affichage
    begin
      H:=Trunc((aSrcH*W) / aSrcW);
      if (H>=NewHeight) then
      begin
        H:=NewHeight;
        W:=Trunc((aSrcW*H) / aSrcH);
      end;
      NewWidth := W;
      NewHeight := H;
    end;
  end;
 
Begin
  SrcW := Self.Width;
  SrcH := Self.Height;
  If (NW = SrcW) And (NH = SrcH) Then exit;
  If KeepRatio Then KeepAspectRatio(SrcW, SrcH, NW, NH);
  BmpDst.SetSize(NW, NH);
  DstW := NW - 1;
  DstH := NH - 1;
  Dx := SrcW / DstW;
  Dy := SrcH / DstH;
  DstPtr := BmpDst.GetScanLine(0);
  UvY :=0;
  For y := 0 To DstH Do
  Begin
    UY := Clamp(Trunc(UvY), 0, Self.Height-1);
    SrcPtr := Self.GetScanLine(UY);
    UvX := 0;
    For X := 0 To DstW Do
    Begin
      UX := Clamp(Trunc(UvX), 0, Self.Width-1);
      AColor := PColor32(SrcPtr + UX)^;
      DstPtr^ := AColor;
      Inc(DstPtr);
      UvX := UvX + DX;
    End;
    UvY := UvY + DY;
  End;
End;

Voila a toi de voir. Idem pour "Var NW, NH" tu peux virer le var si jamais, car sinon tu ne peux pas passer les nouvelles dimensions en dur (genre stretch(100,100); ).
Je les ai mis en var pour récupérer facilement les nouvelles dimensions si elles sont ajustés par "KeepRatio"

Envoyé par Jipété

Et en parlant de code lisible et de documentation, je suis tombé sur ça, dans uFastBitmap :

Code :

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

1
2
3
4
Type
  { TFastBitmapDrawMode : Mode d'Affichage pour la fonction PutImage de TFastBitmap }
  { TFastBitmapDrawMode : Display Mode for the PutImage Function of TFastBitmap }
  TFastBitmapDrawMode = ( dmSet, dmAlpha, dmAlphaCheck);

qui m'a moyennement amusé (tu me diras, ce n'est pas de ta faute, tout le monde fait pareil)

Sauf que moi, quand je vois les 3 paramètres entre parenthèses, je suis comme une poule qui a trouvé un couteau :
ça fait quoi, "dmSet" ?
et "dmAlpha" ?
Et le check de "dmAlphaCheck", qu'est-ce qu'il teste ?

Au final, face à ça je ne sais pas quoi utiliser...

Tu vois le truc ?

Pourquoi réinventé la roue !

(pour ca me suis basé sur BGRABitmap si je me souviens bien)
Tu as mal lu

"Mode d'Affichage pour la fonction PutImage de TFastBitmap"

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
 { Copie une image source "Src" depuis la position "SrcX,SrcY" et de dimension "SrcWidthxSrcHeight" dans le bitmap à la position "DstX, DstY
      et suivant le "Mode"
       Mode : TFastBitmapDrawMode
        - dmSet : Copie brute de l'image
        - dmAlpha : Copie les pixel de l'image source en mixant les couleurs avec celles du bitmap en fonction de leur valeur Alpha
        - dmAlphaCheck : Copie les pixels de l'image source seulement si le pixel est visible (Alpha <> 0)
       Note : les dimensions et les positions entre le bitmap et l'image source sont automatiquement ajustées si besoin.
 
    --------------------------
      Copy a source image 'Src' from the position 'SrcX, SrcY' and dimension 'SrcWidthxSrcHeight' into the bitmap at the position 'DstX, DstY and following the 'Mode'
     Mode: TFastBitmapDrawMode
       - dmSet: Raw copy of the image
       - dmAlpha: Copy the pixels of the source image by mixing the colors with those of the bitmap according to their Alpha value
       - dmAlphaCheck: Copy the pixels of the source image only if the pixel is invisible (Alpha <> 0)
      Note: The dimensions and positions between the bitmap and the source image are automatically adjusted if necessary.
    }
    procedure PutImage(Src : TFastBitmap; SrcX, SrcY, SrcWidth, SrcHeight, DstX, DstY : Integer; Mode : TFastBitmapDrawMode);

Merci de ton retour. Du coup a ton avis cela serai mieux si je dupliquais se commentaire au dessus de : TFastBitmapDrawMode = ( dmSet, dmAlpha, dmAlphaCheck);Car dans lazarus à la complétation du code tu vois l'aide (juste dommage que l'on ne puisse pas redimensionner ce popup pour une meilleur lisibilité)

Je vais penser a cette histoire de Clear, Y'a t-il d'autres avis / suggestions a ce propos ?

Bonne fin de soirée

**Jipété** · 28/02/2019, 00h43

Bonsoir,

pour le resize, merci pour tous ces bouts de code que je vais archiver, mais pour le moment je suis plutôt à essayer d'adapter du Delphi qui travaille en rééchantillonnage bicubique, et là... aspirine !

Je ne montre que la partie où tes composants devraient remplacer ceux qui sont là, avec
Pbm_In : cardinal; initialisé avec Cardinal(bm_In.ScanLine[0]); (0 sous linux, hauteur-1 de l'image source sous windows)
Pbm_Out: idem dessus avec bm_Out, concerne l'image destination
bm_In et bm_Out sont les TBitmaps des TImage.Picture.Bitmap passés à la proc de calcul
col: RGBQuad;
index: integer; qui avance au fur et à mesure du traitement.
weight: integer; qui intervient sur le rendu des couleurs calculées.

Donc en gros il y a du calcul de couleurs, couleurs passées au bitmap de destination, mis à la taille voulue depuis l'ihm, grâce à l'écriture de RGBQuad dans sa RawImage.
Sous Windows en 10 minutes ça tournait -- le temps de faire un café --, sous Linux bientôt deux mois...

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
// avant ici tout un tas de calculs concernant l'interpolation avec des carrés de 4 pixels, normalement il n'y a pas lieu d'y toucher
          with pRGBQuad(index * 4 + Pbm_In)^ do
          begin
            red := red + weight * rgbRed;
            green := green + weight * rgbGreen;
            blue := blue + weight * rgbBlue;
            alpha := alpha + weight * rgbReserved;
          end;
        end;
      col.rgbRed := Floor(red);
      col.rgbGreen := Floor(green);
      col.rgbBlue := Floor(blue);
      col.rgbReserved := Floor(alpha);
      pRGBQuad(Pbm_Out)^ := col;
      Pbm_Out := Pbm_Out + 4;
    end;

Tout ce que j'arrive à faire, c'est

soit de reproduire à l'identique et AV si inférieur ou supérieur demandé,
soit image vide à l'identique et noire si inférieur ou supérieur demandé.

Je ne suis pas loin, mais les derniers pas seront les plus durs, c'est bien connu.
Surtout sans carte ni boussole.
Pour le reste, on en reparlera quand je me serai sorti cette épine du pied.

Juste un mot de plus, en rapport avec ce qui précède et ce que tu viens de répondre :

TBMPImageLoader contient un TFastBitmap qui sert à charger un fichier BMP dans celui-ci. Mais cette classe (TBMPImageLoader) n'est pas faite pour manipuler un bitmap directement. C'est d'ailleurs pour cela que la propriété FastBitmap" est en lecture seule. Mieux vaut faire une copie (Clone) du FastBitmap contenu dans le TBMPImageLoader pour travailler dessus. Ou faire comme tu l'as fait tu t'en sert pour lire les données, mais pas pour écrire.

Ah !
Parce que l'exemple que j'ai donné hier de ma première utilisation, je le redonne ici, juste la partie intéressante et en rapport avec ce que tu dis ci-dessus, c'est ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
    // cœur de la copie
    for h := 0 to BmpLSrc.FastBitmap.Height-1 do begin
      pColSrc  := BmpLSrc.FastBitmap.GetScanLine(h);
      pColDst  := BmpLDst.FastBitmap.GetScanLine(h);
      for w := 0 to BmpLSrc.FastBitmap.Width-1 do begin
        pColDst^ := pColSrc^; // là j'écris les données de la source dans la destination !
        inc(pColSrc);
        inc(pColDst);
      end;
    end;
    //
    image2.Picture.Bitmap.Assign(BmpLDst.FastBitmap.GetBitmap); // témoin après

Donc là j'utilise 2 TBMPImageLoader, l'un qui va charger un fichier, et l'autre qui va recopier les données du fichier dans sa "RawMemory" pour l'afficher ensuite dans un TImage.
Comment peux-tu dire que ce truc est en lecture seule ?
J'ai travaillé exactement comme avec des TBitmap et ça a fonctionné.

Mieux vaut faire une copie (Clone) du FastBitmap contenu dans le TBMPImageLoader pour travailler dessus.

Tu aurais dû faire en sorte que ta démo de viewer utilise ce plan, tu aurais dû mettre l'accent dessus, si c'est capital.

**BeanzMaster** · 28/02/2019, 01h54

Re, on n'est pas couché !

Envoyé par Jipété

Bonsoir,

pour le resize, merci pour tous ces bouts de code que je vais archiver, mais pour le moment je suis plutôt à essayer d'adapter du Delphi qui travaille en rééchantillonnage bicubique, et là... aspirine !

Juste un mot de plus, en rapport avec ce qui précède et ce que tu viens de répondre :

Ah !
Parce que l'exemple que j'ai donné hier de ma première utilisation, je le redonne ici, juste la partie intéressante et en rapport avec ce que tu dis ci-dessus, c'est ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
    // cœur de la copie
    for h := 0 to BmpLSrc.FastBitmap.Height-1 do begin
      pColSrc  := BmpLSrc.FastBitmap.GetScanLine(h);
      pColDst  := BmpLDst.FastBitmap.GetScanLine(h);
      for w := 0 to BmpLSrc.FastBitmap.Width-1 do begin
        pColDst^ := pColSrc^; // là j'écris les données de la source dans la destination !
        inc(pColSrc);
        inc(pColDst);
      end;
    end;
    //
    image2.Picture.Bitmap.Assign(BmpLDst.FastBitmap.GetBitmap); // témoin après

Donc là j'utilise 2 TBMPImageLoader, l'un qui va charger un fichier, et l'autre qui va recopier les données du fichier dans sa "RawMemory" pour l'afficher ensuite dans un TImage.
Comment peux-tu dire que ce truc est en lecture seule ?
J'ai travaillé exactement comme avec des TBitmap et ça a fonctionné.

Je me suis mal exprimé. Ici pour une question de simplicité j'ai intégré la FastBitmap dans le loader, mais normalement, il faudrait faire autrement pour prendre en charge d'autres formats de fichiers. Sinon il faudrait utiliser TGifViewer, TBmpViewer, TPNGViewer ....
Du coup on est loin d'un TBitmap généralisé pour le chargement des fichiers. Avec Un TBitmap.LoadfromFile tu peux charger des Bmp, des jpeg, des png ect.... Ici LoadFromFile est limité tu vois ce que je veux dire.
Les mots lecture seule ne signifient pas que tu peux pas avoir accès aux données contenue dans TFastBitmap mais que tu ne peux pas assigner un autre TFastBitmap TBmpImageLoader.FastBitmap = UnAutreFastBitmap; te renverra une erreur. C'est dans ce sens là que je voulais le dire.
Chaque classe sont métier. D'ou ma suggestion d'utiliser un TFastBitmap directement plutôt celui contenu dans le loader pour travailler.

Envoyé par Jipété

Tu aurais dû faire en sorte que ta démo de viewer utilise ce plan, tu aurais dû mettre l'accent dessus, si c'est capital.

[/QUote]
Je l'ai mis pour y avoir accès. J'aurais pu simplement mettre une propriété "Bitmap: TBitmap" mais la on aurait été marron. Ou sinon faire function LoadfromFile(filename): TFastBitmap; tu vois le genre ?
Dans mon projet ma classe (TBZBitmap) est plus proche du TBitmap car chaque format de fichier est "Register" et "loadfromfile" supporte plusieurs formats de fichier automatiquement.

Envoyé par Jipété

Bonsoir,

pour le resize, merci pour tous ces bouts de code que je vais archiver, mais pour le moment je suis plutôt à essayer d'adapter du Delphi qui travaille en rééchantillonnage bicubique, et là... aspirine !

Fallait le dire que tu voulais du bicubic !

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
function ClampByte(const Value: Integer): Byte;
begin
 Result := Value;
 if Value > 255 then Result := 255
 else if Value < 0 then Result := 0;
end;
 
{ https://en.wikipedia.org/wiki/Bicubic_interpolation du chinois pour moi toutes ces formules :) }
 
{ Fonction adapté du code source de  ??
  d'après le code source en C de Paul Toth (trouvé je ne sais plus ou)
}
Procedure TFastBitmap.StretchBicubic(Var NW, NH: Integer; Const KeepRatio: Boolean = False);
Var
  SrcH, SrcW: Integer;
 
  TmpBmp: TFastBitmap;
 
  xd, yd, xs, ys, ii, jj, n, m: Integer;
 
  cx, cy, dx, dy, weight, red, green, blue, alpha: Single;
  AColor, DstCol: TColor32;
  DstPtr:     PColor32;
  Ind1, Ind2: Integer;
Const
  BiCubicRPrecal: Array[1..16] Of Single = (0.00260416666666667, 0.0208333333333333, 0.0703125, 0.166666666666667,
    0.315104166666667, 0.479166666666667, 0.611979166666667, 0.666666666666667,
    0.611979166666667, 0.479166666666667, 0.315104166666667, 0.166666666666667,
    0.0703125, 0.0208333333333333, 0.00260416666666667, 0.0);
Begin
 
  SrcW := Self.Width;
  SrcH := self.Height;
 
  If KeepRatio Then KeepAspectRatio(SrcW, SrcH, NW, NH);
 
  If (NW = SrcW) And (NH = SrcH) Then exit;
 
  TmpBmp := TFastBitmap.Create(NW, NH);
 
  DstPtr := TmpBmp.GetScanLine(0);
  For yd := 0 To TmpBmp.Height-1 Do
  Begin
    For xd := 0 To TmpBmp.Width-1 Do
    Begin
      xs := (xd * SrcW) Div NW;
      ys := (yd * SrcH) Div NH;
      cx := xd * SrcW / NW;
      cy := yd * SrcH / NH;
 
      dx := cx - xs;
      dy := cy - ys;
      red := 0;
      green := 0;
      blue := 0;
      alpha := 0;
 
      For m := -1 To 2 Do
      Begin
        For n := -1 To 2 Do
        Begin
          ii := Clamp(xs + m, 0, self.width-1);
          jj := Clamp(ys + n, 0, self.Height-1);
 
          Ind1 := round(4 * (m - dx)) + 8; // Indice de correspondance avec la table précalculée
          Ind2 := round(4 * (n - dy)) + 8; // Idem
          // Evite un bug d'indice hors limites
          Ind1 := Max(Min(Ind1, 16), 1);
          Ind2 := Max(Min(Ind2, 16), 1);
 
          weight := BiCubicRPrecal[ind1] * BiCubicRPrecal[ind2];
          AColor := Self.getPixel(ii, jj);
 
          red := red + weight * AColor.Red;
          green := green + weight * AColor.Green;
          blue := blue + weight * AColor.Blue;
          alpha := alpha + weight * AColor.Alpha;
 
        End;
      End;
 
      DstCol.Red := ClampByte(Round(red));
      DstCol.Green := ClampByte(Round(green));
      DstCol.Blue := ClampByte(Round(blue));
      DstCol.Alpha := ClampByte(Round(alpha));
 
      DstPtr^ := DstCol;
      Inc(DstPtr);
    End;
  End;
  self.Assign(TmpBmp);
  FreeAndNil(TmpBmp);
End;

Je n'ai pas testé en l'état, cette routine provient de mon projet, mais vu que la base est très similaire ça devrait rouler. Elle te sera peut-être utile par rapport a ton code Delphi

Bonne nuit

**Jipété** · 28/02/2019, 08h58

Bonjour !

J'en ai un !

Nom : animbicubic.gif
Affichages : 317
Taille : 243,7 Ko

Et avec tes compos au milieu (merci pour l'autre code, vais quand même l'étudier)

Il me reste :
- à faire le ménage (vous verriez l'état des unités, laisse tomber...)
- à tester les autres manières de resampler (oui, l'unité trouvée en comporte 3 ou 4)
- à tester la tienne,
- et quand tout ça sera rutilant, à proposer ici un projet un peu comme les gars de Delphi ont fait en leur temps.
- et enfin, à étudier et mettre en place leur autre projet, qui utilise une manière de resampling un poil différente et dont les premiers tests sous D7 m'avaient agréablement surpris.

Envoyé par BeanzMaster

Fallait le dire que tu voulais du bicubic !

Mais tu es le Père Noël ! Il y a de tout dans ta hotte, y a qu'à demander !

Tiens, d'ailleurs, pourquoi n'ai-je pas trouvé dans tes compos le couple célèbre aBmp.BeginUpdate / EndUpdate ? Il me semble avoir lu récemment que ces deux-là sont utiles pour prévenir un éventuel refresh en cours de traitement et donc mal venu.

Jérôme, merci pour ta patience, hélas je ne dois pas être bien réveillé ce matin car je n'ai rien compris à ton explication du milieu de la nuit :

Envoyé par BeanzMaster

Les mots lecture seule ne signifient pas que tu [ne] peux pas avoir accès aux données contenues dans TFastBitmap mais que tu ne peux pas assigner un autre TFastBitmap

Code :

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

TBmpImageLoader.FastBitmap := UnAutreFastBitmap;

te renverra une erreur. C'est dans ce sens-là que je voulais le dire.

D'où l'importance capitale des bons mots !

Envoyé par BeanzMaster

D'où ma suggestion d'utiliser un TFastBitmap directement plutôt [que] celui contenu dans le loader pour travailler.

Qu'est-ce que ça aurait changé ? Si le FastBitmap est readonly il le reste, de n'importe où et n'importe comment qu'on l'appelle, non ?
Sauf que pour moi, vu d'ici, il ne l'est pas :

Code :

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

        pColDst^ := pColSrc^; // là j'écris les données de la source dans la destination !

Ces pColXXX sont des pointeurs sur le début des zones XXXbmp.FastBitmap, donc j'y écris (XXX pour src ou dst).

J'avais préparé ça, ce matin, avant d'attaquer, je te le copie/colle tel quel :
Tiens, je reviens deux secondes sur ces histoires de sémantique et autres bonnes utilisations des bons mots, j'y ai repensé hier soir ça m'a aidé à m'endormir.

Un truc pour lequel j'ai systématiquement besoin de l'aide de l'infobulle, c'est aBmp.Assign( source ou destination ?
Et ça fait 20 ans que ça dure.
Alors que aBmp.LoadFromFile ne présente aucune ambiguité, grâce au "From".

Et quand on regarde les compos de Mitchell, on découvre un truc fort bien sympathique dans lclCompImages.pas, c'est object.DrawTo(. Toute la différence et tout le bonheur c'est ce "To" : trop fastoche d'écrire object.DrawTo(cible), pas besoin de réfléchir, c'est tellement évident.

Par contre leur histoire de object.Clear(une_couleur); je trouve ça insensé !
Surtout en se souvenant que si je veux vider les lignes de mon mémo, c'est monmemo.Lines.Clear; sans paramètres.
Tu vois l'embrouille ? Un même mot sous-entendant une même action, mais non...

Et c'est tous ces petits détails qui font que le code coule tout seul ou qu'on misère sur des pertes de temps qui ne devraient pas avoir lieu.

Bonne journée, allez, moi je sors le balai,

Travailler avec TBitmap et des fichiers bmp sous Linux [Lazarus]

Lazarus Pascal

Discussions similaires

Partager

Partager