changyong.pas

灰鸽子VIP1.2经典源代码

{*******************************************************}
{                                                       }
{                     葛军常用函数                      }
{                                                       }
{            版权所有 (c) 2000,2002 鸽子工作室          }
{                                                       }
{*******************************************************}
unit Changyong;
{*******************************************************
项目: 灰鸽子
模块:
描述: 常用函数
版本: 0.1版
日期: 2002.1.1
作者: 葛军
更新:
*******************************************************}
interface

uses
  Windows, Messages, SysUtils, Classes, Forms, Winsock, registry;


procedure CutFirstDirectory(var S: string);
function MinimizeName(const Filename: string; MaxLen: Integer): string;

implementation

{uses
   ----,----,----,----;}


{减少文件路径名的长度}

procedure CutFirstDirectory(var S: string);
var
  Root: Boolean;
  P: Integer;
begin
  if S = '' then exit;
  if S = '\' then
    S := ''
  else begin
    if S[1] = '\' then begin
      Root := True;
      Delete(S, 1, 1);
    end else
      Root := False;
    if S[1] = '.' then
      Delete(S, 1, 4);
    P := Pos('\', S);
    if P <> 0 then begin
      Delete(S, 1, P);
      S := '...\' + S;
    end else
      S := '';
    if Root then
      S := '\' + S;
  end;
end;

function MinimizeName(const Filename: string; MaxLen: Integer): string;
var
  Drive: string;
  Dir: string;
  Name: string;
begin
  Result := FileName;
  Dir := ExtractFilePath(Result);
  Name := ExtractFileName(Result);

  if (Length(Dir) >= 2) and (Dir[2] = ':') then begin
    Drive := Copy(Dir, 1, 2);
    Delete(Dir, 1, 2);
  end else
    Drive := '';
  while ((Dir <> '') or (Drive <> '')) and (length(Result) > MaxLen) do begin
    if Dir = '\...\' then begin
      Drive := '';
      Dir := '...\';
    end else if Dir = '' then
      Drive := ''
    else
      CutFirstDirectory(Dir);
    Result := Drive + Dir + Name;
  end;
end;


end.