PCX - файлы...

← →
som (2002-04-22 13:33) [0]

Мне нужно отображать (например в TImаge)РСХ-файлы. Как это сделать?

← →
Donal_Graeme (2002-04-22 18:28) [1]

procedure PCXtoBMP (Filename: String; var Bmp : TBitmap);
var MS : TMemoryStream;
I, J, K, N : Word;
Temp : Byte;
Pos : DWord;

//Fields
Manuf : byte; //Manufacturer
Ver : byte; //Version
Enc : byte; //Encoding
Bits : byte; //Bits per pixel
XMin,
XMax,
YMin,
YMax : Word; //Window
HDpi, VDpi : Word;
Colormap : Array [0..47] of Byte;
nPlanes : Byte;
BPL : Word; //Bites per line
GrayScale : Word;
HSize, //HScreenSize
VSize : Word; //VScreenSize

Palette : Array [0..255] of TColor;
Color : Array [1..3] of Byte;

SL : PByteArray;

//Work vars
HDim, VDim : Integer;
LineCap : Integer;
PalMode : Boolean;

HS : TMemoryStream;
begin
MS := TMemoryStream.Create;
MS.LoadFromFile (Filename);
With MS do
begin
try
Position := 0;
Read (Manuf, 1);
Read (Ver, 1);
Read (Enc, 1);
Read (Bits, 1);
Read (XMin, 2);
Read (YMin, 2);
Read (XMax, 2);
Read (YMax, 2);
Read (HDpi, 2);
Read (VDpi, 2);
Read (Colormap[0], 48);
Read (Temp, 1);
Read (nPlanes, 1);
Read (BPL, 2);
Read (GrayScale, 2);
Read (HSize, 2);
Read (VSize, 2);
For I := 1 to 54 do Read (Temp, 1);

If Ver > 5 then Exit;
If nPlanes > 4 then Exit;
//Decoding
HDim := XMax -XMin +1;
VDim := YMax -YMin +1;
LineCap := nPlanes*BPL;

PalMode := False;

If Ver = 5 then //Reading palette
begin
Pos := Position;
Position := Size -769;
Read (Temp, 1);
If Temp = 12 then
begin
PalMode := True;
For I := 0 to 255 do
begin
Read (Color[1], 3);
Palette[I] := RGB (Color[1], Color[2], Color[3]);
end;
end;
Position := Pos;
end;

HS := TMemoryStream.Create;
HS.Size := LineCap*VDim;
HS.Position := 0;

For J := 0 to VDim -1 do
begin
I := 0;
While I < LineCap do
begin
Read (Temp, 1);
If (Temp and $C0) = $C0 then
begin
N := (Temp and $3F);
Read (Temp, 1);
For K := 1 to N do
begin
HS.Write (Temp, 1);
Inc (I);
If I >= LineCap then Break;
end;
end
else
begin
HS.Write (Temp, 1);
Inc (I);
end;
end;
end;

//Writing Image
HS.Position := 0;
Bmp.Width := HDim;
Bmp.Height := VDim;
If PalMode then
begin
Bmp.PixelFormat := pf24bit;
For I := 0 to VDim -1 do
begin
SL := Bmp.ScanLine[I];
For J := 0 to LineCap -1 do
begin
HS.Read (Temp, 1);
If J < HDim then
begin
SL[J*3] := GetBValue (Palette[Temp]);
SL[J*3 +1] := GetGValue (Palette[Temp]);
SL[J*3 +2] := GetRValue (Palette[Temp]);
end;
end;
end;
end
else
begin
Case Bits of
1 : Bmp.PixelFormat := pf1bit;
4 : Bmp.PixelFormat := pf4bit;
else
Case nPlanes of
1 : Bmp.PixelFormat := pf8bit;
2 : Bmp.PixelFormat := pf16bit;
3 : Bmp.PixelFormat := pf24bit;
4 : Bmp.PixelFormat := pf32bit;
end;
end;
For I := 0 to VDim -1 do
begin
SL := Bmp.ScanLine[I];
For K := nPlanes -1 downto 0 do
begin
J := 0;
Repeat
HS.Read (Temp, 1);
SL[J*3 +K] := Temp;
Inc (J);
Until J >= LineCap div 3;
end;
end;
end;

HS.Free;
finally
Free;
end;
end;
end;

PCX - файлы... Найти похожие ветки