返回
{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                    DAC寄存器单元                        ***}
{***************************************************************}
{$O+,F+,X+,I-,S-}
Unit FDac;
Interface
Uses
  Crt,Dos;

Type
  DacType=array[1..256*3] of Byte;
  TDac=object
   Dac,Plate:DacType;
   DTime:Integer;
   Spc1,Spc2,Spc3:Byte;
   constructor Init;
   procedure Get;
   procedure GetDac(var NewDac:Dactype);
   procedure SetDac;
   procedure SetLoDac;
   procedure SetNewDac(var NewDac:DacType);
   procedure Clear;
   procedure SplashOneColor(Col:Integer);
   procedure Appear(T:Integer);
   procedure DisAppear(T:Integer);
   procedure OneColor(Num:Integer;Red,Green,Blue:Byte);
  end;

Function GetDacIndex(Col16:Byte):Byte;
Function GetLightColor(var Dac:DacType):Byte;
Procedure LoadDacFile(Name:PathStr;var D:DacType);
Function SaveDacFile(Name:PathStr;D:DacType):Boolean;

var
  Dac:TDac;

Implementation

Function GetDacIndex(Col16:Byte):Byte;assembler;
asm mov ax,1007h
    mov bl,col16
    int 10h
    mov al,bh
end;

Function GetLightColor(var Dac:DacType):Byte;
var
  TempColor:Byte;
  Count,i,Temp,Temp1:Integer;
begin
  TempColor:=0;
  Count:=0;
  for i:=0 to 255 do
  begin
    Temp:=Integer(Dac[i*3+1])+Integer(Dac[i*3+2])+Integer(Dac[i*3+3]);
    if Temp>Count then
    begin
      TempColor:=i;
      Count:=Temp;
    end;
  end;
  GetLightColor:=TempColor;
end;

Procedure LoadDacFile(Name:PathStr;var D:DacType);
var
  Fp:File;
  Result,TempAttr:Word;
begin
  Assign(Fp,Name);
  GetFAttr(Fp,TempAttr);
  SetFAttr(Fp,Archive);
  Reset(Fp,1);
  if IOResult<>0 then Exit;
  BlockRead(Fp,D,SizeOf(DacType),Result);
  Close(Fp);
end;

Function SaveDacFile(Name:PathStr;D:DacType):Boolean;
var
  Fp:File;
  Result:Word;
begin
  SaveDacFile:=False;
  Assign(Fp,Name);
  ReWrite(Fp,1);
  if IOResult<>0 then Exit;
  BlockWrite(Fp,D,Sizeof(DacType),Result);
  Close(Fp);
  SaveDacFile:=True;
end;

constructor TDac.Init;
var
  I:Integer;
begin
  Get;
  for I:=1 to 256*3 do
  Plate[I]:=Dac[I];
  Spc1:=0;
  Spc2:=0;
  Spc3:=0;
end;

procedure TDac.Get;
var
  I:Integer;
begin
  Port[$3C7]:=0;
  for I:=1 to 256*3 do
  Dac[I]:=Port[$3C9];
end;

procedure TDac.GetDac;
var
  I:Integer;
begin
  Port[$3C7]:=0;
  for I:=1 to 256*3 do
  NewDac[I]:=Port[$3C9];
end;

procedure TDac.SetDac;
var
  I:Integer;
begin
  Port[$3C8]:=0;
  for I:=1 to 256*3 do
  Port[$3C9]:=dac[I];
end;

procedure TDac.SetLoDac;
var
  I:Integer;
begin
  Port[$3C8]:=0;
  for I:=1 to 16*3 do
  Port[$3C9]:=dac[I];
end;

procedure TDac.Clear;
var
  I:Integer;
begin
  Port[$3C8]:=0;
  for I:=1 to 256*3 do
  Port[$3C9]:=0;
end;

procedure TDac.SetNewDac;
var
  I:Integer;
begin
  Port[$3C8]:=0;
  for I:=1 to 256*3 do
  Port[$3C9]:=NewDac[I];
end;

procedure TDac.SplashOneColor(Col:Integer);
begin
  Spc1:=(Spc1+1) mod 63;
  if Spc1=0 then
  begin
    Spc2:=(Spc2+1) mod 63;
    if Spc2=0 then
      Spc3:=(Spc3+1) mod 63;
  end;
  Port[$3C8]:=Col;
  Port[$3C9]:=Spc1;
  Port[$3C9]:=Spc2;
  Port[$3C9]:=Spc3;
end;

procedure TDac.Appear(T:Integer);
var
  R,G,B:Word;
  R_Ok,G_Ok,B_Ok:Boolean;
  I,J:Integer;
begin
  for I:=1 to 256*3 do
  Plate[I]:=0;
  for J:=0 to 63 do
  begin
    for I:=0 to 63 do
    begin
      r:=i*3+1;g:=i*3+2;b:=i*3+3;
      port[$3c8]:=i;
      port[$3c9]:=plate[r];
      port[$3c9]:=plate[g];
      port[$3c9]:=plate[b];
      if (plate[r]<dac[r]) and (dac[r]>=dac[b]-plate[b])
         and (dac[r]>=dac[g]-plate[g]) then
         r_ok:=true else r_ok:=false;
      if (plate[g]<dac[g]) and (dac[g]>=dac[r]-plate[r])
         and (dac[g]>=dac[b]-plate[b]) then
         g_ok:=true else g_ok:=false;
      if (plate[b]<dac[b]) and (dac[b]>=dac[r]-plate[r])
         and (dac[b]>=dac[g]-plate[g]) then
         b_ok:=true else b_ok:=false;
      if r_ok then plate[r]:=plate[r]+1;
      if g_ok then plate[g]:=plate[g]+1;
      if b_ok then plate[b]:=plate[b]+1;
    end;
    Delay(T);
  end;
end;

procedure TDac.DisAppear(T:Integer);
var
  I,J:Integer;
begin
  for j:=63 downto 0 do
  begin
    for i:=0 to 63 do
    begin
      port[$3c8]:=i;
      port[$3c9]:=plate[i*3+1];
      port[$3c9]:=plate[i*3+2];
      port[$3c9]:=plate[i*3+3];
      if plate[i*3+1]>0 then plate[i*3+1]:=plate[i*3+1]-1;
      if plate[i*3+2]>0 then plate[i*3+2]:=plate[i*3+2]-1;
      if plate[i*3+3]>0 then plate[i*3+3]:=plate[i*3+3]-1;
    end;
    Delay(T);
  end;
end;

procedure TDac.OneColor(Num:Integer;Red,Green,Blue:Byte);
begin
  Dac[Num*3-2]:=Red;
  Dac[Num*3-1]:=Green;
  Dac[Num*3]:=Blue;
  SetDac;
end;

end.