Skip to content

Commit 20531cd

Browse files
PascalVaultPascalVault
authored
Add files via upload
1 parent e970b8e commit 20531cd

File tree

7 files changed

+267
-60
lines changed

7 files changed

+267
-60
lines changed

‎PV_Bitmap.pas‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -165,8 +165,9 @@ TPV_BitmapFormat = class
165165
procedure Unrle_CUT(Src: TStream; Dest: TStream; packedSize: Integer; unitSize: Integer);
166166
procedure Unrle_DLP(Src: TStream; Dest: TStream; packedSize: Integer; escapeByte: Byte);
167167
procedure Unrle_PSD(Src: TStream; Dest: TStream; packedSize: Integer; unitSize: Integer = 1); //psd,mac
168+
procedure UnRle_LBM(Src: TStream; Dest: TStream; packedSize: Integer);
169+
168170
{
169-
procedure UnRleLBM(source: TQFile; out dest: TQFile; packedSize: Integer);
170171
procedure UnRleBMP8(source: TQFile; out dest: TQFile; packedSize: Integer; width, height: Integer);
171172
procedure UnRle4BT(source: TQFile; out dest: TQFile; packedSize: Integer);
172173
}

‎PV_BitmapFormats.pas‎

Lines changed: 129 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -301,6 +301,132 @@ procedure UnGzip(Data: TStream; Result: TStream); //gzdecode from PHP
301301
end;
302302
end;
303303

304+
305+
function LBM_Read(Bmp: TPV_Bitmap; Str: TStream): Boolean;
306+
var Reader: TPV_Reader;
307+
Reader2: TPV_Reader;
308+
Width, Height: Integer;
309+
R,G,B,A: Byte;
310+
x,y: Integer;
311+
i,k,j: Integer;
312+
form, ilbm: String;
313+
size: Cardinal;
314+
bmWidth, bmHeight, bmX, bmY, bmPlanesCount, bmMasking, bmCompression,
315+
bmPad1, bmTransColor, bmXAspect, bmYAspect, bmPageWidth, bmPageHeight: Cardinal;
316+
chName: String;
317+
chSize: Integer;
318+
col: Byte;
319+
pal: array[0..255] of TPix;
320+
rr: array of Cardinal;
321+
gg: Byte;
322+
p: TPix;
323+
Mem: TMemoryStream;
324+
begin
325+
Reader := TPV_Reader.Create(Str);
326+
327+
form := Reader.getS(4);
328+
size := Reader.getMU4;
329+
ilbm := Reader.getS(4);
330+
331+
if form <> 'FORM' then begin
332+
Reader.Free;
333+
Exit(False);
334+
end;
335+
336+
if (ilbm <> 'ILBM') and (ilbm <> 'PBM ') then begin
337+
Reader.Free;
338+
Exit(False);
339+
end;
340+
341+
while Reader.Offset < Reader.Size do begin
342+
chName := Reader.getS(4); //LBM Chunk
343+
chSize := Reader.getMU4;
344+
345+
if chName = 'BMHD' then begin
346+
bmWidth := Reader.getMU2;
347+
bmHeight := Reader.getMU2;
348+
bmX := Reader.getMU2;
349+
bmY := Reader.getMU2;
350+
bmPlanesCount := Reader.getU;
351+
bmMasking := Reader.getU;
352+
bmCompression := Reader.getU;
353+
bmPad1 := Reader.getU;
354+
bmTransColor := Reader.getMU2;
355+
bmXAspect := Reader.getU;
356+
bmYAspect := Reader.getU;
357+
bmPageWidth := Reader.getMU2;
358+
bmPageHeight := Reader.getMU2;
359+
360+
Bmp.SetSize(bmWidth, bmHeight);
361+
end
362+
else if chName = 'CMAP' then begin //palette
363+
for i:=0 to ceil(chSize/3)-1 do begin
364+
365+
pal[i].r := Reader.getU;
366+
pal[i].g := Reader.getU;
367+
pal[i].b := Reader.getU;
368+
end;
369+
end
370+
else if chName = 'BODY' then begin //image body
371+
372+
Mem := TMemoryStream.Create;
373+
Str.Position := Reader.Offset;
374+
375+
setLength(rr, bmWidth);
376+
377+
if bmCompression = 1 then begin//RLE
378+
Unrle_LBM(Str, Mem, Str.Size-Str.Position);
379+
Mem.Position := 0;
380+
Reader2 := TPV_Reader.Create(Mem);
381+
Reader.Offset := Str.Size;
382+
end
383+
else begin
384+
Reader2 := TPV_Reader.Create(Str, chSize);
385+
Reader.Offset := Reader.Offset + chSize;
386+
end;
387+
388+
for y:=0 to bmHeight-1 do begin
389+
for i:=0 to bmWidth-1 do rr[i] := 0;
390+
391+
//showmessage(IntToStr(bmPlanesCount));
392+
393+
for k:=0 to bmPlanesCount-1 do //for every bitplane
394+
for x:=0 to ceil(bmWidth/8)-1 do begin
395+
b := Reader2.getU;
396+
for j:=0 to 8-1 do begin
397+
gg := getBits(b, (8-1)-j, 1);
398+
rr[8*x + j] := rr[8*x + j] + (gg shl k);
399+
end
400+
end;
401+
402+
if bmPlanesCount<9 then
403+
for x:=0 to bmWidth-1 do begin
404+
gg := rr[x];
405+
Bmp.SetRGBA(x, y, pal[gg].r, pal[gg].g, pal[gg].b, 255);
406+
end
407+
else
408+
for x:=0 to bmWidth-1 do begin
409+
P.RGBA := rr[x];
410+
Bmp.SetRGBA(x,y, p.B, p.G, p.R, 255);
411+
end;
412+
end;
413+
414+
Mem.Free;
415+
Reader2.free;
416+
417+
418+
// break; //TODO: remove
419+
420+
end //Other block- ignore
421+
else begin
422+
Reader.offset := Reader.offset + chSize;
423+
end
424+
end;
425+
426+
Result := True;
427+
Reader.Free;
428+
end;
429+
304430
function A4MI_Read(Bmp: TPV_Bitmap; Str: TStream): Boolean;
305431

306432
//Atari 4MI
@@ -9658,6 +9784,9 @@ initialization
96589784
// BitmapFormats.Add('ozt', @OZT_Read, nil, '');
96599785
// BitmapFormats.Add('pgx2', @PGX2_Read, nil, '');
96609786

9787+
BitmapFormats.Add('lbm', @LBM_Read, nil, 'Amiga LBM');
9788+
BitmapFormats.Add('iff', @LBM_Read, nil, 'Amiga LBM');
9789+
96619790
BitmapFormats.Add('pi4', @PI4_Read, nil, 'Degas Extended');
96629791
BitmapFormats.Add('pi5', @PI5_Read, nil, 'Degas Extended'); //medium
96639792
BitmapFormats.Add('pi7', @PI7_Read, nil, 'Degas Extended');

‎PV_Streams.pas‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ TPV_Reader = class
5252
function GetWhite: String;
5353
function GetS(Count: Integer = -1): String;
5454
procedure Skip(Count: Integer);
55-
constructor Create(Str: TStream);
55+
constructor Create(Str: TStream; Length: Integer = -1);
5656
end;
5757

5858
{ TPV_Writer }
@@ -347,11 +347,13 @@ procedure TPV_Reader.Skip(Count: Integer);
347347
Inc(FPos, Count);
348348
end;
349349

350-
constructor TPV_Reader.Create(Str: TStream);
350+
constructor TPV_Reader.Create(Str: TStream; Length: Integer);
351351
begin
352352
FStream := Str;
353353

354-
FSize := Str.Size;
354+
if Length = -1 then FSize := Str.Size
355+
else FSize := Length;
356+
355357
SetLength(Buf, FSize);
356358
Str.Read(Buf[0], FSize);
357359

‎RLE.pas‎

Lines changed: 35 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -1,28 +1,5 @@
11
{
2-
procedure UnRleLBM(source: TQFile; out dest: TQFile; packedSize: Integer);
3-
const unitSize = 1;
4-
var i: Integer;
5-
count: Integer;
6-
begin
7-
i := 0;
8-
while (i<packedSize-1) do begin
9-
// if i> 100 then break;
10-
count := source.readI;
11-
if (count >= 0) then begin //uncompressed
12-
count := count+1;
13-
dest.copyFrom(source, unitSize*count);
14-
inc(i, unitSize*count+1);
15-
end
16-
else if count = -128 then begin
17-
inc(i, 1);
18-
end
19-
else begin
20-
count := -count+1;
21-
dest.copyRepeat(source, unitSize, count);
22-
inc(i, unitSize+1);
23-
end;
24-
end;
25-
end;
2+
263
274
procedure UnRle4BT(source: TQFile; out dest: TQFile; packedSize: Integer);
285
const unitSize = 1;
@@ -99,6 +76,40 @@ procedure UnRleBMP8(source: TQFile; out dest: TQFile; packedSize: Integer; width
9976
end;
10077
}
10178

79+
80+
procedure UnRle_LBM(src: TStream; dest: TStream; packedSize: Integer);
81+
const unitSize = 1;
82+
var i,j: Integer;
83+
count: Byte;
84+
count2: ShortInt absolute count;
85+
buff: array of Byte;
86+
begin
87+
setLength(Buff, unitSize);
88+
89+
i := 0;
90+
while (i<packedSize-1) do begin
91+
count := src.ReadByte;
92+
93+
if (count2 >= 0) then begin //uncompressed
94+
count2 := count2+1;
95+
dest.copyFrom(src, unitSize*count2);
96+
inc(i, unitSize*count2+1);
97+
end
98+
else if count2 = -128 then begin
99+
inc(i, 1);
100+
end
101+
else begin
102+
count2 := -count2+1;
103+
104+
Src.Read(buff[0], unitSize);
105+
for j:=0 to count2-1 do
106+
Dest.Write(Buff[0], unitSize);
107+
108+
inc(i, unitSize+1);
109+
end;
110+
end;
111+
end;
112+
102113
procedure UnRle_PGC(src: TStream; dest: TStream; packedSize: Integer);
103114
const unitSize = 1;
104115
var i,j: Integer;

‎dlg_about.lfm‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -59,8 +59,8 @@ object AboutDlg: TAboutDlg
5959
Left = 360
6060
Height = 15
6161
Top = 64
62-
Width = 56
63-
Caption = 'version 0.7'
62+
Width = 65
63+
Caption = 'version 0.7.1'
6464
end
6565
object Memo1: TMemo
6666
Left = 32

‎unit1.lfm‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ object Form1: TForm1
1515
OnKeyDown = FormKeyDown
1616
OnMouseWheelDown = FormMouseWheelDown
1717
OnMouseWheelUp = FormMouseWheelUp
18+
OnResize = FormResize
1819
LCLVersion = '3.0.0.3'
1920
object Panel1: TPanel
2021
Left = 0

0 commit comments

Comments
 (0)