Разные вопросы

Code:

{ **** UBPFD *********** by kladovka.net u ****

>> Расстояние (разность) между двумя строками. Функция Левенштейна

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

Автор: Андрей aka wicked, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., ICQ:92356239, Тернополь

********************************************** }

const cuthalf = 100; // константа, ограничивающая макс. длину

// обрабатываемых строк

var buf: array [0..((cuthalf * 2) - 1)] of integer; // рабочий буффер, заменяет

// матрицу, представленную

// в описании

function min3(a, b, c: integer): integer; // вспомогательная функция

begin

Result := a;

if b < Result then Result := b;

if c < Result then Result := c;

end;

// реализация функции в принципе соответствует описанию с одной оговоркой:

// матрица из описания заменена статическим буффером, длина которого

// равна удвоенной максимальной длине строк

// это сделано для 1) экономии памяти и во избежание её перераспределений

// 2) повышения быстродействия (у меня функция работает

// в обработчике onfilterRecord)

// таким образом, в реализации половинами буффера представлены только

// две последние строки матрицы, которые меняются местами каждую

// итерацию внешнего цикла (по i)... для определения того, какая из половин

// буффера является "нижней строкой", служит переменная flip

// т. е. при flip = false первая половина буффера является предпоследней

// строкой, а вторая - последней; при flip = true наоборот,

// первая половина - последняя строка, вторая половина - предпоследняя

function LeveDist(s, t: string): integer;

var i, j, m, n: integer;

cost: integer;

flip: boolean;

begin

s := copy(s, 1, cuthalf - 1);

t := copy(t, 1, cuthalf - 1);

m := length(s);

n := length(t);

if m = 0then Result := n

elseif n = 0then Result := m

elsebegin

flip := false;

for i := 0to n do buf[i] := i;

for i := 1to m dobegin

if flip then buf[0] := i

else buf[cuthalf] := i;

for j := 1to n dobegin

if s[i] = t[j] then cost := 0

else cost := 1;

if flip then

buf[j] := min3((buf[cuthalf + j] + 1),

(buf[j - 1] + 1),

(buf[cuthalf + j - 1] + cost))

else

buf[cuthalf + j] := min3((buf[j] + 1),

(buf[cuthalf + j - 1] + 1),

(buf[j - 1] + cost));

end;

flip := not flip;

end;

if flip then Result := buf[cuthalf + n]

else Result := buf[n];

end;

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

Code:

// на форме имеются поля Edit1 и Edit2, метка Label1

.....

Label1.Caption := IntToStr(LeveDist(Edit1.Text, Edit2.Text));

.....

Добавить комментарий

Подробности: Родительская категория: Работа со строками; Категория: Разные вопросы

Code:

const

vlist = 'первый, второй, третий';

var

Values: TStringList;

procedure SetValues(VL : TStringList; S: String);

var

I : Integer;

begin

VL.CommaText := S;

for I := 0to CL.Count-1do

VL.Objects[I] := Pointer(I);

VL.Sorted := True;

end;

function GetValueIndex(VL : TStringList; Match: String): Integer;

begin

Result := VL.IndexOf(Match);

if Result >= 0then

Result := Integer(VL.Objects[Result]);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

case GetValueIndex(Values, Edit1.Text) of

-1: {не найден} ;

0: Caption := '0';

1: Caption := '1';

2: Caption := '2';

end;

initialization

VL := TStringList.Create;

SetValues(VL, vlist);

finalization

VL.Free;

Добавить комментарий

Подробности: Родительская категория: Работа со строками; Категория: Разные вопросы

Как-то раз пришлось решить задачу удаления из файла элементов HTML таких, как, например, ненужные ссылки, и в то эе время преобразования возврата каретки в HTML параграфы, знаков табуляции в пробелы и т.д. В результате соответственно должен был получиться новый HTML документ.

Следующие две процедуры показывают, как это можно сделать:

Code:

procedure TMainForm.LoadFileIntoList(TextFileName: string;

AWebPage: TStringList; WithFilter: Boolean);

var

CurrentFile: TStringList;

begin

CurrentFile := TStringList.Create;

CurrentFile.LoadFromFile(TextFileName);

if WithFilter then

FilterHTML(CurrentFile,AWebPage)

else

with AWebPage do

AddStrings(CurrentFile);

CurrentFile.Free;

end;

procedure TMainForm.FilterHTML(FilterInput, AWebPage: TStringList);

var

i, j: LongInt;

S: string;

begin

FilterMemo.Lines.Clear;

FilterMemo.Lines := FilterInput;

with AWebPage do

begin

FilterMemo.SelectAll;

j := FilterMemo.SelLength;

if j > 0then

begin

i := 0;

repeat

// ищем cr

if FilterMemo.Lines.GetText[i] = Char(VK_RETURN) then

S := S + #10#13;

else

if FilterMemo.Lines.GetText[i] = '<'then

repeat

inc(i);

until

FilterMemo.Lines.GetText[i] = '>'

else

// ищем tab

if FilterMemo.Lines.GetText[i] = Char(VK_TAB) then

S := S + ' '

else

S := S + FilterMemo.Lines.GetText[i]; // добавляем текст

inc(i);

until

i = j + 1;

Add(S); // добавляем строку в WebPage

end

else

Add('No data entered into field.'); // no data in text file

end;

Применение функции:

Всё, что нужно сделать - это вызвать :

LoadFileIntoList("filename.txt",Webpage, True);

Где:

filename

это имя файла, который вы хотите обработать.

WebPage

это TStringList

последний параметр в функции

указывает, применять или нет HTML-фильтр.

PS: В этом примере объект TMemo (который вызывается из "FilterMemo") лежит на форме и поэтому не видим.

Пример:

Code:

WebPage := TStringList.Create;

try

Screen.Cursor := crHourGlass;

AddHeader(WebPage);

with WebPage do

begin

Add('Personal Details');

LoadFileIntoList("filename.txt", Webpage, True);

end;

AddFooter(WebPage);

finally

WebPage.SaveToFile(HTMLFileName);

WebPage.Free;

Screen.Cursor := crDefault;

end;

Добавить комментарий

Подробности: Родительская категория: Работа со строками; Категория: Разные вопросы

Code:

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

>> Сумма и количество прописью, работа с падежами

Несколько функций для работы с строками:

function SumToString(Value : String) : string;//Сумма прописью

function KolToStrin(Value : String) : string;//Количество прописью

function padeg(s:string):string;//Склоняет фамилию имя и отчество (кому)

function padegot(s:string):string;//Склоняет фамилию имя и отчество (от кого)

function fio(s:string):string;//фамилия имя и отчество сокращенно

function longdate(s:string):string;//Длинная дата

procedure getfullfio(s:string;var fnam,lnam,onam:string);//Получить из строки фамилию имя и отчество сокращенно

Зависимости: uses SysUtils, StrUtils,Classes;

Автор: Eda, eda @ arhadm.net.ru, Архангельск

********************************************** }

unit sumstr;

interface

uses

SysUtils, StrUtils,Classes;

var rub:byte;

function SumToString(Value : String) : string;//Сумма прописью

function KolToStrin(Value : String) : string;//Количество прописью

function padeg(s:string):string;//Склоняет фамилию имя и отчество (кому)

function padegot(s:string):string;//Склоняет фамилию имя и отчество (от кого)

function fio(s:string):string;//фамилия имя и отчество сокращенно

function longdate(s:string):string;//Длинная дата

procedure getfullfio(s:string;var fnam,lnam,onam:string);//Получить из строки фамилию имя и отчество сокращенно

implementation

const a:array[0..8,0..9] ofstring=(

('','один ','два ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '),