pals.inc

bmf汉字预览显示

{$IFNDEF pals}
{$DEFINE pals}
{$I GFX.INC}
const
 HIPALR=4; {max.6}
 HIPALG=4;
 HIPALB=4;
var
  pal:array[0..$2FF] of byte;
  hipal:array[0..1 shl (HIPALR+HIPALG+HIPALB)-1] of byte;

procedure setRGB(c,r,g,b:byte); assembler;
asm
  xor  eax,eax
  mov  al,c
  mov  edi,eax
  shl  edi,1
  add  edi,eax
  add  edi,offset pal
  mov  dx,03C8h
  out  dx,al
  inc  dx
  mov  al,r
  stosb
  out  dx,al
  mov  al,g
  stosb
  out  dx,al
  mov  al,b
  stosb
  out  dx,al
end;  {setRGB}

procedure getRGB(c:byte; var r,g,b:byte); assembler;
asm
  mov  ax,1015h
  xor  ebx,ebx
  mov  bl,c
  int  10h
  mov  edi,r
  mov  [edi],dh
  mov  edi,g
  mov  [edi],ch
  mov  edi,b
  mov  [edi],cl
end;  {getRGB}

procedure readRGB(c:byte; var r,g,b:byte); assembler;
asm
  xor  eax,eax
  mov  al,c
  add  eax,offset pal
  xchg eax,esi
  mov  edi,r
  movsb
  mov  edi,g
  movsb
  mov  edi,b
  movsb
end;  {readRGB}

function  nearestColor(r,g,b:byte; palofs:dword):byte;
var i,t,min:integer;
begin
  min:=192; result:=255;
  for i:=0 to 255 do begin
    t:=abs(mem[palofs]-r)+abs(mem[palofs+1]-g)+abs(mem[palofs+2]-b);
    if t<min then begin
      min:=t;
      result:=i;
      if min=0 then exit;
    end;
    inc(palofs,3);
  end;
end;  {nearestColor}

procedure fillPal;
var r:TRmRegs;
begin
  ClearRmRegs(r);
  r.AX:=$1017;
  r.BX:=0;
  r.CX:=$0100;
  r.ES:=Buf_16;
  r.DX:=0;
  RealModeInt($10,r);
  move(pointer(Buf_32)^,pal,sizeof(pal));
end;  {fillPal}

procedure fillHiPal;
var i:longint;
begin
  for i:=0 to sizeof(hipal)-1 do
    hipal[i]:=nearestcolor(i and (1 shl HIPALR-1) shl (6-HIPALR),i shr HIPALG and (1 shl HIPALG-1) shl (6-HIPALG),i shr (HIPALR+HIPALG) and (1 shl HIPALB-1) shl (6-HIPALB),ofs(pal));
end;  {fillHiPal}
{$ENDIF}