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 WriteBitmapToTiff(Bitmap: TBitmap; Filename: String);
var
  OpenTiff: PTIFF;
  RowSize: Longword;
  RowsPerStrip: Longword;
  StripMemory: Pointer;
  StripIndex: Longword;
  StripRowOffset: Longword;
  StripRowCount: Longword;
  mb: PByte;
  ny: Longword;
begin
  if (Bitmap.PixelFormat<>pf1bit) then
    raise Exception.Create('WriteBitmapToTiff is designed for singlebit
                    bitmaps only');
  RowSize:=((Bitmap.Width+7) div 8 );
  RowsPerStrip:=((256*1024) div RowSize);
  if RowsPerStrip>Bitmap.Height then
    RowsPerStrip:=Bitmap.Height
  else if RowsPerStrip=0 then
    RowsPerStrip:=1;
  StripMemory:=GetMemory(RowsPerStrip*RowSize);
  OpenTiff:=TIFFOpen(PAnsiChar(Filename),'w');
  if OpenTiff=nil then
  begin
    FreeMemory(StripMemory);
    raise Exception.Create('Unable to create file '''+Filename+'''');
  end;
  TIFFSetField(OpenTiff,TIFFTAG_IMAGEWIDTH,Bitmap.Width);
  TIFFSetField(OpenTiff,TIFFTAG_IMAGELENGTH,Bitmap.Height);
  TIFFSetField(OpenTiff,TIFFTAG_PHOTOMETRIC,PHOTOMETRIC_MINISWHITE);
  TIFFSetField(OpenTiff,TIFFTAG_SAMPLESPERPIXEL,1);
  TIFFSetField(OpenTiff,TIFFTAG_BITSPERSAMPLE,1);
  TIFFSetField(OpenTiff,TIFFTAG_PLANARCONFIG,PLANARCONFIG_CONTIG);
  TIFFSetField(OpenTiff,TIFFTAG_COMPRESSION,COMPRESSION_CCITTFAX4);
  TIFFSetField(OpenTiff,TIFFTAG_ROWSPERSTRIP,RowsPerStrip);
  StripIndex:=0;
  StripRowOffset:=0;
  while StripRowOffset<Bitmap.Height do
  begin
    StripRowCount:=RowsPerStrip;
    if StripRowCount>Bitmap.Height-StripRowOffset then
      StripRowCount:=Bitmap.Height-StripRowOffset;
    mb:=StripMemory;
    for ny:=StripRowOffset to StripRowOffset+StripRowCount-1 do
    begin
      CopyMemory(mb,Bitmap.ScanLine[ny],RowSize);
      Inc(mb,RowSize);
    end;
    if TIFFWriteEncodedStrip(OpenTiff,StripIndex,
        StripMemory,StripRowCount*RowSize)=-1 then
    begin
      TIFFClose(OpenTiff);
      FreeMemory(StripMemory);
      raise Exception.Create('Failed to write '''+Filename+'''');
    end;
    Inc(StripIndex);
    Inc(StripRowOffset,StripRowCount);
  end;
  TIFFClose(OpenTiff);
  FreeMem(StripMemory);
end;					

1:
2:
3:

  if (Bitmap.PixelFormat<>pf1bit) then
    raise Exception.Create('WriteBitmapToTiff is designed for singlebit
                    bitmaps only');					

1:

      CopyMemory(mb,Bitmap.ScanLine[ny],RowSize);