📄 ietgafil.pas
字号:
TBYTEROW(TempArrayD)[W + 2] := TBYTEROW(TempArrayD)[Z + 2];
TBYTEROW(TempArrayD)[Z + 0] := Byte1;
TBYTEROW(TempArrayD)[Z + 1] := Byte2;
TBYTEROW(TempArrayD)[Z + 2] := Byte3;
dec(Z, 3);
inc(W, 3);
end;
end;
32:
begin
Y := Wide shr 3;
Z := Wide - 4;
W := 0;
for X := 0 to Y - 1 do
begin
Byte1 := TBYTEROW(TempArrayD)[W + 0];
Byte2 := TBYTEROW(TempArrayD)[W + 1];
Byte3 := TBYTEROW(TempArrayD)[W + 2];
TBYTEROW(TempArrayD)[W + 0] := TBYTEROW(TempArrayD)[Z + 0];
TBYTEROW(TempArrayD)[W + 1] := TBYTEROW(TempArrayD)[Z + 1];
TBYTEROW(TempArrayD)[W + 2] := TBYTEROW(TempArrayD)[Z + 2];
TBYTEROW(TempArrayD)[Z + 0] := Byte1;
TBYTEROW(TempArrayD)[Z + 1] := Byte2;
TBYTEROW(TempArrayD)[Z + 2] := Byte3;
Z := Z - 4;
W := W + 4;
end;
end;
end;
end;
//
procedure TGAReverse(var TempArrayD: TBYTEROW);
begin
if TGAHead.Descriptor and $10 <> 0 then
PixelSwapArray(TempArrayD, LineBytes);
end;
//
procedure TGA16_ANY_U(var Z: integer; var TempArrayD; Width: Word);
var
W1: Word;
I: integer;
R, G, B: Byte;
begin
for I := 0 to Width - 1 do
begin
W1 := FastGetWord;
R := ((W1 shr 10) and $1F) shl 3;
G := ((W1 shr 5) and $1F) shl 3;
B := ((W1 shr 0) and $1F) shl 3;
TBYTEROW(TempArrayD)[Z + 0] := B;
TBYTEROW(TempArrayD)[Z + 1] := G;
TBYTEROW(TempArrayD)[Z + 2] := R;
inc(z, 3);
end;
end;
//
procedure TGA24_ANY_U(var Z: integer; Flag: Byte; var TempArrayD; Width: Word; TempArrayAlpha: PBYTEROW);
var
I: integer;
begin
for I := 0 to Width - 1 do
begin
TBYTEROW(TempArrayD)[Z + 0] := FastGetByte;
TBYTEROW(TempArrayD)[Z + 1] := FastGetByte;
TBYTEROW(TempArrayD)[Z + 2] := FastGetByte;
if Flag = 1 then
begin
if TempArrayAlpha <> nil then
TempArrayAlpha[Z div 3] := FastGetByte
else
FastGetByte;
end;
inc(Z, 3);
end;
end;
//
procedure ReadTGALine;
var
Size, LineSize: integer;
W1: Word;
Z: integer;
R, G, B, B1: Byte;
procedure do8;
var
I: integer;
begin
with rc^ do
for I := 0 to Size - 1 do
begin
TempArrayD^[Z] := ((R shl 5) + (G shl 6) + (B * 12)) div 108;
Inc(Z);
end;
end;
procedure do24Raw;
var
I, Z: integer;
begin
with rc^ do
begin
Z := 0;
for I := 0 to Width - 1 do
begin
B1 := FastGetByte;
TempArrayD^[Z + 0] := Palette256[B1].b;
TempArrayD^[Z + 1] := Palette256[B1].g;
TempArrayD^[Z + 2] := Palette256[B1].r;
if (TempArrayAlpha<>nil) and hasalpha256 then
TempArrayAlpha[Z div 3]:=alpha256[B1];
inc(Z, 3);
end;
end;
end;
procedure do24RawPart;
var
I: integer;
begin
with rc^ do
for I := 0 to Size - 1 do
begin
B1 := FastGetByte;
TempArrayD^[Z + 0] := Palette256[B1].b;
TempArrayD^[Z + 1] := Palette256[B1].g;
TempArrayD^[Z + 2] := Palette256[B1].r;
if (TempArrayAlpha<>nil) and hasalpha256 then
TempArrayAlpha[Z div 3]:=alpha256[B1];
inc(Z, 3);
end;
end;
procedure do24Fill(B1: Byte);
var
I: integer;
R, G, B: Byte;
begin
with rc^ do
begin
R := Palette256[B1].r;
G := Palette256[B1].g;
B := Palette256[B1].b;
for I := 0 to Size - 1 do
begin
TempArrayD^[Z + 0] := B;
TempArrayD^[Z + 1] := G;
TempArrayD^[Z + 2] := R;
if (TempArrayAlpha<>nil) and hasalpha256 then
TempArrayAlpha[Z div 3]:=alpha256[B1];
inc(Z, 3);
end;
end;
end;
procedure do24;
var
I: integer;
begin
with rc^ do
for I := 0 to Size - 1 do
begin
TempArrayD^[Z + 0] := B;
TempArrayD^[Z + 1] := G;
TempArrayD^[Z + 2] := R;
inc(Z, 3);
end;
end;
var
col,q: integer;
begin
// ReadTGALine
with rc^ do
begin
if BitsPerPixel = 1 then
LineSize := (Width + 7) shr 3
else
LineSize := Width;
// Uncompressed Lines
if TGAHead.Imagetype in [1, 2, 3] then
case BitsPerPixel of
1: FastGetBytes(TempArrayD^[0], LineBytes);
8: do24Raw;
16:
begin
Z := 0;
TGA16_ANY_U(Z, TempArrayD^[0], Width);
end;
24:
begin
Z := 0;
TGA24_ANY_U(Z, 0, TempArrayD^[0], Width, TempArrayAlpha);
end;
32:
begin
Z := 0;
TGA24_ANY_U(Z, 1, TempArrayD^[0], Width, TempArrayAlpha);
end;
end
else
begin
// Compressed Lines
Z := 0;
col := 0;
repeat
if RemCode>-1 then
begin
B1 := RemCode;
Size:=RemSize;
RemCode:=-1;
end
else
begin
B1 := FastGetByte;
Size := (B1 and $7F) + 1;
end;
if Size+col>LineSize then
begin
RemSize:=(Size+Col)-LineSize;
RemCode:=B1;
Size:=LineSize-col;
end;
if (B1 and $80) <> 0 then
begin
// Run length packet
case BitsPerPixel of
1, 8:
begin
B1 := FastGetByte;
do24Fill(B1);
end;
16:
begin
W1 := FastGetWord;
R := ((W1 shr 10) and $1F) shl 3;
G := ((W1 shr 5) and $1F) shl 3;
B := ((W1 shr 0) and $1F) shl 3;
do24;
end;
24, 32:
begin
B := FastGetByte;
G := FastGetByte;
R := FastGetByte;
if BitsPerPixel = 32 then
begin
B1 := FastGetByte;
if TempArrayAlpha <> nil then
for q:=col to col+Size-1 do
TempArrayAlpha[q] := B1;
end;
do24;
end;
end;
end
else
// Single bytes
case BitsPerPixel of
1, 8:
do24RawPart;
16:
TGA16_ANY_U(Z, TempArrayD^[0], Size);
24:
TGA24_ANY_U(Z, 0, TempArrayD^[0], Size, TempArrayAlpha);
32:
TGA24_ANY_U(Z, 1, TempArrayD^[0], Size, TempArrayAlpha);
end;
inc(col,Size);
until col >= LineSize;
end;
end;
end;
//
begin
new(rc);
zeromemory(rc, sizeof(TRC));
with rc^ do
begin
// init alpha
for i:=0 to 255 do
alpha256[i]:=255;
hasalpha256:=false;
// Read Targa Stream
sbase := Stream.Position;
Index1 := 0;
Index2 := 0;
FileOk := true;
ReadTgaFileHeader(FileOK, Width, Height, BitsPerPixel, Compressed);
if FileOK then
begin
IOParams.Width := Width;
IOParams.Height := Height;
IOParams.DpiX := gDefaultDPIX;
IOParams.DpiY := gDefaultDPIY;
case BitsPerPixel of
1:
begin
IOParams.BitsPerSample := 1;
IOParams.SamplesPerPixel := 1;
end;
8:
begin
IOParams.BitsPerSample := 8;
IOParams.SamplesPerPixel := 1;
end;
16:
begin
IOParams.BitsPerSample := 5;
IOParams.SamplesPerPixel := 3;
end;
24:
begin
IOParams.BitsPerSample := 8;
IOParams.SamplesPerPixel := 3;
end;
32:
begin
IOParams.BitsPerSample := 8;
IOParams.SamplesPerPixel := 4;
end;
end;
if not Preview then
begin
Progress.per1 := 100 / Height;
Progress.val := 0;
if BitsPerPixel = 1 then
begin
Bitmap.Allocate(Width, Height, ie1g);
LineBytes := (Width + 7) shr 3;
end
else
begin
Bitmap.Allocate(Width, Height, ie24RGB);
LineBytes := Width * 3;
end;
try
GetMem(TempArrayD, LineBytes);
if (not IgnoreAlpha) and ( ((BitsPerPixel = 32) (*and ((TGAHead.Descriptor and 8) <> 0)*)) or (TGAHead.ColorMapBits=32) )then // 2.2.4rc3
begin
if not assigned(AlphaChannel) then
AlphaChannel := TIEMask.Create;
AlphaChannel.AllocateBits(Width, Height, 8);
AlphaChannel.Fill(255);
getmem(TempArrayAlpha, Width);
FillChar(TempArrayAlpha^,Width,255);
AlphaChannel.Full := false;
end
else
TempArrayAlpha := nil;
if ((ord(TGAHead.Descriptor) and 32) <> 32) and ((ord(TGAHead.Descriptor) and 16) <> 16) then
begin
StartLine := Height - 1;
IncLine := -1;
end
else
begin
StartLine := 0;
IncLine := 1;
end;
RemCode:=-1;
I := StartLine;
II := 0;
if TGAHead.Imagetype in [1, 2, 3, 9, 10, 11] then
repeat
ReadTGALine;
TGAReverse(TempArrayD^);
Ptr1 := BitMap.ScanLine[I];
// Copy the data
Move(TempArrayD^, Ptr1^, LineBytes);
// copy alpha
if TempArrayAlpha <> nil then
copymemory(AlphaChannel.Scanline[I], TempArrayAlpha, Width);
Inc(II);
I := I + IncLine;
with Progress do
begin
inc(val);
if assigned(fOnProgress) then
fOnProgress(Sender, trunc(per1 * val));
end;
until (II >= Height) or (Progress.Aborting^=True)
else
Progress.Aborting^ := True;
finally
FreeMem(TempArrayD);
if TempArrayAlpha <> nil then
FreeMem(TempArrayAlpha);
end;
end; // not preview
end
else
Progress.Aborting^ := True;
end;
dispose(rc);
if assigned(AlphaChannel) then
begin
AlphaChannel.SyncRect;
if AlphaChannel.IsEmpty then
FreeAndNil(AlphaChannel);
end;
end;
///////////////////////////////////////////////////////////////////////////////////////
procedure WriteTGAStream(Stream: TStream; Bitmap: TIEBitmap; var IOParams: TIOParamsVals; var Progress: TProgressRec; AlphaChannel: TIEMask);
var
rc: PRC;
TGAHead: TGAHeader;
OutputWidth: integer;
OutputHeight: integer;
DestBitsPerPixel: integer;
OrigBitsPerPixel: integer;
NewLine: PBYTEROW;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -