bmchar.inc

bmf汉字预览显示

{$IFNDEF bmchar}
{$DEFINE bmchar}
{$I SYST.INC}
{$I BUF2D.INC}
{$I STREAM.INC}
type
  PBMChar=^TBMChar;
  TBMChar=object(TBuf2d)
  private
    relx,rely:shortint;
    shift:byte;
  public
    Constructor init(_w,_h:longint);
    Constructor init0;
    Function  load(var f:TStream):boolean; virtual;
    Procedure copyToMe(src:PRect); virtual;
    Procedure countColors(var buf);
    Function  empty:boolean; virtual;
    {$IFDEF bmfchange}
    Function  save(var f:TStream):boolean; virtual;
    Function  saveInfo(var f:TStream):boolean; virtual;
    Function  saveData(var f:TStream):boolean; virtual;
    Function  dirOk(x0,y0:integer; horizontal:boolean):boolean;
    Procedure minimize;
    Procedure softenH;
    Procedure softenV;
    Procedure turnRight; virtual;
    {$ENDIF}
  end;  {TBMChar}

Constructor TBMChar.init(_w,_h:longint);
begin
  inherited init(0,0,_w,_h);
  relx:=0;
  rely:=0;
  shift:=0;
end;  {TBMChar.init}

Constructor TBMChar.init0;
begin
  x:=0; y:=0; w:=0; h:=0;
  relx:=0; rely:=0; shift:=0;
  d:=nil;
end;  {TBMChar.init0}

Function  TBMChar.load(var f:TStream):boolean;
begin
  result:=true;
  f.readOrSkip(mem[ofs(w)],1,result);
  f.readOrSkip(mem[ofs(h)],1,result);
  init(byte(w),byte(h));
  f.readOrSkip(relx,sizeof(relx),result);
  f.readOrSkip(rely,sizeof(rely),result);
  f.readOrSkip(shift,sizeof(shift),result);
  if not inherited empty then f.readOrSkip(d^,w*h,result);
end;  {TBMChar.load}

Procedure TBMChar.copyToMe(src:PRect);
begin
  free;
  if src=nil then exit;
  init(src^.w,src^.h);
  moveto(src^.x,src^.y);
  if typeof(src^)=typeof(TBuf2d) then
    if not PBuf2d(src)^.empty then move(PBuf2d(src)^.d^,d^,w*h);
  if typeof(src^)=typeof(TBMChar) then begin
    relx:=PBMChar(src)^.relx;
    rely:=PBMChar(src)^.rely;
    shift:=PBMChar(src)^.shift;
    if not {correct->}PBuf2d(src)^.empty then move(PBMChar(src)^.d^,d^,w*h);
  end;
end;  {TBMChar.copyToMe}

Procedure TBMChar.countColors(var buf);
var
  i,j:longint;
  buf2:array[byte] of byte absolute buf;
begin
  if not empty then begin
    for j:=0 to h-1 do
      for i:=0 to w-1 do
        buf2[getpoint(i,j)]:=1;
  end;
end;  {TBMChar.countColors}

Function  TBMChar.empty:boolean;
begin
  result:=inherited empty and (shift=0);
end;  {TBMChar.empty}

{$IFDEF bmfchange}
Function  TBMChar.saveInfo(var f:TStream):boolean;
begin
  result:=f.write(mem[ofs(w)],1);
  result:=f.write(mem[ofs(h)],1) and result;
  result:=f.write(relx,sizeof(relx)) and result;
  result:=f.write(rely,sizeof(rely)) and result;
  result:=f.write(shift,sizeof(shift)) and result;
  result:=(w shr 8 or h shr 8=0) and result;
end;  {TBMChar.saveInfo}

Function  TBMChar.saveData(var f:TStream):boolean;
begin
  if d=nil then result:=true else result:=f.write(d^,w*h);
end;  {TBMChar.saveData}

Function  TBMChar.save(var f:TStream):boolean;
begin
  result:=saveinfo(f);
  result:=savedata(f) and result;
end;  {TBMChar.save}

Function TBMChar.dirOk(x0,y0:integer; horizontal:boolean):boolean;
begin
  dirOk:=false;
  repeat
    if d=nil then exit;
    repeat
      if not contains(x0,y0) then break;
      if getpoint(x0,y0)<>0 then exit;
      if horizontal then inc(y0) else inc(x0);
    until false;
  until true;
  dirOk:=true;
end;  {TBMChar.dirOk}

Procedure TBMChar.minimize;
var
  t,l,b,r:integer; {top left bottom right}
  i,j:integer;
  d2:pointer;
begin
  if empty then exit;
  t:=0;   while (t<h) and dirOk(0,t,false) do inc(t);
  l:=0;   while (l<w) and dirOk(l,0,true) do inc(l);
  b:=h-1; while (b>=0) and dirOk(0,b,false) do dec(b);
  r:=w-1; while (r>=0) and dirOk(r,0,true) do dec(r);
  if t>=h then begin
    free;
    exit;
  end;
  dec(r,pred(l)); {new width}
  dec(b,pred(t)); {new height}
  getmem(d2,r*b);
  for j:=0 to b-1 do
    for i:=0 to r-1 do
      mem[ofs(d2^)+j*r+i]:=getpoint(l+i,t+j); {*crop}
  freemem(d,w*h);
  w:=r; h:=b;
  d:=d2;
  inc(relx,l);
  inc(rely,t);
end;  {TBMChar.minimize}

Procedure TBmChar.softenH;
var
  i,j:longint;
  b:byte;
begin
  if empty then exit;
  for j:=0 to h-1 do
    for i:=0 to w-1 do begin
      b:=getpoint(i,j);
      if (b=0) {or
         ((b=$1F) and (getpoint(i-1,j)=0)) or
         ((b=$1F) and (getpoint(i+1,j)=0))} then
      else setpoint(i,j,round((getpoint(i-1,j)+b*2+getpoint(i+1,j))/4));
    end;
end;  {TBmChar.softenH}

Procedure TBmChar.softenV;
var
  i,j:longint;
  b:byte;
begin
  if empty then exit;
  for j:=0 to h-1 do
    for i:=0 to w-1 do begin
      b:=getpoint(i,j);
      if (b=0) {or
         ((b=$1F) and (getpoint(i,j-1)=0)) or
         ((b=$1F) and (getpoint(i,j+1)=0))} then
      else setpoint(i,j,round((getpoint(i,j-1)+b*2+getpoint(i,j+1))/4));
    end;
end;  {TBmChar.softenV}

Procedure TBmChar.turnRight;
begin
  inherited turnRight;
  inc(shift,w-h);
end;  {TBmChar.turnRight}
{$ENDIF}
{$ENDIF}