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;