Чтение заголовка PCX файла и чтение растровых данных PCX файла

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtDlgs, ExtCtrls, StdCtrls;
 
const
  PixelCountMax = 32768;
 
type
 
 pRGBArray = ^TRGBArray;
 TRGBArray = array[0..PixelCountMax - 1] of TRGBTriple;
 
 PCX=record
 Identifier:  Byte;
 Version:  Byte;
 Encoding: Byte;
 BitPerPixel:  Byte;
 Xstart:  Word;
 Ystart:   Word;
 Xend:  Word;
 Yend:   Word;
 HorizRez: Word;
 VertRez: Word;
 Palette:    array [0..48]  of Char;
 VideoMode:     Byte;
 NumBitPlanes:  Byte;
 BytesPerLine:   Word;
 PaletteType:  Word;
 HorizScrSize: Word;
 VertScrSize:  Word;
 Reserved2:  array [0..54]  of Char;
 
 end;
 
 
  TForm1 = class(TForm)
    mmo1: TMemo;
    img1: TImage;
    dlgOpen1: TOpenDialog;
    dlg1: TSavePictureDialog;
    mm1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    procedure N2Click(Sender: TObject);
 
    function invertword(val: Word): Word;
 
    procedure loadmemo();
 
 
 
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
 
  bmp:TBitmap;
  Head: PCX;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.N2Click(Sender: TObject);
var
  workpath: string;
  f1: file;
  Rhead: PCX;
  Row: pRGBArray;
  i,j: Integer;
begin
    workpath := ExtractFilePath(ParamStr(0));
     dlgOpen1.initialdir:= workpath + 'Images\';
     if dlgOpen1.execute
     then
     begin
     with Rhead do
     begin
       AssignFile(f1, dlgOpen1.Filename);
       Reset(f1,1);
       BlockRead(f1,Identifier, 1);
       Head.Identifier:= Identifier;
       if Identifier=10
       then
          begin
             BlockRead(f1,Version, 1);
                 Head.Version:=Version;
             BlockRead(f1,Encoding, 1);
                 Head.Encoding:=Encoding;
             BlockRead(f1,BitPerPixel, 1);
                 Head.BitPerPixel:=BitPerPixel;
             BlockRead(f1,Xstart, 2);
                 Head.Xstart:=invertword(Xstart);
             BlockRead(f1,Ystart, 2);
                 Head.Ystart:=invertword(Ystart);
             BlockRead(f1,Xend, 2);
                 Head.Xend:=invertword(Xend);
             BlockRead(f1,Yend, 2);
                 Head.Yend:=invertword(Yend);
             BlockRead(f1,HorizRez, 2);
                 Head.HorizRez:=invertword(HorizRez);
             BlockRead(f1,VertRez, 2);
                 Head.VertRez:=invertword(VertRez);
             BlockRead(f1,Palette, 48);
                 Head.Palette:=Palette;
             BlockRead(f1,VideoMode, 1);
                 Head.VideoMode:=VideoMode;
             BlockRead(f1,NumBitPlanes, 1);
                 Head.NumBitPlanes:=NumBitPlanes;
             BlockRead(f1,BytesPerLine, 2);
                 Head.BytesPerLine:=invertword(BytesPerLine);
             BlockRead(f1,PaletteType, 2);
                 Head.PaletteType:=invertword(PaletteType);
             BlockRead(f1,HorizScrSize, 2);
                 Head.HorizScrSize:=invertword(HorizScrSize);
             BlockRead(f1,VertScrSize, 1);
                 Head.VertScrSize:=invertword(VertScrSize);
             BlockRead(f1,Reserved2, 1);
                 Head.Reserved2:=Reserved2;
             loadmemo();
 
             bmp:=tbitmap.create;
             bmp.Width:=Head.Xstart;
             bmp.Width:=Head.Xend;
             bmp.Height:=Head.Ystart;
             bmp.Height:=Head.Yend;
 
             for j:= 0 to bmp.Height do
             begin
               Row := bmp.ScanLine[j];
               for i:= 0 to bmp.Width do
               begin
                 BlockRead(f1,Row[i].rgbtRed,1);
               end;
             end;
             end;
             end;
             for j:= 0 to bmp.Height do
             begin
               Row := bmp.ScanLine[j];
               for i:= 0 to bmp.Width  do
               begin
                 BlockRead(f1,Row[i].rgbtBlue,1);
               end;
             end;
             for j:= 0 to bmp.Height do
             begin
               Row := bmp.ScanLine[j];
               for i:= 0 to bmp.Width do
               begin
                 BlockRead(f1,Row[i].rgbtGreen,1);
               end;
             end;
 
               img1.Picture.Bitmap.Height:=bmp.Height;
               img1.Picture.Bitmap.Width:=bmp.Width;
 
               img1.Picture.Bitmap:=bmp;
 
             end ;
        //     else  MessageBox(0, 'Данный формат не соответствует формату PCX','Внимание') ;
             closefile(f1) ;
             end;
    function TForm1.invertword(val:Word): Word;
    begin
      invertword := ((val and $FF00) shr 8) or((val and $00FF) shl 8);
    end;
 
    procedure TForm1.loadmemo;
    begin
         mmo1.Lines.Clear;
         img1.Picture:=nil;
         with mmo1.Lines do
         begin
           with Head do
           begin
             Add('Изготовитель ' +inttostr(Identifier));
             Add('Версия ' +inttostr(Version));
             Add('Кодирование ' +inttostr(Encoding));
             Add('Битов на пиксель ' +inttostr(BitPerPixel));
             Add('Координаты изображения на экране ' +inttostr(Xstart));
             Add('Координаты изображения на экране ' +inttostr(Ystart));
             Add('Координаты изображения на экране ' +inttostr(Xend));
             Add('Координаты изображения на экране ' +inttostr(Yend));
             Add('Горизонтальный размер дисплея ' +inttostr(HorizRez));
             Add('Вертикальный размер дисплея ' +inttostr(VertRez));
             Add('16-цветная палитра ' +Palette) ;
             Add('Видеорежим ' +inttostr(VideoMode))  ;
             Add('Кол-во битовых плоскостей ' +inttostr(NumBitPlanes));
             Add('Байтов на строку развертки ' +inttostr(BytesPerLine)) ;
             Add('Тип палитры ' +inttostr(PaletteType)) ;
             Add('Горизонтальное разрешение сканера ' +inttostr(HorizScrSize));
             Add('Вертикальное разрешение сканера ' +inttostr(VertScrSize)) ;
             Add('Резерв ' +Reserved2);
           end;
         end;
    end;
 
    end.

BlockRead(f1, Rhead, 128);