Delphi解决刷新闪烁、图片文字透明、报告内存泄露……

1.防止刷新时闪烁的终极解决办法

 

{ 防止刷新时闪烁的终极解决办法(对付双缓冲无效时) }
  Perform($000B,  0, 0);  //锁屏幕  防止闪烁

  // 做一些会发生严重闪烁的事情..

  //解锁屏幕并重画
  Perform($000B, 1, 0 );
  RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE + RDW_ALLCHILDREN + RDW_NOINTERNALPAINT);

 

 

2.图片上显示透明文字

 

//图片上显示透明的文字
//直接用.Canvas.Brush.Style:=bsClear;
//然后.Canvas.TextOut(x,y,'文字显示透明');
procedure  TForm1.Button1Click(Sender: TObject);
var
  bitBuf:TBitmap;
begin
  bitBuf : =  TBitmap.Create;
  try
    bitbuf.LoadFromFile( '测试图片.bmp' );
    Self.Canvas.Draw(0,0 ,bitbuf);

    bitbuf.Transparent :=  True;
    bitbuf.TransparentColor := clWhite;     //文字显示透明
    bitbuf.Canvas.font.color := clBlue;     //文字颜色
    bitbuf.Canvas.TextOut( 10,10,'这样就是透明的字了！' );

    Self.Canvas.Draw(0,0 ,bitbuf);
  finally
    bitBuf.Free;
   end ;
end;

 

 

3.取得本机IP地址(精简版)

 

//取得本地IP地址(精简版)
//注：使用函数前需要 WSAStartup($202, wsdata);
function  GetLocalIP(): String;
var
  HostName:  array[0..255] of  Char;
  HostEnt: PHostEnt;
begin
  Result : = '' ;
  if gethostname(HostName, 255) = 0 then
   begin
    HostEnt : =  gethostbyname(HostName);
    Result :=  StrPas(inet_ntoa(PInAddr(PInAddr(HostEnt^.h_addr_list)^)^));
  end ;
end;

 

 

4.报告内存泄漏

 

  // 在程序中加上这句，当退出时会报告内存泄漏
  ReportMemoryLeaksOnShutdown : = True;

 

 

5.释放资源文件

 

// 首先加入.RC文件，写上 MyDLL DAT testDLL.dll
// 然后程序里 ExtractRes('DAT','MyDLL','123DLL.dll');
procedure  ExtractRes(ResType, ResName, ResNewName:String);
var  Res:TResourceStream;
begin
  Res: = TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
  try
    Res.SavetoFile( './'+ ResNewName);  // 释放到当前目录
   finally
    Res.Free;
   end ;
end;

 

 

6.延时

 

// 模仿VB里DoEvents的延时
procedure Delay(const  uDelay: DWORD);
var
  n: DWORD;
begin
  n : =  GetTickCount;
  while ( (GetTickCount - n) <= uDelay ) do
    Application.ProcessMessages;
end ;

 

 

7.标准C中的 itoa() 函数Delphi版，将Int型变量转化为(radix)进制输出

 

//二进制   itoa(i, 2);
//八进制   itoa(i, 8);
//十六进制 itoa(i, 16);
function  itoa(aData, radix: Integer): String;
var
  t: Integer;
begin
  Result : = '' ;
  repeat
    t : = aData mod  radix;
    if t < 10 then
      Result : = InttoStr(t)+ Result
    else
      Result : = InttoHex(t, 1)+ Result;
    aData := aData div  radix;
  until (aData = 0 );
end ;

 

 

8.程序删除自身

 

// 利用批处理文件构造一个循环，只要在 OnClose() 中调用 DeleteMe() 就可以删除自身
procedure  DeleteMe();
var
  BatchFile: TextFile;
  BatchFileName:  string ;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  BatchFileName : = ExtractFilePath(ParamStr(0)) + '_deleteme.bat' ;
  AssignFile(BatchFile, BatchFileName);
  Rewrite(BatchFile);

  Writeln(BatchFile, ':try' );
  Writeln(BatchFile, 'del "' + ParamStr(0) + '"' );
  Writeln(BatchFile,
    'if exist "' + ParamStr(0) + '"' + ' goto try' );
  Writeln(BatchFile, 'del %0' );
  CloseFile(BatchFile);

  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00 );
  StartUpInfo.dwFlags :=  STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow :=  SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then
   begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
   end ;
end;