Показать сообщение отдельно
  #5  
Старый 24.08.2008, 18:48
Аватар для Vayrus
Vayrus Vayrus вне форума
Исполняемый Ретровирус
 
Регистрация: 09.08.2008
Адрес: Umbrella Corporation
Сообщения: 743
Репутация: 1293
Счастье

Код:
function ReplaceSubString(source,target,new:string):string;
var
rslt: String;
begin
While POS(target,source)>0 do
begin
rslt:=rslt+copy(source,1,POS(target,source)-1)+new;
Delete(source,1,POS(target,source)+Length(target)-1);
Application.ProcessMessages;
end;
Result:=rslt+source;
end;

function To_HTML_Table(InTxt: String): String;
const
first='<TR><TD noWrap width="30%">';
Stand='</TD><TD noWrap align=middle width="1%">';
closet='</TD></TR>';
var
List : TstringList;
OutL : TstringList;
I:Integer;
S:String;
begin
List := TstringList.Create;
OutL := TstringList.Create;
List.Text := InTxt;
for i:=0 to list.Count-1 do
begin
S:=List.Strings[i];
S:=ReplaceSubString(S,#9,Stand);
S:=first+S+closet;
OutL.Add(S);
Application.ProcessMessages;
end;
RESULT:=OutL.Text;
List.Free;
OutL.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if not CheckBox1.Checked then
begin
ShowMessage('ClipBoard is empty!');
EXIT;
end;
Memo1.Clear;
memo1.Text:=To_HTML_Table(CB.AsText);
end;

Подскажите в чем ошибка?
Есть такая строчка в буфере обмена:
АЕ 2066-20А* 2 853,0 554,5

Вместо:
<TR><TD noWrap width="30%">АЕ 2066-20А*</TD><TD noWrap align=middle width="1%">2</TD><TD noWrap align=middle width="1%"> 853,0 </TD><TD noWrap align=middle width="1%"> 554,5 </TD></TR>

выдает:
<TR><TD noWrap width="30%">АЕ 2066-20А*</TD><TD noWrap align=middle width="1%"></TD><TD noWrap align=middle width="1%"></TD><TD noWrap align=middle width="1%">2</TD><TD noWrap align=middle width="1%"> 853,0 </TD><TD noWrap align=middle width="1%"> 554,5 </TD></TR>
Ответить с цитированием