libTIFF for Lazarus - reading and writing TIF images

[Packs]

DecodeFromStream is having orient variable

Code: Pascal  [Select][+][-]

1. // for  rotation problem
2.        if Orient = 0 then
3.          Orient := 1 ;
4.       //
5.  
6.       if Orient = 0 then
7.  
8.           for y:=AHeight-1 downto 0 do begin
9.             P := FBmp.Scanline[y];
10.  
11.             for x:=0 to AWidth-1 do begin
12.               P[4*x+2] := SrcPtr^; Inc(SrcPtr);
13.               P[4*x+1] := SrcPtr^; Inc(SrcPtr);
14.               P[4*x  ] := SrcPtr^; Inc(SrcPtr);
15.               P[4*x+3] := SrcPtr^; Inc(SrcPtr); //alfa
16.             end;
17.           end
18.       else
19.           for y:=0 to AHeight-1 do begin
20.             P := FBmp.Scanline[y];
21.  
22.             for x:=0 to AWidth-1 do begin
23.               P[4*x+2] := SrcPtr^; Inc(SrcPtr);
24.               P[4*x+1] := SrcPtr^; Inc(SrcPtr);
25.               P[4*x  ] := SrcPtr^; Inc(SrcPtr);
26.               P[4*x+3] := SrcPtr^; Inc(SrcPtr); //alfa
27.             end;
28.           end;
29.  

I have added inside DecodeFromStream not working

[bytebites]

Code: Pascal  [Select][+][-]

1.       if Orient = 1 then
2.  
3.           for y:=AHeight-1 downto 0 do begin
4.             P := FBmp.Scanline[y];
5.  
6.             for x:=0 to AWidth-1 do begin
7.               P[4*x+2] := SrcPtr^; Inc(SrcPtr);
8.               P[4*x+1] := SrcPtr^; Inc(SrcPtr);
9.               P[4*x  ] := SrcPtr^; Inc(SrcPtr);
10.               P[4*x+3] := SrcPtr^; Inc(SrcPtr); //alfa
11.             end;
12.           end
13.       else
14.           for y:=0 to AHeight-1 do begin
15.             P := FBmp.Scanline[y];
16.  
17.             for x:=0 to AWidth-1 do begin
18.               P[4*x+2] := SrcPtr^; Inc(SrcPtr);
19.               P[4*x+1] := SrcPtr^; Inc(SrcPtr);
20.               P[4*x  ] := SrcPtr^; Inc(SrcPtr);
21.               P[4*x+3] := SrcPtr^; Inc(SrcPtr); //alfa
22.             end;
23.           end;
24.  

[Packs]

Thank you sir . it is working

[Packs]

try to create TTIF with compression COMPRESSION_CCITT4

it is giving following error message .

Code: Pascal  [Select][+][-]

1.  In file 'TifImage.pas' at line 310:
2. raise Exception.CreateFmt('Error writing row %d', [y]);
3.  
4. var
5.   t: TTifImage;
6. begin
7.  
8.   Image1.Picture.LoadFromFile('demo.jpg');
9.  
10.   t := TTifImage.Create;
11.   t.Assign(Image1.Picture.Bitmap);
12.   t.SetCompression(COMPRESSION_CCITT4);
13.   t.SaveToFile('out.tif');
14.   t.Free;
15.  

how to set dpi . I want image should be 200 dpi.

[Tomxe]

1) Download new version:
https://github.com/Xelitan/TIFF-for-Delphi-Lazarus-Free-Pascal/blob/main/TifImage.pas
2) Make sure your image in Image1 is TBitmap with PixelFormat = pf1bit. If it's not you need convert.

Setting DPI is not supported right now.

[Packs]

Code: Pascal  [Select][+][-]

1.  In file 'TifImage.pas' at line 321:
2. raise Exception.CreateFmt('Error writing row %d', [y]);
3.  
4.  
5.  

[Tomxe]

Seems your image is not pf1bit. You need to convert it to pf1bit.

[Packs]

Code: Pascal  [Select][+][-]

1. var
2.   t: TTifImage;
3. begin
4.  
5.   Image1.Picture.LoadFromFile('demo.jpg');
6.   Image1.Picture.Bitmap.PixelFormat:=  pf1bit;
7.  
8.   t := TTifImage.Create;
9.   t.Assign(Image1.Picture.Bitmap);
10.   t.SetCompression(COMPRESSION_CCITT4);
11.   t.SaveToFile('out.tif');
12.   t.Free;  
13.  

code is working . it is creating tiff image but it is black colour.
I am attaching demo.jpg file

[Tomxe]

Your code would work in Delphi but PixelFormat isn't finished in Lazarus. That's why you get a black picture. Add "Math" to your uses.

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2. var
3.   t: TTifImage;
4.   Bmp,Bmp2: TBitmap;
5.   x,y,i: Integer;
6.   G,B: Byte;
7.   P,R: PByteArray;
8. begin
9.  
10.   Image1.Picture.LoadFromFile('demo.jpg');
11.  
12.   Bmp := TBitmap.Create;
13.   Bmp.PixelFormat := pf32bit;
14.   Bmp.SetSize(Image1.Picture.Graphic.Width, Image1.Picture.Graphic.Height);
15.   Bmp.Canvas.Draw(0,0, Image1.Picture.Graphic);
16.  
17.   for y:=0 to Bmp.Height-1 do begin
18.     P := Bmp.Scanline[y];
19.     for x:=0 to Bmp.Width-1 do begin
20.       G := (P^[4*x] + P^[4*x+1] + P^[4*x+2]) div 3;
21.       if G > 127 then G := 1
22.       else            G := 0;
23.  
24.       P^[4*x  ] := G;
25.     end;
26.   end;
27.  
28.   Bmp2 := TBitmap.Create;
29.   Bmp2.PixelFormat := pf1bit;
30.   Bmp2.SetSize(Bmp.Width, Bmp.Height);
31.  
32.   for y:=0 to Bmp2.Height-1 do begin
33.     P := Bmp2.Scanline[y];
34.     R := Bmp.Scanline[y];
35.     for x:=0 to Ceil(Bmp2.Width/8)-1 do begin
36.  
37.       B := 0;
38.       for i:=0 to 7 do begin
39.         G := R^[4*(8*x+i)];
40.         B := B + (G shl (7-i));
41.       end;
42.  
43.       P^[x] := B;
44.     end;
45.   end;
46.  
47.   t := TTifImage.Create;
48.   t.Assign(Bmp2);
49.   t.SetCompression(COMPRESSION_CCITT4);
50.   t.SaveToFile('out.tif');
51.   t.Free;
52.   Bmp2.Free;
53.   Bmp.Free;
54. end;  

[Packs]

Thank you Sir. 🙏🙏🙏

it is working .

can you explain me in detail. why you are using for loop. what you have done .

My last requirement in tiff image is DPI.

Please guide me .

[Packs]

Dear sir,

can we use this link for create DPI https://forum.lazarus.freepascal.org/index.php?topic=40663.0

[Tomxe]

Please download new version:
https://github.com/Xelitan/TIFF-for-Delphi-Lazarus-Free-Pascal/blob/main/TifImage.pas

And you can set dpi like this:

Code: Pascal  [Select][+][-]

1. var T: TTiffImage;
2. begin
3. ...
4. T.SetDpi(300);

Explanation of the code posted before:

Code: Pascal  [Select][+][-]

1. for y:=0 to Bmp.Height-1 do begin
2.     P := Bmp.Scanline[y];
3.     for x:=0 to Bmp.Width-1 do begin
4.       G := (P^[4*x] + P^[4*x+1] + P^[4*x+2]) div 3;
5.       if G > 127 then G := 1
6.       else            G := 0;
7.  
8.       P^[4*x  ] := G;
9.     end;
10.   end;;

The above code changes image to grayscale by averaging Red, Green and Blue colors.
And then if the resulting gray pixel has value > 127 it makes it white  and if not- makes it black.
So this converts picture to black and white only.

Code: Pascal  [Select][+][-]

1. for y:=0 to Bmp2.Height-1 do begin
2.     P := Bmp2.Scanline[y];
3.     R := Bmp.Scanline[y];
4.     for x:=0 to Ceil(Bmp2.Width/8)-1 do begin
5.  
6.       B := 0;
7.       for i:=0 to 7 do begin
8.         G := R^[4*(8*x+i)];
9.         B := B + (G shl (7-i));
10.       end;
11.  
12.       P^[x] := B;
13.     end;
14.   end;

The code above is packing 8 pixels into 1 Byte.

[Packs]

Thank You so much. 🙏🙏🙏🙏

it is working .