Komponente TMemoEx - ein TMemo mit Zeilennummern

[turboPASCAL]

Irgend wann mal braucht man Zeilennummern in einem Memo. Klar, es gibt SynEdit ist aber manchmal ein bissel gross... Warum nicht mal als kleine Komponente ?

Ja ist doch einfach..., das dachte ich mir heute früh und tippte darauf los. Gar nicht so einfach denke ich jetzt.

Soweit funktioniert es jetzt, jedoch gibt es noch ein Problem. Wenn in einer neuen Zeile ein Zeichen eingeg. wird springt der Zähler auf eine neue Zeile.


Wer kann helfen (Bitte nicht nur "Ich" sagen )?

Delphi-Quellcode:

unit MemoEx;

{...}

implementation

{...}

function CountVisibleLines(const Memo: TMemo): Integer;
var
  OldFont: HFont;
  DC: THandle;
  TextMetric: TTextMetric;
begin
  Result := 0;

  DC := GetDC(Memo.Handle);
  try
    OldFont := SelectObject(DC, Memo.Font.Handle);
    try
      GetTextMetrics(DC, TextMetric);
      Result := (Memo.ClientRect.Bottom - Memo.ClientRect.Top) div
        (TextMetric.tmHeight + TextMetric.tmExternalLeading);
    finally
      SelectObject(DC, OldFont);
    end;
  finally
    ReleaseDC(Memo.Handle, DC);
  end;
end;

procedure CalcRect(var R: TRect; aScrollBars: TScrollStyle);
begin
  if aScrollBars = ssBoth then
  begin
    R.Right := R.Right - GetSystemMetrics(SM_CYVSCROLL);
    R.Bottom := R.Bottom - GetSystemMetrics(SM_CYHSCROLL);
  end else
  if aScrollBars = ssHorizontal then
  begin
    R.Bottom := R.Bottom - GetSystemMetrics(SM_CYHSCROLL);
  end else
  if aScrollBars = ssVertical then
    R.Right := R.Right - GetSystemMetrics(SM_CYVSCROLL);
end;

procedure TMemoEx.WMPaint(var Msg: TWMPaint);
var
  canv: Tcanvas;
  r: trect;
  i, h, y: Integer;
  FirstVisibleLine,
  VisibleLines: Integer;
begin
  inherited;

  canv := tcanvas.Create;
  canv.Handle := GetWindowDC(Handle);

  r := ClientRect;
  if self.BorderStyle = bsSingle then
  begin
    r.Top := +GetSystemmetrics(SM_CXEDGE);
    r.Left := +GetSystemmetrics(SM_CXEDGE);
    r.Bottom := r.Bottom + GetSystemmetrics(SM_CXEDGE);
  end;

  FirstVisibleLine := SendMessage(self.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
  VisibleLines := CountVisibleLines(Self);

  with canv do
  begin
    r.Right := FGutterSize;
    brush.Color := clbtnface;

    if FGutterType = gtLine then
    begin
      brush.Color := clWindow;
      pen.Color := cl3DDkShadow;
      canv.MoveTo(r.Right - 2, r.Top);
      canv.LineTo(r.Right - 2, r.Bottom);
    end else
    begin
      FillRect(r);
      Frame3D(canv, r, clBtnHighlight, clBtnShadow, 1);
    end;

    Font := self.Font;
    Font.Color := clBtnText;

    if self.Lines.Count < VisibleLines then h := self.Lines.Count
    else h := FirstVisibleLine + (VisibleLines - 1);

    y := 0;
    for i := FirstVisibleLine to h do
    begin
      TextOut(r.Left + 8, r.Top + (y * textheight('X')),
        format('%4.4d', [i + 1]));
      inc(y);
    end;
  end;

  canv.Free;
end;

{...}

[Lannes]

Hallo,

hast Du Dein Problem schon behoben?
Hier eine mögliche Lösung:

Delphi-Quellcode:

//... für diese Zeilen
//if self.Lines.Count < VisibleLines then h := self.Lines.Count 
//    else h := FirstVisibleLine + (VisibleLines - 1); 
//... das einsetzen
   if self.Lines.Count < VisibleLines then
      begin
      if (Length(self.Text) > 0 ) and 
         (Length(self.Text) = self.SelStart) and (self.Text[Length(self.Text)] = #10) then
         h := self.Lines.Count
         else
           h := self.Lines.Count-1;
      end
      else
        begin
        h := FirstVisibleLine + (VisibleLines-1);
        end;

Hoffe das es das ist was Du Dir vorgestellt hast.

[Master_RC]

danke, sowas hab ich gesucht

Ich finde auch, dass e snicht mehr haben sollte

[Lannes]

Hallo,

etwas müsste noch verbessert werden:
Wenn Scrollbars eingeblendet werden/sind
bzw. die Zeilenanzahl das Ende des Memos erreichen wirkt das noch nicht sauber gelöst.
In einem Standard-Memo sieht das besser aus.

[Master_RC]

---------------------------
Error
---------------------------
Control 'MemoEx1' has no parent window.
---------------------------
OK
---------------------------

[turboPASCAL]

Delphi-Quellcode:

procedure TMemoEx.Change;
begin
  inherited Change;

  {if OldLineCount <> Lines.Count then
  begin
    OldLineCount := Lines.Count;
    Invalidate;
  end; }
  Invalidate;
end;

@Master_RC bitte in MemoEx.pas die if-Abfrage wie oben ausklammern, dann funktioniert es.

Zitat von Lannes :

hast Du Dein Problem schon behoben?

Nein, noch nicht wirklich, ich wollte erst noch das flackern beim eingeben von Zeichen beseitigen...

[Master_RC]

danke!

//EDIT:
Man sollte noch einstellen können, wie oft sich die Zahlen am Rand aktualisieren

[turboPASCAL]

@Master_RC verstehe ich jetzt nicht so recht, wie ist das gemeint ?

----------

Der Fehler ist noch nicht weg, ich komme aber auch nicht dahinter wie er entsteht.