2009. december 12., szombat

Viewing PCX File Format in Delphi (256-colors)


Problem/Question/Abstract:

How to show bitmap in pcx file format using Delphi ??

Answer:

This is quite simple way to answer above question: viewing pcx file format using Delphi. But this answer is limited only for 256-colors image (pcx image).

Here is the example code for the answer :

type
  TArrBuff = array[1..512] of Byte;
  TPalette_Cell = record
    r, g, b: byte;
  end;
  TPal = array[0..255] of TPalette_Cell;
  TPPal = ^TPal;

  TPCX_Header = record // PCX Header
    Manufacture, Version, Encoding, BpPixel: Byte;
    XMin, YMin, XMax, YMax, Hdpi, Vdpi: Smallint;
    ColorMap: array[0..15, 0..2] of Byte;
    Reserved, Nplanes: Byte;
    BpLpPlane, PaletteInfo, HScreenSize, VScreenSize: Smallint;
    Filer: array[74..127] of Byte;
  end;

var
  pal: TPPal;
  pFile: file;
  FPcxHeader: TPCX_Header;
  buffer: TArrBuff;

procedure THPPcx.ReadImageData2Bitmap;
var
  X, Y: Integer;
  i, Loop: Byte;
  data: Word;
  tmpClr: TColor;
begin
  X := FPcxHeader.XMin;
  Y := FPcxHeader.YMin;
  data := 1;
  BlockRead(pFile, Buffer, SizeOf(Buffer));
  while (Y <= FPcxHeader.YMax) do
  begin
    if (Buffer[data] and $C0) = $C0 then
    begin
      Loop := Buffer[data] and $3F;
      if data < SizeOf(Buffer) then
        Inc(data)
      else
      begin
        data := 1;
        BlockRead(pFile, Buffer, SizeOf(Buffer));
      end;
    end
    else
      Loop := 1;
    for i := 1 to Loop do
    begin
      tmpClr := rgb(pal^[Buffer[data]].R, pal^[Buffer[data]].G, pal^[Buffer[data]].B);
      SetPixel(Bitmap.Canvas.Handle, x, y, tmpClr);
      Inc(X);
      if X = FPcxHeader.BpLpPlane then
      begin
        X := FPcxHeader.XMin;
        Inc(Y);
      end;
    end;
    if data < SizeOf(Buffer) then
      Inc(data)
    else
    begin
      data := 1;
      BlockRead(pFile, Buffer, SizeOf(Buffer));
    end;
  end;
end;

procedure THPPCX.LoadFromFile(const FileName: string);
begin
  AssignFile(pFile, FileName);
{$I-}Reset(pFile, 1);
{$I+}
  if IOResult = 0 then
  begin
    BlockRead(pFile, FPcxHeader, SizeOf(FPcxHeader));
    if FPcxHeader.Manufacture = 10 then
    begin // valid pcx header id
      Bitmap.Width := FPcxHeader.XMax;
      Bitmap.Height := FPcxHeader.YMax;
      GetMem(pal, 768);
      try
        Seek(pFile, FileSize(pFile) - 768); // palette position
        BlockRead(pFile, pal^, 768);
        Seek(pFile, SizeOf(FPcxHeader)); // image data position
        ReadImageData2Bitmap;
      finally
        FreeMem(pal);
      end;
    end
    else
      MessageBox(Application.Handle, 'Not A Valid PCX File Format',
        'PCX Viewer Error', MB_ICONHAND);
    CloseFile(pFile);
  end
  else
    MessageBox(Application.Handle, 'Error Opening File', 'PCX Viewer Error',
      MB_ICONHAND);
end;

How to try this code ?? Just call the "LoadFromFile" procedure above in your application (probably with little modification offcourse, especially about the name of mainForm that I used here [THPPCX]).

Hopefully It can help you.

For full source code and simple application that use this, you can look and download from my website: www.geocities.com/h4ryp/delphi.html

Nincsenek megjegyzések:

Megjegyzés küldése