-
Notifications
You must be signed in to change notification settings - Fork 0
/
dtinytga.pas
69 lines (61 loc) · 1.69 KB
/
dtinytga.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
unit dtinytga;
// Tiny TGA writer: original code by jon olick, public domain
// Elder C version by rlyeh, public domain | wtrmrkrlyeh
// Ported to pascal by Doj
{$MODE FPC}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}
interface
procedure TinyTGA(var F: File; RGBA: Pointer; Width, Height, NumChannels: UInt16); overload;
procedure TinyTGA(const FileName: AnsiString; RGBA: Pointer; Width, Height, NumChannels: UInt16); overload;
implementation
procedure TinyTGA(var F: File; RGBA: Pointer; Width, Height, NumChannels: UInt16); overload;
const
HEADER: array[0 .. 12 - 1] of Byte = (
$00, $00, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00
);
var
X, I, Y, J: PtrInt;
BPC: UInt16;
ReMap: array[0 .. 4 - 1] of PtrInt;
S: PByte;
begin
// Swap RGBA to BGRA if using 3 or more channels
BPC := NumChannels * 8; // 8 bits per channel
if NumChannels >= 3 then begin
ReMap[0] := 2;
ReMap[1] := 1;
ReMap[2] := 0;
ReMap[3] := 3;
end else begin
ReMap[0] := 0;
ReMap[1] := 1;
ReMap[2] := 2;
ReMap[3] := 3;
end;
// Header
BlockWrite(F, HEADER[0], 12);
BlockWrite(F, Width, 2);
BlockWrite(F, Height, 2);
BlockWrite(F, BPC, 2);
for Y := Height - 1 downto 0 do begin
I := (Y * Width) * NumChannels;
X := I;
while X < I + Width * NumChannels do begin
for J := 0 to NumChannels - 1 do
BlockWrite(F, PByte(RGBA)[X + ReMap[j]], 1);
Inc(X, NumChannels);
end;
end;
end;
procedure TinyTGA(const FileName: AnsiString; RGBA: Pointer; Width, Height, NumChannels: UInt16); overload;
var
F: File;
begin
Assign(F, FileName);
ReWrite(F, 1);
TinyTGA(F, RGBA, Width, Height, NumChannels);
Close(F);
end;
end.