Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  166

•  TDictionary Custom Sort  3 340

•  Fast Watermark Sources  3 093

•  3D Designer  4 849

•  Sik Screen Capture  3 348

•  Patch Maker  3 554

•  Айболит (remote control)  3 664

•  ListBox Drag & Drop  3 016

•  Доска для игры Реверси  81 721

•  Графические эффекты  3 946

•  Рисование по маске  3 250

•  Перетаскивание изображений  2 631

•  Canvas Drawing  2 754

•  Рисование Луны  2 584

•  Поворот изображения  2 191

•  Рисование стержней  2 169

•  Paint on Shape  1 569

•  Генератор кроссвордов  2 239

•  Головоломка Paletto  1 767

•  Теорема Монжа об окружностях  2 233

•  Пазл Numbrix  1 685

•  Заборы и коммивояжеры  2 059

•  Игра HIP  1 282

•  Игра Go (Го)  1 230

•  Симулятор лифта  1 475

•  Программа укладки плитки  1 219

•  Генератор лабиринта  1 548

•  Проверка числового ввода  1 367

•  HEX View  1 497

•  Физический маятник  1 359

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Короткое имя файла в длинное и наоборот, сокращённое имя файла



Следующие три функции помогут преобразовать длинные имена файлов в коротки и наоборот. Функция Mince служит для отображения полного имени файла, включая путь.


{=========================================================} 
Function Mince(PathToMince: String; InSpace: Integer): String; 
{=========================================================} 
// "C:\Program Files\Delphi\DDrop\TargetDemo\main.pas" 
// "C:\Program Files\..\main.pas" 
Var 
  sl: TStringList; 
  sHelp, sFile: String; 
  iPos: Integer; 

Begin 
  sHelp := PathToMince; 
  iPos := Pos('\', sHelp); 
  If iPos = 0 Then 
  Begin 
    Result := PathToMince; 
  End 
  Else 
  Begin 
    sl := TStringList.Create; 
    // Decode string 
    While iPos <> 0 Do 
    Begin 
      sl.Add(Copy(sHelp, 1, (iPos - 1))); 
      sHelp := Copy(sHelp, (iPos + 1), Length(sHelp)); 
      iPos := Pos('\', sHelp); 
    End; 
    If sHelp <> '' Then 
    Begin 
      sl.Add(sHelp); 
    End; 
    // Encode string 
    sFile := sl[sl.Count - 1]; 
    sl.Delete(sl.Count - 1); 
    Result := ''; 
    While (Length(Result + sFile) < InSpace) And (sl.Count <> 0) Do 
    Begin 
      Result := Result + sl[0] + '\'; 
      sl.Delete(0); 
    End; 
    If sl.Count = 0 Then 
    Begin 
      Result := Result + sFile; 
    End 
    Else 
    Begin 
      Result := Result + '..\' + sFile; 
    End; 
    sl.Free; 
  End; 
End; 

{===================================================} 
Function ShortFileName(Const FileName: String): String; 
{===================================================} 
Var 
  aTmp: Array[0..255] Of Char; 

Begin 
  If Not FileExists(FileName) Then 
  Begin 
    Result := ''; 
  End 
  Else 
  Begin 
    If GetShortPathName(PChar (FileName), aTmp, Sizeof (aTmp) - 1) = 0 Then 
    Begin 
      Result:= FileName; 
    End 
    Else 
    Begin 
      Result:= StrPas (aTmp); 
    End; 
  End; 
End; 

{==============================================} 
Function LongFileName(ShortName: String): String; 
{==============================================} 
Var 
  SR: TSearchRec; 

Begin 
  Result := ''; 
  If (pos ('\\', ShortName) + pos ('*', ShortName) + 
      pos ('?', ShortName) <> 0) Or Not FileExists(ShortName) Then 
  Begin 
    { ignore NetBIOS name, joker chars and invalid file names } 
    Exit; 
  End; 
  While FindFirst(ShortName, faAnyFile, SR) = 0 Do 
  Begin 
    { next part as prefix } 
    Result := '\' + SR.Name + Result; 
    SysUtils.FindClose(SR);  { the SysUtils, not the WinProcs procedure! } 
    { directory up (cut before '\') } 
    ShortName := ExtractFileDir (ShortName); 
    If length (ShortName) <= 2 Then 
    Begin 
      Break;  { ShortName contains drive letter followed by ':' } 
    End; 
  End; 
  Result := ExtractFileDrive (ShortName) + Result; 
end;





Похожие по теме исходники

Разбиение файла на части

Текст внутри файла




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте