functions.pas

六路三十二次谐波信号发生器 可产生三十次以下任何谐波叠加的波形

unit functions;

interface
uses Windows,math, Classes,SysUtils,StrUtils,Forms,comobj,dialogs;
  procedure EnumComPorts(Ports: TStrings);
  function StrToHexStr(const S:string):string;
  function HexStrToStr(const S:string):string;
  function GetMaxInArray(A: array of double): double;
  function CRC(const S:string):string;stdcall;
  function   HexToDec(HexData:   Integer):   Integer;
 

implementation






procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(
    HKEY_LOCAL_MACHINE,
    'HARDWARE\DEVICEMAP\SERIALCOMM',
    0,
    KEY_READ,
    KeyHandle);

  if ErrCode <> ERROR_SUCCESS then
    Exit;  // raise EComPort.Create(CError_RegError, ErrCode);

  TmpPorts := TStringList.Create;
  try
    Index := 0;
    repeat
      ValueLen := 256;
      DataLen := 256;
      SetLength(ValueName, ValueLen);
      SetLength(Data, DataLen);
      ErrCode := RegEnumValue(
        KeyHandle,
        Index,
        PChar(ValueName),
        Cardinal(ValueLen),
        nil,
        @ValueType,
        PByte(PChar(Data)),
        @DataLen);

      if ErrCode = ERROR_SUCCESS then
      begin
        SetLength(Data, DataLen);
        TmpPorts.Add(Data);
        Inc(Index);
      end
      else
        if ErrCode <> ERROR_NO_MORE_ITEMS then
          exit;

    until (ErrCode <> ERROR_SUCCESS) ;

    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;

end;




//求最大值
function GetMaxInArray(A: array of double): double;
var
I: integer;
tmpMax: double;
begin
tmpMax := A[0];

for I := low(A) to High(A) do
begin
if A[I] > tmpMax then tmpMax := A[I];
end;

Result := tmpMax;
end;

function CRC(const S:string):string;
var
CRCcode:Word;
TT,Flg:Byte;
i,j:integer;
begin
  i:=1;
  CRCcode:=strtoint('$FFFF');
  while i<=(length(S)-1) do
  begin
     TT:=strtoint('$'+S[i]+s[i+1]);
     i:=i+2;
     CRCcode:=CRCcode xor TT;
     for j:=0 to 7 do 
     begin
       Flg:=CRCcode and 1;
       CRCcode:=CRCcode shr 1;
       CRCcode:=CRCcode and strtoint('$7fff');
       if(Flg=1) then CRCcode:=CRCcode xor strtoint('$a001');
       CRCcode:=CRCcode and strtoint('$ffff');
     end;
  end;
  Result:=InttoHex(CRCcode and strtoint('$ff'),2);
  Result:=Result+InttoHex(CRCcode div strtoint('$100'),2);


end;
function StrToHexStr(const S:string):string;
var
  I:Integer;
begin
  for I:=1 to Length(S) do
  begin
    if I=1 then
      Result:=IntToHex(Ord(S[1]),2)
    else Result:=Result+' '+IntToHex(Ord(S[I]),2);
  end;
end;
function HexStrToStr(const S:string):string;
var
  t:Integer;
  ts:string;
  M,Code:Integer;
begin
  t:=1;
  Result:='';
  while t<=Length(S) do
  begin
    while (t<=Length(S)) and (not (S[t] in ['0'..'9','A'..'F','a'..'f'])) do
      inc(t);
    if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
      ts:='$'+S[t]
    else
      ts:='$'+S[t]+S[t+1];
    Val(ts,M,Code);
    if Code=0 then
      Result:=Result+Chr(M);
    inc(t,2);
  end;
end;

function   HexToDec(HexData:   Integer):   Integer;
  var   m:   Integer;   
  begin   
      Result   :=   0;   
      m   :=   Trunc(Power(10,   Length(IntToStr(HexData))   -   1));
      while   m   >   0   do   
      begin   
          Result   :=   (Result*16   +   HexData   div   m);   
          HexData   :=   HexData   mod   m;   
          m   :=   m   div   10;   
      end;   
  end;

end.