unit MCGLoder; // Mooncore Graphics Loader interface uses windows, paszlib; type RGBquad = packed record b, g, r, a : byte; end; RGBA64 = packed record b, g, r, a : word; end; RGBAarray = array[0..$FFFFFF] of RGBquad; bitmaptype = packed record image : pointer; palette : array of rgbquad; sizex, sizey : word; memformat, bitdepth : byte; // memformat: 0 = RGB, 1 = RGBA // 2 = monochrome, 3 = monochrome with alpha // 4 = indexed RGB, 5 = indexed RGBA (no separate A channel) // The loading routine calls ExpandImage which expands bitdepth always // to 8, and converts all images into formats 0 or 1. // If bitdepth is < 8, each image scanline must still be byte-aligned. // PNGs are such by definition; BMPs come with DWORD-aligned rows. // Bitdepth may not be > 8, due to effort involved. end; pbitmaptype = ^bitmaptype; function xlatezerror(incode : longint) : string; // Image loading, handling and unloading functions procedure mcg_ForgetImage(which : pbitmaptype); procedure mcg_PremulRGBA32(imagep : pointer; numpixels : dword); procedure mcg_ExpandBitdepth(whither : pbitmaptype); procedure mcg_ExpandIndexed(whither : pbitmaptype); function mcg_MatchColorInPal(color : rgbquad; which : pbitmaptype) : longint; function mcg_PNGtoMemory(p : pointer; membmp : pbitmaptype) : byte; function mcg_BMPtoMemory(p : pointer; membmp : pbitmaptype) : byte; function mcg_LoadGraphic(p : pointer; membmp : pbitmaptype) : byte; function mcg_MemorytoPNG(membmp : pbitmaptype; p, psizu : pointer) : byte; // Image scaling algorithms procedure BunnyScale2x32(poku : pbitmaptype); procedure BunnyScale2x24(poku : pbitmaptype); procedure mcg_EPScale32(poku : pbitmaptype; tox, toy : word); procedure mcg_EPScale24(poku : pbitmaptype; tox, toy : word); procedure mcg_ScaleBitmapCos(poku : pbitmaptype; tox, toy : word); procedure mcg_ScaleBitmap(poku : pbitmaptype; tox, toy : word); var mcg_errortxt : string; // in case of error, the caller can read this mcg_AutoConvert : byte; // what to do to images upon loading? // 0 - Do nothing // 1 - Expand bitdepth to 8 // 2 - Expand bitdepth and convert indexed to truecolor const mcg_costable : array[0..256] of word = ( 65535, 65533, 65525, 65513, 65496, 65473, 65446, 65414, 65377, 65335, 65289, 65237, 65180, 65119, 65053, 64981, 64905, 64825, 64739, 64648, 64553, 64453, 64348, 64238, 64124, 64005, 63881, 63753, 63620, 63482, 63339, 63192, 63041, 62885, 62724, 62559, 62389, 62215, 62036, 61853, 61666, 61474, 61278, 61078, 60873, 60664, 60451, 60234, 60013, 59787, 59558, 59324, 59087, 58845, 58600, 58350, 58097, 57840, 57579, 57315, 57047, 56775, 56499, 56220, 55938, 55652, 55362, 55069, 54773, 54473, 54170, 53864, 53555, 53243, 52927, 52609, 52287, 51963, 51635, 51305, 50972, 50636, 50298, 49957, 49613, 49267, 48919, 48567, 48214, 47858, 47500, 47140, 46777, 46413, 46046, 45678, 45307, 44935, 44560, 44184, 43807, 43427, 43046, 42663, 42279, 41894, 41507, 41119, 40729, 40339, 39947, 39554, 39160, 38765, 38369, 37973, 37575, 37177, 36779, 36379, 35979, 35579, 35178, 34777, 34375, 33974, 33572, 33170, 32767, 32365, 31963, 31561, 31160, 30758, 30357, 29956, 29556, 29156, 28756, 28358, 27960, 27562, 27166, 26770, 26375, 25981, 25588, 25196, 24806, 24416, 24028, 23641, 23256, 22872, 22489, 22108, 21728, 21351, 20975, 20600, 20228, 19857, 19489, 19122, 18758, 18395, 18035, 17677, 17321, 16968, 16616, 16268, 15922, 15578, 15237, 14899, 14563, 14230, 13900, 13572, 13248, 12926, 12608, 12292, 11980, 11671, 11365, 11062, 10762, 10466, 10173, 9883, 9597, 9315, 9036, 8760, 8488, 8220, 7956, 7695, 7438, 7185, 6935, 6690, 6448, 6211, 5977, 5748, 5522, 5301, 5084, 4871, 4662, 4457, 4257, 4061, 3869, 3682, 3499, 3320, 3146, 2976, 2811, 2650, 2494, 2343, 2196, 2053, 1915, 1782, 1654, 1530, 1411, 1297, 1187, 1082, 982, 887, 796, 710, 630, 554, 482, 416, 355, 298, 246, 200, 158, 121, 89, 62, 39, 22, 10, 2, 0); implementation type lonkero = array[0..$FFFFFF] of dword; RGBtriplet = packed record b, g, r : byte; end; RGBarray = array[0..$FFFFFF] of RGBtriplet; const allowdiff = 4; // if < 2 then change var calc to a word var sspat : array[0..$FF] of array[0..3] of byte; CRCtable : array[0..255] of dword; CRC : dword; pnghdr : packed record streamlength : dword; bitdepth, colortype, compression, filter, interlace : byte; end; {$asmmode intel} function xlatezerror(incode : longint) : string; // Writes a ZLib error code into an informative string. begin case incode of 0: xlatezerror := 'ZLib errorcode Z_OK is not an error, you should never see this.'; 1: xlatezerror := 'ZLib errorcode Z_STREAM_END is not an error, you should never see this.'; 2: xlatezerror := 'ZLib errorcode Z_NEED_DICT is not an error, you should never see this.'; -1: xlatezerror := 'ZLib error -1: Z_ERRNO'; -2: xlatezerror := 'ZLib error -2: Z_STREAM_ERROR'; -3: xlatezerror := 'ZLib error -3: Z_DATA_ERROR'; -4: xlatezerror := 'ZLib error -4: Z_MEM_ERROR'; -5: xlatezerror := 'ZLib error -5: Z_BUF_ERROR'; -6: xlatezerror := 'ZLib error -6: Z_VERSION_ERROR'; else xlatezerror := 'Unknown ZLib error!'; end; end; function strdec(luku : dword) : string; // Takes a value and returns it in plain numbers in an ascii string begin strdec := ''; repeat strdec := chr(luku mod 10 + $30) + strdec; luku := luku div 10; until luku = 0; end; procedure updateCRC(withwhat : byte); begin CRC := CRCtable[(CRC xor withwhat) and $FF] xor (CRC shr 8); end; // Paeth filter, called by the PNG loader. // The longint type has to do with the calling mechanism from in-line asm. function pathos(aa, bee, see : longint) : byte; stdcall; local; var plop, p_a, p_b, p_c : longint; begin aa := aa and $FF; bee := bee and $FF; see := see and $FF; plop := aa + bee - see; p_a := abs(plop - aa); p_b := abs(plop - bee); p_c := abs(plop - see); if (p_a <= p_b) and (p_a <= p_c) then pathos := aa else if p_b <= p_c then pathos := bee else pathos := see; end; // Releases the memory used by a bitmap resource. procedure mcg_ForgetImage(which : pbitmaptype); begin if which^.image <> NIL then begin freemem(which^.image); which^.image := NIL; end; setlength(which^.palette, 0); end; procedure mcg_PremulRGBA32(imagep : pointer; numpixels : dword); // Imagep must point to an image buffer of RGBquads, numpixels pixels. // This procedure then multiplies all pixels by their alpha value. This is // called pre-multiplied alpha, and it makes the actual alpha-blending // simpler. Only call this once per image. assembler; asm // about 20% faster than the non-asm version pushad mov edi, imagep; mov ecx, numpixels xor ebx, ebx; mov ebp, $1010102 // magic divider @premuloop: mov bl, [edi + 3] // BL <-- alpha xor eax, eax mov al, [edi + 0] // AL <-- blue mul bl // AX <-- blue * alpha mul ebp // EDX <-- AX div 255 xor eax, eax mov al, [edi + 1] // AL <-- green mov [edi + 0], dl // save blue result mul bl // AX <-- green * alpha mul ebp // EDX <-- AX div 255 xor eax, eax mov al, [edi + 2] // AL <-- red mov [edi + 1], dl // save green result mul bl // AX <-- red * alpha add edi, 4 mul ebp // EDX <-- AX div 255 mov [edi - 2], dl // save red result dec ecx; jnz @premuloop popad end; {begin while numpixels <> 0 do begin dec(numpixels); RGBAarray(imagep^)[numpixels].r := (RGBAarray(imagep^)[numpixels].r * RGBAarray(imagep^)[numpixels].a) div 255; RGBAarray(imagep^)[numpixels].g := (RGBAarray(imagep^)[numpixels].g * RGBAarray(imagep^)[numpixels].a) div 255; RGBAarray(imagep^)[numpixels].b := (RGBAarray(imagep^)[numpixels].b * RGBAarray(imagep^)[numpixels].a) div 255; end; end;} procedure mcg_ExpandBitdepth(whither : pbitmaptype); // Transforms indexed bitmaps of less than 8 bits per pixel to 8 bpp. var ivar, jvar, lvar, ofsu : dword; puhvi : pointer; bvar : byte; begin if whither^.bitdepth = 8 then exit; // already at 8 bpp if whither^.bitdepth in [1,2,4] = FALSE then begin mcg_ErrorTxt := 'Unsupported bitdepth: ' + strdec(whither^.bitdepth); exit; end; getmem(puhvi, whither^.sizex * whither^.sizey); // Inflate bitdepth row by row, assuming source rows are BYTE-aligned jvar := whither^.sizey; lvar := 0; ofsu := 0; while jvar <> 0 do begin ivar := whither^.sizex; bvar := 8; while ivar <> 0 do begin dec(bvar, whither^.bitdepth); byte((puhvi + ofsu)^) := (byte((whither^.image + lvar)^) shr bvar) and ((1 shl whither^.bitdepth) - 1); if bvar = 0 then begin inc(lvar); bvar := 8; end; inc(ofsu); dec(ivar); end; if bvar <> 8 then inc(lvar); // force byte-align after end of row dec(jvar); end; freemem(whither^.image); whither^.image := puhvi; puhvi := NIL; whither^.bitdepth := 8; end; procedure mcg_ExpandIndexed(whither : pbitmaptype); // Transforms an indexed bitmap into usable 24-bit RGB or 32-bit RGBA. // (An inverse transition usually requires color compression, try BunComp) var poku : pointer; ivar : dword; bvar : byte; begin if whither^.memformat < 2 then exit; // already truecolor // Inflate bitdepth to 8 to start with if whither^.bitdepth <> 8 then mcg_ExpandBitdepth(whither); getmem(poku, whither^.sizex * whither^.sizey * (3 + whither^.memformat and 1)); // Convert indexed if whither^.memformat = 4 then begin // Indexed to 24-bit RGB ivar := whither^.sizex * whither^.sizey; while ivar <> 0 do begin dec(ivar); bvar := byte((whither^.image + ivar)^); RGBarray(poku^)[ivar].r := whither^.palette[bvar].r; RGBarray(poku^)[ivar].g := whither^.palette[bvar].g; RGBarray(poku^)[ivar].b := whither^.palette[bvar].b; end; whither^.memformat := 0; freemem(whither^.image); whither^.image := poku; poku := NIL; end; if whither^.memformat = 5 then begin // Indexed to 32-bit RGBA for ivar := whither^.sizex * whither^.sizey - 1 downto 0 do lonkero(poku^)[ivar] := dword(whither^.palette[byte((whither^.image + ivar)^)]); whither^.memformat := 1; freemem(whither^.image); whither^.image := poku; poku := NIL; end; // Convert monochrome if whither^.memformat = 2 then begin // Monochrome to 24-bit RGB ivar := whither^.sizex * whither^.sizey; while ivar <> 0 do begin dec(ivar); fillbyte((whither^.image + ivar * 3)^, 3, byte((whither^.image + ivar)^)); end; whither^.memformat := 0; end; if whither^.memformat = 3 then begin // Monochrome to 32-bit RGB // this should not happen mcg_ErrorTxt := 'Monochrome/alpha!? Contact the author or code a conversion routine.'; end; end; function mcg_MatchColorInPal(color : RGBquad; which : pbitmaptype) : longint; // bitmaptype(which^) must have its .palette array filled in. // The function finds the first palette color that matches the given color, // and returns the 0-based index. In case of errors, it returns a negative // number and places the explanation in mcg_errortxt. begin if length(which^.palette) = 0 then begin mcg_MatchColorInPal := -1; mcg_errortxt := 'MatchColorInPal: given bitmap has no palette!'; exit; end; mcg_MatchColorInPal := length(which^.palette); while mcg_MatchColorInPal <> 0 do begin dec(mcg_MatchColorInPal); if dword(color) = dword(which^.palette[mcg_MatchColorInPal]) then exit; end; mcg_MatchColorInPal := -2; mcg_errortxt := 'MatchColorInPal: no match found!'; end; function Openping(whence : pointer; whither : pbitmaptype) : byte; // Openping accepts a PNG datastream together with a filled PNGHdr record. // Whence^ needs to contain the PNG image datastream from its IDAT chunks. // PNGHdr is a private variable record that has the most important image // definitions. It must be filled in before calling this function. // The decompressed image goes in bitmaptype(whither^). // The output format is 24-bit RGB, or 32-bit RGBA if the image has alpha. // Bitdepths 1, 2, 4 and 8 per sample are supported; interlacing is not. // OpenPing returns 0 if all OK; otherwise mcg_errortxt is filled. var lbx, lbz, lbi, compbuffyofs : dword; lbb : byte; puhvi : pointer; z : tzstream; begin openping := 1; mcg_errortxt := ''; case pnghdr.colortype of 2: begin // truecolor whither^.memformat := 0; lbi := 3; end; 0: begin // monochrome whither^.memformat := 2; lbi := 1; end; 3: begin // indexed color whither^.memformat := 4; lbi := 1; end; 55: begin // indexed color that has alpha values in the palette whither^.memformat := 5; lbi := 1; end; 6: begin // truecolor with alpha channel whither^.memformat := 1; lbi := 4; end; 4: mcg_errortxt := 'Greyscale PNGs with full alpha are not supported.'; else mcg_errortxt := 'Messed up colortype: ' + strdec(pnghdr.colortype); end; whither^.bitdepth := pnghdr.bitdepth; if not pnghdr.bitdepth in [1,2,4,8] then mcg_errortxt := 'Unsupported bits per sample value in PNG image! (' + strdec(pnghdr.bitdepth) + ')'; if pnghdr.compression <> 0 then mcg_errortxt := 'Unknown compression ' + strdec(pnghdr.compression) + ' in PNG image!'; if pnghdr.filter <> 0 then mcg_errortxt := 'Unknown filtering method ' + strdec(pnghdr.filter) + ' in PNG image!'; if pnghdr.interlace <> 0 then mcg_errortxt := 'Image is interlaced! You convert it, I''m too lazy.'; if mcg_errortxt <> '' then exit; getmem(whither^.image, whither^.sizex * whither^.sizey * (3 + whither^.memformat and 1)); // Decompress the image stream lbx := inflateInit(z); if lbx <> z_OK then begin mcg_errortxt := 'Openping: Error while calling inflateInit.'; exit; end; lbx := whither^.sizex * whither^.sizey * 4 + whither^.sizey; getmem(puhvi, lbx); z.next_in := whence; z.avail_in := pnghdr.streamlength; z.total_in := 0; z.next_out := puhvi; z.avail_out := lbx; z.total_out := 0; lbx := inflate(z, Z_FINISH); inflateEnd(z); if (lbx <> Z_STREAM_END) and (lbx <> Z_OK) then begin mcg_errortxt := 'Openping: Error ' + xlatezerror(lbx) + ' while inflating PNG image!'; exit; end; // Filter the thing - from puhvi^ to bitmaptype(whither^).image^ lbx := whither^.sizex * lbi; if whither^.bitdepth < 8 then lbx := (lbx * whither^.bitdepth + 7) div 8; //if byte(puhvi^) = 4 then writeln(stdout, 'Uh oh, Paeth filter called on first scanline.'); asm pushad mov esi, whither; xor eax, eax mov edi, [esi] // EDI <-- .image mov ax, [esi + 10] // EAX <-- .size_y mov ebx, lbi // BL <-- bytes per pixel, minimum 1 mov esi, puhvi push eax // [ESP + 4] <-- y-loop counter push eax // [ESP] <-- reserved stack space for laterz @slurp: mov ecx, lbx // refresh the x-loop counter // New scanline - read filter byte lodsb cmp al, 4; jz @filter4; cmp al, 1; jz @filter1 cmp al, 2; jz @filter2; cmp al, 3; jz @filter3 // No change, do a direct copy @filter0: rep movsb jmp @chomp // Subtraction filter @filter1: mov edx, ecx; mov ecx, ebx rep movsb // just copy the first pixel mov ecx, edx; sub edi, ebx sub ecx, ebx @filter1a: lodsb add al, [edi] // EDI lags behind by one pixel mov [edi + ebx], al; inc edi dec ecx; jnz @filter1a add edi, ebx // remove lag jmp @chomp // Up filter (assume this is not called for topmost row) @filter2: mov [esp], ebx // temp storage mov ebx, edi; sub ebx, lbx @filter2a: lodsb mov dl, [ebx]; inc ebx add al, dl stosb dec ecx; jnz @filter2a mov ebx, [esp] // restore from storage jmp @chomp // Average filter @filter3: mov [esp], ecx // temp storage mov edx, edi; mov ecx, ebx; sub edx, lbx @filter3a: lodsb; mov ah, [edx]; inc edx; shr ah, 1; add al, ah stosb dec ecx; jnz @filter3a mov ecx, [esp] // restore from storage sub ecx, ebx; sub edi, ebx mov [esp], ebx // temp storage @filter3b: xor eax, eax; xor ebx, ebx mov al, [edi] // EDI lags behind by one pixel mov bl, [edx] // the pixel right above... add bx, ax; shr bx, 1 // sum, then average them out lodsb; add al, bl mov ebx, [esp] // restore from storage, repeatedly mov [edi + ebx], al; inc edx; inc edi dec ecx; jnz @filter3b add edi, ebx // remove lag jmp @chomp // Paeth filter // Will not work if called on first scanline of image... @filter4: mov [esp], ecx // temp storage mov edx, edi mov ecx, ebx // ECX <-- size of pixel sub edx, lbx // EDX <-- scanline above @filter4a: pushad xor eax, eax; push eax // C at leftmost column is zero mov al, [edx]; push eax // B xor eax, eax; push eax // A is also zero call pathos; mov lbb, al; popad lodsb; add al, lbb; stosb inc edx dec ecx; jnz @filter4a mov ecx, [esp] // restore from storage sub edi, ebx; sub ecx, ebx; sub edx, ebx @filter4b: pushad xor eax, eax mov al, [edx]; push eax // C mov al, [edx + ebx]; push eax // B mov al, [edi]; push eax // A call pathos; mov lbb, al; popad lodsb; add al, lbb mov [edi + ebx], al; inc edx; inc edi dec ecx; jnz @filter4b add edi, ebx // remove lag @chomp: dec dword ptr [esp + 4]; jnz @slurp // check the y-loop counter add esp, 8; popad // restore the stack, clean up end; freemem(puhvi); puhvi := NIL; // Flip RGB around! // PNG stores color values consistently in byte order RGBA. // Windows contrarily stores color values in byte order BGRA. // Of course, due to Intel's wacky least-significant byte first order, the // first color byte is actually the rightmost when printed as text. // Alpha is always stored as the last byte, but printed as the leftmost. if whither^.memformat = 0 then begin lbx := whither^.sizex * whither^.sizey; while lbx <> 0 do begin dec(lbx); lbi := RGBarray(whither^.image^)[lbx].r; RGBarray(whither^.image^)[lbx].r := RGBarray(whither^.image^)[lbx].b; RGBarray(whither^.image^)[lbx].b := lbi; end; end else if whither^.memformat = 1 then begin lbx := whither^.sizex * whither^.sizey * 4; while lbx <> 0 do begin dec(lbx, 4); lbi := byte((whither^.image + lbx)^); byte((whither^.image + lbx)^) := byte((whither^.image + lbx + 2)^); byte((whither^.image + lbx + 2)^) := lbi; end; end; // Make sure the image will be in 24-bit RGB or 32-bit RGBA format. case mcg_AutoConvert of 1: mcg_ExpandBitdepth(whither); 2: mcg_ExpandIndexed(whither); end; openping := 0; end; function mcg_PNGtoMemory(p : pointer; membmp : pbitmaptype) : byte; // P must point to a PNG datastream in memory, consisting of the necessary // PNG chunks to render the picture: IHDR, [PLTE, tRNS], IDAT and IEND. That // is, a regular PNG file read into memory, with or without the 8-byte sig. // membmp must point to a record of bitmaptype, as defined in this unit. // The PNG image from p^ is loaded into membmp^, auto-converted as specified // by the mcg_AutoConvert variable. // Membmp^ need not be initialised; if it already points to a graphic, the // pointers are released first. // The memory in p^ is not released by this function. // PNGtoMemory returns 0 if all OK; otherwise mcg_errortxt is filled. var chunklen, chunktype, konkeli : dword; readp, pend, whence : pointer; begin mcg_PNGtoMemory := 1; // Make sure we are not overwriting a graphic; release the memory if we are. mcg_ForgetImage(membmp); readp := p; ptruint(pend) := dword(memsize(p)) + ptruint(p); repeat // Parse the PNG chunks (also recognise PNG signature if encountered) // Every chunk has a length dword, an ID dword, a variable length of data, // and a CRC dword. chunklen := swapendian(dword(readp^)); // chunk length - dword inc(readp, 4); chunktype := dword(readp^); // chunk ID - dword inc(readp, 4); case chunktype of $52444849: begin // IHDR membmp^.sizex := swapendian(dword(readp^)); membmp^.sizey := swapendian(dword((readp + 4)^)); pnghdr.bitdepth := byte((readp + 8)^); pnghdr.colortype := byte((readp + 9)^); pnghdr.compression := byte((readp + 10)^); pnghdr.filter := byte((readp + 11)^); pnghdr.interlace := byte((readp + 12)^); pnghdr.streamlength := 0; end; $45544C50: begin // PLTE konkeli := chunklen div 3; setlength(membmp^.palette, konkeli); while konkeli <> 0 do begin dec(konkeli); membmp^.palette[konkeli].r := byte((readp + konkeli * 3)^); membmp^.palette[konkeli].g := byte((readp + konkeli * 3 + 1)^); membmp^.palette[konkeli].b := byte((readp + konkeli * 3 + 2)^); membmp^.palette[konkeli].a := $FF; end; end; $54414449: begin // IDAT if pnghdr.streamlength = 0 then getmem(whence, chunklen) else reallocmem(whence, pnghdr.streamlength + chunklen); move(readp^, (whence + pnghdr.streamlength)^, chunklen); inc(pnghdr.streamlength, chunklen); end; $534E5274: if pnghdr.colortype = 3 then begin // tRNS konkeli := chunklen; if konkeli > length(membmp^.palette) then konkeli := length(membmp^.palette); while konkeli <> 0 do begin dec(konkeli); membmp^.palette[konkeli].a := byte((readp + konkeli)^); end; pnghdr.colortype := 55; // internal: indexed with valid alpha end; end; // Move read pointer to beginning of next chunk (except after PNG sig) if (chunktype <> $0A1A0A0D) or (chunklen <> $89504E47) then inc(readp, chunklen + 4); // stop repeat-loop after an IEND chunk, or at the end of pointed memory until (chunktype = $444E4549) or (readp >= pend); mcg_PNGtoMemory := openping(whence, membmp); freemem(whence); whence := NIL; end; function mcg_BMPtoMemory(p : pointer; membmp : pbitmaptype) : byte; // P must point to a BITMAPINFOHEADER structure followed by the bitmap bits, // or to a BITMAPFILEHEADER followed by a BITMAPINFOHEADER and bitmap bits. // These are regular Windows device-independent bitmaps. // membmp must point to a record of my bitmaptype, defined in loder. // The bitmap from p^ is loaded into membmp^, converted into a bitdepth of // 24 or 32. Membmp^ need not be initialised; if it already points to // a graphic, the pointers are released first. // The memory in p^ is not released by this function. // BMPtoMemory returns 0 if all OK; otherwise mcg_errortxt is filled. var sizu, destofs : dword; palsize, yloop : word; upsidedown : boolean; // although a negative height should imply a top-down DIB, it seems that // Windows cannot handle those at least on the clipboard begin mcg_BMPtoMemory := 1; // Make sure we are not overwriting a graphic; release the memory if we are. mcg_ForgetImage(membmp); // Skip the BITMAPFILEHEADER if one exists if word(p^) = 19778 then // does it spell BM at the start? inc(p, 14); // Parse the BITMAPINFOHEADER (I couldn't find a program that makes v4 DIBs) if (bitmapv4header(p^).bv4v4Compression <> BI_RGB) //and (bitmapv4header(p^).bv4v4Compression <> BI_BITFIELDS) then begin mcg_errortxt := 'Only uncompressed BI_RGB bitmaps are presently supported, as I never encountered any other kind!'; exit; end; membmp^.sizex := bitmapv4header(p^).bv4Width; membmp^.sizey := abs(bitmapv4header(p^).bv4Height); // Most DIBs are stored vertically mirrored... if bitmapv4header(p^).bv4Height < 0 then upsidedown := FALSE else upsidedown := TRUE; membmp^.bitdepth := bitmapv4header(p^).bv4BitCount; // Set sizu to the byte width of one image scanline. For example: an image // of bitdepth 4 with a width of 7 pixels will occupy 4 bytes per scanline. sizu := (membmp^.sizex * membmp^.bitdepth + 7) shr 3; // Bitdepths of 8 or below are an indexed image, and have a palette. // Bitdepths of 16-32 mean an RGB image without a palette. case membmp^.bitdepth of 1: begin membmp^.memformat := 4; palsize := 2; end; 2: begin membmp^.memformat := 4; palsize := 4; end; // unsupported by specs 4: begin membmp^.memformat := 4; palsize := 16; end; 8: begin membmp^.memformat := 4; palsize := 256; end; // 16: meh; // would have to write a channel expander... not worth it 24: begin membmp^.memformat := 0; palsize := 0; end; 32: begin membmp^.memformat := 1; palsize := 0; end; else begin mcg_errortxt := 'Unsupported BMP bitdepth, ' + strdec(membmp^.bitdepth); exit; end; end; // If the colors used variable is nonzero, it defines the real palette size. if bitmapv4header(p^).bv4ClrUsed > 0 then palsize := bitmapv4header(p^).bv4ClrUsed; if (membmp^.memformat = 4) and (palsize > 0) then setlength(membmp^.palette, palsize); // Read the palette into memory // Per DIB specs, the alpha byte must be 0 both in the bitmap and palette // colors. Some programs put correct alpha data in anyway. With correct // alpha, 0 is fully transparent, so if the program reads all DIBs using the // alpha channel, fully compliant DIBs will be entirely transparent. // If all alpha samples are $FF, then the image is fully opaque. // Therefore, assume the image is alphaless, unless any alpha sample is not // $FF; and if all alpha is 0, discard the alpha channel. inc(p, bitmapv4header(p^).bv4Size); destofs := 0; if palsize > 0 then begin for yloop := 0 to palsize - 1 do begin // Switch DIB BGRA into our ABGR format //dword(membmp^.palette[yloop]) := (dword(p^) shl 8) + (dword(p^) shr 24); dword(membmp^.palette[yloop]) := dword(p^); // Hack the alpha if RGBquad(p^).a <> $FF then membmp^.memformat := 5; if RGBquad(p^).a = 0 then inc(destofs); inc(p, 4); end; if destofs = palsize then begin membmp^.memformat := 4; for yloop := palsize - 1 downto 0 do membmp^.palette[yloop].a := $FF; end; end; // P now points to the beginning of the image data. // Since DIBs have DWORD-aligned scanlines, we must copy them one at a time // and reduce them to BYTE-alignment. Flip the image vertically while at it. getmem(membmp^.image, sizu * membmp^.sizey); destofs := 0; if upsidedown then destofs := sizu * membmp^.sizey; for yloop := 0 to membmp^.sizey - 1 do begin if upsidedown then dec(destofs, sizu) else inc(destofs, sizu); move((p + yloop * ((sizu + 3) and $FFFFFFFC))^, (membmp^.image + destofs)^, sizu); end; // Images copied from Opera are saved on the clipboard as 32-bit ARGB DIBs. // Irfanview and PSP import them as 24-bit RGB images, ignoring the alpha, // as expected by the DIB specs. However, including valid alpha data in an // old format DIB is a Microsoft-endorsed hack, since apparently even the // native XP printscreen screengrab may have valid alpha data. // Version 4 and 5 DIBs have color masks that allow legally defining an // alpha channel, but all programs I tried only generate old basic DIBs. if membmp^.memformat = 1 then begin sizu := 0; destofs := membmp^.sizex * membmp^.sizey; while destofs <> 0 do begin dec(destofs); //lonkero(membmp^.image^)[destofs] := //(lonkero(membmp^.image^)[destofs] shl 8) // rol 8 //or (lonkero(membmp^.image^)[destofs] shr 24); if RGBAarray(membmp^.image^)[destofs].a <> 0 then sizu := sizu or 1; if RGBAarray(membmp^.image^)[destofs].a <> $FF then sizu := sizu or 2; end; // if all alpha data is 0 (fully transparent), or all FF, scrap the channel // (not properly tested...) if (sizu and 1 = 0) or (sizu and 2 = 0) then begin destofs := 0; repeat RGBarray(membmp^.image^)[destofs].b := RGBAarray(membmp^.image^)[destofs].b; RGBarray(membmp^.image^)[destofs].g := RGBAarray(membmp^.image^)[destofs].g; RGBarray(membmp^.image^)[destofs].r := RGBAarray(membmp^.image^)[destofs].r; inc(destofs); until destofs >= membmp^.sizex * membmp^.sizey; membmp^.memformat := 0; end; end; // Finally, AutoConvert the image format to 8 bpp and maybe even truecolor. case mcg_AutoConvert of 1: mcg_ExpandBitdepth(membmp); 2: mcg_ExpandIndexed(membmp); end; mcg_BMPtoMemory := 0; end; function mcg_LoadGraphic(p : pointer; membmp : pbitmaptype) : byte; // This is a general BMP/DIB/PNG loader function. // // P must point to a memory area containing a BMP or PNG image. If it is // a BMP, the data must begin with a BITMAPFILEHEADER (BMP files begin with // this) or with a BITMAPINFOHEADER (Windows DIBs begin with this, such as // graphics copied to the clipboard). // If it is a PNG, the data must begin with the 8-byte PNG signature or // a recognisable PNG chunk, most likely IHDR. // // membmp must point to a record of my bitmaptype, as defined by this unit. // The image format in p^ is identified and the appropriate loader function // is called; the image goes into membmp^, converted into a bitdepth of // 24 or 32. Membmp^ need not be initialised; if it already points to // a graphic, the pointers are released first. // The memory in p^ is not released by this function. // LoadGraphic returns 0 if all OK; otherwise mcg_errortxt is filled. begin if (dword(p^) = $474E5089) and (lonkero(p^)[1] = $0A1A0A0D) or (dword(p^) = $0D000000) and (lonkero(p^)[1] = $52444849) then mcg_LoadGraphic := mcg_PNGtoMemory(p, membmp) else //if (word(p^) = 19778) mcg_LoadGraphic := mcg_BMPtoMemory(p, membmp); end; function mcg_MemorytoPNG(membmp : pbitmaptype; p, psizu : pointer) : byte; // This generates a PNG datastream from the image in bitmaptype(membmp^). // P must point to a valid pointer variable, set to a NIL value! The function // reserves memory for the datastream and puts the pointer in pointer(P^). // The caller is responsible for freeing the memory afterward. // PSizu must point to a usable DWORD-sized memory area! The function places // the size in bytes of the resulting datastream into DWORD(PSizu^). // The function return 0 if all goes well, otherwise mcg_errortxt is filled. var ivar, jvar, rowsize : dword; iofs, dofs : dword; poku, puhvi : pointer; z : tzstream; begin // Safety first mcg_MemorytoPNG := 1; mcg_errortxt := ''; if membmp^.memformat < 2 then if membmp^.bitdepth in [24,32] then membmp^.bitdepth := 8 else if membmp^.bitdepth < 8 then mcg_errortxt := 'MemorytoPNG: True color images may not have a bitdepth of ' + strdec(membmp^.bitdepth) + '!'; if membmp^.image = NIL then mcg_errortxt := 'The image bitmap memory is unallocated!'; if membmp^.bitdepth in [1,2,4,8] = FALSE then mcg_errortxt := 'MemorytoPNG: Bitdepth ' + strdec(membmp^.bitdepth) + ' is not supported!'; if membmp^.memformat in [0..2,4,5] = FALSE then mcg_errortxt := 'MemorytoPNG: Unsupported image format ' + strdec(membmp^.memformat) + '!'; if mcg_errortxt <> '' then exit; // Split the image into scanlines and theoretically filter it -> puhvi^ case membmp^.memformat of 0: rowsize := membmp^.sizex * 3; 1: rowsize := membmp^.sizex * 4; 2,4,5: rowsize := (membmp^.sizex * membmp^.bitdepth + 7) div 8; end; dword(psizu^) := (rowsize + 1) * membmp^.sizey; getmem(puhvi, dword(psizu^)); getmem(poku, dword(psizu^) + 65536); iofs := 0; dofs := 0; if membmp^.memformat = 0 then begin // 24-bit RGB for ivar := membmp^.sizey - 1 downto 0 do begin byte((puhvi + dofs)^) := 0; inc(dofs); // filter byte = lazy constant 0 for jvar := membmp^.sizex - 1 downto 0 do begin byte((puhvi + dofs + 2)^) := byte((membmp^.image + iofs )^); // blue byte((puhvi + dofs + 1)^) := byte((membmp^.image + iofs + 1)^); // green byte((puhvi + dofs )^) := byte((membmp^.image + iofs + 2)^); // red inc(dofs, 3); inc(iofs, 3); end; end; end else if membmp^.memformat = 1 then begin // 32-bit (in: BGRA; out: RGBA) for ivar := membmp^.sizey - 1 downto 0 do begin byte((puhvi + dofs)^) := 0; inc(dofs); // filter byte = lazy constant 0 for jvar := membmp^.sizex - 1 downto 0 do begin byte((puhvi + dofs + 2)^) := byte((membmp^.image + iofs )^); // blue byte((puhvi + dofs + 1)^) := byte((membmp^.image + iofs + 1)^); // green byte((puhvi + dofs )^) := byte((membmp^.image + iofs + 2)^); // red byte((puhvi + dofs + 3)^) := byte((membmp^.image + iofs + 3)^); // alpha inc(dofs, 4); inc(iofs, 4); end; end; end else // Any-bit indexed for ivar := membmp^.sizey - 1 downto 0 do begin byte((puhvi + dofs)^) := 0; inc(dofs); // filter byte = lazy constant 0 move((membmp^.image + iofs)^, (puhvi + dofs)^, rowsize); inc(iofs, rowsize); inc(dofs, rowsize); end; // Sic ZLib on the puhvi^ image longint(ivar) := DeflateInit(z, Z_DEFAULT_COMPRESSION); if longint(ivar) <> Z_OK then begin mcg_errortxt := xlatezerror(longint(ivar)); freemem(puhvi); puhvi := NIL; freemem(poku); poku := NIL; exit; end; z.next_in := puhvi; z.avail_in := dword(psizu^); z.total_in := 0; z.next_out := poku; z.avail_out := dword(psizu^) + 65536; z.total_out := 0; longint(ivar) := Deflate(z, z_finish); dword(psizu^) := z.total_out; freemem(puhvi); puhvi := poku; poku := NIL; DeflateEnd(z); if longint(ivar) <> Z_STREAM_END then begin mcg_errortxt := xlatezerror(longint(ivar)); freemem(puhvi); puhvi := NIL; exit; end; // Reserve memory ivar := dword(psizu^) + length(membmp^.palette) * 4 + 65536; pointer(p^) := NIL; getmem(pointer(p^), ivar); poku := pointer(p^); // PNG signature dword(poku^) := $474E5089; inc(poku, 4); dword(poku^) := $0A1A0A0D; inc(poku, 4); // IHDR dword(poku^) := $0D000000; inc(poku, 4); // header.length iofs := ptruint(poku) - ptruint(p^); // store the offset of CRC start dword(poku^) := $52444849; inc(poku, 4); // header.signature dword(poku^) := swapendian(dword(membmp^.sizex)); inc(poku, 4); // width dword(poku^) := swapendian(dword(membmp^.sizey)); inc(poku, 4); // height byte(poku^) := membmp^.bitdepth; inc(poku); // header.bitdepth case membmp^.memformat of 0: byte(poku^) := 2; // truecolor 1: byte(poku^) := 6; // truecolor with alpha 2: byte(poku^) := 0; // greyscale 4,5: byte(poku^) := 3; // indexed-color end; inc(poku); // header.colortype byte(poku^) := 0; inc(poku); // header.compressionmethod byte(poku^) := 0; inc(poku); // header.filtermethod byte(poku^) := 0; inc(poku); // header.interlacemethod dofs := ptruint(poku) - ptruint(p^); CRC := $FFFFFFFF; while iofs < dofs do begin UpdateCRC(byte((pointer(p^) + iofs)^)); inc(iofs); end; dword(poku^) := swapendian(CRC xor $FFFFFFFF); inc(poku, 4); // CRC // PLTE if membmp^.memformat and 4 <> 0 then begin ivar := length(membmp^.palette); if ivar > 256 then ivar := 256; dword(poku^) := swapendian(ivar * 3); inc(poku, 4); // pal.length iofs := ptruint(poku) - ptruint(p^); // store the offset of CRC start dword(poku^) := $45544C50; inc(poku, 4); // pal.signature dofs := 0; while dofs < ivar do begin byte(poku^) := membmp^.palette[dofs].r; inc(poku); byte(poku^) := membmp^.palette[dofs].g; inc(poku); byte(poku^) := membmp^.palette[dofs].b; inc(poku); inc(dofs); end; dofs := ptruint(poku) - ptruint(p^); CRC := $FFFFFFFF; while iofs < dofs do begin UpdateCRC(byte((pointer(p^) + iofs)^)); inc(iofs); end; dword(poku^) := swapendian(CRC xor $FFFFFFFF); inc(poku, 4); // CRC end; // tRNS if membmp^.memformat = 5 then begin ivar := length(membmp^.palette); if ivar > 256 then ivar := 256; dword(poku^) := swapendian(ivar); inc(poku, 4); // transparency.length iofs := ptruint(poku) - ptruint(p^); // store the offset of CRC start dword(poku^) := $534E5274; inc(poku, 4); // transparency.signature dofs := 0; while dofs < ivar do begin byte(poku^) := membmp^.palette[dofs].a; inc(poku); inc(dofs); end; dofs := ptruint(poku) - ptruint(p^); CRC := $FFFFFFFF; while iofs < dofs do begin UpdateCRC(byte((pointer(p^) + iofs)^)); inc(iofs); end; dword(poku^) := swapendian(CRC xor $FFFFFFFF); inc(poku, 4); // CRC end; // IDAT dword(poku^) := swapendian(dword(psizu^)); inc(poku, 4); // imagedata.length iofs := ptruint(poku) - ptruint(p^); // store the offset of CRC start dword(poku^) := $54414449; inc(poku, 4); // imagedata.signature move(puhvi^, poku^, dword(psizu^)); inc(poku, dword(psizu^)); // the compressed image data itself freemem(puhvi); puhvi := NIL; dofs := ptruint(poku) - ptruint(p^); CRC := $FFFFFFFF; while iofs < dofs do begin UpdateCRC(byte((pointer(p^) + iofs)^)); inc(iofs); end; dword(poku^) := swapendian(CRC xor $FFFFFFFF); inc(poku, 4); // CRC // IEND dword(poku^) := 0; inc(poku, 4); // end length dword(poku^) := $444E4549; inc(poku, 4); // end signature dword(poku^) := $826042AE; inc(poku, 4); // end CRC // Calculate the final size, and we're done dword(psizu^) := ptruint(poku) - ptruint(p^); poku := NIL; mcg_MemorytoPNG := 0; end; // ------------------------------------------------------------------ // There Be Scaling Algorithms Here // ------------------------------------------------------------------ procedure BunnyScale2x32(poku : pbitmaptype); // Resizes the bitmaptype(poku^) resource to double resolution both axles. // Uses a sharp scaling algorithm to reduce pixelization without blurring. var processor : pointer; loopx, loopy : word; c : dword; grid, nextline, source, target, optimus : dword; gridbyte, kalk : byte; calc : byte; // change to word if allowdiff < 2 begin if (poku^.image = NIL) or (poku^.memformat <> 1) then exit; getmem(processor, poku^.sizex * poku^.sizey * 4 * 4); // The edges would not be changed using this algorithm, so pixel-copy them. source := 0; target := 0; nextline := poku^.sizex * (poku^.sizey - 1); grid := nextline * 4; optimus := poku^.sizex * 2; for loopx := 0 to poku^.sizex - 1 do begin c := lonkero(poku^.image^)[source]; lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; inc(target); lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; dec(target); c := lonkero(poku^.image^)[source + nextline]; inc(target, grid); lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; inc(target); lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; dec(target, grid - 1); inc(source); end; source := poku^.sizex; target := source * 4; for loopy := 1 to poku^.sizey - 2 do begin c := lonkero(poku^.image^)[source]; lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; inc(target); lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; inc(target, optimus - 3); inc(source, poku^.sizex - 1); c := lonkero(poku^.image^)[source]; inc(source); lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; inc(target); lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; inc(target, optimus + 1); end; // Build a 3x3 neighbor grid for all remaining pixels. // The grid is packed into 8 bits, where a bit is set if the neighbor pixel // has the exact same color as the center pixel. The gridbyte is then used // to access a precalculated array which defines how the center pixel will // be divided into four new pixels. // Gridbyte bits: // 7 6 5 // 4 . 3 // 2 1 0 // If a gridbyte bit is set, that color is not the center color. source := 0; target := poku^.sizex * 4 + 2; for loopy := 1 to poku^.sizey - 2 do begin for loopx := 1 to poku^.sizex - 2 do begin c := lonkero(poku^.image^)[source + poku^.sizex + 1]; if c shr 24 = 0 then begin lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; inc(target); lonkero(processor^)[target] := c; lonkero(processor^)[target + optimus] := c; inc(target); inc(source); continue; end; gridbyte := 0; // top left calc := (abs(byte(c) - byte(lonkero(poku^.image^)[source])) + abs(byte(c shr 8) - byte(lonkero(poku^.image^)[source] shr 8)) + abs(byte(c shr 16) - byte(lonkero(poku^.image^)[source] shr 16))) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := calc; // top calc := (abs(byte(c) - byte(lonkero(poku^.image^)[source + 1])) + abs(byte(c shr 8) - byte(lonkero(poku^.image^)[source + 1] shr 8)) + abs(byte(c shr 16) - byte(lonkero(poku^.image^)[source + 1] shr 16))) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // top right calc := (abs(byte(c) - byte(lonkero(poku^.image^)[source + 2])) + abs(byte(c shr 8) - byte(lonkero(poku^.image^)[source + 2] shr 8)) + abs(byte(c shr 16) - byte(lonkero(poku^.image^)[source + 2] shr 16))) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // left calc := (abs(byte(c) - byte(lonkero(poku^.image^)[source + poku^.sizex])) + abs(byte(c shr 8) - byte(lonkero(poku^.image^)[source + poku^.sizex] shr 8)) + abs(byte(c shr 16) - byte(lonkero(poku^.image^)[source + poku^.sizex] shr 16))) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // right calc := (abs(byte(c) - byte(lonkero(poku^.image^)[source + poku^.sizex + 2])) + abs(byte(c shr 8) - byte(lonkero(poku^.image^)[source + poku^.sizex + 2] shr 8)) + abs(byte(c shr 16) - byte(lonkero(poku^.image^)[source + poku^.sizex + 2] shr 16))) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // bottom left calc := (abs(byte(c) - byte(lonkero(poku^.image^)[source + optimus])) + abs(byte(c shr 8) - byte(lonkero(poku^.image^)[source + optimus] shr 8)) + abs(byte(c shr 16) - byte(lonkero(poku^.image^)[source + optimus] shr 16))) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // bottom inc(optimus); calc := (abs(byte(c) - byte(lonkero(poku^.image^)[source + optimus])) + abs(byte(c shr 8) - byte(lonkero(poku^.image^)[source + optimus] shr 8)) + abs(byte(c shr 16) - byte(lonkero(poku^.image^)[source + optimus] shr 16))) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // bottom right inc(optimus); calc := (abs(byte(c) - byte(lonkero(poku^.image^)[source + optimus])) + abs(byte(c shr 8) - byte(lonkero(poku^.image^)[source + optimus] shr 8)) + abs(byte(c shr 16) - byte(lonkero(poku^.image^)[source + optimus] shr 16))) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // Apply the gridbyte! // Reduce effect of center pixel? // Top left subpixel optimus := lonkero(poku^.image^)[source + poku^.sizex]; kalk := (byte(lonkero(poku^.image^)[source + 1]) * 2 + byte(optimus) * 2 + byte(lonkero(poku^.image^)[source]) + byte(c)) div 6; grid := (kalk and sspat[gridbyte][0]) or (byte(c) and (sspat[gridbyte][0] xor $FF)); kalk := (byte(lonkero(poku^.image^)[source + 1] shr 8) * 2 + byte(optimus shr 8) * 2 + byte(lonkero(poku^.image^)[source] shr 8) + byte(c shr 8)) div 6; grid := grid or ((kalk and sspat[gridbyte][0]) or (byte(c shr 8) and (sspat[gridbyte][0] xor $FF))) shl 8; kalk := (byte(lonkero(poku^.image^)[source + 1] shr 16) * 2 + byte(optimus shr 16) * 2 + byte(lonkero(poku^.image^)[source] shr 16) + byte(c shr 16)) div 6; lonkero(processor^)[target] := grid or ((kalk and sspat[gridbyte][0]) or (byte(c shr 16) and (sspat[gridbyte][0] xor $FF))) shl 16 or (c and $FF000000); // Top right subpixel inc(target); optimus := lonkero(poku^.image^)[source + poku^.sizex + 2]; kalk := (byte(lonkero(poku^.image^)[source + 1]) * 2 + byte(optimus) * 2 + byte(lonkero(poku^.image^)[source + 2]) + byte(c)) div 6; grid := (kalk and sspat[gridbyte][1]) or (byte(c) and (sspat[gridbyte][1] xor $FF)); kalk := (byte(lonkero(poku^.image^)[source + 1] shr 8) * 2 + byte(optimus shr 8) * 2 + byte(lonkero(poku^.image^)[source + 2] shr 8) + byte(c shr 8)) div 6; grid := grid or ((kalk and sspat[gridbyte][1]) or (byte(c shr 8) and (sspat[gridbyte][1] xor $FF))) shl 8; kalk := (byte(lonkero(poku^.image^)[source + 1] shr 16) * 2 + byte(optimus shr 16) * 2 + byte(lonkero(poku^.image^)[source + 2] shr 16) + byte(c shr 16)) div 6; lonkero(processor^)[target] := grid or ((kalk and sspat[gridbyte][1]) or (byte(c shr 16) and (sspat[gridbyte][1] xor $FF))) shl 16 or (c and $FF000000); // Bottom right subpixel inc(target, poku^.sizex * 2); optimus := lonkero(poku^.image^)[source + poku^.sizex * 2 + 1]; kalk := (byte(optimus) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex + 2]) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex * 2 + 2]) + byte(c)) div 6; grid := (kalk and sspat[gridbyte][2]) or (byte(c) and (sspat[gridbyte][2] xor $FF)); kalk := (byte(optimus shr 8) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex + 2] shr 8) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex * 2 + 2] shr 8) + byte(c shr 8)) div 6; grid := grid or ((kalk and sspat[gridbyte][2]) or (byte(c shr 8) and (sspat[gridbyte][2] xor $FF))) shl 8; kalk := (byte(optimus shr 16) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex + 2] shr 16) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex * 2 + 2] shr 16) + byte(c shr 16)) div 6; lonkero(processor^)[target] := grid or ((kalk and sspat[gridbyte][2]) or (byte(c shr 16) and (sspat[gridbyte][2] xor $FF))) shl 16 or (c and $FF000000); // Bottom left subpixel dec(target); kalk := (byte(optimus) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex]) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex * 2]) + byte(c)) div 6; grid := (kalk and sspat[gridbyte][3]) or (byte(c) and (sspat[gridbyte][3] xor $FF)); kalk := (byte(optimus shr 8) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex] shr 8) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex * 2] shr 8) + byte(c shr 8)) div 6; grid := grid or ((kalk and sspat[gridbyte][3]) or (byte(c shr 8) and (sspat[gridbyte][3] xor $FF))) shl 8; kalk := (byte(optimus shr 16) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex] shr 16) * 2 + byte(lonkero(poku^.image^)[source + poku^.sizex * 2] shr 16) + byte(c shr 16)) div 6; lonkero(processor^)[target] := grid or ((kalk and sspat[gridbyte][3]) or (byte(c shr 16) and (sspat[gridbyte][3] xor $FF))) shl 16 or (c and $FF000000); optimus := poku^.sizex * 2; inc(source); dec(target, optimus - 2); end; inc(source, 2); inc(target, optimus + 4); end; poku^.sizex := poku^.sizex * 2; poku^.sizey := poku^.sizey * 2; freemem(poku^.image); poku^.image := processor; processor := NIL; end; procedure BunnyScale2x24(poku : pbitmaptype); // Resizes the bitmaptype(poku^) resource to double resolution both axles. // Uses a sharp scaling algorithm to reduce pixelization without blurring. var processor : pointer; loopx, loopy : word; c : RGBtriplet; grid, nextline, source, target, optimus : dword; gridbyte, kalk : byte; calc : byte; // change to word if allowdiff < 2 begin if (poku^.image = NIL) or (poku^.memformat <> 0) then exit; getmem(processor, poku^.sizex * poku^.sizey * 4 * 3); // The edges would not be changed using this algorithm, so pixel-copy them. source := 0; target := 0; nextline := poku^.sizex * (poku^.sizey - 1); grid := nextline * 4; optimus := poku^.sizex * 2; for loopx := 0 to poku^.sizex - 1 do begin c := RGBarray(poku^.image^)[source]; RGBarray(processor^)[target] := c; RGBarray(processor^)[target + optimus] := c; inc(target); RGBarray(processor^)[target] := c; RGBarray(processor^)[target + optimus] := c; dec(target); c := RGBarray(poku^.image^)[source + nextline]; inc(target, grid); RGBarray(processor^)[target] := c; RGBarray(processor^)[target + optimus] := c; inc(target); RGBarray(processor^)[target] := c; RGBarray(processor^)[target + optimus] := c; dec(target, grid - 1); inc(source); end; source := poku^.sizex; target := source * 4; for loopy := 1 to poku^.sizey - 2 do begin c := RGBarray(poku^.image^)[source]; RGBarray(processor^)[target] := c; RGBarray(processor^)[target + optimus] := c; inc(target); RGBarray(processor^)[target] := c; RGBarray(processor^)[target + optimus] := c; inc(target, optimus - 3); inc(source, poku^.sizex - 1); c := RGBarray(poku^.image^)[source]; inc(source); RGBarray(processor^)[target] := c; RGBarray(processor^)[target + optimus] := c; inc(target); RGBarray(processor^)[target] := c; RGBarray(processor^)[target + optimus] := c; inc(target, optimus + 1); end; // Build a 3x3 neighbor grid for all remaining pixels. // The grid is packed into 8 bits, where a bit is set if the neighbor pixel // has the exact same color as the center pixel. The gridbyte is then used // to access a precalculated array which defines how the center pixel will // be divided into four new pixels. // Gridbyte bits: // 7 6 5 // 4 . 3 // 2 1 0 // If a gridbyte bit is set, that color is not the center color. source := 0; target := poku^.sizex * 4 + 2; for loopy := 1 to poku^.sizey - 2 do begin for loopx := 1 to poku^.sizex - 2 do begin c := RGBarray(poku^.image^)[source + poku^.sizex + 1]; gridbyte := 0; // top left calc := (abs(c.r - RGBarray(poku^.image^)[source].r) + abs(c.g - RGBarray(poku^.image^)[source].g) + abs(c.b - RGBarray(poku^.image^)[source].b)) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := calc; // top calc := (abs(c.r - RGBarray(poku^.image^)[source + 1].r) + abs(c.g - RGBarray(poku^.image^)[source + 1].g) + abs(c.b - RGBarray(poku^.image^)[source + 1].b)) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // top right calc := (abs(c.r - RGBarray(poku^.image^)[source + 2].r) + abs(c.g - RGBarray(poku^.image^)[source + 2].g) + abs(c.b - RGBarray(poku^.image^)[source + 2].b)) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // left calc := (abs(c.r - RGBarray(poku^.image^)[source + poku^.sizex].r) + abs(c.g - RGBarray(poku^.image^)[source + poku^.sizex].g) + abs(c.b - RGBarray(poku^.image^)[source + poku^.sizex].b)) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // right calc := (abs(c.r - RGBarray(poku^.image^)[source + poku^.sizex + 2].r) + abs(c.g - RGBarray(poku^.image^)[source + poku^.sizex + 2].g) + abs(c.b - RGBarray(poku^.image^)[source + poku^.sizex + 2].b)) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // bottom left calc := (abs(c.r - RGBarray(poku^.image^)[source + optimus].r) + abs(c.g - RGBarray(poku^.image^)[source + optimus].g) + abs(c.b - RGBarray(poku^.image^)[source + optimus].b)) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // bottom inc(optimus); calc := (abs(c.r - RGBarray(poku^.image^)[source + optimus].r) + abs(c.g - RGBarray(poku^.image^)[source + optimus].g) + abs(c.b - RGBarray(poku^.image^)[source + optimus].b)) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // bottom right inc(optimus); calc := (abs(c.r - RGBarray(poku^.image^)[source + optimus].r) + abs(c.g - RGBarray(poku^.image^)[source + optimus].g) + abs(c.b - RGBarray(poku^.image^)[source + optimus].b)) shr allowdiff; calc := (calc and $F) or (calc shr 4); calc := (calc and $3) or (calc shr 2); calc := (calc and $1) or (calc shr 1); gridbyte := (gridbyte shl 1) or calc; // Apply the gridbyte! // Top left subpixel optimus := source + poku^.sizex; kalk := (RGBarray(poku^.image^)[source + 1].r * 2 + RGBarray(poku^.image^)[optimus].r * 2 + RGBarray(poku^.image^)[source].r + c.r) div 6; RGBarray(processor^)[target].r := (kalk and sspat[gridbyte][0]) or (c.r and (sspat[gridbyte][0] xor $FF)); kalk := (RGBarray(poku^.image^)[source + 1].g * 2 + RGBarray(poku^.image^)[optimus].g * 2 + RGBarray(poku^.image^)[source].g + c.g) div 6; RGBarray(processor^)[target].g := (kalk and sspat[gridbyte][0]) or (c.g and (sspat[gridbyte][0] xor $FF)); kalk := (RGBarray(poku^.image^)[source + 1].b * 2 + RGBarray(poku^.image^)[optimus].b * 2 + RGBarray(poku^.image^)[source].b + c.b) div 6; RGBarray(processor^)[target].b := (kalk and sspat[gridbyte][0]) or (c.b and (sspat[gridbyte][0] xor $FF)); // Top right subpixel inc(target); inc(optimus, 2); // := source + poku^.sizex + 2; kalk := (RGBarray(poku^.image^)[source + 1].r * 2 + RGBarray(poku^.image^)[optimus].r * 2 + RGBarray(poku^.image^)[source + 2].r + c.r) div 6; RGBarray(processor^)[target].r := (kalk and sspat[gridbyte][1]) or (c.r and (sspat[gridbyte][1] xor $FF)); kalk := (RGBarray(poku^.image^)[source + 1].g * 2 + RGBarray(poku^.image^)[optimus].g * 2 + RGBarray(poku^.image^)[source + 2].g + c.g) div 6; RGBarray(processor^)[target].g := (kalk and sspat[gridbyte][1]) or (c.g and (sspat[gridbyte][1] xor $FF)); kalk := (RGBarray(poku^.image^)[source + 1].b * 2 + RGBarray(poku^.image^)[optimus].b * 2 + RGBarray(poku^.image^)[source + 2].b + c.b) div 6; RGBarray(processor^)[target].b := (kalk and sspat[gridbyte][1]) or (c.b and (sspat[gridbyte][1] xor $FF)); // Bottom right subpixel optimus := poku^.sizex * 2; inc(target, optimus); inc(optimus); kalk := (RGBarray(poku^.image^)[source + optimus].r * 2 + RGBarray(poku^.image^)[source + poku^.sizex + 2].r * 2 + RGBarray(poku^.image^)[source + optimus + 1].r + c.r) div 6; RGBarray(processor^)[target].r := (kalk and sspat[gridbyte][2]) or (c.r and (sspat[gridbyte][2] xor $FF)); kalk := (RGBarray(poku^.image^)[source + optimus].g * 2 + RGBarray(poku^.image^)[source + poku^.sizex + 2].g * 2 + RGBarray(poku^.image^)[source + optimus + 1].g + c.g) div 6; RGBarray(processor^)[target].g := (kalk and sspat[gridbyte][2]) or (c.g and (sspat[gridbyte][2] xor $FF)); kalk := (RGBarray(poku^.image^)[source + optimus].b * 2 + RGBarray(poku^.image^)[source + poku^.sizex + 2].b * 2 + RGBarray(poku^.image^)[source + optimus + 1].b + c.b) div 6; RGBarray(processor^)[target].b := (kalk and sspat[gridbyte][2]) or (c.b and (sspat[gridbyte][2] xor $FF)); // Bottom left subpixel dec(optimus); dec(target); kalk := (RGBarray(poku^.image^)[source + optimus + 1].r * 2 + RGBarray(poku^.image^)[source + poku^.sizex].r * 2 + RGBarray(poku^.image^)[source + optimus].r + c.r) div 6; RGBarray(processor^)[target].r := (kalk and sspat[gridbyte][3]) or (c.r and (sspat[gridbyte][3] xor $FF)); kalk := (RGBarray(poku^.image^)[source + optimus + 1].g * 2 + RGBarray(poku^.image^)[source + poku^.sizex].g * 2 + RGBarray(poku^.image^)[source + optimus].g + c.g) div 6; RGBarray(processor^)[target].g := (kalk and sspat[gridbyte][3]) or (c.g and (sspat[gridbyte][3] xor $FF)); kalk := (RGBarray(poku^.image^)[source + optimus + 1].b * 2 + RGBarray(poku^.image^)[source + poku^.sizex].b * 2 + RGBarray(poku^.image^)[source + optimus].b + c.b) div 6; RGBarray(processor^)[target].b := (kalk and sspat[gridbyte][3]) or (c.b and (sspat[gridbyte][3] xor $FF)); inc(source); dec(target, optimus - 2); end; inc(source, 2); inc(target, optimus + 4); end; poku^.sizex := poku^.sizex * 2; poku^.sizey := poku^.sizey * 2; freemem(poku^.image); poku^.image := processor; processor := NIL; end; procedure mcg_EPScale32(poku : pbitmaptype; tox, toy : word); // Resizes the bitmaptype(poku^) resource to tox:toy resolution. // Uses a weighed average of 2x2 pixel matrices, reducing the importance of // any pixels in the matrix whose color differs too much from the top left // pixel. The end result makes the edges a little sharper than cosine // interpolation, while very slightly anti-aliasing jagged lines. // Downscaling images with this will not give optimal results, since this // does not stack values over pixel spans. var processor, target : pointer; loopx, loopy : word; source, ysource : dword; x1, y1, r1, g1, b1, a1, stacksize, diff : dword; cr, cg, cb, ca, r2, g2, b2, a2 : byte; t1, t2, t3 : byte; begin if (poku^.image = NIL) or (poku^.memformat <> 1) or (tox or toy = 0) then exit; getmem(processor, tox * toy * 4); target := processor; for loopy := 0 to toy - 1 do begin y1 := (loopy shl 8) * word(poku^.sizey - 1) div word(toy - 1); ysource := (y1 shr 8) * poku^.sizex; for loopx := 0 to tox - 1 do begin x1 := (loopx shl 8) * word(poku^.sizex - 1) div word(tox - 1); // X1,Y1 is now the subpixel in the original with the value to stick in // the scaled image at loopx,loopy; subpixel accuracy = fixed point 16.8 source := (ysource + (x1 shr 8)) * 4; t2 := x1 and $FF; t1 := t2 xor $FF; t3 := (y1 and $FF) xor $FF; cr := byte((poku^.image + source)^); cg := byte((poku^.image + source + 1)^); cb := byte((poku^.image + source + 2)^); ca := byte((poku^.image + source + 3)^); r1 := (cr * t1 * t3); g1 := (cg * t1 * t3); b1 := (cb * t1 * t3); a1 := (ca * t1 * t3); stacksize := t1 * t3; r2 := byte((poku^.image + source + 4)^); g2 := byte((poku^.image + source + 5)^); b2 := byte((poku^.image + source + 6)^); a2 := byte((poku^.image + source + 7)^); diff := abs(cr - r2) + abs(cg - g2) + abs(cb - b2); if diff shr allowdiff <> 0 then diff := (t2 * t3) shr 1 else diff := t2 * t3; inc(r1, r2 * diff); inc(g1, g2 * diff); inc(b1, b2 * diff); inc(a1, a2 * diff); inc(stacksize, diff); inc(source, poku^.sizex * 4); t3 := t3 xor $FF; r2 := byte((poku^.image + source)^); g2 := byte((poku^.image + source + 1)^); b2 := byte((poku^.image + source + 2)^); a2 := byte((poku^.image + source + 3)^); diff := abs(cr - r2) + abs(cg - g2) + abs(cb - b2); if diff shr allowdiff <> 0 then diff := (t1 * t3) shr 1 else diff := t1 * t3; inc(r1, r2 * diff); inc(g1, g2 * diff); inc(b1, b2 * diff); inc(a1, a2 * diff); inc(stacksize, diff); r2 := byte((poku^.image + source + 4)^); g2 := byte((poku^.image + source + 5)^); b2 := byte((poku^.image + source + 6)^); a2 := byte((poku^.image + source + 7)^); diff := abs(cr - r2) + abs(cg - g2) + abs(cb - b2); if diff shr allowdiff <> 0 then diff := (t2 * t3) shr 2 else diff := t2 * t3; inc(r1, r2 * diff); inc(g1, g2 * diff); inc(b1, b2 * diff); inc(a1, a2 * diff); inc(stacksize, diff); byte(target^) := r1 div stacksize; inc(target); byte(target^) := g1 div stacksize; inc(target); byte(target^) := b1 div stacksize; inc(target); byte(target^) := a1 div stacksize; inc(target); end; end; poku^.sizex := tox; poku^.sizey := toy; freemem(poku^.image); poku^.image := processor; processor := NIL; end; procedure mcg_EPScale24(poku : pbitmaptype; tox, toy : word); // Resizes the bitmaptype(poku^) resource to tox:toy resolution. // Uses a weighed average of 2x2 pixel matrices, reducing the importance of // any pixels in the matrix whose color differs too much from the top left // pixel. The end result makes the edges a little sharper than cosine // interpolation, while very slightly anti-aliasing jagged lines. // Downscaling images with this will not give optimal results, since this // does not stack values over pixel spans. var processor, target : pointer; loopx, loopy : word; source, ysource : dword; x1, y1, r1, g1, b1, stacksize, diff : dword; cr, cg, cb, r2, g2, b2 : byte; t1, t2, t3 : byte; begin if (poku^.image = NIL) or (poku^.memformat <> 0) or (tox or toy = 0) then exit; getmem(processor, tox * toy * 3); target := processor; for loopy := 0 to toy - 1 do begin y1 := (loopy shl 8) * word(poku^.sizey - 1) div word(toy - 1); ysource := ((y1 shr 8) * poku^.sizex) * 3; for loopx := 0 to tox - 1 do begin x1 := (loopx shl 8) * word(poku^.sizex - 1) div word(tox - 1); // X1,Y1 is now the subpixel in the original with the value to stick in // the scaled image at loopx,loopy; subpixel accuracy = fixed point 16.8 source := ysource + (x1 shr 8) * 3; t2 := x1 and $FF; t1 := t2 xor $FF; t3 := (y1 and $FF) xor $FF; cr := byte((poku^.image + source)^); cg := byte((poku^.image + source + 1)^); cb := byte((poku^.image + source + 2)^); r1 := (cr * t1 * t3); g1 := (cg * t1 * t3); b1 := (cb * t1 * t3); stacksize := t1 * t3; r2 := byte((poku^.image + source + 3)^); g2 := byte((poku^.image + source + 4)^); b2 := byte((poku^.image + source + 5)^); diff := abs(cr - r2) + abs(cg - g2) + abs(cb - b2); if diff shr allowdiff <> 0 then diff := (t2 * t3) shr 1 else diff := t2 * t3; inc(r1, r2 * diff); inc(g1, g2 * diff); inc(b1, b2 * diff); inc(stacksize, diff); inc(source, poku^.sizex * 3); t3 := t3 xor $FF; r2 := byte((poku^.image + source)^); g2 := byte((poku^.image + source + 1)^); b2 := byte((poku^.image + source + 2)^); diff := abs(cr - r2) + abs(cg - g2) + abs(cb - b2); if diff shr allowdiff <> 0 then diff := (t1 * t3) shr 1 else diff := t1 * t3; inc(r1, r2 * diff); inc(g1, g2 * diff); inc(b1, b2 * diff); inc(stacksize, diff); r2 := byte((poku^.image + source + 3)^); g2 := byte((poku^.image + source + 4)^); b2 := byte((poku^.image + source + 5)^); diff := abs(cr - r2) + abs(cg - g2) + abs(cb - b2); if diff shr allowdiff <> 0 then diff := (t2 * t3) shr 2 else diff := t2 * t3; inc(r1, r2 * diff); inc(g1, g2 * diff); inc(b1, b2 * diff); inc(stacksize, diff); byte(target^) := r1 div stacksize; inc(target); byte(target^) := g1 div stacksize; inc(target); byte(target^) := b1 div stacksize; inc(target); end; end; poku^.sizex := tox; poku^.sizey := toy; freemem(poku^.image); poku^.image := processor; processor := NIL; end; procedure mcg_ScaleBitmapCos32(poku : pbitmaptype; tox, toy : word); // Resizes the bitmaptype(poku^) resource to tox:toy resolution. // Uses immediate cosine interpolation. // Downscaling images with this will not give optimal results, since this // does not stack values over pixel spans. var processor, target : pointer; loopx, loopy : word; ysource, source : dword; x1, y1, r1, r2, g1, g2, b1, b2, a1, a2, p1, p2 : dword; cos1, cos2 : byte; begin if (poku^.image = NIL) or (poku^.memformat <> 1) or (tox or toy = 0) then exit; getmem(processor, tox * toy * 4); target := processor; for loopy := 0 to toy - 1 do begin y1 := (loopy shl 8) * word(poku^.sizey - 1) div word(toy - 1); ysource := (y1 shr 8) * poku^.sizex; for loopx := 0 to tox - 1 do begin x1 := (loopx shl 8) * word(poku^.sizex - 1) div word(tox - 1); // X1,Y1 is now the subpixel in the original with the value to stick in // the scaled image at loopx,loopy; subpixel accuracy = fixed point 16.8 source := ysource + (x1 shr 8); cos1 := mcg_costable[x1 and $FF] shr 8; cos2 := cos1 xor $FF; p1 := lonkero(poku^.image^)[source]; p2 := lonkero(poku^.image^)[source + 1]; r1 := byte(p1) * cos1 + byte(p2) * cos2; p1 := p1 shr 8; p2 := p2 shr 8; g1 := byte(p1) * cos1 + byte(p2) * cos2; p1 := p1 shr 8; p2 := p2 shr 8; b1 := byte(p1) * cos1 + byte(p2) * cos2; p1 := p1 shr 8; p2 := p2 shr 8; a1 := byte(p1) * cos1 + byte(p2) * cos2; inc(source, poku^.sizex); p1 := lonkero(poku^.image^)[source]; p2 := lonkero(poku^.image^)[source + 1]; r2 := byte(p1) * cos1 + byte(p2) * cos2; p1 := p1 shr 8; p2 := p2 shr 8; g2 := byte(p1) * cos1 + byte(p2) * cos2; p1 := p1 shr 8; p2 := p2 shr 8; b2 := byte(p1) * cos1 + byte(p2) * cos2; p1 := p1 shr 8; p2 := p2 shr 8; a2 := byte(p1) * cos1 + byte(p2) * cos2; cos1 := mcg_costable[y1 and $FF] shr 8; cos2 := cos1 xor $FF; byte(target^) := (r1 * cos1 + r2 * cos2) shr 16; inc(target); byte(target^) := (g1 * cos1 + g2 * cos2) shr 16; inc(target); byte(target^) := (b1 * cos1 + b2 * cos2) shr 16; inc(target); byte(target^) := (a1 * cos1 + a2 * cos2) shr 16; inc(target); end; end; poku^.sizex := tox; poku^.sizey := toy; freemem(poku^.image); poku^.image := processor; processor := NIL; end; procedure mcg_ScaleBitmapCos24(poku : pbitmaptype; tox, toy : word); // Resizes the bitmaptype(poku^) resource to tox:toy resolution. // Uses immediate cosine interpolation. // Downscaling images with this will not give optimal results, since this // does not stack values over pixel spans. var processor, target : pointer; loopx, loopy : word; source, ysource : dword; x1, y1, r1, r2, g1, g2, b1, b2 : dword; cos1, cos2 : byte; begin if (poku^.image = NIL) or (poku^.memformat <> 0) or (tox or toy = 0) then exit; getmem(processor, tox * toy * 3); target := processor; for loopy := 0 to toy - 1 do begin y1 := (loopy shl 8) * word(poku^.sizey - 1) div word(toy - 1); ysource := ((y1 shr 8) * poku^.sizex) * 3; for loopx := 0 to tox - 1 do begin x1 := (loopx shl 8) * word(poku^.sizex - 1) div word(tox - 1); // X1,Y1 is now the subpixel in the original with the value to stick in // the scaled image at loopx,loopy; subpixel accuracy = fixed point 16.8 source := ysource + (x1 shr 8) * 3; cos1 := mcg_costable[x1 and $FF] shr 8; cos2 := cos1 xor $FF; r1 := byte((poku^.image + source)^) * cos1 + byte((poku^.image + source + 3)^) * cos2; g1 := byte((poku^.image + source + 1)^) * cos1 + byte((poku^.image + source + 4)^) * cos2; b1 := byte((poku^.image + source + 2)^) * cos1 + byte((poku^.image + source + 5)^) * cos2; inc(source, poku^.sizex * 3); r2 := byte((poku^.image + source)^) * cos1 + byte((poku^.image + source + 3)^) * cos2; g2 := byte((poku^.image + source + 1)^) * cos1 + byte((poku^.image + source + 4)^) * cos2; b2 := byte((poku^.image + source + 2)^) * cos1 + byte((poku^.image + source + 5)^) * cos2; cos1 := mcg_costable[y1 and $FF] shr 8; cos2 := cos1 xor $FF; byte(target^) := (r1 * cos1 + r2 * cos2) shr 16; inc(target); byte(target^) := (g1 * cos1 + g2 * cos2) shr 16; inc(target); byte(target^) := (b1 * cos1 + b2 * cos2) shr 16; inc(target); end; end; poku^.sizex := tox; poku^.sizey := toy; freemem(poku^.image); poku^.image := processor; processor := NIL; end; procedure mcg_ScaleBitmapCos(poku : pbitmaptype; tox, toy : word); begin if poku^.image = NIL then begin mcg_errortxt := 'Image pointer is NIL'; exit; end; if (tox = 0) or (toy = 0) then begin mcg_errortxt := 'Target size cannot be 0'; exit; end; case poku^.memformat of 0: mcg_ScaleBitmapCos24(poku, tox, toy); 1: mcg_ScaleBitmapCos32(poku, tox, toy); else begin mcg_errortxt := 'Image memformat must be 0 or 1'; exit; end; end; end; procedure mcg_ScaleBitmap24(poku : pbitmaptype; tox, toy : word); // Resize procedure called by mcg_ScaleBitmap. var processor, source, target : pointer; loopx, loopy : word; start, finish, span, b : dword; a : array[0..5] of dword; begin if (poku^.image = NIL) or (poku^.memformat <> 0) or (tox or toy = 0) then exit; // Adjust image horizontally from poku^ into processor if tox > poku^.sizex then begin start := 0; b := poku^.sizex * 3; a[3] := tox * 3; // Horizontal stretch getmem(processor, poku^.sizey * a[3]); target := processor; span := (poku^.sizex shl 15) div tox; for loopx := tox - 1 downto 0 do begin finish := start + span - 1; source := poku^.image + (start shr 15) * 3; if start shr 15 = finish shr 15 then begin // start and finish are in the same source pixel column for loopy := poku^.sizey - 1 downto 0 do begin word(target^) := word(source^); byte((target + 2)^) := byte((source + 2)^); inc(source, b); inc(target, a[3]); end; dec(target, poku^.sizey * a[3]); end else begin // start and finish are in separate source pixel columns a[0] := (start and $7FFF) xor $7FFF; // weight of left column a[1] := (finish and $7FFF); // weight of right column a[2] := a[0] + a[1]; // total weight for dividing for loopy := poku^.sizey - 1 downto 0 do begin byte(target^) := (byte(source^) * a[0] + byte((source + 3)^) * a[1]) div a[2]; byte((target + 1)^) := (byte((source + 1)^) * a[0] + byte((source + 4)^) * a[1]) div a[2]; byte((target + 2)^) := (byte((source + 2)^) * a[0] + byte((source + 5)^) * a[1]) div a[2]; inc(source, b); inc(target, a[3]); end; dec(target, poku^.sizey * a[3]); end; inc(start, span); inc(target, 3); end; freemem(poku^.image); poku^.image := processor; processor := NIL; end else if tox < poku^.sizex then begin // Horizontal shrink getmem(processor, tox * poku^.sizey * 3); source := poku^.image; target := processor; span := (poku^.sizex shl 15) div tox; for loopy := poku^.sizey - 1 downto 0 do begin start := 0; for loopx := tox - 1 downto 0 do begin finish := start + span - 1; b := (start shr 15) * 3; // left edge a[0] := (start and $7FFF) xor $7FFF; // weight of left column a[1] := a[0]; // accumulated weight for this pixel a[2] := byte((source + b)^) * a[0]; inc(b); a[3] := byte((source + b)^) * a[0]; inc(b); a[4] := byte((source + b)^) * a[0]; inc(b); // full middle columns a[0] := start shr 15 + 1; while a[0] < finish shr 15 do begin inc(a[1], $8000); // accumulate weight inc(a[2], byte((source + b)^) shl 15); inc(b); inc(a[3], byte((source + b)^) shl 15); inc(b); inc(a[4], byte((source + b)^) shl 15); inc(b); inc(a[0]); end; // right edge a[0] := (finish and $7FFF); // weight of right column inc(a[1], a[0]); // accumulate weight inc(a[2], byte((source + b)^) * a[0]); inc(b); inc(a[3], byte((source + b)^) * a[0]); inc(b); inc(a[4], byte((source + b)^) * a[0]); // store result a[0] := a[1] shr 1; byte(target^) := (a[2] + a[0]) div a[1]; inc(target); byte(target^) := (a[3] + a[0]) div a[1]; inc(target); byte(target^) := (a[4] + a[0]) div a[1]; inc(target); inc(start, span); end; inc(source, poku^.sizex * 3); end; freemem(poku^.image); poku^.image := processor; processor := NIL; end; // else... Horizontal change is unnecessary poku^.sizex := tox; // Adjust image vertically from poku^ into processor start := 0; b := poku^.sizex * 3; if toy > poku^.sizey then begin // Vertical stretch getmem(processor, b * toy); target := processor; span := (poku^.sizey shl 15) div toy; for loopy := toy - 1 downto 0 do begin finish := start + span - 1; source := poku^.image + (start shr 15) * b; if start shr 15 = finish shr 15 then begin // start and finish are on the same source pixel row move(source^, target^, b); inc(target, b); end else begin // start and finish are on separate source pixel rows a[0] := (start and $7FFF) xor $7FFF; // weight of upper row a[1] := (finish and $7FFF); // weight of lower row a[2] := a[0] + a[1]; // total weight for dividing for loopx := b - 1 downto 0 do begin byte(target^) := (byte(source^) * a[0] + byte((source + b)^) * a[1]) div a[2]; inc(source); inc(target); end; end; inc(start, span); end; freemem(poku^.image); poku^.image := processor; processor := NIL; end else if toy < poku^.sizey then begin // Vertical shrink getmem(processor, b * toy); target := processor; span := (poku^.sizey shl 15) div toy; for loopy := toy - 1 downto 0 do begin finish := start + span - 1; source := poku^.image + (start shr 15) * b; a[0] := (start and $7FFF) xor $7FFF; // weight of highest row a[1] := (finish and $7FFF); // weight of lowest row a[2] := (finish shr 15) - (start shr 15); if a[2] <> 0 then dec(a[2]); // number of full rows between high and low a[3] := a[0] + a[1] + a[2] shl 15; // total weight for loopx := b - 1 downto 0 do begin // accumulate weighed pixels in a[4], first add highest and lowest a[4] := byte(source^) * a[0] + byte((source + b * (a[2] + 1))^) * a[1]; a[5] := a[2]; // then add middle lines while a[5] <> 0 do begin inc(a[4], byte((source + b * a[5])^) shl 15); dec(a[5]); end; byte(target^) := (a[4] + a[3] shr 1) div a[3]; // divide by total weight inc(source); inc(target); end; inc(start, span); end; freemem(poku^.image); poku^.image := processor; processor := NIL; end; // else ... Vertical change is unnecessary poku^.sizey := toy; end; procedure mcg_ScaleBitmap32(poku : pbitmaptype; tox, toy : word); // Resize procedure called by mcg_ScaleBitmap. var processor, source, target : pointer; loopx, loopy : word; start, finish, span, b : dword; a : array[0..5] of dword; begin if (poku^.image = NIL) or (poku^.memformat <> 1) or (tox or toy = 0) then exit; // Adjust image horizontally from poku^ into processor if tox > poku^.sizex then begin start := 0; b := poku^.sizex * 4; a[3] := tox * 4; // Horizontal stretch getmem(processor, poku^.sizey * a[3]); target := processor; span := (poku^.sizex shl 15) div tox; for loopx := tox - 1 downto 0 do begin finish := start + span - 1; source := poku^.image + (start shr 15) * 4; if start shr 15 = finish shr 15 then begin // start and finish are in the same source pixel column for loopy := poku^.sizey - 1 downto 0 do begin dword(target^) := dword(source^); inc(source, b); inc(target, a[3]); end; dec(target, poku^.sizey * a[3]); end else begin // start and finish are in separate source pixel columns a[0] := (start and $7FFF) xor $7FFF; // weight of left column a[1] := (finish and $7FFF); // weight of right column a[2] := a[0] + a[1]; // total weight for dividing for loopy := poku^.sizey - 1 downto 0 do begin byte(target^) := (byte(source^) * a[0] + byte((source + 4)^) * a[1]) div a[2]; byte((target + 1)^) := (byte((source + 1)^) * a[0] + byte((source + 5)^) * a[1]) div a[2]; byte((target + 2)^) := (byte((source + 2)^) * a[0] + byte((source + 6)^) * a[1]) div a[2]; byte((target + 3)^) := (byte((source + 3)^) * a[0] + byte((source + 7)^) * a[1]) div a[2]; inc(source, b); inc(target, a[3]); end; dec(target, poku^.sizey * a[3]); end; inc(start, span); inc(target, 4); end; freemem(poku^.image); poku^.image := processor; processor := NIL; end else if tox < poku^.sizex then begin // Horizontal shrink getmem(processor, tox * poku^.sizey * 4); source := poku^.image; target := processor; span := (poku^.sizex shl 15) div tox; for loopy := poku^.sizey - 1 downto 0 do begin start := 0; for loopx := tox - 1 downto 0 do begin finish := start + span - 1; b := (start shr 15) * 4; // left edge a[0] := (start and $7FFF) xor $7FFF; // weight of left column a[1] := a[0]; // accumulated weight for this pixel a[2] := byte((source + b)^) * a[0]; inc(b); a[3] := byte((source + b)^) * a[0]; inc(b); a[4] := byte((source + b)^) * a[0]; inc(b); a[5] := byte((source + b)^) * a[0]; inc(b); // full middle columns a[0] := start shr 15 + 1; while a[0] < finish shr 15 do begin inc(a[1], $8000); // accumulate weight inc(a[2], byte((source + b)^) shl 15); inc(b); inc(a[3], byte((source + b)^) shl 15); inc(b); inc(a[4], byte((source + b)^) shl 15); inc(b); inc(a[5], byte((source + b)^) shl 15); inc(b); inc(a[0]); end; // right edge a[0] := (finish and $7FFF); // weight of right column inc(a[1], a[0]); // accumulate weight inc(a[2], byte((source + b)^) * a[0]); inc(b); inc(a[3], byte((source + b)^) * a[0]); inc(b); inc(a[4], byte((source + b)^) * a[0]); inc(b); inc(a[5], byte((source + b)^) * a[0]); // store result a[0] := a[1] shr 1; byte(target^) := (a[2] + a[0]) div a[1]; inc(target); byte(target^) := (a[3] + a[0]) div a[1]; inc(target); byte(target^) := (a[4] + a[0]) div a[1]; inc(target); byte(target^) := (a[5] + a[0]) div a[1]; inc(target); inc(start, span); end; inc(source, poku^.sizex * 4); end; freemem(poku^.image); poku^.image := processor; processor := NIL; end; // else... Horizontal change is unnecessary poku^.sizex := tox; // Adjust image vertically from poku^ into processor start := 0; b := poku^.sizex * 4; if toy > poku^.sizey then begin // Vertical stretch getmem(processor, b * toy); target := processor; span := (poku^.sizey shl 15) div toy; for loopy := toy - 1 downto 0 do begin finish := start + span - 1; source := poku^.image + (start shr 15) * b; if start shr 15 = finish shr 15 then begin // start and finish are on the same source pixel row move(source^, target^, b); inc(target, b); end else begin // start and finish are on separate source pixel rows a[0] := (start and $7FFF) xor $7FFF; // weight of upper row a[1] := (finish and $7FFF); // weight of lower row a[2] := a[0] + a[1]; // total weight for dividing for loopx := b - 1 downto 0 do begin byte(target^) := (byte(source^) * a[0] + byte((source + b)^) * a[1]) div a[2]; inc(source); inc(target); end; end; inc(start, span); end; freemem(poku^.image); poku^.image := processor; processor := NIL; end else if toy < poku^.sizey then begin // Vertical shrink getmem(processor, b * toy); target := processor; span := (poku^.sizey shl 15) div toy; for loopy := toy - 1 downto 0 do begin finish := start + span - 1; source := poku^.image + (start shr 15) * b; a[0] := (start and $7FFF) xor $7FFF; // weight of highest row a[1] := (finish and $7FFF); // weight of lowest row a[2] := (finish shr 15) - (start shr 15); if a[2] <> 0 then dec(a[2]); // number of full rows between high and low a[3] := a[0] + a[1] + a[2] shl 15; // total weight for loopx := b - 1 downto 0 do begin // accumulate weighed pixels in a[4], first add highest and lowest a[4] := byte(source^) * a[0] + byte((source + b * (a[2] + 1))^) * a[1]; a[5] := a[2]; // then add middle lines while a[5] <> 0 do begin inc(a[4], byte((source + b * a[5])^) shl 15); dec(a[5]); end; byte(target^) := (a[4] + a[3] shr 1) div a[3]; // divide by total weight inc(source); inc(target); end; inc(start, span); end; freemem(poku^.image); poku^.image := processor; processor := NIL; end; // else ... Vertical change is unnecessary poku^.sizey := toy; end; procedure mcg_ScaleBitmap(poku : pbitmaptype; tox, toy : word); // Resizes the bitmaptype(poku^) resource to tox:toy resolution. // Uses a sort of general purpose linear method to do it. // Scaling downwards looks good, as color values stack properly. // Scaling upwards by integer multiples looks like a point scaler. begin if poku^.image = NIL then begin mcg_errortxt := 'Image pointer is NIL'; exit; end; if (tox = 0) or (toy = 0) then begin mcg_errortxt := 'Target size cannot be 0'; exit; end; case poku^.memformat of 0: mcg_ScaleBitmap24(poku, tox, toy); 1: mcg_ScaleBitmap32(poku, tox, toy); else begin mcg_errortxt := 'Image memformat must be 0 or 1'; exit; end; end; end; procedure InitMCGLoder; var blob, blub : dword; begin fillbyte(pnghdr, sizeof(pnghdr), 0); // Precalculate the CRC table for PNG creation for blob := 0 to 255 do begin CRC := blob; for blub := 0 to 7 do if CRC and 1 <> 0 then CRC := $EDB88320 xor (CRC shr 1) else CRC := CRC shr 1; CRCtable[blob] := CRC; end; // Set default AutoConversion value to turn everything into truecolor mcg_AutoConvert := 2; end; begin InitMCGLoder; end.