zoukankan      html  css  js  c++  java
  • 一大波技巧性代码...

    禁止程序切换:

    {
    将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, 'VarFileInfoTranslation', 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;
  • 相关阅读:
    IOS-多线程技术
    设计模式-抽象工厂设计模式
    IOS-内存管理
    IOS-MVC的使用
    POJ2411 Mondriaan's Dream (广场铺砖问题 状压dp)
    NOIp2006T2 金明的预算方案
    POJ1179 Polygon(区间DP)
    NOIp2006T1能量项链
    美梦1(JSOI2014SC)
    TJOI2013(BZOJ3173)最长上升子序列
  • 原文地址:https://www.cnblogs.com/lzl_17948876/p/3672446.html
Copyright © 2011-2022 走看看