combas.pas

完成虚拟的多功能电能表

  exit;
 end;}
 Result:=tmpstr;
end;

Function bzb_js(dd:TMSComm;str_len:integer):String;
var
 MyVariant: Variant;
 tmpbyte:integer;
 i:integer;
 tu:Double;
 tmpstr:String;

begin
 MyVariant := VarArrayCreate([0,str_len-1], varByte);
 dd.InputMode:=1;
 dd.InputLen:=0;
 dd.RThreshold:=0;
 dd.InBufferCount:=0;
 tu := nowTime;
 repeat
   if nowTime-tu>5 then
     begin
      spkbeep(50);
      Application.MessageBox('接收中断！','警告',mb_OK+mb_ICONSTOP);
      dd.InputMode:=0;
      dd.InputLen:=1;
      dd.RThreshold:=1;
      dd.InBufferCount:=0;
      Result:='RECV_BAD';
      exit;
     end;
   DoEvents;
 until dd.InBufferCount>=str_len;
 MyVariant:=dd.Input;
 dd.InputMode:=0;
 dd.InputLen:=1;
 dd.RThreshold:=1;
 dd.InBufferCount:=0;
 tmpstr:='';
 for i:=0 to str_len-1 do
  begin
   tmpbyte:=MyVariant[i];
   if tmpbyte<>13 then tmpstr:=tmpstr+chr(tmpbyte);
  end;
// if MyVariant[str_len-1]<>ord('E') then
 if InStr(tmpstr,'YE')<>0 then
 begin
  spkbeep(50);
  Application.MessageBox('接收错误！','警告',mb_OK+mb_ICONSTOP);
  Result:='RECV_BAD';
  exit;
 end;
 Result:=tmpstr;
end;

Function sjhz(sj,dj:Double):String;
var
 tmp,tmp1:Single;
 tmpfh:ShortInt;
 tmpstr:String;
Begin
If dj = 3 Then dj := 2;
tmp := (sj / dj) * 10;
tmp1 := tmp - int(tmp);
if tmp<0 then
 tmpfh:=-1
else
 if tmp>0 then
  tmpfh:=1
 else
  tmpfh:=0;
If Abs(tmp1) > 0.5 Then
 begin
 tmp := ((Int(tmp) + tmpfh) / 10) * dj;
 end
Else
  If Abs(tmp1) < 0.5 Then
   tmp := (Int(tmp) / 10) * dj
  Else
   If not odd(Trunc(tmp))  Then
     tmp := (Int(tmp) / 10) * dj
   Else
     tmp := ((Int(tmp) + tmpfh) / 10) * dj;
If dj <0.01 Then
 tmpstr:= FormatFloat('0.0000',tmp)
else
If dj <0.1 Then
 tmpstr:= FormatFloat('0.000',tmp)
else
If dj < 1 Then
 tmpstr:= FormatFloat('0.00',tmp)
else
If dj < 10 Then
 tmpstr:= FormatFloat('0.0',tmp)
else
 tmpstr:= FormatFloat('0',tmp);
if tmp>0 then
  tmpstr:='+'+tmpstr;
//else
//  tmpstr:=tmpstr;
if StrToFloat(tmpstr)=0 then
 if sj>=0 then
  tmpstr:='+'+tmpstr
 else
  tmpstr:='-'+tmpstr;
Result:=tmpstr;
End;


function strrev(mystr:string):string;
var
 i,j:integer;
begin
Result:='';
j:=length(mystr);
for i:=0 to j-1 do
 Result:=Result+mystr[j-i];
end;

Function valsndform(sz_val:Double;sz_frm:string):String;
var
sz,tmpstr:string;
begin
 sz:=FormatFloat(sz_frm,Trunc(sz_val));
 tmpstr:= strrev(sz);
 Result := tmpstr;
End;


function predate(ndate:TDateTime;fyear:Integer):String; //计算前一天
var
 tu: TTimeStamp;
 tmpd:TDateTime;
 tmpYear,tmpmon,tmpday:Word;
begin
 tu:=DateTimeToTimeStamp(ndate);
 Inc(tu.Date,-1);
 tmpd:=TimeStampToDateTime(tu);
 decodedate(tmpd,tmpYear,tmpmon,tmpday);
 tmpyear:=tmpyear+fyear;
 try
  tmpd:=encodedate(tmpYear,tmpmon,tmpday);
 except
  tmpd:=encodedate(tmpYear,tmpmon,tmpday-1);
 end;
 Result:=FormatDateTime('yyyy"-"mm"-"dd',tmpd);
end;

{function comyes:Boolean;
var
 tu:LongInt;
 tmpval:Integer;
 try_num:integer;

 Label comagain;

begin
  try_num:=0;
comagain:
  Out_Port(input_buff,ord('T'));
  tu := nowTime;
  While True do
   begin
    If (in_port(ctl_buff) And $20) <> 0 Then break;
    If NowTime-tu>=2 then
     begin
      spkbeep(200);
      Application.MessageBox('通讯失败，请仔细检查通讯线路！','警告',mb_OK+mb_ICONSTOP);
      result:=False;
      exit;
     end;
   end;
  tu := nowTime;
  While True do
  begin
   If (in_port(ctl_buff) And $1) <> 0 Then
   begin
    tmpval:= in_port(input_buff);
    If tmpval <> ord('t') Then
    begin
     delay(1);
     Inc(try_num);
     if try_num>=5 then
     begin
      spkbeep(200);
      Application.MessageBox('通讯失败，请仔细检查通讯线路！','警告',mb_OK+mb_ICONSTOP);
      Result:= False;
      exit;
     end
     else
     GoTo comagain;
    End
    else
    begin
    Result := True;
    Exit;
    end;
   end;
   if nowTime-tu>2 then
     begin
      spkbeep(200);
      Application.MessageBox('通讯失败，请仔细检查通讯线路！','警告',mb_OK+mb_ICONSTOP);
      result:=False;;
      exit;
     end;
  end;
end;}
Function StrToFloatDef(tmp:String;tmpval:Double):Double;
begin
 try
  Result:=StrToFloat(tmp);
 except
  Result:=tmpval;
 end;
end;

Function comyes(dd:TMSComm):Boolean;
var
 tu:Double;
 tmpstr:String;
 try_num:integer;

 Label comagain;
 Label COMMERR;

begin
{if GLDEMO then begin
 result:=True;
 exit;
end;
try_num:=0;
dd.RThreshold := 0;
comagain:
dd.InBufferCount := 0;
dd.Output := 'T';
tu := nowTime;
repeat
 If nowTime - tu > 5 Then GoTo COMMERR;
Until dd.InBufferCount >= 1;
tmpstr := dd.Input;
If tmpstr <> 't' Then
begin
// delay(1);
 Inc(try_num);
 if try_num>=10 then GoTo COMMERR;
 GoTo comagain;
End;
dd.RThreshold := 1;
Result := True;
Exit;
COMMERR:
spkbeep(200);
Application.MessageBox('通讯失败，请仔细检查通讯线路！','警告',mb_OK+mb_ICONSTOP);
dd.RThreshold := 1;
Result:= False; }
End;


Procedure delay(dels:Double);
var
 tu:DWORD;
begin
tu := GetTickCount+Trunc(dels*1000);
while True do
begin
 If GetTickCount >=tu Then break;
  Doevents;
end;
end;

Function timestr(tmpval:integer):String;
var
tmph, tmpm, tmps :String;
tmpz, tmpy:Integer;
begin
 tmpz := tmpval div 3600;
 tmph:=FormatFloat('00',tmpz);
 tmpz := tmpval - tmpz * 3600;
 tmpy := tmpz div 60;
 tmpm:=FormatFloat('00',tmpy);
 tmpz := tmpz - tmpy * 60;
 tmps:=FormatFloat('00',tmpz);
 Result:= tmph+ ':' + tmpm + ':' + tmps;
End;

Function strtime(tmpval:String):Integer;
var
 tmp:Integer;
begin
 if tmpval='' then
 begin
  Result:=0;
  exit;
 end;
 tmp:= StrToInt(Mid(tmpval, 1, 2)) * 3600;
 tmp:=tmp + StrToInt(Mid(tmpval, 4, 2)) * 60;
 tmp:=tmp+ StrToInt(Mid(tmpval, 7, 2));
 Result:=tmp;
end;

Function formatstr(tmpformat,tmp:String):String;
var
 tmplen,tmplen2:Integer;
begin
tmplen:=length(tmpformat);
tmplen2:=length(tmp);
if tmplen>tmplen2 then
 Result:=Copy(tmpformat,1,tmplen-tmplen2)+tmp
else if tmplen<tmplen2 then
 Result:=Copy(tmp,tmplen2-tmplen+1,tmplen)
else
 Result:=tmp;
end; 

Function StrToHex(tmpstr:String):String;
var
  i  : Integer;
begin
Result:='';
for i:=1 to length(tmpstr) do
 Result:=Result+IntToHex(Ord(tmpstr[i]),2);
end;



Function formatdj(tmpdj:String):String;
begin
 if ((Pos('s',tmpdj)<>0) or (Pos('S',tmpdj)<>0)) then
  Result:=leftstr(tmpdj,length(tmpdj)-1)
 else
  Result:=tmpdj;
end;

procedure Doevents;
var
 s_msg:TMSG;
begin
//Applicaton.ProcessMessages;
 while (PeekMessage(s_msg,0,0,0,1)) do
 begin
  TranslateMessage(s_msg);
  DispatchMessage(s_msg);
 end;
end;

Function time_str(tmpval:integer):String;
var
tmph, tmpm, tmps :String;
tmpz, tmpy:Integer;
begin
 tmpz := tmpval div 3600;
 tmph:=IntToStr(tmpz);
 tmpz := tmpval - tmpz * 3600;
 tmpy := tmpz div 60;
 tmpm:=IntToStr(tmpy);
 tmpz := tmpz - tmpy * 60;
 tmps:=IntToStr(tmpz);
 if tmph<>'0' then
  Result:= tmph+ '小时' + tmpm + '分' + tmps+'秒'
 else if tmpm<>'0' then
  Result:= tmpm + '分' + tmps+'秒'
 else
  Result:= tmps+'秒';
End;

Function nowtime:Double;
//var
// tmp:Double;
// Present:TDateTime;
// Hour, Min, Sec, MSec:Word;
begin
// Present:= Now;
// DecodeTime(Present, Hour, Min, Sec, MSec);
// tmp:= Hour * 3600+Min*60+Sec;
// tmp:=tmp+MSec/1000;
 Result:=GetTickCount/1000;//tmp;
end;

procedure spkbeep(beepnum:Integer);
var
i:Integer;
begin
For i := 1 To 20 do
 Beep;
End;

function instr(surstr,destr:string):Integer;
begin
 Result:=Pos(destr,surstr);
end;

function mid(mystr:string;strstart,str_len:Integer):string;
begin
 Result:=copy(mystr,strstart,str_len);
end;

function leftstr(mystr:string;str_len:Integer):string;
begin
 Result:=copy(mystr,1,str_len);
end;

function rightstr(mystr:string;str_len:Integer):string;
begin
 Result:=copy(mystr,length(mystr)-str_len+1,str_len);
end;

Function getwc(wcno:Integer;wcbz:String;var wczz:String):String;
var
 tmpstr,tmpa,tmpb:String;
begin
tmpa:=wcbz+IntToStr(wcno);
tmpb:=wcbz+IntToStr(wcno+1);
tmpstr:=Mid(wczz,InStr(wczz,tmpa)+length(tmpa),
        InStr(wczz,tmpb)-InStr(wczz,tmpa)-length(tmpa));
delete(wczz,InStr(wczz,tmpa),length(tmpa));
Result:=tmpstr;
end;


Function hyval(tmpstr:String):Double;
var
 tmplen,i,tmp_dot_num:Integer;
 tmpval:string;
begin
tmplen:=length(tmpstr);
tmp_dot_num:=0;
try
strtofloat(tmpstr);
tmpval:=tmpstr;
except
for i:=1 to tmplen do
 if tmpstr[i]='.' then begin
  Inc(tmp_dot_num);
  if tmp_dot_num=2 then begin
   try
    tmpval:=copy(tmpstr,1,i-1);
   except
    tmpval:='';
   end;
   break;
  end;
 end else
 if tmpstr[i] in ['+','-'] then begin
  if i<>1 then begin
   try
    tmpval:=copy(tmpstr,1,i-1);
   except
    tmpval:='';
   end;
   break;
  end;
 end else
 if not(tmpstr[i] in ['0'..'9']) then begin
   try
    tmpval:=copy(tmpstr,1,i-1);
   except
    tmpval:='';
   end;
   break;
 end;
if tmpval='' then
 tmpval:='0'
else if tmpval='+' then
 tmpval:='0'
else if tmpval='-' then
 tmpval:='0'
else if tmpval[1]='.' then
 tmpval:='0'+tmpval;
end;
Result:=StrToFloatDef(tmpval,0);
end;

Function SetPCSystemTime(tDati: TDateTime): Boolean;
var
   tSetDati: TDateTime;
   vDatiBias: Variant;
   tTZI: TTimeZoneInformation;
   tST: TSystemTime;
begin
   GetTimeZoneInformation(tTZI);
   vDatiBias := tTZI.Bias / 1440;
   tSetDati := tDati + vDatiBias;
   with tST do
     begin
        wYear := StrToInt(FormatDateTime('yyyy', tSetDati));
        wMonth := StrToInt(FormatDateTime('mm', tSetDati));
        wDay := StrToInt(FormatDateTime('dd', tSetDati));
        wHour := StrToInt(FormatDateTime('hh', tSetDati));
        wMinute := StrToInt(FormatDateTime('nn', tSetDati));
        wSecond := StrToInt(FormatDateTime('ss', tSetDati));
        wMilliseconds := 0;
     end;
   SetPCSystemTime := SetSystemTime(tST);
end;



end.