Ich habe es jetzt hinbekommen!
Hier eine immerhin funktionierende Prozedur, kann aber sicher noch optimiert werden! Probleme gibt's nur mit WordWrap, wenn die Zeilenlängen zu eng zusammengestaucht sind. Aber vielleicht schaffe ich auch das noch. Es klappt auch mit TJvRichEdit von den Jedis, nicht aber mit TCustomRichEdit.
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123:
| procedure TForm1.Textfolding(const aRichEdit: TRichEdit; const cCollapse, cExpand: Char; const aFontName: String); var i, n, iSelStart, y: Integer;
procedure HideText(const aRichEdit: TRichEdit); var Format: TCharFormat2; begin FillChar(Format, SizeOf(Format), 0);
with Format do begin cbSize := SizeOf(Format); dwMask := CFM_HIDDEN; dwEffects := CFM_HIDDEN; end;
SendMessage(aRichEdit.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Format)); end;
procedure ShowText(const aRichEdit: TRichEdit); var Format: TCharFormat2; begin FillChar(Format, SizeOf(Format), 0);
with Format do begin cbSize := SizeOf(Format); dwMask := CFM_HIDDEN; dwEffects := 0; end;
SendMessage(aRichEdit.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Format)); end;
begin with aRichEdit do begin if CaretPos.X = 0 then begin if (Length(Lines[CaretPos.Y]) = 0) then exit;
if (Lines[CaretPos.Y][1] = cCollapse) or (Lines[CaretPos.Y][1] = cExpand) then begin n := 0; iSelStart := SelStart; y := CaretPos.Y;
Lines.BeginUpdate;
try if not (aFontName = '') then begin SelLength := 1; if not (AnsiLowerCase(SelAttributes.Name) = AnsiLowerCase(aFontName)) then exit; end; SelLength := 0;
if (Lines[CaretPos.Y][1] = cCollapse) then for i := CaretPos.Y+1 to Lines.Count-1 do begin if Lines[i] = '' then break;
Inc(n, Length(Lines[i])+1); end;
if (Lines[CaretPos.Y][1] = cCollapse) then begin SelLength := 1; SelText := cExpand;
SelStart := SelStart+Length(Lines[CaretPos.Y]); SelLength := n;
if n > 0 then while SelText[Length(SelText)] <> #13 do SelLength := SelLength-1;
HideText(aRichEdit); end else begin SelLength := 1; SelText := cCollapse;
SelStart := SelStart+Length(Lines[y]);
n := SelStart; for i := y-1 to Lines.Count-1 do begin if Lines[i] = '' then break;
Inc(n); end;
SelLength := Length(Lines[y+1]); if SelLength = 0 then exit;
for i := n downto iSelStart do if SelText[Length(SelText)] <> #13 then SelLength := SelLength-1;
ShowText(aRichEdit); end;
finally SelStart := iSelStart; SelLength := 0; Lines.EndUpdate; end; end; end; end; end; |
Edit:
Die Prozedur war immer noch fehlerhaft (SelLength war beim wieder sichtbarmachen des Textes zu lang oder, je nach SelStart, zu kurz), ich habe sie daher aktualisiert.
Edit:
Nach Zuweisung von
SelLength := n: und
SelLength := Length(Lines[y+1]); noch jeweils SelText prüfen:
Delphi-Quelltext
1: 2:
| if (SelText = '') or not (SelText[Length(SelText)] = #13) then exit; |
gedunstig war's - und fahle wornen zerschellten karsig im gestrock. oh graus, es gloomt der jabberwock - und die graisligen gulpen nurmen!