Русские субтитры: Объединенение переносов слов - Русские субтитры

Перейти к содержимому

Страница 1 из 1
  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

Объединенение переносов слов

#1 Пользователь офлайн   BedaZzle Иконка

  • Иконка
  • Отправить ЛС
  • Группа: Admin
  • Сообщений: 2 987
  • Регистрация: 22 Октябрь 02
  • Страна:
  • Прислал(a) субтитров: 98
  • Своих переводов: 16

Отправлено 03 Июнь 2007 - 17:33

Появился новый скрипт для объединения переносов слов в конце строки.


 
// This script looks for split words and places them on the next line.
// It looks for the divider character (default "-") at the end of the line.
// It then looks for the first space in front of the divider.
// The space is replaced by a newline.
// The word is unsplit and placed on the next line.
//
// By Tengo, June 03 '07

program UnSplitWords;

// Inline Functions ------------------------------------------------------------

  function PosEx(SubStr: string; S: string; Offset: Integer): Integer;
  var tmp: string;
	  n: Integer;
  begin
	  result := 0;
	  tmp := copy(s, offset, length(s)-offset-1);
	  n := Pos(SubStr, tmp);
	  if n>0 then result := Offset + n - 1;
  end;

  function ReverseString(AText: string): string;
  var
	L, I, N: Integer;
  begin
	L := Length(AText);
	N := 1;
	SetLength(Result, L);
	for I := L downto 1 do
	begin
	  Result[N] := AText[i];
	  N := N+1;
	end;
  end;

  function PosExRev(SubStr: string; S: string; Offset: Integer): Integer;
  var RevTmp, RevSub: string;
	  n: Integer;
  begin
	  Result := 0;
	  RevSub := ReverseString(SubStr);
	  RevTmp := ReverseString(copy(S, 1, Offset));
	  n := Pos(RevSub, RevTmp);
	  if n>0 then result := Offset + 1 - n;
  end;

// Inline Functions end --------------------------------------------------------

const
  Divider = '-';  
  CRLF = ''#13''#10;

var
  Index: Integer;
  SubtitleText: String;
  DividerPos: Integer;
  WordStart: Integer;
  NewText: string;

begin
  for Index := 0 to GetSubtitleCount-1 do
  begin
	SubtitleText := GetSubtitleText(Index);
	DividerPos := PosEx(Divider+CRLF, SubTitleText, 1);
	while (DividerPos > 0) do
	begin
	  Wordstart := PosExRev(' ', SubtitleText, DividerPos) + 1;
	  if Wordstart > 0 then
	  begin
		NewText := Copy(SubtitleText, 1, Wordstart - 2) + CRLF
		  + Copy(SubtitleText, Wordstart, DividerPos - Wordstart)
		  + Copy(SubtitleText, DividerPos + 3, Length(SubtitleText) - DividerPos - 2)
		 ;
	  end;
	  DividerPos := PosEx(Divider+CRLF, NewText, DividerPos);
	  SubtitleText := NewText;
	end; {while}
	SetSubtitleText(Index, SubTitleText);
  end; {for}
end.

0

Страница 1 из 1
  • Вы не можете создать новую тему
  • Вы не можете ответить в тему