Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник
Коллекция курьезных вопросов из форумов
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »
Страницы: 1 2

WideString или UniCode [Windows]


dmk ©   (10.06.21 09:12[20]

Вот абсолютно рабочий пример, но у меня Delphi XE6.
Вместо Delphi 7 можно скачать бесплатную Delphi Сommunity.
Она лучше чем Delphi 7.

unit DialogOS;

interface

uses
 Windows, Winapi.CommDlg;

type
 TOFN = record
   ADir: string;
   AExt: string;
   AFilter: string;
   ATitle: string;
 end;

 function OpenDialog(AParent: THandle; AFN: TOFN; var AName: string): Boolean;
 function MultiOpenDialog(AParent: THandle; AFN: TOFN; var AFiles: TStringArray): Boolean;
 function SaveDialog(AParent: THandle; AFN: TOFN; var AName: string): Boolean;

implementation

const
 LC_MAX_PATH = 65535; //64 Кб

//---------------------------------------------------------------------------------------

function MultiOpenDialog(AParent: THandle; AFN: TOFN; var AFiles: TStringArray): Boolean;
var
 F: TOpenFileName;
 LFiles: array[0..LC_MAX_PATH] of Char;

begin
 Result := False;

 ZeroMemory(@F, SizeOf(TOpenFileName));
 ZeroMemory(@LFiles, ByteLength(LFiles));

 F.lStructSize := SizeOf(TOpenFileName);
 F.hInstance := HInstance;
 F.lpstrInitialDir := PChar(GetCurrentDir);
 F.hWndOwner := AParent;
 F.lpstrFile := @LFiles[0];
 F.nMaxFile := SizeOf(LFiles);
 F.nFilterIndex := 1;

 if (AFN.ADir <> '') then F.lpstrInitialDir := PChar(AFN.ADir);
 if (AFN.AExt <> '') then F.lpstrDefExt := PChar(AFN.AExt);
 if (AFN.ATitle <> '') then F.lpstrTitle := PChar(AFN.ATitle);

 AFN.AExt := F.lpstrFile;
 F.lpstrFilter := PChar(ReplaceChar(AFN.AFilter, '|', #0) + #0#0);

 F.Flags := (OFN_EXPLORER or OFN_NONETWORKBUTTON or OFN_ENABLESIZING or OFN_ALLOWMULTISELECT);

 if GetOpenFileName(F) then
 begin
   ParseCharArray(AFiles, LFiles);
   Result := True;
 end;
end;

//---------------------------------------------------------------------------

function OpenDialog(AParent: THandle; AFN: TOFN; var AName: string): Boolean;
var
 F: TOpenFileName;
 Files: array[0..MAX_PATH] of Char;
 N: Integer;

begin
 Result := False;
 ZeroMemory(@F, SizeOf(TOpenFileName));

 N := High(Files) - Low(Files) + 1;
 ZeroMemory(@Files, N);

 F.lStructSize := SizeOf(TOpenFileName);
 F.hInstance := HInstance;
 F.lpstrInitialDir := PChar(GetCurrentDir);
 F.hWndOwner := AParent;
 F.lpstrFile := @Files[0];
 F.nMaxFile := SizeOf(Files);
 F.nFilterIndex := 1;

 if (AFN.ADir <> '') then F.lpstrInitialDir := PChar(AFN.ADir);
 if (AFN.AExt <> '') then F.lpstrDefExt := PChar(AFN.AExt);
 if (AFN.ATitle <> '') then F.lpstrTitle := PChar(AFN.ATitle);

 AName := F.lpstrFile;
 F.lpstrFilter := PChar(ReplaceChar(AFN.AFilter, '|', #0) + #0#0);

 F.Flags := (OFN_EXPLORER or OFN_NONETWORKBUTTON or OFN_ENABLESIZING);

 if GetOpenFileName(F) then
 begin
   AName := string(Files);
   Result := True;
 end;
end;

//---------------------------------------------------------------------------

function SaveDialog(AParent: THandle; AFN: TOFN; var AName: string): Boolean;
var
 F: TOpenFileName;
 FPath: array[0..MAX_PATH] of Char;

begin
 Result := False;
 ZeroMemory(@F, SizeOf(TOpenFileName));

 F.lStructSize := SizeOf(TOpenFileName);
 F.hWndOwner := AParent;
 F.lpstrFile := @FPath[0];
 F.nMaxFile := SizeOf(FPath);
 F.nFilterIndex := 1;

 if (AFN.ADir <> '') then F.lpstrInitialDir := PChar(AFN.ADir);
 if (AFN.AExt <> '') then F.lpstrDefExt := PChar(AFN.AExt);
 if (AFN.ATitle <> '') then F.lpstrTitle := PChar(AFN.ATitle);

 AName := F.lpstrFile;
 F.lpstrFilter := PChar(ReplaceChar(AFN.AFilter, '|', #0) + #0#0);
 F.Flags := (OFN_EXPLORER or OFN_NONETWORKBUTTON or OFN_ENABLESIZING);

 if GetSaveFileName(F) then
 begin
   AName := string(FPath);
   Result := True;
 end;
end;

end.


dmk ©   (10.06.21 09:15[21]

Вот еще одна функция из MultiOpenDialog.

procedure ParseCharArray(var AStrings: TStringArray; var Arr: array of Char);
var
 i: Integer;
 ArrLen: Integer;
 C: Char;
 S, Path: string;
 bPath, bPathFound, bFile: Boolean;

const
 BSlash: Char = '\';

begin
 ArrLen := Length(Arr);

 if (AStrings <> nil) then
 begin
   AStrings.Clear;

   S := '';

   bPath := False;
   bPathFound := False;

   // Извлекаем параметры разделенные нулями #0
   for i := 0 to (ArrLen - 1) do
   begin
     // Текущий знак
     C := Arr[i];

     // Формируем строку
     if (C <> #0) then S := (S + C);

     // Последний символ
     if (C = #0) and (S <> '') then
     begin
       if (not bPathFound) then
         bPath := DirExists(S);

       // Сохраним найденый путь
       if bPath and (not bPathFound) then
       begin
         Path := (S + BSlash);
         bPathFound := True;
       end
       else
       begin
         bFile := FileExists(S);
         if (bFile) then
         begin
           AStrings.Add(S);
         end;
       end;

       S := '';
     end;
   end;

   if bPath then
   begin
     // Добавляем к именам файлов путь
     for i := AStrings.Lo to AStrings.Hi do
     begin
       S := Path + AStrings.Get(i);
       AStrings.Replace(i, S);
     end;
   end;
 end;
end;


dmk ©   (10.06.21 09:22[22]

Вот класс списка строк. Можно дельфевый TStrings вставить если что.
Если чего не хватит - спрашивай. И не пользуй KOL. Это тупик.

type
 PStringRec = ^TStringRec;
 TStringRec = record
   Size: Integer;
   Value: string;
 end;

type
 PStringArray = ^TStringArray;
 TStringArray = class(TObject)
 protected
   FStringArray: array of TStringRec;
   FCount: Integer;
   FLoIndex: Integer;
   FHiIndex: Integer;

 private
   procedure SetLength(AValue: Integer);
   procedure UpdateIndexes;

 public
   procedure Add(AValue: string);
   procedure Assign(AStrings: TStrings);
   procedure Clear;
   constructor Create;
   procedure Delete(AIndex: Integer);
   destructor Destroy; Override;
   procedure Free(AVar: Pointer);
   function Get(AIndex: Integer): string;
   procedure Replace(AIndex: Integer; ANewValue: string);
   //------
   property Count: Integer read FCount;
   property Lo: Integer read FLoIndex;
   property Hi: Integer read FHiIndex;
 end;

implementation

//------------------------------

constructor TStringArray.Create;
begin
 inherited Create;

 FCount := 0;
 UpdateIndexes;
end;

//------------------------------

destructor TStringArray.Destroy;
begin
 Clear;
 inherited Destroy;
end;

//-----------------------------------------

procedure TStringArray.Free(AVar: Pointer);
begin
 inherited Free;

 if (AVar <> nil) then
   PVar(AVar)^ := nil;
end;

//------------------------------------------------

procedure TStringArray.SetLength(AValue: Integer);
begin
 FCount := AValue;
 System.SetLength(FStringArray, FCount);
 UpdateIndexes;
end;

//-----------------------------------------

procedure TStringArray.Add(AValue: string);
begin
 if (AValue <> '') then
 begin
   SetLength(FCount + 1);
   FStringArray[Hi].Size := Length(AValue);
   FStringArray[Hi].Value := AValue;
 end;
end;

//------------------------------------------------

procedure TStringArray.Assign(AStrings: TStrings);
var
 i: Integer;

begin
 if (AStrings <> nil) then
 begin
   Clear;
   for i := 0 to (AStrings.Count - 1) do
   begin
     Add(AStrings.Strings[i]);
   end;
 end;
end;

//-------------------------------------------------

function TStringArray.Get(AIndex: Integer): string;
begin
 Result := FStringArray[AIndex].Value;
end;

//-----------------------------------------------------------------

procedure TStringArray.Replace(AIndex: Integer; ANewValue: String);
begin
 FStringArray[AIndex].Value := ANewValue;
end;

//---------------------------

procedure TStringArray.Clear;
var
 i: Integer;
 R: PStringRec;

begin
 for i := Lo to Hi do
 begin
   R := @FStringArray[i];
   R.Size := 0;
   R.Value := '';
 end;

 SetLength(0);
end;

//---------------------------------------------

procedure TStringArray.Delete(AIndex: Integer);
var
 i, k: Integer;

begin
 if (Self <> nil) then
 begin
   k := 0;

   for i := Lo to Hi do
   begin
     if (i = AIndex) then Continue;
     FStringArray[k] := FStringArray[i];
     Inc(k);
   end;

   SetLength(FCount - 1);
 end;
end;

//-----------------------------------

procedure TStringArray.UpdateIndexes;
begin
 FLoIndex := Low(FStringArray);
 FHiIndex := High(FStringArray);
end;


dmk ©   (10.06.21 09:54[23]

Пример использования диалога:
procedure TMainForm.OpenFile(const AName: string);
var
 FName, FExt: string;
 FN: TOFN;

begin
 // Проверяем файл
 if (AName <> '') then
 begin
   if FileExists(AName) then
   begin
     FName := AName;
     FExt := ExtractFileExt(FName);

     if (FExt <> '.txt') then
     begin
       ErrorMessage(Handle, MSG_UNKNOWN_FILE + AName);
       Exit;
     end;
   end
   else
   begin
     ErrorMessage(Handle, MSG_FILE_NOT_FOUND + AName);
     Exit;
   end;
 end
 else
 begin
   FName := '';

   FN.ADir := GetCurrentDir;
   FN.AExt := '*.txt';
   FN.AFilter := 'Text file|*.txt';
   FN.ATitle := 'Text file';

   // Открываем диалог
   if not OpenDialog(Handle, FN, FName) then Exit;
 end;
end;


Митя   (21.06.21 13:45[24]

В тот то исмысл что использовать я буду KOL&MCK,
Не вижу в этом тупика, т.к. и в версиях без KOL&MCK картина та же


ParanoiS ©   (03.01.22 17:43[25]

чё вы паритесь-

type PKOLStrList = ^TKOLStrList; TKOLStrList =
 {$IFDEF UNICODE_CTRLS}
    TStrList
 {$ELSE}
     TWStrList
 {$ENDIF};


Митя   (17.01.22 01:21[26]

Не понимаю - как создать UnicodeStringList


Митя   (17.01.22 01:32[27]

А также UnicodeDirList


ParanoiS ©   (18.01.22 19:56[28]

Да он так то создан тов. Кладовым. Читай мой пост выше.

TWstrList


Страницы: 1 2 версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо