Code:

{ **** UBPFD *********** by kladovka.net.ru ****

>> Преобразование Unicode строк в DFM файлах Delphi 6 в Ansi строки.

При попытке открыть проект созданный в Delphi 6 из Delphi 5 возникает

проблема с чтением DFM-файла. Проблема заключается в том, что Delphi5

не может прочитать строки, записанные в формате Unicode (WideString).

Данная функция переводит строки из DFM файла в формат ANSI, после чего

DFM файл читается в D5. Но при этом может возникнуть проблема,

связанная с незнакомыми для D5 свойствами компонентов, которая,

в свою очередь, решается игнорированием этих свойств.

Зависимости: Classes

Автор: Радионов Алексей (Alx2), Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., 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

IfNot WasLexem Then

Result := S

Else

Result := '''''';

End;

Function Min(A, B: Integer): Integer;

Begin

If A = 0Then Result := B

Else

If B = 0Then 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 > 0Then

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 := 0To SList.Count - 1Do

If isChanges(SList[K], Res) Then

SList[K] := Res;

SList.SaveToFile(Filename);

Finally

SList.Free;

End;

End;

Code:

Procedure TForm1.Button1Click(Sender: TObject);

Var

K: Integer;

Begin

If OpenDialog1.Execute Then

For K := 0To OpenDialog1.Files.Count - 1Do

RemoveUnicodeFromDFM(OpenDialog1.Files[K]);

End;