Einzelnen Beitrag anzeigen

Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#1

Scrollbar springt immer zurück

  Alt 25. Sep 2012, 20:11
Ich versuche gerade, ein Control zu schreiben, das so ähnlich funktionieren soll wie die Konsole von der Eingabeaufforderung, d.h. es gibt einen Buffer mit Text, und man soll darin u.a. scrollen können. Das Zeichnen funktioniert, und die Scrollbars werden auch richtig angezeigt; man kann sogar mit dem Balken scrollen, solange man die linke Maustaste gedrückt hält. Aber sobald man sie loslässt, springt die Scrollbar wieder auf Position 0 zurück.

Ich habe jetzt bestimmt über eine Stunde im MSDN und in VCL-Sourcen rumgesucht und werde einfach nicht daraus schlau...

Hier ist die Komponente mal nur auf die Scroll-relevanten Teile reduziert:

Delphi-Quellcode:
TConsoleOutput = class(TCustomControl)
  FOffsetX, FOffsetY: integer;

  procedure CreateHandle; override;
  procedure CreateParams(var Params: TCreateParams); override;

  procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
  procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;

  function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
    MousePos: TPoint): Boolean; override;
  procedure UpdateScrollbars;
end;

implementation

procedure TConsoleOutput.CreateHandle;
begin
  inherited;
  ShowScrollbar(Handle, SB_BOTH, True);
end;

procedure TConsoleOutput.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_HSCROLL or WS_VSCROLL;
end;

procedure TConsoleOutput.WMHScroll(var Message: TWMHScroll);
begin
  FOffsetX := Message.Pos;
  Repaint;
  Message.Result := 0;
end;

procedure TConsoleOutput.WMVScroll(var Message: TWMVScroll);
begin
  FOffsetY := Message.Pos;
  Repaint;
  Message.Result := 0;
end;

// Methoden für Scrollen mit Mausrad (funktioniert perfekt)

function TConsoleOutput.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  FOffsetY := Max(Min(FOffsetY - WheelDelta, (FBuffer.Count-1)*GetLineHeight), 0);

  UpdateScrollbars;

  Repaint;
end;

procedure TConsoleOutput.UpdateScrollbars;
var
  ScrollInfo: TScrollInfo;
begin
  ScrollInfo.nPos := FOffsetY;
  ScrollInfo.nMin := 0;
  ScrollInfo.nPage := Height;
  ScrollInfo.nMax := (FBuffer.Count-1)*GetLineHeight + ScrollInfo.nPage;
  ScrollInfo.fMask := SIF_PAGE or SIF_POS or SIF_RANGE;
  SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);

  ScrollInfo.nPage := Width;
  ScrollInfo.nPos := FOffsetX;
  ScrollInfo.nMin := 0;
  ScrollInfo.nMax := FLongestLine;
  ScrollInfo.fMask := SIF_PAGE or SIF_POS or SIF_RANGE;
  SetScrollInfo(Handle, SB_HORZ, ScrollInfo, True);
end;
Kann mir jemand von euch sagen, was da fehlt?
  Mit Zitat antworten Zitat