Пересмотрел код Snowy, решил делать по его принцу, получилось следующее: | Код |
function RichToBB(RichEdit: TRxRichEdit): String;
// очистка от возможных тегов
function HtmlChar(ch: char): string;
const
sim: array[1..6] of string = ('<', '>','"','&', '<br>', '');
sims = '<>"&'#13#10;
begin
if pos(ch, sims) > 0 then result := sim[pos(ch, sims)]
else result := ch;
end;
// конвертер цветов
function HtmlColor(Col: integer): string;
begin
Col := ColorToRGB(Col);
Result := '#' + Format('%.2x%.2x%.2x', [GetRValue(Col), GetGValue(Col), GetBValue(Col)]);
end;
// обработка URL-адресов
function DetectUrl(txt: string): string;
var
i,j: integer;
s,l: string;
h: boolean;
begin
result := '';
l := LowerCase(txt);
h := false;
i := 0;
repeat
inc(i);
if txt[i] = #1 then h := not h;
if h then result := result + txt[i]
else
if (copy(l, i, 7) = 'http://')
or (copy(l, i, 8) = 'https://')
or (copy(l, i, 6) = 'ftp://')
or (copy(l, i, 4) = 'www.') then begin
s := '';
for j := i to Length(l) do
if pos(l[j], #1#13#10' <>') = 0 then s := s + txt[j]
else Break;
inc(i, Length(s)-1);
result := result + '[URL]';
if pos('://', s) = 0 then result := result + 'http://';
result := result + s + '[/URL]';
end else result := result + txt[i];
until i >= Length(l);
end;
// обработка MAIL-адресов
function DetectMail(txt: string): string;
var
i,j: integer;
s,l: string;
h: boolean;
begin
result := '';
l := LowerCase(txt);
h := false;
i := 0;
repeat
inc(i);
if txt[i] = #1 then h := not h;
if h then result := result + txt[i]
else
if (copy(l, i, 7) = 'mailto:') then begin
s := '';
i := i + 7;
for j := i to Length(l) do
if pos(l[j], #1#13#10' <>') = 0 then s := s + txt[j]
else Break;
inc(i, Length(s)-1);
result := result + '[MAIL]';
result := result + s + '[/MAIL]';
end else result := result + txt[i];
until i >= Length(l);
end;
var
s, f : String;
i, sz, cl : Integer;
st : TFontStyles;
n : TRxNumbering;
output : String;
fontcolor : Boolean;
bold : Boolean;
italic : Boolean;
underline : Boolean;
strike : Boolean;
begin
s := RichEdit.Text;
f := '';
sz := 0;
cl := -1;
st := [];
n := nsNone;
output := '';
fontcolor := False;
bold := False;
italic := False;
underline := False;
strike := False;
for i := 1 to Length(s) do
begin
RichEdit.SelStart := i;
if (RichEdit.CaretPos.X = 0) and (RichEdit.Lines[RichEdit.CaretPos.Y] = '') then
if (s[i] = #13) then output := output + '[BR]';
if (RichEdit.CaretPos.X = 1) then begin
if (n = nsNone) and (i <> 1) then output := output + '[BR]';
if (n = nsBullet) then output := output + '[/LI]';
if (RichEdit.Paragraph.Numbering = nsBullet) and (n = nsNone) then begin output := output + '[UL]'; n := nsBullet; end;
if (RichEdit.Paragraph.Numbering <> nsBullet) and (n = nsBullet) then begin output := output + '[/UL]'; n := nsNone; end;
if (n = nsBullet) then output := output + '[LI]';
end;
with RichEdit.SelAttributes do
if (f <> Name) or (sz <> Size) or (cl <> Color) or (st <> Style) then begin
if (s[i] > #31) then begin
f := Name; sz := Size; cl := Color; st := Style;
// ----
if (fontcolor = True) then begin output := output + '[/COLOR]'; fontcolor := False; end;
if (bold = True) then begin output := output + '[ /B ]'; bold := False; end;
if (italic = True) then begin output := output + '[/I]'; italic := False; end;
if (underline = True) then begin output := output + '[/U]'; underline := False; end;
if (strike = True) then begin output := output + '[/S]'; strike := False; end;
// ----
if cl <> 0 then begin output := output + '[COLOR=' + HtmlColor(cl)+']'; fontcolor := True; end;
if fsBold in st then begin output := output + '[ B ]'; bold := True; end;
if fsItalic in st then begin output := output + '[I]'; italic := True; end;
if fsUnderline in st then begin output := output + '[U]'; underline := True; end;
if fsStrikeOut in st then begin output := output + '[S]'; strike := True; end;
end;
end;
if s[i] > #31 then output := output + HtmlChar(s[i]);
end;
if (fontcolor = True) then begin output := output + '[/COLOR]'; fontcolor := False; end;
if (bold = True) then begin output := output + '[ /B ]'; bold := False; end;
if (italic = True) then begin output := output + '[/I]'; italic := False; end;
if (underline = True) then begin output := output + '[/U]'; underline := False; end;
if (strike = True) then begin output := output + '[/S]'; strike := False; end;
if n = nsBullet then output := output + '[/UL]';
// обработка URL-адресов
output := DetectUrl(output);
// обработка MAIL-адресов
output := DetectMail(output);
// возвращаяем результат
Result := output;
end;
|
Есть небольшая проблема со списком, но в целом работает отлично. Сейчас встал вопрос о конвертировании данных в RichEdit из текста оформленного с помощью BB-кодов. Не могу понять как сделать список – на бумаге выходит просто, а в программе не получается. Вот что есть сейчас: | Код |
procedure BBToRich(RichEdit:TRxRichEdit; Str: String);
var
i : Integer;
output : String;
bold : Boolean;
italic : Boolean;
underline : Boolean;
strike : Boolean;
begin
i := 0;
output := '';
bold := False;
italic := False;
underline := False;
strike := False;
// --
while i < Length(Str) do begin
// перенос строки
if (copy(Str, i+1, 4) = '[BR]') then begin
i := i + 4;
RichEdit.Text := RichEdit.Text + sLineBreak;
// жирный текст
end else if (copy(Str, i+1, 3) = '[ B ]') then begin
i := i + 3;
bold := True;
end else if (copy(Str, i+1, 4) = '[ /B ]') then begin
i := i + 4;
bold := False;
// курсив
end else if (copy(Str, i+1, 3) = '[I]') then begin
i := i + 3;
italic := True;
end else if (copy(Str, i+1, 4) = '[/I]') then begin
i := i + 4;
italic := False;
// подчёркнутый текст
end else if (copy(Str, i+1, 3) = '[U]') then begin
i := i + 3;
underline := True;
end else if (copy(Str, i+1, 4) = '[/U]') then begin
i := i + 4;
underline := False;
// зачёркнутый текст
end else if (copy(Str, i+1, 3) = '[S]') then begin
i := i + 3;
strike := True;
end else if (copy(Str, i+1, 4) = '[/S]') then begin
i := i + 4;
strike := False;
end;
// обработка текста
i := i + 1;
RichEdit.SelStart := Length(RichEdit.Text);
RichEdit.SelLength := 0;
// жирный текст
if (bold = True) then begin
RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsBold];
end else begin
RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsBold];
end;
// курсив
if (italic = True) then begin
RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsItalic];
end else begin
RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsItalic];
end;
// подчёркнутый текст
if (underline = True) then begin
RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsUnderline];
end else begin
RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsUnderline];
end;
// зачёркнутый текст
if (strike = True) then begin
RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsStrikeOut];
end else begin
RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsStrikeOut];
end;
RichEdit.SelText := Str[i];
end;
end;
|
* пробелы в тегах [ B] [ /B] т.к. парсер vingrad их принимает за выделение |
WYSIWYG BBCode, Поиск компонента или его реализация 
Дата 7.4.2010, 12:43 (
Загрузка ...
Дата 11.4.2010, 14:23 (
Дата 12.4.2010, 15:13 (
