to get all infos at the position of caret

[j&b]

Hello,

I want to get all infos at the position of caret (which is in a memo or in a “memo-table”).
This was created under Vista, Delphi 7.1 and TDBRichViewEdit v13.9


Who can complete or finish or correct the following code ?



procedure TForm1.sbTesten1Click(Sender: TObject);
var fi: TFontInfo;
schrSchnitt,schrFarbe, hgFarbe, itemStil, paraStil: string;
r,c: integer;
begin
IgnoreChanges := True; // ???
fi := rvs.TextStyles[Memo.CurTextStyleNo];
IgnoreChanges := False; // ???

if fsBold in fi.Style then schrSchnitt:= 'fett, ';
if fsItalic in fi.Style then schrSchnitt:= schrSchnitt+'kursiv, ';
if fsUnderline in fi.Style then schrSchnitt:= schrSchnitt+'unterstrichen, ';
if fsStrikeOut in fi.Style then schrSchnitt:= schrSchnitt+'durchgestrichen';
if fi.Style= [] then schrSchnitt:= 'normal';
schrSchnitt:=str_DelE(schrSchnitt, #32); //löscht am Stringende: #32
schrSchnitt:=str_DelE(schrSchnitt, ','); //löscht am Stringende: ','

case fi.color of
0: schrFarbe:= 'schwarz';
255: schrFarbe:= 'rot';
16711680: schrFarbe:= 'blau';
536870911: schrFarbe:= 'weiß';
3252790: schrFarbe:= 'grün';
65280: schrFarbe:= 'hellgrün';
16711935: schrFarbe:= 'fuchsia';
65535: schrFarbe:= 'gelb';
13146423: schrFarbe:= 'türkis';
else schrFarbe:= intToStr(fi.color);
end;

case fi.backcolor of
0: hgFarbe:= 'schwarz';
255: hgFarbe:= 'rot';
16711680: hgFarbe:= 'blau';
536870911: hgFarbe:= 'weiß';
3252790: hgFarbe:= 'grün';
65280: hgFarbe:= 'hellgrün';
16711935: hgFarbe:= 'fuchsia';
65535: hgFarbe:= 'gelb';
13146423: hgFarbe:= 'türkis';
else hgFarbe:= intToStr(fi.backcolor);
end;

//---- GetItemStyle --------------------------------------------------------
//(* //muss dieses Splittung in Tabelle + Nicht-Tabelle sein ?
if memo.GetItemStyle(memo.CurItemNo)= -60 then begin
if memo.GetCurrentItemEx(TRVTableItemInfo, rve, TCustomRVItemInfo(rveTable)) then rveTable.GetEditedCell(r,c);
case rveTable.Cells[r,c].GetRVData.GetItemStyle(0) of
0: ItemStil:= 'normal text';
1: ItemStil:= 'Heading 1';
2: ItemStil:= 'Heading 2';
3: ItemStil:= 'Keywords';
4: ItemStil:= 'Hypertext 1';
5: ItemStil:= 'Hypertext 2';
6: ItemStil:= '6';
10: ItemStil:= 'normal';
11: ItemStil:= 'hochgestellt';
12: ItemStil:= '12';
13: ItemStil:= 'tiefgestellt';
-1: ItemStil:= 'break (horizontal line)';
-3: ItemStil:= 'picture';
-4: ItemStil:= 'hotspot (picture from ImageList - hyperlink)';
-5: ItemStil:= 'inserted Delphi control';
-6: ItemStil:= 'bullet (picture from ImageList)';
-10: ItemStil:= 'hot picture (picture - hyperlink)';
-11: ItemStil:= 'list marker (bullet or numbering of paragraphs)';
-12: ItemStil:= 'tabulator';
-60: ItemStil:= 'table';
-200: ItemStil:= 'label (non-text item looking like text)';
-202: ItemStil:= 'numbered sequence';
-203: ItemStil:= 'footnote';
-204: ItemStil:= 'endnote';
-205: ItemStil:= 'reference to the parent footnote or endnote';
else ItemStil:= intToStr(rveTable.Cells[r,c].GetRVData.GetItemStyle(0));
end;
end else begin
//*)
case memo.GetItemStyle(memo.CurItemNo) of
0: ItemStil:= 'normal text';
1: ItemStil:= 'Heading 1';
2: ItemStil:= 'Heading 2';
3: ItemStil:= 'Keywords';
4: ItemStil:= 'Hypertext 1';
5: ItemStil:= 'Hypertext 2';
6: ItemStil:= '6';
10: ItemStil:= 'normal';
11: ItemStil:= 'hochgestellt';
12: ItemStil:= '12';
13: ItemStil:= 'tiefgestellt';
-1: ItemStil:= 'break (horizontal line)';
-3: ItemStil:= 'picture';
-4: ItemStil:= 'hotspot (picture from ImageList - hyperlink)';
-5: ItemStil:= 'inserted Delphi control';
-6: ItemStil:= 'bullet (picture from ImageList)';
-10: ItemStil:= 'hot picture (picture - hyperlink)';
-11: ItemStil:= 'list marker (bullet or numbering of paragraphs)';
-12: ItemStil:= 'tabulator';
-60: ItemStil:= 'table';
-200: ItemStil:= 'label (non-text item looking like text)';
-202: ItemStil:= 'numbered sequence';
-203: ItemStil:= 'footnote';
-204: ItemStil:= 'endnote';
-205: ItemStil:= 'reference to the parent footnote or endnote';
else ItemStil:= intToStr(memo.GetItemStyle(memo.CurItemNo));
end;

end;

//---- GetItemPara --------------------------------------------------------

//(* muss dieses Splittung in Tabelle + Nicht-Tabelle sein ?
if memo.GetItemStyle(memo.CurItemNo)= -60 then begin //Tabelle
if memo.GetCurrentItemEx(TRVTableItemInfo, rve, TCustomRVItemInfo(rveTable)) then rveTable.GetEditedCell(r,c);
case rveTable.Cells[r,c].GetRVData.GetItemPara(0) of
0: ParaStil:= 'normal text';
else ParaStil:= intToStr(rveTable.Cells[r,c].GetRVData.GetItemPara(0));
end;
end else begin //<> Tabelle
//*)
case memo.GetItemPara(memo.CurItemNo) of
0: ParaStil:= 'Normaler Text';
else ParaStil:= intToStr(memo.GetItemPara(memo.CurItemNo));
end;

end;

//-------------- Hier sollen fehlende Informationen rein --------------------


//-----------------------------------------------------------------------------


//Auswertung
ShowMessage('Schriftart: '+fi.fontname+#10+
'Schriftgrad: '+intToStr(fi.size)+#10+
'Schriftschnitt: '+schrSchnitt+#10+
'Schriftfarbe: '+schrFarbe+#10+
'Hintergrundfarbe: '+hgFarbe+#10+
'ItemStyle: '+ItemStil+#10+
'ParaStyle: '+paraStil+#10#10);

end;

[Sergey Tkachenko]

Something like this.

Code: Select all

procedure AddStr(var s1: String; const s2: String);
begin
  if s1='' then
    s1 := s2
  else
    s1 := s1+', '+s2;
end;

procedure AddStrSpace(var s1: String; const s2: String);
begin
  if s1='' then
    s1 := s2
  else
    s1 := s1+' '+s2;
end;

function DescribeColor(Color: TColor): String;
begin
  Result := ColorToString(Color);
  if (Result[1]='c') then
    Result := LowerCase(Copy(Result, 3, Length(Result)));
end;


function DescribeTextStyle(fi: TFontInfo): String;
begin
  Result := Format('"%s", %d, color=%s', [fi.FontName, fi.Size, DescribeColor(fi.Color)]);
  if fi.BackColor<>clNone then
    AddStr(Result, 'background='+DescribeColor(fi.BackColor));
  if fsBold in fi.Style then
    AddStr(Result, 'bold');
  if fsItalic in fi.Style then
    AddStr(Result, 'italic');
  if fsUnderline in fi.Style then
    AddStr(Result, 'underline');
  if fsStrikeOut in fi.Style then
    AddStr(Result, 'strike out');
  if rvfsOverline in fi.StyleEx then
    AddStr(Result, 'overline');
  if rvfsAllCaps in fi.StyleEx then
    AddStr(Result, 'all caps');
end;

function DescribeParaStyle(pi: TParaInfo): String;
begin
  Result := '';
  if pi.OutlineLevel>0 then
    AddStr(Result, Format('heading %d', [pi.OutlineLevel]));
  case pi.Alignment of
    rvaLeft: AddStr(Result, 'left');
    rvaRight: AddStr(Result, 'right');
    rvaCenter: AddStr(Result, 'center');
    rvaJustify: AddStr(Result, 'justify');
  end;
  if (pi.SpaceBefore<>0) or (pi.SpaceAfter<>0) then
    AddStr(Result, 'space:');
  if pi.SpaceBefore<>0 then
    AddStrSpace(Result, Format('before=%d', [pi.SpaceBefore]));
  if pi.SpaceAfter<>0 then
    AddStrSpace(Result, Format('after=%d', [pi.SpaceAfter]));
  if (pi.LeftIndent<>0) or (pi.RightIndent<>0) or (pi.FirstIndent<>0) then
    AddStr(Result, 'indent:');
  if pi.LeftIndent<>0 then
    AddStrSpace(Result, Format('left=%d', [pi.LeftIndent]));
  if pi.RightIndent<>0 then
    AddStrSpace(Result, Format('right=%d', [pi.RightIndent]));
  if pi.FirstIndent<>0 then
    AddStrSpace(Result, Format('first line=%d', [pi.FirstIndent]));
  case pi.LineSpacingType of
    rvlsPercent:
      if pi.LineSpacing<>100 then
        AddStr(Result, Format('line spacing=%d%%', [pi.LineSpacing]));
    rvlsSpaceBetween:
        AddStr(Result, Format('spacing between lines=%d', [pi.LineSpacing]));
    rvlsLineHeightAtLeast:
        AddStr(Result, Format('line height at least %d', [pi.LineSpacing]));
    rvlsLineHeightExact:
        AddStr(Result, Format('line height exactly %d', [pi.LineSpacing]));
  end;
  if pi.Background.Color<>clNone then
    AddStr(Result, 'background='+DescribeColor(pi.Background.Color))
end;

function DescribeCurrentItem(rve: TCustomRichViewEdit): String;
var TextStyleNo: Integer;
    InCell: Boolean;
begin
  Result := '';
  InCell := rve.InplaceEditor<>nil;
  rve := rve.TopLevelEditor;
  case rve.CurItemStyle of
    rvsBreak: AddStr(Result, 'break (horizontal line)');
    rvsPicture, rvsHotPicture: AddStr(Result, 'picture');
    rvsBullet, rvsHotspot: AddStr(Result, 'picture from image list');
    rvsComponent: AddStr(Result, 'control');
    rvsListMarker: AddStr(Result,  'list marker');
    rvsTab: AddStr(Result,  'tabulator');
    rvsTable: AddStr(Result, 'table');
    rvsLabel: AddStr(Result, 'label');
    rvsSequence: AddStr(Result, 'numbered sequence');
    rvsFootnote: AddStr(Result, 'footnote');
    rvsEndnote: AddStr(Result, 'endnote');
    rvsNoteReference: AddStr(Result, 'note reference');
    else
      if rve.CurItemStyle>=0 then
        AddStr(Result, 'text '#13#10'font {'+DescribeTextStyle(rve.Style.TextStyles[rve.CurItemStyle])+'}')
      else
        AddStr(Result, 'other object');
  end;
  if (rve.CurItemStyle<0) then begin
    TextStyleNo := TRVNonTextItemInfo(rve.GetCurrentItem).AssociatedTextStyleNo;
    if TextStyleNo>=0 then
      AddStr(Result, #13#10'font {'+DescribeTextStyle(rve.Style.TextStyles[TextStyleNo])+'}')
  end;
  if rve.GetCurrentItem.GetBoolValueEx(rvbpJump, rve.Style) then
    AddStr(Result, #13#10'hyperlink');
  if InCell then
    AddStr(Result, #13#10'paragraph inside table cell')
  else
    AddStr(Result, #13#10'paragraph');
  AddStrSpace(Result, '{'+DescribeParaStyle(rve.Style.ParaStyles[rve.CurParaStyleNo])+'}')
end;

procedure TForm3.RichViewEdit1Click(Sender: TObject);
begin
  ShowMessage(DescribeCurrentItem(RichViewEdit1))
end;

[Sergey Tkachenko]

Note 1: Of course, the code above does not display all the properties. It displays the most of properties of a text style (except for hyperlink properties), of a paragraph style (except for borders and background color padding).
However, it does not display properties specific to the item type. For example, for pictures it shows 'picture', without specifying its type, size, alternative text, spacing around, etc.

Note 2: As you asked, this code displays properties at the position of the caret ("current item"). But this is not properties of the clicked item! For example, list marker never becomes a clicked item. Or if you click to the left side of an item, the caret is moved before it, and the previous item becomes current.

[j&b]

[quote="Sergey Tkachenko"]Something like this.

Thank you.

But when I use your solution, I must deactivate the red lines below (Undefinierter Bezeichner: 'rvsLabel'
[Hinweis] unit1_mh.pas(1230): Das private-Symbol 'HySuchen_Memo)

Why ?

Best regards

j&b


...
function DescribeCurrentItem(rve: TCustomRichViewEdit): String;
var TextStyleNo: Integer;
InCell: Boolean;
begin
Result := '';
...
{
rvsLabel: AddStr(Result, 'label');
rvsSequence: AddStr(Result, 'numbered sequence');
rvsFootnote: AddStr(Result, 'footnote');
rvsEndnote: AddStr(Result, 'endnote');
rvsNoteReference: AddStr(Result, 'note reference');
}
...

[Sergey Tkachenko]

Add RVLabelItem, RVSeqItem, RVNote in "uses".