一大波技巧性代码...

禁止程序切换:

{
将Form的FormStyle属性设为fsStayOnTop 
将Form的WindowState属性设为wsMaximized 
在Form的OnCreate事件处理过程中为Windows发送一个屏幕保护程序正在运 
行的消息 
当程序结束时清除屏幕保护程序运行标志。 
}

procedure TForm1.FormCreate(Sender: TObject); 
var
  nTmp: Integer; 
begin 
  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @nTmp, 0); 
end; 

procedure Form1.OnClose(Sender: TObject; var Action: TCloseAction); 
var 
  nTmp: Integer; 
begin 
  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @nTmp, 0); 
end; 

 

得到窗口移动事件:

private
    procedure WMMove(var Msg: TMessage); message WM_MOVE;
    procedure WMMoving(var Msg: TMessage); message WM_MOVING;


procedure Tfrm_new.WMMove(var Msg: TMessage);
begin
  inherited;
  Caption := '移动完毕';
end;
procedure TFrm_new.WMMoving(var Msg: TMessage);
begin
  inherited;
  Caption := '正在移动';
end;

 

限制鼠标移动范围:

var
  nRC: TRect;
begin
  nRC := Button1.BoundsRect; {限制到Button1的区域内}
  MapWindowPoints(Button1.Parent.Handle, 0, nRC, 2); {座标换算}
  ClipCursor(@nRC); {限制鼠标移动区域，API函数}
end;


begin
  ClipCursor(nil); {解除限制}
end;

 

类似MSN那样, 显示/隐藏标题栏:

{显示}
var
  nH: Integer;
begin
  DisableAlign;
  nH := GetSystemMetrics(SM_CYCAPTION); {获取标题栏高度}
  SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle ,GWL_STYLE) or WS_CAPTION);
  SetBounds(Left, Top - nH, Width, Height + nH);
  EnableAlign;
end;


{隐藏}
var
  nH: Integer;
begin
  DisableAlign;
  nH := GetSystemMetrics(SM_CYCAPTION); {获取标题栏高度}
  SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) AND NOT WS_CAPTION);
  SetBounds(Left, Top + nH, Width, Height - nH);
  EnableAlign;
end;

 

修改文件时间属性(创建/访问/修改):

TFileTimeType = (fttCreation, fttLastAccess, fttLastWrite);

function GetFileDateTime(const FileName: string; FileTimeType: TFileTimeType): TDateTime;
var
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;
  DosDateTime: Integer;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      case FileTimeType of
      fttCreation:
        FileTimeToLocalFileTime(FindData.ftCreationTime, LocalFileTime);
      fttLastAccess:
        FileTimeToLocalFileTime(FindData.ftLastAccessTime, LocalFileTime);
      fttLastWrite:
        FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      end;
      if FileTimeToDosDateTime(LocalFileTime, LongRec(DosDateTime).Hi,
        LongRec(DosDateTime).Lo) then 
      begin
        Result := FileDateToDateTime(DosDateTime);
        Exit;
      end;
    end;
  end;
  Result := -1;
end;

function SetFileDateTime(const FileName: string; FileTimeType: TFileTimeType; DateTime: TDateTime): Integer;
var
  Handle: THandle;
  LocalFileTime, FileTime: TFileTime;
  DosDateTime: Integer;
  I : TFileTimeType;
  FileTimes: array[TFileTimeType] of Pointer;
begin
  Result := 0;
  DosDateTime := DateTimeToFileDate(DateTime);
  Handle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone);
  if Handle <> INVALID_HANDLE_VALUE then
  try
    for I := fttCreation to fttLastWrite do
      FileTimes[I] := nil;
    DosDateTimeToFileTime(LongRec(DosDateTime).Hi, LongRec(DosDateTime).Lo, LocalFileTime);
    LocalFileTimeToFileTime(LocalFileTime, FileTime);
    FileTimes[FileTimeType] := @FileTime;
    if SetFileTime(Handle, FileTimes[fttCreation], FileTimes[fttLastAccess],
      FileTimes[fttLastWrite]) then Exit;
  finally
    FileClose(Handle);
  end;
  Result := GetLastError;
end;

 

选择文件夹:

uses shlobj

function SelectDirectoryX(AHandle: HWND; const ACaption: string;
    const ARoot: WideString; var ADirectory: string): Boolean;
var
  lpbi: _browseinfo;
  buf: array [0..MAX_PATH] of Char;
  id: IShellFolder;
  eaten, att: Cardinal;
  rt: PItemIDList;
  nInitDir: PWideChar;
begin
  Result := False;
  lpbi.hwndOwner := AHandle;
  lpbi.lpfn := nil;
  lpbi.lpszTitle := PChar(ACaption);
  lpbi.ulFlags := BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE;  
  SHGetDesktopFolder(id);
  nInitDir := PWideChar(ARoot);
  id.ParseDisplayName(0, nil, nInitDir, eaten, rt, att);
  lpbi.pidlRoot := rt;
  GetMem(lpbi.pszDisplayName, MAX_PATH);
  try
    Result := SHGetPathFromIDList(SHBrowseForFolder(lpbi), buf);
  except
    FreeMem(lpbi.pszDisplayName);
  end;
  if Result then
        ADirectory := buf;
end;

 

读取外部拖拽进来的文件列表:

uses
    ShellAPI;

    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;


procedure TForm1.WMDropFiles(VAR Msg: TWMDropFiles);
var
  i: Cardinal;
  nBuffer: array[0..255] of Char;
  nExtStr, nFileName: string;
  nCount: Integer;
  nList: array of String;
begin
  with Msg do
  begin
    nCount := DragQueryFile(Drop, $FFFFFFFF, nBuffer, 1);
    SetLength(nList, nCount);
    for i := 0 to nCount - 1 do
    begin
      DragQueryFile(Drop, i, nBuffer, SizeOf(nBuffer));
      nList[i] := nBuffer;
    end;
    DragFinish(Drop);
  end;
  if Length(nList) > 0 then
    DoLoad(nList[0]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, True);
end;

 

读取文件属性信息:

type
  {文件版本信息}
  TFileInfo = packed record
    CommpanyName: string;
    FileDescription: string;
    FileVersion: string;
    InternalName: string;
    LegalCopyright: string;
    LegalTrademarks: string;
    OriginalFileName: string;
    ProductName: string;
    ProductVersion: string;
    Comments: string;
    VsFixedFileInfo: VS_FIXEDFILEINFO;
    UserDefineValue: string;
    DBVersion: string;
    VersionDesc: string;
  end;

function GetFileInfo(const AFileName: string; var AInfo: TFileInfo;
  AUserDefine: string = ''): Boolean;
const
  SFInfo = '\StringFileInfo\';
var
  nVersionInfo: Pointer;
  nInfoSize: Cardinal;
  nInfoPointer: Pointer;
  nTranslation: Pointer;
  nVersionValue: string;
  nHandle: Cardinal;
begin
  nHandle := 0;
  Result := False;
  nInfoSize := GetFileVersionInfoSize(PChar(AFileName), nHandle);
  if nInfoSize = 0 then
    Exit;

  GetMem(nVersionInfo, nInfoSize);
  try
    if not GetFileVersionInfo(pchar(AFileName), 0, nInfoSize, nVersionInfo) then
      Exit;

    VerQueryValue(nVersionInfo, '\VarFileInfo\Translation', nTranslation, nInfoSize);
    nVersionValue := SFInfo + IntToHex(LoWord(Longint(nTranslation^)), 4) + IntToHex(HiWord(Longint(nTranslation^)), 4) + '\';
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'CompanyName'), nInfoPointer, nInfoSize);
    AInfo.CommpanyName := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'FileDescription'), nInfoPointer, nInfoSize);
    AInfo.FileDescription := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'FileVersion'), nInfoPointer, nInfoSize);
    AInfo.FileVersion := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'InternalName'), nInfoPointer, nInfoSize);
    AInfo.InternalName := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'LegalCopyright'), nInfoPointer, nInfoSize);
    AInfo.LegalCopyright := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'LegalTrademarks'), nInfoPointer, nInfoSize);
    AInfo.LegalTrademarks := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'OriginalFileName'), nInfoPointer, nInfoSize);
    AInfo.OriginalFileName := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'ProductName'), nInfoPointer, nInfoSize);
    AInfo.ProductName := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'ProductVersion'), nInfoPointer, nInfoSize);
    AInfo.ProductVersion := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'Comments'), nInfoPointer, nInfoSize);
    AInfo.Comments := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'DBVersion'), nInfoPointer, nInfoSize);
    AInfo.DBVersion := string(pchar(nInfoPointer));
    VerQueryValue(nVersionInfo, pchar(nVersionValue + 'VersionDesc'), nInfoPointer, nInfoSize);
    AInfo.VersionDesc := string(pchar(nInfoPointer));

    if VerQueryValue(nVersionInfo, '\', nInfoPointer, nInfoSize) then
      AInfo.VsFixedFileInfo := TVSFixedFileInfo(nInfoPointer^);
    if AUserDefine <> '' then
    begin
      if VerQueryValue(nVersionInfo,pchar(nVersionValue + AUserDefine), nInfoPointer,nInfoSize) then
        AInfo.UserDefineValue := string(PChar(nInfoPointer));
    end;
    Result := True;
  finally
    FreeMem(nVersionInfo);
  end;
end;

 

创建快捷方式:

uses
  ShlObj, ComObj, ActiveX;

{参数说明
AFile: 执行文件(含全路径)
AArguments: 启动参数
ALinkCaption: 快捷方式名称
ADescription: 快捷方式描述
ALinkPath: 快捷方式目录}
procedure CreateLinkFile(AFile, AArguments, ALinkCaption, ADescription: string;
  ALinkPath: String = '');
var
  nIShellLink: IShellLink;
  nIPFile: IPersistFile;
  nLKFile: string;
  i: integer;
begin
  if SUCCEEDED(CoInitialize(nil)) then
  Try
    nIShellLink := CreateComObject(CLSID_ShellLink) as IShellLink;
    nIPFile  := nIShellLink as IPersistFile;

    if ALinkPath = '' then
      ALinkPath := ExtractFilePath(AFile);

    with nIShellLink do
    begin
      SetPath(PChar(AFile)); //执行程序的文件名
      SetDescription(PChar(ADescription)); //提示说明文本
      SetWorkingDirectory(PChar(ExtractFilePath(AFile))); //启动目录
      SetArguments(PChar(AArguments));
    end;

    nLKFile := ALinkPath + ALinkCaption + '.lnk';
    if FileExists(nLKFile) then //如果文件名存在，就以数据序号来重新命名一个新的文件名
    begin
      i := 1;
      repeat
        nLKFile := ALinkPath + ALinkCaption + '(' + IntToStr(i)+ ').lnk';
        Inc(i);
      until not FileExists(nLKFile);
    end;

    nIPFile.Save(PWChar(WideString(nLKFile)), False);
  finally
    CoUninitialize;
  end;
end;