misc.pas

=== === === MiniHex 1.61 源程序说明 ============================== “$(MiniHex)Source”目录中的所有

unit Misc;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  ShellApi, ShlObj, ActiveX;

procedure SwapInt(var V1, V2: Integer);
function IsInt(const S: string): Boolean;
function IsFloat(const S: string): Boolean;
procedure SetStayOnTop(Form : TForm; Setting : Boolean);
function GetWindowsDir: string;
function GetWinTempDir: string;
function GetWinUserName: string;
function GetFullFileName(const FileName: string): string;
function AddDirSuffix(Dir: string): string;
function AddThoundandFlag(Num: Integer): string;
function GetSizeString(Bytes: Integer): string;
procedure BeginWait;
procedure EndWait;
function GetFileSize(FileName: string): Integer;
function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean;
function GetFileIcon(const FileName: string; var Icon: TIcon): Boolean;
function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime;
function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime;
function GetWorkAreaRect: TRect;
function SelectDir(ParentHWnd: HWND; const Caption: string; const Root: WideString; var Path: string): Boolean;
function CheckWindows9598: Boolean;
function CreateBakFile(const FileName: string; const Ext: string = 'bak'): Boolean;
function ExecuteFile(FileName, Params, DefaultDir: string; ShowCmd: Integer): HWND;
function MsgBox(const Msg: string; Flags: Integer = MB_OK + MB_ICONINFORMATION): Integer;
function RestrictStrWidth(const S: WideString; Canvas: TCanvas; Width: Integer): WideString;

implementation

procedure SwapInt(var V1, V2: Integer);
var
  Temp: Integer;
begin
  Temp := V1;
  V1 := V2;
  V2 := Temp;
end;

function IsInt(const S: string): Boolean;
var
  E, R: Integer;
begin
  Val(S, R, E);
  Result := E = 0;
  E := R; //avoid hints
end;

function IsFloat(const S: string): boolean;
var
  V: Extended;
begin
  Result := TextToFloat(PChar(S), V, fvExtended);
end;

procedure SetStayOnTop(Form : TForm; Setting : Boolean);
begin
  if Setting Then
    SetWindowPos(Form.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
  else
    SetWindowPos(Form.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE);
end;

function GetWindowsDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
begin
  GetWindowsDirectory(Buf, MAX_PATH);
  Result := AddDirSuffix(Buf);
end;

function GetWinTempDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH, Buf);
  Result := AddDirSuffix(Buf);
end;

function GetWinUserName: string;
var
  Buf: array[0..255] of Char;
  Len: DWord;
begin
  Len := 255;
  GetUserName(Buf, Len);
  Result := Buf;
end;

function GetFullFileName(const FileName: string): string;
var
  Buf: array[0..255] of Char;
  FileNamePtr: PChar;
  Len: DWord;
begin
  Len := 255;
  GetFullPathName(PChar(FileName), Len, Buf, FileNamePtr);
  Result := Buf;
end;

function AddDirSuffix(Dir: string): string;
begin
  Result := Trim(Dir);
  if Result='' then exit;
  if Result[Length(Result)]<>'\' then Result := Result+'\';
end;

function AddThoundandFlag(Num: integer): string;
var
  Temp: Double;
begin
  Temp := Num;
  Result := Format('%.0n', [Temp]);
end;

function GetSizeString(Bytes: Integer): string;
var
  Temp: Double;
begin
  if Bytes > 0 then
  begin
    Temp := Bytes div 1024;
    if Bytes mod 1024 <> 0 then Temp := Temp + 1;
  end else
    Temp := 0;
  Result := Format('%s KB', [Format('%.0n', [Temp])]);
end;

procedure BeginWait;
begin
  Screen.Cursor := crHourGlass;
end;

procedure EndWait;
begin
  Screen.Cursor := crDefault;
end;

function GetFileSize(FileName: string): Integer;
var
  FileVar: file of Byte;
begin
  {$I-}
  try
    AssignFile(FileVar, FileName);
    Reset(FileVar);
    Result := FileSize(FileVar);
    CloseFile(FileVar);
  except
    Result := 0;
  end;
  {$I+}
end;

function SetFileDate(FileName: string; CreationTime, LastWriteTime, LastAccessTime: TFileTime): Boolean;
var
  FileHandle : Integer;
begin
  FileHandle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone);
  if FileHandle > 0 then
  begin
    SetFileTime(FileHandle, @CreationTime, @LastAccessTime, @LastWriteTime);
    FileClose(FileHandle);
    Result := True;
  end else
    Result := False;
end;

//-----------------------------------------------------------------------------
// 描述: 取得与文件相关的图标
// 参数:
//   FileName - 文件名。e.g. "c:\a.txt"
//   Icon     - 存放图标。应事先分配好内存。
// 返回:
//   True  - 成功
//   False - 失败
//-----------------------------------------------------------------------------
function GetFileIcon(const FileName: string; var Icon: TIcon): Boolean;
var
  SHFileInfo: TSHFileInfo;
  h: HWnd;
begin
  h := SHGetFileInfo(PChar(FileName),
        0,
        SHFileInfo,
        SizeOf(SHFileInfo),
        SHGFI_ICON or SHGFI_SYSICONINDEX);
  Icon.Handle := SHFileInfo.hIcon;
  Result := (h <> 0);
end;

function FileTimeToLocalSystemTime(FTime: TFileTime): TSystemTime;
var
  STime: TSystemTime;
begin
  FileTimeToLocalFileTime(FTime, FTime);
  FileTimeToSystemTime(FTime, STime);
  Result := STime;
end;

function LocalSystemTimeToFileTime(STime: TSystemTime): TFileTime;
var
  FTime: TFileTime;
begin
  SystemTimeToFileTime(STime, FTime);
  LocalFileTimeToFileTime(FTime, FTime);
  Result := FTime;
end;

function GetWorkAreaRect: TRect;
begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
end;

{$WRITEABLECONST ON}
//-----------------------------------------------------------------------------
// 描述: 浏览文件夹，可定位文件夹
// 参数:
//   ParentHWnd - 父窗口的句柄
//   Caption    - 浏览对话框的提示标题
//   Root       - 根目录
//   Path       - 存放用户最终选择的目录
// 返回:
//   True  - 用户点了确定
//   False - 用户点了取消
//-----------------------------------------------------------------------------
function SelectDir(ParentHWnd: HWND; const Caption: string;
  const Root: WideString; var Path: string): Boolean;
const
  InitPath: string = '';
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;

  function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: Cardinal; lpData: Cardinal):Integer; stdcall;
  var
    R: TRect;
  begin
    if uMsg = BFFM_INITIALIZED then
    begin
      GetWindowRect(hwnd, R);
      MoveWindow(hwnd,
        (Screen.Width - (R.Right - R.Left)) div 2,
        (Screen.Height - (R.Bottom - R.Top)) div 2,
        R.Right - R.Left,
        R.Bottom - R.Top,
        True);
      Result := SendMessage(hwnd, BFFM_SETSELECTION, Ord(TRUE), Longint(PChar(InitPath)))
    end else
      Result := 1;
  end;

begin
  Result := False;
  InitPath := Path;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
  begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList := nil;
      if Root <> '' then
      begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
          POleStr(Root), Eaten, RootItemIDList, Flags);
      end;
      with BrowseInfo do
      begin
        hwndOwner := ParentHWnd;
        pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
        ulFlags := BIF_RETURNONLYFSDIRS;
        lpfn :=@BrowseCallbackProc;
        lParam :=BFFM_INITIALIZED;
      end;
      WindowList := DisableTaskWindows(0);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result :=  ItemIDList <> nil;
      if Result then
      begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Path := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;
{$WRITEABLECONST OFF}

function CheckWindows9598: Boolean;
var
  V: TOSVersionInfo;
begin
  V.dwOSVersionInfoSize := SizeOf(V);
  Result := False;
  if not GetVersionEx(V) then Exit;
  if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
    Result := True;
end;

function CreateBakFile(const FileName: string; const Ext: string): Boolean;
var
  BakFileName: string;
begin
  BakFileName := FileName + '.' + Ext;
  Result := CopyFile(PChar(FileName), PChar(BakFileName), False);
end;

function ExecuteFile(FileName, Params, DefaultDir: string; ShowCmd: Integer): HWND;
begin
  Result := ShellExecute(Application.MainForm.Handle, nil,
    PChar(FileName), PChar(Params), PChar(DefaultDir), ShowCmd);
end;

function MsgBox(const Msg: string; Flags: Integer): Integer;
begin
  Result := Application.MessageBox(PChar(Msg), PChar(Application.Title), Flags);
end;

//-----------------------------------------------------------------------------
// 描述: 缩短字符串的长度以适应显示宽度
// 参数:
//   S       - 待缩短的字符串.
//   Canvas  - 字符串所在的Canvas.
//   Width   - 最大象素宽度
// 返回:
//   缩短之后的字符串
//-----------------------------------------------------------------------------
function RestrictStrWidth(const S: WideString; Canvas: TCanvas;
  Width: Integer): WideString;
var
  Src: WideString;
begin
  Src := S;
  Result := S;
  while (Canvas.TextWidth(Result) > Width) and (Length(Result) > 0) do
  begin
    if Length(Src) > 1 then
    begin
      Delete(Src, Length(Src), 1);
      Result := Src + '...';
    end else
      Delete(Result, Length(Result), 1);
  end;
end;

end.