常用 delphi code

//延时函数，MSecs单位为毫秒(千分之1秒)
procedure Delay(MSecs: Longint);
var
  FirstTickCount, Now: Longint;
begin
  FirstTickCount := GetTickCount();
  repeat
    Application.ProcessMessages;
    Now := GetTickCount();
  until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount);
end;

 

// 十六进制转换成字符串
function HexToString(H: String): String;
var I: Integer;
begin
Result:= '';
 for I := 1 to length (H) div 2 do
    Result:= Result+Char(StrToInt('$'+Copy(H,(I-1)*2+1,2)));
end;

 

function BinToInt(a_bin: String; a_reverse: Boolean=False): Integer;
var
  v_i,v_len,v_t: Integer;
begin
  v_len := Length(a_Bin);
  Result := 0;
  if not a_reverse then
    for v_i := v_Len downto 1 do
    begin
      v_t := StrToInt(a_Bin[v_i]);
      if v_t = 1 then
        Result := Result+Trunc(power(2,v_Len-v_i));
    end
  else
    for v_i := 1 to v_Len do
    begin
      v_t := StrToInt(a_Bin[v_i]);
      if v_t = 1 then
        Result := Result+Trunc(power(2,v_i-1));
    end;
end;

 

//文件读写

procedure saveListViewToFile(listview : TListView;fileName : string);
var
  item   : TListItem;
  Column : TListColumn;
  i ,j   : integer;
  line   : string;

  FileHandle : Integer;
  F:textfile;
begin
  if (listview = nil) then exit;
  if (listview.Items.Count <= 0) then exit;

  if FileExists(fileName)  then  DeleteFile(fileName);
  FileHandle := FileCreate(FileName);
  if (FileHandle <= 0) then exit;
  FileClose(FileHandle);

  assignFile(f,fileName);
  append(f);

  //保存标题
  line := '';
  for i := 0 to listview.Columns.Count -1 do
  begin
    Column := listview.Columns.Items[i];
    line := line + Column.Caption + #9;
  end;
  writeln(f,line);

  //保存数据
  for i := 0 to listview.Items.Count -1 do
  begin
    line := '';
    item := listview.Items.Item[i];
    line := item.Caption + #9;
    for j := 0 to item.SubItems.Count -1 do
    begin
      line := line + item.SubItems.Strings[j] + #9;
    end;
    writeln(f,line);
  end;

  closefile(f);
end;

procedure splitString(s : string;strlist : TStringList;splitTag : string);
var
  indexbegin ,i ,len : integer;
  str : string;
begin
  len := length(s);
  indexbegin := 1;
  for i := 1 to len do
  begin
    if copy(s,i,1) = splitTag then
    begin
      str :=copy(s,indexbegin,i - indexbegin);
      strlist.Add(str);
      indexbegin := i +1;
    end;
  end;
  strlist.Add(copy(s,indexbegin,len - indexbegin));
end;

procedure loadListViewFromFile(listview : TListView;fileName : string);
var
  item   : TListItem;
  j   : integer;
  line   : string;
  F:textfile;
  strlist : TStringList;
  splitTag : string;
begin
  if (listview = nil) then exit;
  if FileExists(fileName) = false then  exit;

  assignFile(f,fileName);
  Reset(f);

  //添加标题
  Readln(f,line);
  if line = '' then exit;

  strlist := TStringList.Create;

  splitTag := #9;
  Readln(f,line);
  while line <> '' do
  begin
    splitString(line,strlist,splitTag);
    item := listview.Items.Add;
    item.Caption := strlist[0];
    for j := 1 to strlist.Count -1 do
    begin
      item.SubItems.Add(strlist[j]);
    end;
    strlist.Clear();
    Readln(f,line);
  end;
  strList.Free;
end;

 

//把字符串转换成16进制表示
function GetHexString(AStr: String; ASepStr: String): String;
var
  v_i: Integer;
begin
  Result := '';
  for v_i := 1 to Length(AStr) do
    Result := Result + IntToHex(Ord(AStr[v_i]),2) + ASepStr;
end;

 

 

//当前进程占用内存大小（字节）
function CurrentMemoryUsage: Cardinal;
var
  pmc: TProcessMemoryCounters;
begin
   pmc.cb := SizeOf(pmc) ;
   if GetProcessMemoryInfo(GetCurrentProcess, @pmc, SizeOf(pmc)) then
     Result := pmc.WorkingSetSize
   else
     RaiseLastOSError;
end;

 

procedure TForm1.FormCreate(Sender: TObject);
begin
 // with Form1 do
    SetWindowPos(Handle,
                 HWND_TOPMOST,
                                //hWndInsertAfter参数设置为HWND_TOPMOST
                 Left,
                 Top,
                 Width,
                 Height,
                                        //窗体的位置和尺寸不变
                 SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
                                        //SWP_NOACTIVATE：不激活窗体
                                        //SWP_NOMOVE：保持窗体当前位置，忽略X和Y参数
                                        //SWP_NOSIZE：保持窗体当前尺寸，忽略cx 和cy参数
 
end;

//消息机制

WM_Message = WM_USER + 4010;

procedure TFrm.WMMessage(var AMsg: TMessage);
var
  sMessage: string;
begin
  sMessage := PChar(AMsg.WParam);
  FreeMem(PChar(AMsg.WParam));
  if AMsg.LParam = 0 then
     Label6.Caption:=sMessage
  else if AMsg.LParam = 1 then
     Label7.Caption:=sMessage;

end;

 

procedure SendException(sLog:string);
var
  pLogBuf3:PChar;
begin
    GetMem(pLogBuf3, Length(sLog)+1);
    CopyMemory(@pLogBuf3[0], @sLog[1], Length(sLog));
    pLogBuf3[Length(sLog)] := #0;
    SendMessage(MainFrm.Handle, WM_Message, WParam(@pLogBuf3[0]), 4);
end;

 

//读写UTF-8文本

procedure SaveUTF8File(AContent:string;AFileName: string);
var
  ffileStream:TFileStream;
  futf8Bytes: string;
  S: string;
begin
  ffileStream:=TFileStream.Create(AFileName,fmCreate);
  futf8Bytes:= UTF8Encode(AContent);
  S:=#$EF#$BB#$BF;
  ffileStream.Write(S[1],Length(S));
  ffileStream.Write(futf8Bytes[1],Length(futf8Bytes));
  ffileStream.Free;
end;

function  LoadUTF8File(AFileName: string): string;
var
  ffileStream:TFileStream;
  fAnsiBytes: string;
  S: string;
begin
  ffileStream:=TFileStream.Create(AFileName,fmOpenRead);
  SetLength(S,ffileStream.Size);
  ffileStream.Read(S[1],Length(S));
  fAnsiBytes:= UTF8Decode(Copy(S,4,MaxInt));
  Result:= fAnsiBytes;
end;