Een simpel algoritme voor foto-compressie

Nieuw: versie 5

- maximale grootte van plaatjes 4000 * 3000 (h*v) pixels
- gedecomprimeerde (*.pic) plaatjes kunnen weer als *bmp bestand worden bewaard
- ook .jpg afbeeldingen kunnen worden geladen

Image Compressie

Aanpak.

Kleuren.

- tel de helft van het veelvoud op bij het getal
- kap af op een veelvoud

1111 1100
0000 1000 +
----------------
10000 0100 afkappen op 16 tallen:
10000 0000

Pixels

1. Kopiëren van de linkerbuur
2. Kopiëren van de bovenbuur
3. Kiezen uit een tabel (stack) van eerder gebruikte kleuren
4. De linkerbuurkleur een beetje veranderen
5. Een nieuwe kleur toevoegen

00 00 rrrr gggg bbbb	nieuwe kleur met rood, groen,blauw
00 01	Hmarker
00 10	Vmarker
00 11 rgb ddd	Delta
01 sssss	kleur uit stack[sssss] (0..31)
10	kopieer kleur van linkerbuur
11	kopieer kleur van bovenbuur

Markers

101010101010101010101010101010 (15 keer linkerkleur gekopiëerd)

Het stack

Delta

0 : geen verandering voor deze basiskleur 1 : wel verandering

0 : +1 maar: als de kleur $f is, dan -2
1 : -1 maar: als de kleur al $1 is, dan +2

Samenvatting

File formaat

Trucs die het niet gehaald hebben

Grijstinten

00 00		delta +
00 01		Hmarker
00 10		Vmarker
00 11		delta -
01 gggg		nieuwe kleur
10		kopiëer linkerpixel
11		kopiëer bovenpixel

(rrrr 1111 + gggg 1111 + bbbb 1111 ) / 3 or $0f0f0f

Bitmap adressering

bm.pixelformat := pf32bit

type PDW = ^dword;
var po,ps,p : dword;
.....
p0 := dword(scanline[0]);
ps := p0-dword(scanline[i];//ps = pointer step tussen opvolgende     
                           //rijen

Pixel [x,y] is nu te lezen met

p := p0 - y*ps + (x shl 2); // x * 4 om van byte adres een dword 
                            //adres te maken.
color := PDW(p)^;

Randen

Bitstromen

var director : array[0..maxdir] of dword;
      dirPtr : dword;
      accu   : dword;
      acount : byte;

Resultaten

zeeslag	huizen	Madoff	raster	strepen	fill

naam	% gif	% png	% pic
zeeslag	23,6	66,2	16,07
huizen	18,1	57,5	14,75
Madoff	17	14,8	12,39
raster	1	0,5	2,54
strepen	0,97	0,97	2,06
fill	0,89	0,46	10,81

Het spic project

- form1 / unit1
- knoppen voor load, store, compressen, decompressen, grijsmaken
- event methods
- controle van het programma
- statistiek
- paintbox voor het weergeven van de bitmaps
- labels voor het tonen van gegevens en statistiek.

- compressunit
- procedures voor compressen en decompressen
- procedures voor het tellen van het aantal kleuren tbv de statistiek

Data flows

Data formaten

Programma code

type PDW = ^dword;

const maxdir   = 250000;
      stacklength = 32;
      pic = 'pic';
      spic = 'spic';
      
var director    : array[0..maxdir] of dword;
    dirPtr      : dword;
    accu        : dword;  //bit asembly register
    acount      : byte;   //nr of valid bitsin accu
    map         : Tbitmap;
    p0          : dword;  //left top canvas pointer
    ps          : dword;  //line downstep value
    cc          : array[0..127] of dword; //colorcount bits
    stack       : array[0..stacklength-1] of word;   //rrrrggggbbbb

procedure storeCode(w : dword; n : byte);
//store n bits of w to dirictor (via accu)
//n = 1 ..16
var space : byte;
begin
 space := 32 - acount;
 accu := accu or (w shl acount);
 if space >= n then            //if space
  begin
   acount := acount + n;
   if acount = 32 then
    begin
     acount := 0;
     director[dirPtr] := accu;
     inc(dirPtr);
     accu := 0;
    end;
  end
  else                         //if no space
   begin
    director[dirPtr] := accu;
    accu := 0;
    inc(dirPtr);
    accu := w shr space;
    acount := n - space;
   end;
end;

function readcode(n : byte) : dword;
//read n bits from director table
var mask : dword;
    space : byte;
begin
 if acount= 0 then
  begin
   accu := director[dirPtr];
   inc(dirPtr);
  end;
 mask := (1 shl n) -1;
 space := 32 - acount;
 result := accu shr acount;
 acount := acount + n;
 if acount = 32 then acount := 0
  else if acount > 32 then
        begin
         accu := director[dirPtr];
         inc(dirPtr);
         dec(acount,32);
         result := (result or (accu shl space));
        end;
 result := result and mask;
end;

function fixRGB12(c : byte) : byte; //hulpje van colorfix12
//round 4 bit to $1f,$2f.....$ff
var c1 :  word;
begin
 c1 := (c + $8) and $1f0;
 if c1 < $20 then c1 := $20;
 dec(c1);
 result := c1 and $ff;
end;

procedure colorfix12;
//reduce colors in map to 12 bit
var x,y : word;
    Pline,p  : dword;
    color : dword;
    r,g,b : word;
begin
 clearCC;  //clear colorcount array
 for y := 0 to map.Height-1 do
  begin
   Pline := p0 - y*ps;
   for x := 0 to map.Width-1 do
    begin
     p := pline + (x shl 2);
     color := PDW(p)^;
     r := (color shr 16) and $ff;
     g := (color shr 8) and $ff;
     b := color and $ff;
     r := fixRGB12(r);
     g := fixRGB12(g);
     b := fixRGB12(b);
     color := b or (g shl 8) or (r shl 16);
     PDW(p)^ := color;
     setcolorbit(r,g,b);         //for colorcount;
    end;
  end;
 countcolors;
end;

Bediening

left		aantal kopiën van de linkerbuur
exp.left		aantal kopiën van de linkerbuur met compressie (exp = expanded)
top		aantal kopiën van de bovenbuur
exp.top		aantal kopiën van de bovenbuur met compressie (exp = expanded)
stack		aantal malen dat de kleur door het stack werd geleverd
new		aantal malen dat een nieuwe kleur werd ingevoegd

Grootte