http://bugs.winehq.org/show_bug.cgi?id=16597
--- Comment #2 from bas teach2000@basement.nl 2008-12-23 05:01:46 --- The code of the demo-application:
--------------------- procedure TForm14.FormCreate(Sender: TObject); begin Memo1Change(nil); end;
procedure TForm14.Memo1Change(Sender: TObject); begin T2KItemEdit1.BBCode := Memo1.Text; end;
procedure TForm14.T2KItemEdit1Change(Sender: TObject); begin Memo2.Text := T2KItemEdit1.BBCode; end; ---------------------
The code of the procedure that introduces the problem:
--------------------- class function TT2KBBCode.FromRichEdit(ARichEdit: TBasCustomRichEdit): WideString; var LRow: Integer; LBBState: TBBState;
procedure CheckLine(ALine: WideString); var LCol: Integer;
procedure AddControl; begin // Bold if (fsBold in ARichEdit.SelAttributes.Style) and (not LBBState.Bold) then begin LBBState.Bold := True; LBBState.Text.AppendString(cBBControlOpen + cBBBold + cBBControlClose); end else if (not (fsBold in ARichEdit.SelAttributes.Style)) and LBBState.Bold then begin LBBState.Bold := False; LBBState.Text.AppendString(cBBControlOpen + cBBBoldEnd + cBBControlClose); end;
// Italic if (fsItalic in ARichEdit.SelAttributes.Style) and (not LBBState.Italic) then begin LBBState.Italic := True; LBBState.Text.AppendString(cBBControlOpen + cBBItalic + cBBControlClose); end else if (not (fsItalic in ARichEdit.SelAttributes.Style)) and LBBState.Italic then begin LBBState.Italic := False; LBBState.Text.AppendString(cBBControlOpen + cBBItalicEnd + cBBControlClose); end;
// Underline if (fsUnderline in ARichEdit.SelAttributes.Style) and (not LBBState.Underline) then begin LBBState.Underline := True; LBBState.Text.AppendString(cBBControlOpen + cBBUnderline + cBBControlClose); end else if (not (fsUnderline in ARichEdit.SelAttributes.Style)) and LBBState.Underline then begin LBBState.Underline := False; LBBState.Text.AppendString(cBBControlOpen + cBBUnderlineEnd + cBBControlClose); end;
// Strike if (fsStrikeOut in ARichEdit.SelAttributes.Style) and (not LBBState.Strike) then begin LBBState.Strike := True; LBBState.Text.AppendString(cBBControlOpen + cBBStrike + cBBControlClose); end else if (not (fsStrikeOut in ARichEdit.SelAttributes.Style)) and LBBState.Strike then begin LBBState.Strike := False; LBBState.Text.AppendString(cBBControlOpen + cBBStrikeEnd + cBBControlClose); end;
if ARichEdit.CharScript <> LBBState.CharScript then begin case LBBState.CharScript of csSuper: LBBState.Text.AppendString(cBBControlOpen + cBBSuperEnd + cBBControlClose); csSub: LBBState.Text.AppendString(cBBControlOpen + cBBSubEnd + cBBControlClose); end;
LBBState.CharScript := ARichEdit.CharScript;
case LBBState.CharScript of csSuper: LBBState.Text.AppendString(cBBControlOpen + cBBSuper + cBBControlClose); csSub: LBBState.Text.AppendString(cBBControlOpen + cBBSub + cBBControlClose); end; end;
if LBBState.Color <> ARichEdit.SelAttributes.Color then begin if ARichEdit.SelAttributes.Color = clRed then begin LBBState.Text.AppendString(cBBControlOpen + cBBRed + cBBControlClose); LBBState.Color := clRed; end else begin LBBState.Text.AppendString(cBBControlOpen + cBBRedEnd + cBBControlClose); LBBState.Color := cDefaultColor; end; end; end;
begin for LCol := 1 to Length(ALine) do begin ARichEdit.SelLength := 1; AddControl; LBBState.Text.AppendString(ARichEdit.SelText);
ARichEdit.SelStart := ARichEdit.SelStart + 1; end;
if LRow < ARichEdit.Lines.Count - 1 then LBBState.Text.AppendString(cBBLineBreakComplete); end;
begin LBBState := TBBState.Create; try LBBState.Color := cDefaultColor; for LRow := 0 to ARichEdit.Lines.Count - 1 do begin ARichEdit.SelStart := ARichEdit.EmulatedCharPos(ARichEdit.Perform(EM_LINEINDEX, LRow, 0)); CheckLine(ARichEdit.Lines[LRow]); end;
LBBState.Text.Trim; Result := LBBState.Text.Result; finally LBBState.Free; end; end; ---------------------