home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap06 / howto05 / delphi10 / delphpcx.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-09  |  20.6 KB  |  671 lines
  1. {$R-}
  2. unit Delphpcx;
  3.  
  4. interface
  5.  
  6. uses
  7.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  8.   Forms, Dialogs, ExtCtrls;
  9. type
  10.  
  11.   { This record is used instead of TRGBTriple due to a need for reversed fields }
  12.   RGBRecord = record
  13.     RedValue   ,
  14.     GreenValue ,
  15.     BlueValue  : byte;
  16.   end;
  17.   { These records are used to replace normal palettes with the rgbrecord }
  18.   PPCX256Palette = ^PCX256Palette;
  19.   PPCX16Palette = ^PCX16Palette;
  20.   PCX256Palette = array[ 0 .. 255 ] of RGBRecord;
  21.   PCX16Palette = array[ 0 .. 15 ] of RGBRecord;
  22.   { This is used for large files }
  23.   LongType = record
  24.     case Word of
  25.       0: (Ptr: pointer);
  26.       1: (Long: Longint);
  27.       2: (Lo: word; Hi: word);
  28.     end;
  29.   { This is the header for the PCX file, which is vital to decoding it! }
  30.   PPCXHeader = ^PCXHeader;
  31.   PCXHeader = record
  32.     PCXMagicNumber         : byte;
  33.     Version                : byte;
  34.     Encoding               : byte;
  35.     BitsPerPixel           : byte;
  36.     XMinimum             ,
  37.     YMinimum               : integer;
  38.     XMaximum             ,
  39.     YMaximum               : integer;
  40.     HorizontalResolution ,
  41.     VerticalResolution     : integer;
  42.     EGAColorMap            : PCX16Palette;
  43.     Reserved               : byte;
  44.     NumberOfPlanes         : byte;
  45.     NumberOfBytesPerLine   : integer;
  46.     PaletteType            : integer;
  47.   end;
  48.   { This is the main PCX decoding object }
  49.   TPCXFileObject = class( TObject )
  50.     ThePCXHeader: PPCXHeader;
  51.     FileHandle: integer;
  52.     ErrorString : String;
  53.     procedure Init( Filename: PChar );
  54.     destructor Destroy; virtual;
  55.     function GetHeaderInfo: pointer;
  56.     procedure LoadPCXBitMap( var TheBitmap : hBitmap; var ThePalette : hPalette);
  57.   end;
  58.  
  59.   MDecoder16 = class( TObject )
  60.     BufferPointer  : integer;
  61.     BytesPerLine   : integer;
  62.     FileDataBuffer : array[ 0 .. 1023 ] of byte;
  63.     TheHeader      : PPCXHeader;
  64.     Height         : longint;
  65.     FileHandle     : integer;
  66.     Palette        : HPalette;
  67.     Width          : longint;
  68.     procedure Init( TheFileHandle : integer; Header: PPCXHeader);
  69.     function CreateDIB( var TheDIBPalette : hPalette ): HBitmap; virtual;
  70.     procedure Decode_Row( var ScanLine : pointer ); virtual;
  71.     procedure CreatePCXPalette(BMI: PBitMapInfo);
  72.     procedure Decode(MemoryPointer: THandle; MemorySize: longint; TheBytesPerLine: longint);
  73.     function GetBMI(var Size: word): PBitMapInfo;
  74.     procedure Convert_Row( TheBytesPerLine: longint; TheSource : pointer; var Dest: pointer);
  75.   end;
  76.  
  77.   MDecoder256 = class( TObject )
  78.     BufferPointer  : integer;
  79.     BytesPerLine   : integer;
  80.     FileDataBuffer : array[ 0 .. 1023 ] of byte;
  81.     TheHeader      : PPCXHeader;
  82.     Height         : longint;
  83.     FileHandle     : integer;
  84.     Palette        : HPalette;
  85.     Width          : longint;
  86.     procedure Init( TheFileHandle : integer; Header: PPCXHeader);
  87.     function CreateDIB( var TheDIBPalette : hPalette ): HBitmap; virtual;
  88.     procedure Decode_Row( var ScanLine : pointer ); virtual;
  89.     function GetPaletteInfo: pointer;
  90.     procedure CreatePCXPalette( BMI: PBitMapInfo );
  91.     procedure Decode( MemoryPointer: THandle; MemorySize: longint; TheBytesPerLine: longint);
  92.     function GetBMI(var Size: word): PBitMapInfo;
  93.   end;
  94.  
  95. const
  96.   ErrorString0 = 'OK';
  97.   ErrorString1 = 'Unable to open file';
  98.   ErrorString2 = 'File read error!';
  99.   ErrorString3 = 'Not a PCX file!';
  100.   ErrorString4 = 'Unsupported PCX file format.';
  101.   ErrorString5 = 'Out of Memory';
  102.   ErrorString6 = 'Cannot create 256 color palette';
  103.   ErrorString7 = 'DIB Creation Error';
  104.  
  105. implementation
  106.  
  107. procedure AHIncr; far; external 'KERNEL' index 114;
  108.  
  109. function AlignDouble( Size : longint ) : longint;
  110. begin
  111.   AlignDouble := (Size + 3) div 4 * 4;
  112. end;
  113.  
  114. {---------- TPCXFileObject Methods --------}
  115.  
  116. procedure TPCXFileObject.Init( Filename : PChar );
  117. begin
  118.   ErrorString := ErrorString1;
  119.   FileHandle := _LOpen( Filename , of_Read );
  120.   if FileHandle = -1 then exit;
  121.   ErrorString := ErrorString2;
  122.   ThePCXHeader := PPCXHeader( GetHeaderInfo );
  123.   if ThePCXHeader = nil then exit;
  124.   ErrorString := ErrorString3;
  125.   if ThePCXHeader^.PCXMagicNumber <> $0A then exit;
  126.   ErrorString := ErrorString0;
  127. end;
  128.  
  129. destructor TPCXFileObject.Destroy;
  130. begin
  131.   Dispose( ThePCXHeader );
  132.   _lClose( FileHandle );
  133.   inherited Destroy;
  134. end;
  135.  
  136. {Get PCX header info for format validation}
  137. function TPCXFileObject.GetHeaderInfo: pointer;
  138. var
  139.   TheHeader : PPCXHeader;
  140. begin
  141.   New( TheHeader );
  142.   _llSeek( FileHandle , 0 , 0);
  143.   if ( _lRead( FileHandle , @TheHeader^ , Sizeof( PCXHeader )) <> Sizeof( PCXHeader )) then
  144.   Dispose( TheHeader );
  145.   GetHeaderInfo := TheHeader;
  146. end;
  147.  
  148. {Initialize correct decoder instance, decode and return DIB and Palette handles }
  149. procedure TPCXFileObject.LoadPCXBitMap( var TheBitmap : HBitmap; var ThePalette : hPalette );
  150. var
  151.   Decoder16 : MDecoder16;
  152.   Decoder256 : MDecoder256;
  153.   HDIB    : HBitmap;
  154. begin
  155.   ErrorString := ErrorString2;
  156.   if ( ThePCXHeader^.BitsPerPixel = 8 ) and ( ThePCXHeader^.NumberOfPlanes = 1) then
  157.   begin
  158.     Decoder256 := MDecoder256.Create;
  159.     Decoder256.Init( FileHandle , ThePCXHeader );
  160.     ErrorString := ErrorString7;
  161.     HDIB := Decoder256.CreateDIB( ThePalette );
  162.     Decoder256.Free;
  163.     if HDIB = 0 then Exit;
  164.     TheBitmap := HDIB;
  165.     ErrorString := ErrorString0;
  166.   end
  167.   else
  168.   begin
  169.     if ( ThePCXHeader^.BitsPerPixel = 1) and ( ThePCXHeader^.NumberOfPlanes = 4 ) then
  170.     begin
  171.       Decoder16 := MDecoder16.Create;
  172.       Decoder16.Init( FileHandle , ThePCXHeader );
  173.       ErrorString := ErrorString7;
  174.       HDIB := Decoder16.CreateDIB( ThePalette );
  175.       Decoder16.Free;
  176.       if HDIB = 0 then Exit;
  177.       TheBitmap := HDIB;
  178.       ErrorString := ErrorString0;
  179.     end
  180.     else
  181.     begin
  182.       ErrorString := ErrorString3;
  183.       Exit;
  184.     end;
  185.   end;
  186. end;
  187.  
  188. {---------- MDecoder Methods --------}
  189.  
  190. procedure MDecoder16.Init( TheFileHandle : integer; Header : PPCXHeader);
  191. begin
  192.   FileHandle := TheFileHandle;
  193.   TheHeader := Header;
  194.   _llseek( FileHandle , 128 , 0 );
  195.   Palette := 0;
  196.   BufferPointer := 0;
  197.   BytesPerLine := TheHeader^.NumberOfBytesPerLine;
  198.   Width := longint( TheHeader^.XMaximum ) - longint( TheHeader^.XMinimum ) + 1;
  199.   Height := longint( TheHeader^.YMaximum ) - longint( TheHeader^.YMinimum ) + 1;
  200. end;
  201.  
  202. procedure MDecoder256.Init( TheFileHandle : integer; Header : PPCXHeader);
  203. begin
  204.   FileHandle := TheFileHandle;
  205.   TheHeader := Header;
  206.   _llseek( FileHandle , 128 , 0 );
  207.   Palette := 0;
  208.   BufferPointer := 0;
  209.   BytesPerLine := TheHeader^.NumberOfBytesPerLine;
  210.   Width := longint( TheHeader^.XMaximum ) - longint( TheHeader^.XMinimum ) + 1;
  211.   Height := longint( TheHeader^.YMaximum ) - longint( TheHeader^.YMinimum ) + 1;
  212. end;
  213.  
  214.  
  215. function MDecoder16.CreateDIB( var TheDIBPalette : hPalette ) : HBitmap;
  216. var
  217.   BMInfo          : PBitMapInfo;
  218.   bmiSize         : word;
  219.   DCHandle        : HDC;
  220.   DIBBytesPerLine : longint;
  221.   HImage ,
  222.   HImageNew       : HBitmap;
  223.   i               : integer;
  224.   ImageSize       : longint;
  225.   PImage          : pointer;
  226.   OldPal          : hPalette;
  227.  
  228. begin
  229.   CreateDIB := 0;
  230.   if ( TheHeader^.BitsPerPixel = 1 ) and ( TheHeader^.NumberOfPlanes = 4 ) then
  231.    DIBBytesPerLine := AlignDouble( longint( Width ) div 2 )
  232.     else DIBBytesPerLine := AlignDouble( BytesPerLine );
  233.   ImageSize := DIBBytesPerLine * Height;
  234.   GlobalCompact( ImageSize );
  235.   HImage := GlobalAlloc( gmem_Moveable or gmem_ZeroInit , ImageSize );
  236.   if HImage = 0 then Exit;
  237.   Decode( HImage , ImageSize , DIBBytesPerLine );
  238.   BMInfo := GetBMI( bmiSize );
  239.   CreatePCXPalette( BMInfo );
  240.   DCHandle := GetDC( 0 );
  241.   PImage := GlobalLock( HImage );
  242.   OldPal := SelectPalette( DCHandle , Palette , false );
  243.   UnRealizeObject( Palette );
  244.   RealizePalette( DCHandle );
  245.   HImageNew := CreateDIBitmap( DCHandle , BMInfo^.bmiHeader , cbm_Init ,
  246.                        PImage   , BMInfo^           , 0          );
  247.   SelectPalette( DCHandle , OldPal , false );
  248.   ReleaseDC( 0 , DCHandle );
  249.   GlobalUnlock( HImage );
  250.   Globalfree( HImage );
  251.   {FreeMem( BMInfo , bmiSize );}
  252.   TheDIBPalette := Palette;
  253.   CreateDIB := HImageNew;
  254. end;
  255.  
  256. function MDecoder256.CreateDIB( var TheDIBPalette : hPalette ) : HBitmap;
  257. var
  258.   BMInfo          : PBitMapInfo;
  259.   bmiSize         : word;
  260.   DCHandle        : HDC;
  261.   DIBBytesPerLine : longint;
  262.   HImage ,
  263.   HImageNew       : HBitmap;
  264.   i               : integer;
  265.   ImageSize       : longint;
  266.   PImage          : pointer;
  267.   OldPal          : hPalette;
  268.  
  269. begin
  270.   CreateDIB := 0;
  271.   if ( TheHeader^.BitsPerPixel = 1 ) and ( TheHeader^.NumberOfPlanes = 4 ) then
  272.    DIBBytesPerLine := AlignDouble( longint( Width ) div 2 )
  273.     else DIBBytesPerLine := AlignDouble( BytesPerLine );
  274.   ImageSize := DIBBytesPerLine * Height;
  275.   GlobalCompact( ImageSize );
  276.   HImage := GlobalAlloc( gmem_Moveable or gmem_ZeroInit , ImageSize );
  277.   if HImage = 0 then Exit;
  278.   Decode( HImage , ImageSize , DIBBytesPerLine );
  279.   BMInfo := GetBMI( bmiSize );
  280.   CreatePCXPalette( BMInfo );
  281.   DCHandle := GetDC( 0 );
  282.   PImage := GlobalLock( HImage );
  283.   OldPal := SelectPalette( DCHandle , Palette , false );
  284.   UnRealizeObject( Palette );
  285.   RealizePalette( DCHandle );
  286.   HImageNew := CreateDIBitmap( DCHandle , BMInfo^.bmiHeader , cbm_Init ,
  287.                        PImage   , BMInfo^           , 0          );
  288.   SelectPalette( DCHandle , OldPal , false );
  289.   ReleaseDC( 0 , DCHandle );
  290.   GlobalUnlock( HImage );
  291.   Globalfree( HImage );
  292.   {FreeMem( BMInfo , bmiSize );}
  293.   TheDIBPalette := Palette;
  294.   CreateDIB := HImageNew;
  295. end;
  296.  
  297. { Decode an entire scanline into S regardless of image type }
  298. procedure MDecoder16.Decode_Row(var ScanLine : pointer);
  299. var
  300.   i         ,
  301.   ByteCount ,
  302.   Repeats   ,
  303.   RunLength ,
  304.   Plane     ,
  305.   NoRead      : integer;
  306.   BlueValue   : byte;
  307.   SAddr       : LongType;
  308.   StartOfs    : longint;
  309.   NumRead     : integer;
  310. begin
  311.   SAddr.Ptr := ScanLine;
  312.   StartOfs := SAddr.Lo;
  313.   ByteCount := 0;
  314.   RunLength := TheHeader^.NumberOfBytesPerLine * TheHeader^.NumberOfPlanes;
  315.   if BufferPointer = 0 then
  316.     NumRead := _lread( FileHandle , @FileDataBuffer , Sizeof( FileDataBuffer ));
  317.   while ( ByteCount < RunLength ) do
  318.   begin
  319.     if BufferPointer = 1024 then
  320.     begin
  321.       NumRead := _lread( FileHandle , @FileDataBuffer , Sizeof( FileDataBuffer ));
  322.       BufferPointer := 0;
  323.     end;
  324.     BlueValue := FileDataBuffer[ BufferPointer ];
  325.     BufferPointer := BufferPointer + 1;
  326.     if ( BlueValue >= 192 ) then
  327.     begin
  328.       Repeats := BlueValue - 192;
  329.       if BufferPointer = 1024 then
  330.       begin
  331.         NumRead := _lread( FileHandle , @FileDataBuffer , Sizeof( FileDataBuffer ));
  332.         BufferPointer := 0;
  333.       end;
  334.       BlueValue := FileDataBuffer[ BufferPointer ];
  335.       BufferPointer := BufferPointer + 1;
  336.       for i :=  1 to Repeats do
  337.       begin
  338.         Mem[ SAddr.Hi:SAddr.Lo ] := BlueValue;
  339.         ByteCount := ByteCount + 1;
  340.         SAddr.Lo := StartOfs + ByteCount;
  341.       end;
  342.     end
  343.     else
  344.     begin
  345.       Mem[ SAddr.Hi:SAddr.Lo ] := BlueValue;
  346.       ByteCount := ByteCount + 1;
  347.       SAddr.Lo := StartOfs + ByteCount;
  348.     end;
  349.   end;
  350. end;
  351. { Decode an entire scanline into S regardless of image type }
  352. procedure MDecoder256.Decode_Row(var ScanLine : pointer);
  353. var
  354.   i         ,
  355.   ByteCount ,
  356.   Repeats   ,
  357.   RunLength ,
  358.   Plane     ,
  359.   NoRead      : integer;
  360.   BlueValue   : byte;
  361.   SAddr       : LongType;
  362.   StartOfs    : longint;
  363.   NumRead     : integer;
  364. begin
  365.   SAddr.Ptr := ScanLine;
  366.   StartOfs := SAddr.Lo;
  367.   ByteCount := 0;
  368.   RunLength := TheHeader^.NumberOfBytesPerLine * TheHeader^.NumberOfPlanes;
  369.   if BufferPointer = 0 then
  370.     NumRead := _lread( FileHandle , @FileDataBuffer , Sizeof( FileDataBuffer ));
  371.   while ( ByteCount < RunLength ) do
  372.   begin
  373.     if BufferPointer = 1024 then
  374.     begin
  375.       NumRead := _lread( FileHandle , @FileDataBuffer , Sizeof( FileDataBuffer ));
  376.       BufferPointer := 0;
  377.     end;
  378.     BlueValue := FileDataBuffer[ BufferPointer ];
  379.     BufferPointer := BufferPointer + 1;
  380.     if ( BlueValue >= 192 ) then
  381.     begin
  382.       Repeats := BlueValue - 192;
  383.       if BufferPointer = 1024 then
  384.       begin
  385.         NumRead := _lread( FileHandle , @FileDataBuffer , Sizeof( FileDataBuffer ));
  386.         BufferPointer := 0;
  387.       end;
  388.       BlueValue := FileDataBuffer[ BufferPointer ];
  389.       BufferPointer := BufferPointer + 1;
  390.       for i :=  1 to Repeats do
  391.       begin
  392.         Mem[ SAddr.Hi:SAddr.Lo ] := BlueValue;
  393.         ByteCount := ByteCount + 1;
  394.         SAddr.Lo := StartOfs + ByteCount;
  395.       end;
  396.     end
  397.     else
  398.     begin
  399.       Mem[ SAddr.Hi:SAddr.Lo ] := BlueValue;
  400.       ByteCount := ByteCount + 1;
  401.       SAddr.Lo := StartOfs + ByteCount;
  402.     end;
  403.   end;
  404. end;
  405.  
  406. {---------- MDecoder256 Methods --------}
  407.  
  408. procedure MDecoder256.Decode(MemoryPointer: THandle; MemorySize: longint; TheBytesPerLine: longint);
  409. var
  410.   Start  ,
  411.   ToAddr ,
  412.   Bits   ,
  413.   Source      : LongType;
  414.   ScanLine    : pointer;
  415.   LineNo   ,
  416.   i           : integer;
  417. begin
  418.   Bits.Ptr := GlobalLock( MemoryPointer );
  419.   GetMem( ScanLine , TheBytesPerLine );
  420.   if _llseek( FileHandle , 128 , 0 ) = -1 then Exit;
  421.   Source.Ptr := ScanLine;
  422.   for LineNo := ( Height - 1 ) downto 0 do
  423.   begin
  424.     Decode_Row( ScanLine );
  425.     Start.Long := longint( LineNo ) * TheBytesPerLine;
  426.     Source.Ptr := ScanLine;
  427.     for i := 1 to TheBytesPerLine do
  428.     begin
  429.       ToAddr.Hi := Bits.Hi + ( Start.Hi * Ofs( AHIncr ));
  430.       ToAddr.Lo := Start.Lo;
  431.       Mem[ ToAddr.Hi:ToAddr.Lo ] := Mem[ Source.Hi:Source.Lo ];
  432.       Source.Long := Source.Long + 1;
  433.       Start.Long := Start.Long + 1;
  434.     end;
  435.   end;
  436.   FreeMem( ScanLine , TheBytesPerLine );
  437.   GlobalUnLock( MemoryPointer );
  438. end;
  439.  
  440. function MDecoder256.GetBMI(var Size: word): PBitMapInfo;
  441. var
  442.   BitMapInfo : PBitMapInfo;
  443.   i          : integer;
  444.   bmiSize    : word;
  445.   PalInfo    : PPCX256Palette;
  446. begin
  447.   bmiSize := SizeOf( TBitmapInfoHeader ) + ( Sizeof( TRGBQuad ) * 256 );
  448.   GetMem( BitMapInfo , bmiSize );
  449.   BitmapInfo^.bmiHeader.biSize := Sizeof( TBitmapInfoHeader );
  450.   BitmapInfo^.bmiHeader.biWidth := Width;
  451.   BitmapInfo^.bmiHeader.biHeight := Height;
  452.   BitmapInfo^.bmiHeader.biPlanes := 1;
  453.   BitmapInfo^.bmiHeader.biBitCount := 8;
  454.   BitmapInfo^.bmiHeader.biCompression := 0;
  455.   BitmapInfo^.bmiHeader.biSizeImage := 0;
  456.   BitmapInfo^.bmiHeader.biXPelsperMeter := 0;
  457.   BitmapInfo^.bmiHeader.biYPelsperMeter := 0;
  458.   BitmapInfo^.bmiHeader.biClrUsed := 256;
  459.   BitmapInfo^.bmiHeader.biClrImportant := 0;
  460.   PalInfo := PPCX256Palette( GetPaletteInfo );
  461.   if Assigned( PalInfo ) then
  462.   begin
  463.     for i := 0 to 255 do
  464.     with BitMapInfo^.bmiColors[ i ], PalInfo^[ i ] do
  465.     begin
  466.       rgbRed := RedValue;
  467.       rgbGreen := GreenValue;
  468.       rgbBlue := BlueValue;
  469.       rgbReserved := 0;
  470.     end;
  471.     FreeMem( PalInfo , Sizeof( PCX256Palette ));
  472.   end;
  473.   Size := bmiSize;
  474.   GetBMI := BitMapInfo;
  475. end;
  476.  
  477. procedure MDecoder256.CreatePCXPalette( BMI : PBitMapInfo );
  478. var
  479.   LogPalette : PLogPalette;
  480.   i          : integer;
  481.   PalSize    : word;
  482. begin
  483.   if Palette <> 0 then
  484.   begin
  485.     DeleteObject( Palette );
  486.     Palette := 0;
  487.   end;
  488.   PalSize := Sizeof( TLogPalette ) + ( 256 * Sizeof( TPaletteEntry )); {check this size?}
  489.   GetMem( LogPalette , PalSize );
  490.   for i := 0 to 255 do
  491.   with LogPalette^ do
  492.     begin
  493.       palNumEntries := 256;
  494.       palVersion := $300;
  495.       with palPalEntry[ i ], BMI^.bmiColors[ i ] do
  496.       begin
  497.           peRed := rgbRed;
  498.         peGreen := rgbGreen;
  499.         peBlue := rgbBlue;
  500.         peFlags := 0;
  501.       end;
  502.     end;
  503.   Palette := CreatePalette( LogPalette^ );
  504.   FreeMem( LogPalette , PalSize );
  505. end;
  506.  
  507. function MDecoder256.GetPaletteInfo: pointer;
  508. var
  509.   TempPal: PPCX256Palette;
  510.   i: integer;
  511.   BlueValue: byte;
  512. begin
  513.   GetPaletteInfo := nil;
  514.   if (_llseek(FileHandle, -769, 2)) = -1 then Exit;
  515.   if ((_lread(FileHandle, @BlueValue, 1)) <> -1) then
  516.   if BlueValue = $0C then
  517.   begin { 256k palette exists }
  518.     New(TempPal);
  519.     if (_lread(FileHandle, @TempPal^, Sizeof(PCX256Palette))) = -1 then
  520.      Dispose(TempPal)
  521.       else
  522.        GetPaletteInfo := TempPal;
  523.   end;
  524. end;
  525.  
  526. {---------- MDecoder16 Methods --------}
  527.  
  528. procedure MDecoder16.Decode(MemoryPointer: THandle; MemorySize: longint; TheBytesPerLine: longint);
  529. var
  530.   Start    ,
  531.   ToAddr   ,
  532.   Bits     ,
  533.   Source     : LongType;
  534.   ScanLine   : pointer;
  535.   LineNo   ,
  536.   i          : integer;
  537. begin
  538.   Bits.Ptr := GlobalLock( MemoryPointer );
  539.   GetMem( ScanLine , TheBytesPerLine );
  540.   if _llseek( FileHandle , 128 , 0 ) = -1 then Exit;
  541.   Source.Ptr := ScanLine;
  542.   for LineNo := ( Height - 1 ) downto 0 do
  543.   begin
  544.     Decode_Row( ScanLine );
  545.     Convert_Row( TheBytesPerLine , ScanLine , ScanLine );
  546.     Start.Long := longint( LineNo ) * TheBytesPerLine;
  547.     Source.Ptr := ScanLine;
  548.     for i := 1 to TheBytesPerLine do
  549.     begin
  550.       ToAddr.Hi := Bits.Hi + ( Start.Hi * Ofs( AHIncr ));
  551.       ToAddr.Lo := Start.Lo;
  552.       Mem[ ToAddr.Hi:ToAddr.Lo ] := Mem[ Source.Hi:Source.Lo ];
  553.       Source.Long := Source.Long + 1;
  554.       Start.Long := Start.Long + 1;
  555.     end;
  556.   end;
  557.   FreeMem( ScanLine , TheBytesPerLine );
  558.   GlobalUnLock( MemoryPointer );
  559. end;
  560.  
  561. function MDecoder16.GetBMI(var Size: word): PBitMapInfo;
  562. var
  563.   BitMapInfo : PBitMapInfo;
  564.   i          : integer;
  565.   bmiSize    : word;
  566. begin
  567.   bmiSize := SizeOf( TBitmapInfoHeader ) + ( Sizeof( TRGBQuad ) * 16 );
  568.   GetMem( BitMapInfo, bmiSize );
  569.   BitmapInfo^.bmiHeader.biSize := Sizeof( TBitmapInfoHeader );
  570.   BitmapInfo^.bmiHeader.biWidth := Width;
  571.   BitmapInfo^.bmiHeader.biHeight := Height;
  572.   BitmapInfo^.bmiHeader.biPlanes := 1;
  573.   BitmapInfo^.bmiHeader.biBitCount := 4;
  574.   BitmapInfo^.bmiHeader.biCompression := 0;
  575.   BitmapInfo^.bmiHeader.biSizeImage := 0;
  576.   BitmapInfo^.bmiHeader.biXPelsperMeter := 0;
  577.   BitmapInfo^.bmiHeader.biYPelsperMeter := 0;
  578.   BitmapInfo^.bmiHeader.biClrUsed := 16;
  579.   BitmapInfo^.bmiHeader.biClrImportant := 0;
  580.   for i := 0 to 15 do
  581.   with BitMapInfo^.bmiColors[ i ], TheHeader^.EGAColorMap[ i ] do
  582.   begin
  583.     rgbRed := RedValue;
  584.     rgbGreen := GreenValue;
  585.     rgbBlue := BlueValue;
  586.     rgbReserved := 0;
  587.   end;
  588.   Size := bmiSize;
  589.   GetBMI := BitMapInfo;
  590. end;
  591.  
  592. procedure MDecoder16.CreatePCXPalette( BMI : PBitMapInfo) ;
  593. var
  594.   LogPalette : PLogPalette;
  595.   i          : integer;
  596.   PalSize    : word;
  597. begin
  598.   if Palette <> 0 then
  599.   begin
  600.     DeleteObject( Palette );
  601.     Palette := 0;
  602.   end;
  603.   PalSize := Sizeof( TLogPalette ) + ( 16 * Sizeof( TPaletteEntry )); {check this size?}
  604.   GetMem( LogPalette, PalSize );
  605.   for i := 0 to 15 do
  606.     with LogPalette^ do
  607.     begin
  608.       palNumEntries := 16;
  609.       palVersion := $300;
  610.       with palPalEntry[ i ], BMI^.bmiColors[ i ] do
  611.       begin
  612.           peRed := rgbRed;
  613.         peGreen := rgbGreen;
  614.         peBlue := rgbBlue;
  615.         peFlags := 0;
  616.       end;
  617.     end;
  618.   Palette := CreatePalette( LogPalette^ );
  619.   FreeMem( LogPalette , PalSize );
  620. end;
  621.  
  622. procedure MDecoder16.Convert_Row( TheBytesPerLine: longint; TheSource : pointer; var Dest: pointer);
  623. var
  624.   Nibbles      : byte;
  625.   Start      ,
  626.   ToAddr     ,
  627.   Bits       ,
  628.   Source       : LongType;
  629.   RedValue   ,
  630.   GreenValue ,
  631.   BlueValue  ,
  632.   i          ,
  633.   j          ,
  634.   k            : byte;
  635. begin
  636.   Source.Ptr := TheSource;
  637.   GetMem( Bits.Ptr, TheBytesPerLine );
  638.   Start.Long := Bits.Long;
  639.   for j := 1 to TheBytesPerLine do
  640.   begin
  641.     RedValue := Mem[ Source.Hi:Source.Lo ];
  642.     GreenValue := Mem[ Source.Hi:Source.Lo + TheBytesPerLine ];
  643.     BlueValue := Mem[ Source.Hi:Source.Lo + ( TheBytesPerLine * 2 ) ];
  644.     i := Mem[ Source.Hi:Source.Lo + ( TheBytesPerLine * 3 ) ];
  645.     for k := 0 to 3 do
  646.     begin
  647.       Nibbles := 0;
  648.       if (( RedValue and $80 ) = $80 ) then Nibbles := Nibbles or $10;
  649.       if (( GreenValue and $80 ) = $80 ) then Nibbles := Nibbles or $20;
  650.       if (( BlueValue and $80 ) = $80 ) then Nibbles := Nibbles or $40;
  651.       if (( i and $80 ) = $80 ) then Nibbles := Nibbles or $80;
  652.       RedValue := RedValue shl 1; GreenValue := GreenValue shl 1; BlueValue := BlueValue shl 1; i := i shl 1;
  653.       if (( RedValue and $80 ) = $80 ) then Nibbles := Nibbles or $01;
  654.       if (( GreenValue and $80 ) = $80 ) then Nibbles := Nibbles or $02;
  655.       if (( BlueValue and $80 ) = $80 ) then Nibbles := Nibbles or $04;
  656.       if (( i and $80 ) = $80 ) then Nibbles := Nibbles or $08;
  657.       RedValue := RedValue shl 1; GreenValue := GreenValue shl 1; BlueValue := BlueValue shl 1; i := i shl 1;
  658.       ToAddr.Hi := Bits.Hi;
  659.       ToAddr.Lo := Start.Lo;
  660.       Mem[ ToAddr.Hi:ToAddr.Lo ] := Nibbles;
  661.       Start.Long := Start.Long + 1;
  662.     end;
  663.     Source.Long := Source.Long + 1;
  664.   end;
  665.   FreeMem( TheSource, TheBytesPerLine );
  666.   Dest := Bits.Ptr;
  667. end;
  668.  
  669.  
  670. end.
  671.