Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Преобразование Unicode строк в DFM файлах Delphi 6 в Ansi строки

Автор: Alx2
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Преобразование Unicode строк в DFM файлах Delphi 6 в Ansi строки.

При попытке открыть проект созданный в Delphi 6 из Delphi 5 возникает
проблема с чтением DFM-файла. Проблема заключается в том, что Delphi5
не может прочитать строки, записанные в формате Unicode (WideString).

Данная функция переводит строки из DFM файла в формат ANSI, после чего
DFM файл читается в D5. Но при этом может возникнуть проблема, связанная
с незнакомыми для D5 свойствами компонентов, которая, в свою очередь,
решается игнорированием этих свойств.

Зависимости: Classes
Автор:       Радионов Алексей (Alx2), alx@argo.mv.ru, ICQ:113442587, Ульяновск
Copyright:   Alx2
Дата:        31 мая 2002 г.
***************************************************** }

procedure RemoveUnicodeFromDFM(const Filename: string);
  function isChanges(const S: string; var Res: string): Boolean;
  var
    len: Integer;
    function LexemSharp(var K: Integer): Boolean;
    begin
      Result := (K < len) and (S[K] = '#');
      if Result then
      begin
        inc(K);
        while (K <= len) and (S[K] in ['0'..'9']) do
          inc(K);
      end;
    end;
    function LexemAp(var K: Integer): Boolean;
    begin
      Result := (K < len) and (S[K] = '''');
      if Result then
      begin
        inc(K);
        while (K <= len) and (S[K] <> '''') do
          inc(K);
        if K <= len then
          inc(K);
      end;
    end;

    function Lexem(var K: Integer; var Str: string): Boolean;
    var
      Start: Integer;
      ValS: string;
    begin
      Result := False;
      Start := K;
      if LexemSharp(K) then
      begin
        ValS := Copy(S, Start + 1, K - Start - 1);
        Str := WideChar(StrToInt(ValS));
        Result := True;
      end
      else if LexemAp(K) then
      begin
        Str := Copy(S, Start + 1, K - Start - 2);
        Result := True;
      end;
    end;

    function Prepare(var K: Integer): string;
    var
      Str: string;
      WasLexem: Boolean;
    begin
      Result := '';
      WasLexem := False;
      while Lexem(K, Str) do
      begin
        Result := Result + Str;
        WasLexem := True;
      end;
      if Result <> '' then
        Result := '''' + Result + '''' + Copy(S, K, Length(S))
      else if not WasLexem then
        Result := S
      else
        Result := '''''';
    end;
    function Min(A, B: Integer): Integer;
    begin
      if A = 0 then
        Result := B
      else if B = 0 then
        Result := A
      else if A > B then
        Result := B
      else
        Result := A;
    end;

  var
    StartIdx: Integer;
  begin
    Result := False;
    StartIdx := Min(Pos('#', S), Pos('''', S));
    if StartIdx > 0 then
    begin
      len := Length(S);
      while (StartIdx <= len) and (not (S[StartIdx] in ['#', ''''])) do
        inc(StartIdx);
      if StartIdx < len then
      begin
        Res := Copy(S, 1, StartIdx - 1) + Prepare(StartIdx);
        Result := True;
      end;
    end;
  end;

var
  SList: TStringList;
  K: Integer;
  Res: string;
begin
  SList := TStringList.Create;
  try
    SList.LOADFROMFILE(Filename);
    for K := 0 to SList.Count - 1 do
      if isChanges(SList[K], Res) then
        SList[K] := Res;
    SList.SaveToFile(Filename);
  finally
    SList.Free;
  end;
end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
  K: Integer;
begin
  if OpenDialog1.Execute then
    for K := 0 to OpenDialog1.Files.Count - 1 do
      RemoveUnicodeFromDFM(OpenDialog1.Files[K]);
end;
Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.