急！如何将图片文件转换成PCX图片文件保存

Question

在Delphi中怎样将Bitmap,Icon等普通支持的图片文件
转换成PCX文件，最好是有源码示例

Answer 1

给段简单的代码，不支持RLE压缩，只能用8、24位两种色深写入type
  TPCXHeader = record
    FileID: Byte;
    Version: Byte;
    Encoding: Byte;
    BitsPerPixel: Byte;
    XMin,
    YMin,
    XMax,
    YMax,
    HRes,
    VRes: Word;
    ColorMap: array[0..15] of TRGB;
    Reserved,
    ColorPlanes: Byte;
    BytesPerLine,
    PaletteType: Word;
    Fill: array[0..57] of Byte;
  end;TPCXGraphic = class(TBitmap)
public
  procedure SaveToStream(Stream: TStream); override;
end;procedure TPCXGraphic.SaveToStream(Stream: TStream);
var
  Header: TPCXHeader;
  Run: Pointer;
  Line, EncodeBuffer: PByte;
  RLine, Gline, BLine: PByte;
  X, Y, I: Integer;
  Encoder: TPCXRLEDecoder;
  BytesStored: Cardinal;
  Filled: Boolean;
  Pal: TMaxLogPalette;
  Palarray:array[0..767] of Byte;
begin
  Header.FileID := $0A;
  Header.Version := 5;
  Header.Encoding := 1;
  Header.XMin := 0;
  Header.YMin := 0;
  Header.XMax := Width - 1;
  Header.YMax := Height - 1;
  Header.HRes := 72;
  Header.VRes := 72;
  FillChar(Header.ColorMap, 48, 0);
  Header.Reserved := 1;
  FillChar(Header.Fill,58,0);
  case PixelFormat of
    pf1bit,
    pf4bit:
    begin
      PixelFormat := pf8bit;
      Header.BitsPerPixel := 8;
      Header.ColorPlanes := 1;
      Header.BytesPerLine := (Width + 1) div 2 * 2;
      Header.PaletteType := 0;
    end;
    pf8bit:
    begin
      Header.BitsPerPixel := 8;
      Header.ColorPlanes := 1;
      Header.BytesPerLine := (Width + 1) div 2 * 2;
      Header.PaletteType := 0;
    end;
    pf24bit:
    begin
      Header.BitsPerPixel := 8;
      Header.ColorPlanes := 3;
      Header.BytesPerLine := (Width + 1) div 2 * 2;
      Header.PaletteType := 0;
    end;
    else
    begin
      PixelFormat := pf24bit;
      Header.BitsPerPixel := 8;
      Header.ColorPlanes := 3;
      Header.BytesPerLine := (Width + 1) div 2 * 2;
      Header.PaletteType := 0;
    end;
  end;  Stream.Write(Header, SizeOf(Header));
  Filled := Boolean(Width mod 2);  if PixelFormat = pf8bit then
  begin
    try
      for Y := 0 to Height - 1 do
      begin
        Line := ScanLine[Y];
        Stream.WriteBuffer(Line^, Width);
        if Filled then
        begin
          I := 0;
          Stream.WriteBuffer(I, 1);
        end;
      end;
      GetPaletteEntries(Palette, 0, 256, Pal.palPalEntry);
      for I := 0 to 255 do
      begin
        Palarray[3*I] := Pal.palPalEntry[I].peRed;
        Palarray[3*I+1] := Pal.palPalEntry[I].peGreen;
        Palarray[3*I+2] := Pal.palPalEntry[I].peBlue;
      end;
      I := $C;
      Stream.WriteBuffer(I, 1);
      Stream.WriteBuffer(Palarray, SizeOf(Palarray));
    finally    end;
  end
  else
  begin
    try
      GetMem(RLine, Width);
      GetMem(GLine, Width);
      GetMem(BLine, Width);
      for Y := 0 to Height - 1 do
      begin
        Line := ScanLine[Y];
        for X := 0 to Width - 1 do
        begin
          RLine^ := Line^;
          Inc(RLine);
          Inc(Line);
          GLine^ := Line^;
          Inc(GLine);
          Inc(Line);
          BLine^ := Line^;
          Inc(BLine);
          Inc(Line);
        end;
        Dec(BLine, Width);
        Stream.WriteBuffer(BLine^, Width);
        if Filled then
        begin
          I := 0;
          Stream.WriteBuffer(I, 1);
        end;
        Dec(GLine, Width)
        Stream.WriteBuffer(BLine^, Width);
        if Filled then
        begin
          I := 0;
          Stream.WriteBuffer(I, 1);
        end;
        Dec(RLine, Width);
        Stream.WriteBuffer(BLine^, Width);
        if Filled then
        begin
          I := 0;
          Stream.WriteBuffer(I, 1);
        end;
      end;
    finally
      if Assigned(RLine) then FreeMem(RLine);
      if Assigned(GLine) then FreeMem(GLine);
      if Assigned(BLine) then FreeMem(BLine);
    end;
  end;
end;

Answer 2

var PCXGraphic: TPCXGraphicPCXGraphic := TPCXGraphic.Create;
PCXGraphic.Assign(Bmp);
PCXGraphic.SaveToFile(FileName);

Answer 3

请问楼上的
TRGB，TPCXRLEDecoder，TMaxLogPalette怎么定义

Answer 4

TGB是我图形库里的东西，这里改成TRGBTripleEncoder: TPCXRLEDecoder;
删了，这里不用行程编码，如果要用RLE，这里很难办，因为这部分我提不出来，自己搞定吧，PCX图像的格式非常简单不过ACDSee这里存在BUG，所有PCX图像它都当作RLE编码的去读，所以这种图ACDSee打不开TMaxLogPalette Windows单元定义了，接触过调色板就应该用过用下面修正过的代码：type
  TPCXHeader = record
    FileID: Byte;
    Version: Byte;
    Encoding: Byte;
    BitsPerPixel: Byte;
    XMin,
    YMin,
    XMax,
    YMax,
    HRes,
    VRes: Word;
    ColorMap: array[0..15] of TRGBTriple;
    Reserved,
    ColorPlanes: Byte;
    BytesPerLine,
    PaletteType: Word;
    Fill: array[0..57] of Byte;
  end;TPCXGraphic = class(TBitmap)
public
  procedure SaveToStream(Stream: TStream); override;
end;procedure TPCXGraphic.SaveToStream(Stream: TStream);
var
  Header: TPCXHeader;
  Run: Pointer;
  Line, EncodeBuffer: PByte;
  RLine, Gline, BLine: PByte;
  X, Y, I: Integer;
  BytesStored: Cardinal;
  Filled: Boolean;
  Pal: TMaxLogPalette;
  Palarray:array[0..767] of Byte;
begin
  Header.FileID := $0A;
  Header.Version := 5;
  Header.Encoding := 0;
  Header.XMin := 0;
  Header.YMin := 0;
  Header.XMax := Width - 1;
  Header.YMax := Height - 1;
  Header.HRes := 72;
  Header.VRes := 72;
  FillChar(Header.ColorMap, 48, 0);
  Header.Reserved := 1;
  FillChar(Header.Fill,58,0);
  case PixelFormat of
    pf1bit,
    pf4bit:
    begin
      PixelFormat := pf8bit;
      Header.BitsPerPixel := 8;
      Header.ColorPlanes := 1;
      Header.BytesPerLine := (Width + 1) div 2 * 2;
      Header.PaletteType := 0;
    end;
    pf8bit:
    begin
      Header.BitsPerPixel := 8;
      Header.ColorPlanes := 1;
      Header.BytesPerLine := (Width + 1) div 2 * 2;
      Header.PaletteType := 0;
    end;
    pf24bit:
    begin
      Header.BitsPerPixel := 8;
      Header.ColorPlanes := 3;
      Header.BytesPerLine := (Width + 1) div 2 * 2;
      Header.PaletteType := 0;
    end;
    else
    begin
      PixelFormat := pf24bit;
      Header.BitsPerPixel := 8;
      Header.ColorPlanes := 3;
      Header.BytesPerLine := (Width + 1) div 2 * 2;
      Header.PaletteType := 0;
    end;
  end;  Stream.Write(Header, SizeOf(Header));
  Filled := Boolean(Width mod 2);  if PixelFormat = pf8bit then
  begin
    try
      for Y := 0 to Height - 1 do
      begin
        Line := ScanLine[Y];
        Stream.WriteBuffer(Line^, Width);
        if Filled then
        begin
          I := 0;
          Stream.WriteBuffer(I, 1);
        end;
      end;
      GetPaletteEntries(Palette, 0, 256, Pal.palPalEntry);
      for I := 0 to 255 do
      begin
        Palarray[3*I] := Pal.palPalEntry[I].peRed;
        Palarray[3*I+1] := Pal.palPalEntry[I].peGreen;
        Palarray[3*I+2] := Pal.palPalEntry[I].peBlue;
      end;
      I := $C;
      Stream.WriteBuffer(I, 1);
      Stream.WriteBuffer(Palarray, SizeOf(Palarray));
    finally    end;
  end
  else
  begin
    try
      GetMem(RLine, Width);
      GetMem(GLine, Width);
      GetMem(BLine, Width);
      for Y := 0 to Height - 1 do
      begin
        Line := ScanLine[Y];
        for X := 0 to Width - 1 do
        begin
          RLine^ := Line^;
          Inc(RLine);
          Inc(Line);
          GLine^ := Line^;
          Inc(GLine);
          Inc(Line);
          BLine^ := Line^;
          Inc(BLine);
          Inc(Line);
        end;
        Dec(BLine, Width);
        Stream.WriteBuffer(BLine^, Width);
        if Filled then
        begin
          I := 0;
          Stream.WriteBuffer(I, 1);
        end;
        Dec(GLine, Width);
        Stream.WriteBuffer(GLine^, Width);
        if Filled then
        begin
          I := 0;
          Stream.WriteBuffer(I, 1);
        end;
        Dec(RLine, Width);
        Stream.WriteBuffer(RLine^, Width);
        if Filled then
        begin
          I := 0;
          Stream.WriteBuffer(I, 1);
        end;
      end;
    finally
      if Assigned(RLine) then FreeMem(RLine);
      if Assigned(GLine) then FreeMem(GLine);
      if Assigned(BLine) then FreeMem(BLine);
    end;
  end;
end;

Answer 5

这代码就是我写的,没有问题,你用ACDSee查看的吧? 你一定没看清我的话,我不是说的很清楚了,这是ACDSee的BUG

Answer 6

var PCXGraphic: TPCXGraphic ;
begin
  PCXGraphic := TPCXGraphic.Create;
  PCXGraphic.Assign(Image1.Picture.Bitmap);
  PCXGraphic.SaveToFile('C:\1.PCX');会有问题吗

Answer 7

我不是用ACDSee看的，看别的PCX为何可以呢，自己写的就是不行

Answer 8

说明它也不支持非RLE压缩的PCX图，用IrfanView、XnView等试