ホーム >プログラム >Delphiソースコード一覧 >lib >myCommon.pas
unit myCommon;
{汎用関数の詰め合わせ。}

interface
uses
  Windows;

//myFile.pas
function gfnbFolderExists(sFolder: WideString): Boolean; //DirectoryExitsのUnicode対応
function gfnbFileExists(sFile: WideString): Boolean;     //FileExitsのUnicode対応
function gfnsFileNameGet(sFile: WideString): WideString; //パスを除いたファイル名を返す
function gfniFileSizeGet(sFile: WideString): Int64;      //ファイルのサイズをByte単位で返す


//myString.pas
function gfnsStrEndFit(sSrc, sEnd: WideString): WideString; //末尾をsEndにして返す。


//myNum.pas
function gfniRoundUp  (fNum: Extended): Int64; //切り上げ
function gfniRoundDown(fNum: Extended): Int64; //切り下げ
function gfniNumLimit(iNum: Integer; iMin, iMax: Integer): Integer; //範囲制限


//mySize.pas
function gfniRectWidth (rtRect: TRect): Integer; //幅を返す
function gfniRectHeight(rtRect: TRect): Integer; //高さを返す
function gfnrcRectCenter(rcParent, rcChild: TRect): TRect;


implementation
uses
  Classes;


//------------------------------------------------------------------------------
//myFile.pas
function gfnbFolderExists(sFolder: WideString): Boolean;
//Unicode対応DirectoryExits。
var
  li_Attr: DWORD;
begin
  li_Attr := GetFileAttributesW(PWideChar(sFolder));
  Result  := ((li_Attr <> $FFFFFFFF) and ((li_Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0));
end;

function gfnbFileExists(sFile: WideString): Boolean;
//FileExistsのUnicode対応版。
var
  li_Attr: DWORD;
begin
  li_Attr := GetFileAttributesW(PWideChar(sFile));
  Result  := (li_Attr <> $FFFFFFFF) and ((li_Attr and FILE_ATTRIBUTE_DIRECTORY) = 0);
end;

function gfnsFileDriveGet(sFile: WideString): WideString ;
{2008-04-28,2009-01-21:
ドライブ名を返す。

2009-01-21:'\\?\'に対応。
}

const
  lcs_DRIVEDELIM = WideString(':');
  lcs_PATHDELIM  = WideString('\');

  function lfns_DriveGet(sDrive: WideString; iIndex: Integer): WideString;
  begin
    if (WideUpperCase(sDrive[iIndex])[1] in [WideChar('A')..WideChar('Z')]) then begin
      Result := Copy(sFile, iIndex, 2)
    end else begin
      Result := '';
    end;
  end;
  function lfns_UncGet(sDrive: WideString; iIndex, iLen: Integer): WideString;
  //UNC名を返す。
  var
    i: Integer;
    iServer: Integer;
  begin
    Result := '';
    i := iIndex;
    iServer := -1;
    while (i < iLen) do begin
      if (sDrive[i] = lcs_PATHDELIM) then begin
        if (i = iIndex) then begin
          Exit;  //サーバー名が''
        end else begin
          if (iServer <> -1) then begin
            if ((iServer + 1) = i) then begin
              Exit;  //共有フォルダ名が''
            end else begin
              Break;
            end;
          end else begin
            iServer := i;
          end;
        end;
      end;
      Inc(i);
    end;
    if (iServer <> -1) and (iServer < iLen) then begin
      if (sDrive[i] = lcs_PATHDELIM) then Dec(i);
      Result := Copy(sDrive, iIndex, i - iIndex + 1);
      if (Result <> '') then Result := '\\' + Result;
    end;
  end;
var
  li_Len: Integer;
begin
  Result := '';
  li_Len := Length(sFile);
  if (li_Len >= 2) then begin
    //2文字以上。
    //1文字以下の場合はドライブ名とはみなさない(A-Zならドライブとみなす方が良いか?)
    if (sFile[2] = lcs_DRIVEDELIM) then begin
      //C:〜など
      Result := lfns_DriveGet(sFile, 1);
    end else if (sFile[1] = lcs_PATHDELIM) and (sFile[2] = lcs_PATHDELIM) then begin
      if (li_Len >= 8) and (WideUpperCase(Copy(sFile, 1, 8)) = '\\?\UNC\') then begin
        //\\?\UNC\〜
        Result := lfns_UncGet(sFile, 9, li_Len);
      end else if (li_Len >= 3) and (sFile[3] = '?') then begin
        //\\?\〜
        if (li_Len >= 6) and (sFile[6] = lcs_DRIVEDELIM) then begin
          Result := lfns_DriveGet(sFile, 5);
        end;
      end else begin
        //\\〜 UNC
        Result := lfns_UncGet(sFile, 3, li_Len);
      end;
    end;
  end;
end;
function gfnsFileDriveCut(var sFile: WideString): WideString;
{2009-01-21:
ドライブ名を返し、残りをsFileにセットする。
}

begin
  Result := gfnsFileDriveGet(sFile);
  sFile  := gfnsStrHeadCut(Copy(sFile, Length(Result) +1, MAXINT), '\');
end;

function gfnsFileDirGet(sFile: WideString): WideString;
{2007-09-18:
Unicode対応ExtractFileDir。
ドライブ名も含む。
末尾の'\'はつかない。
ドライブ名のみの場合も'\'はつかない。
'\temp'このような場合空文字が返る。
}

var
  i: Integer;
begin
  Result := '';
  if (sFile <> '') then begin
    for i := Length(sFile) downto 1 do begin
      if (sFile[i] = '\') or (sFile[i] = '/') then begin
        Result := Copy(sFile, 1, i -1);
        Break;
      end else if (sFile[i] = ':') then begin
        Result := Copy(sFile, 1, i);
        Break;
      end;
    end;
  end;
end;

function gfnsFilePathGet(sFile: WideString): WideString;
{2007-07-27,10-26:
Unicode対応ExtractFilePath。
ドライブ名も含む。
末尾の'\'はつく。
ドライブ名のみの場合も'\'はつく。
ただしパスが空文字の場合のみ'\'はつかない。

2007-10-26:パスが空文字の場合'\'をつけないことにした。
}

var
  i: Integer;
begin
  Result := '';
  if (sFile <> '') then begin
    for i := Length(sFile) downto 1 do begin
      if (sFile[i] = '\') or (sFile[i] = '/') then begin
        Result := Copy(sFile, 1, i);
        Break;
      end else if (sFile[i] = ':') then begin
        Result := Copy(sFile, 1, i) + '\';
        Break;
      end;
    end;
  end;
end;

function gfnsFileNameGet(sFile: WideString): WideString;
{2007-08-05:
パスを除いたファイル名を返す。
拡張子はつく。
'\'はつかない。
}

var
  i, li_Len, li_Pos: Integer;
begin
  Result := '';
  if (sFile <> '') then begin
    li_Len := Length(sFile);
    li_Pos := li_Len + 1;  //sFileの最後が'\'であった場合への対策
    for i := li_Len downto 1 do begin
      if (sFile[i] = '\') or (sFile[i] = '/') or(sFile[i] = ':') then begin
        Break;
      end;
      li_Pos := i;
    end;
    Result := Copy(sFile, li_Pos, MaxInt);
  end;
end;

function gfnsFileMainGet(sFile: WideString): WideString;
{2007-08-05,10-26:
ファイル名のうちパスと拡張子を除いた部分を返す
メインファイル名の拡張子のないもの
\ と . はつかない

2007-10-26:ピリオドつきの主ファイル名の処理がうまくいっていなかったのを修正
  lb_Extを判定に追加
}

var
  i: Integer;
  lb_Ext: Boolean;  //2007-10-26
begin
  Result := '';
  lb_Ext := True;
  for i := Length(sFile) downto 1 do begin
    if (sFile[i] = '\') or (sFile[i] = '/') or (sFile[i] = ':') then begin
      //\と/と:が出てきた時点でファイル名の終了なのでループを抜ける
      Break;
    end else if (sFile[i] = '.') and (lb_Ext) then begin//2007-10-26
      //拡張子であったので今までのをチャラにする
      Result := '';
      lb_Ext := False;
    end else begin
      Result := sFile[i] + Result;
    end;
  end;
end;

function gfnsFileExtGet(sFile: WideString): WideString;
{2007-08-05,2008-12-27:
Unicode対応ExtractFileExt。
'.'は返る

2008-12-27:'.'のないファイル名のみの場合sFileすべてを返してしまう間違いを修正。
}

var
  i: Integer;
begin
  Result := '';
  for i := Length(sFile) downto 1 do begin
    if (sFile[i] = '\') or (sFile[i] = '/') or (sFile[i] = ':') then begin
      //拡張子なし
      Break;
    end else if (sFile[i] = '.') then begin;
      //拡張子あり
      Result := Copy(sFile, i, MaxInt);
      Break;
    end;
  end;
end;

function gfniFileSizeGet(sFile: WideString): Int64;
//sWFileのサイズをByte単位で返す
var
  lh_File: Cardinal;
  lr_Info: TWin32FindDataW;
begin
  Result := 0;
  lh_File := FindFirstFileW(PWideChar(sFile), lr_Info);
  try
    if (lh_File <> INVALID_HANDLE_VALUE) then begin
      repeat
        if not(BOOL(lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then begin
          Result := lr_Info.nFileSizeHigh * (Int64(MAXDWORD) + 1) + lr_Info.nFileSizeLow;
          Break;
        end;
      until not(FindNextFileW(lh_File, lr_Info));
    end;
  finally
    Windows.FindClose(lh_File);
  end;
end;


//------------------------------------------------------------------------------
//myString.pas
function gfnsStrEndFit(sSrc, sEnd: WideString): WideString;
//sSrcの末尾がsEndでなければsEndを足して返す。
begin
  if (Copy(sSrc, Length(sSrc) - Length(sEnd)+1, Length(sEnd)) <> sEnd) then begin
    Result := sSrc + sEnd;
  end else begin
    Result := sSrc;
  end;
end;


//------------------------------------------------------------------------------
//myNum.pas
function lfniCeil(X: Extended): Int64;
begin
  Result := Trunc(X);
  if Frac(X) > 0 then
    Inc(Result);
end;
function lfniFloor(X: Extended): Int64;
begin
  Result := Trunc(X);
  if Frac(X) < 0 then
    Dec(Result);
end;

function gfniRoundUp(fNum: Extended): Int64;
{2007-06-09:
fNumを切り上げて返す
}

begin
  if (fNum >= 0) then begin
    Result := lfniCeil(fNum);
  end else begin
    Result := lfniFloor(fNum);
  end;
end;

function gfniRoundDown(fNum: Extended): Int64;
{2007-06-09:
fNumを切り下げて返す
}

begin
  if (fNum >= 0) then begin
    Result := lfniFloor(fNum);
  end else begin
    Result := lfniCeil(fNum);
  end;
end;

function gfniNumLimit(iNum: Integer; iMin, iMax: Integer): Integer;
//範囲制限
begin
  if (iMin = iMax) then begin
    Result := iMin;
  end else begin
    if (iNum < iMin) then begin
      Result := iMin;
    end else if (iNum > iMax) then begin
      Result := iMax;
    end else begin
      Result := iNum;
    end;
  end;
end;


//------------------------------------------------------------------------------
//mySize.pas
function gfniRectWidth (rtRect: TRect): Integer;
//rtRectの幅を返す
begin
  with rtRect do begin
    Result := Right - Left;
  end;
end;

function gfniRectHeight(rtRect: TRect): Integer;
//rtRectの高さを返す
begin
  with rtRect do begin
    Result := Bottom - Top;
  end;
end;

function gfnrcRectCenter(rcParent, rcChild: TRect): TRect;
//rcChildがrcParentの真ん中にくるようなRectを返す
var
  li_Left, li_Top, li_Width, li_Height: Integer;
begin
  li_Width  := gfniRectWidth (rcChild);
  li_Height := gfniRectHeight(rcChild);
  li_Left   := rcParent.Left + (gfniRectWidth (rcParent) - li_Width)  div 2;
  li_Top    := rcParent.Top  + (gfniRectHeight(rcParent) - li_Height) div 2;

  Result := Rect(li_Left, li_Top, li_Left + li_Width, li_Top + li_Height);
end;


end.