[Bug 16597] Wrong detection of SelAttributes in RichEdit
wine-bugs at winehq.org
wine-bugs at winehq.org
Tue Dec 23 05:01:47 CST 2008
http://bugs.winehq.org/show_bug.cgi?id=16597
--- Comment #2 from bas <teach2000 at 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;
---------------------
--
Configure bugmail: http://bugs.winehq.org/userprefs.cgi?tab=email
Do not reply to this email, post in Bugzilla using the
above URL to reply.
------- You are receiving this mail because: -------
You are watching all bug changes.
More information about the wine-bugs
mailing list