www.pudn.com > 灰鸽子VIP1.2.rar > Changyong.pas

{*******************************************************} 
{                                                       } 
{                     葛军常用函数                      } 
{                                                       } 
{            版权所有 (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.