diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/corelib/fpg_base.pas | 1 | ||||
-rw-r--r-- | src/corelib/fpg_widget.pas | 18 | ||||
-rw-r--r-- | src/corelib/x11/fpg_x11.pas | 47 | ||||
-rw-r--r-- | src/gui/fpg_basegrid.pas | 341 |
4 files changed, 316 insertions, 91 deletions
diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas index f3e8f6db..504aa9ea 100644 --- a/src/corelib/fpg_base.pas +++ b/src/corelib/fpg_base.pas @@ -119,6 +119,7 @@ const FPGM_FREEME = 19; FPGM_DROPENTER = 20; FPGM_DROPEXIT = 21; + FPGM_HSCROLL = 22; FPGM_USER = 50000; FPGM_KILLME = MaxInt; diff --git a/src/corelib/fpg_widget.pas b/src/corelib/fpg_widget.pas index a74c1b30..ae18ff98 100644 --- a/src/corelib/fpg_widget.pas +++ b/src/corelib/fpg_widget.pas @@ -39,6 +39,8 @@ type TfpgDragDropEvent = procedure(Sender, Source: TObject; X, Y: integer; AData: variant) of object; + { TfpgWidget } + TfpgWidget = class(TfpgWindow) private FAcceptDrops: boolean; @@ -56,6 +58,7 @@ type FOnMouseMove: TMouseMoveEvent; FOnMouseUp: TMouseButtonEvent; FOnMouseScroll: TMouseWheelEvent; + FOnMouseHorizScroll: TMouseWheelEvent; FOnPaint: TPaintEvent; FOnKeyPress: TKeyPressEvent; FOnResize: TNotifyEvent; @@ -81,6 +84,7 @@ type procedure MsgMouseEnter(var msg: TfpgMessageRec); message FPGM_MOUSEENTER; procedure MsgMouseExit(var msg: TfpgMessageRec); message FPGM_MOUSEEXIT; procedure MsgMouseScroll(var msg: TfpgMessageRec); message FPGM_SCROLL; + procedure MsgMouseHorizScroll(var msg: TfpgMessageRec); message FPGM_HSCROLL; procedure MsgDropEnter(var msg: TfpgMessageRec); message FPGM_DROPENTER; procedure MsgDropExit(var msg: TfpgMessageRec); message FPGM_DROPEXIT; protected @@ -134,6 +138,7 @@ type procedure HandleMouseEnter; virtual; procedure HandleMouseExit; virtual; procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); virtual; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); virtual; function FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget; procedure HandleAlignments(const dwidth, dheight: TfpgCoord); virtual; procedure HandleShow; virtual; @@ -153,6 +158,7 @@ type property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; property OnMouseUp: TMouseButtonEvent read FOnMouseUp write FOnMouseUp; property OnMouseScroll: TMouseWheelEvent read FOnMouseScroll write FOnMouseScroll; + property OnMouseHorizScroll: TMouseWheelEvent read FOnMouseHorizScroll write FOnMouseHorizScroll; property OnPaint: TPaintEvent read FOnPaint write FOnPaint; property OnResize: TNotifyEvent read FOnResize write FOnResize; property OnShowHint: THintEvent read GetOnShowHint write SetOnShowHint; @@ -854,6 +860,12 @@ begin msg.Params.mouse.shiftstate, msg.Params.mouse.delta); end; +procedure TfpgWidget.MsgMouseHorizScroll(var msg: TfpgMessageRec); +begin + HandleMouseHorizScroll(msg.Params.mouse.x, msg.Params.mouse.y, + msg.Params.mouse.shiftstate, msg.Params.mouse.delta); +end; + procedure TfpgWidget.MsgDropEnter(var msg: TfpgMessageRec); begin // do nothing @@ -1189,6 +1201,12 @@ begin FOnMouseScroll(self, shiftstate, delta, Point(x, y)); end; +procedure TfpgWidget.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); +begin + if Assigned(FOnMouseHorizScroll) then + FOnMouseHorizScroll(self, shiftstate, delta, Point(x, y)); +end; + function TfpgWidget.FindFocusWidget(startwg: TfpgWidget; direction: TFocusSearchDirection): TfpgWidget; var w: TfpgWidget; diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas index 20974dfe..27f59abe 100644 --- a/src/corelib/x11/fpg_x11.pas +++ b/src/corelib/x11/fpg_x11.pas @@ -1749,31 +1749,50 @@ begin if not blockmsg then begin if (ev.xbutton.button >= 4) and (ev.xbutton.button <= 7) then // mouse wheel + // 4=up, 5=down, 6=left, 7=right begin // generate scroll events: if ev._type = X.ButtonPress then begin - if ev.xbutton.button = Button4 then + if (ev.xbutton.button = Button4) or (ev.xbutton.button = 6) then // x.pp lacks Button6, Button7 i := -1 else i := 1; // Check for other mouse wheel messages in the queue - while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do - begin - if NewEvent.xbutton.Button = 4 then - Dec(i) - else if NewEvent.xbutton.Button = 5 then - Inc(i) - else - begin - XPutBackEvent(display, @NewEvent); - break; - end; - end; + if ev.xbutton.button in [Button4,Button5] then + while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do + begin + if NewEvent.xbutton.Button = 4 then + Dec(i) + else if NewEvent.xbutton.Button = 5 then + Inc(i) + else + begin + XPutBackEvent(display, @NewEvent); + break; + end; + end + else // button is 6 or 7 + while XCheckTypedWindowEvent(display, ev.xbutton.window, X.ButtonPress, @NewEvent) do + begin + if NewEvent.xbutton.Button = 6 then + Dec(i) + else if NewEvent.xbutton.Button = 7 then + Inc(i) + else + begin + XPutBackEvent(display, @NewEvent); + break; + end; + end; msgp.mouse.delta := i; - fpgPostMessage(nil, w, FPGM_SCROLL, msgp); + + if ev.xbutton.button in [Button4,Button5] then + fpgPostMessage(nil, w, FPGM_SCROLL, msgp) + else + fpgPostMessage(nil, w, FPGM_HSCROLL, msgp); end; end else diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index 51b50408..127403b3 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -50,6 +50,9 @@ type // Column 2 is special just for testing purposes. Descendant classes will // override that special behavior anyway. + + { TfpgBaseGrid } + TfpgBaseGrid = class(TfpgWidget) private FColResizing: boolean; @@ -132,11 +135,13 @@ type procedure HandleResize(awidth, aheight: TfpgCoord); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; procedure HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); override; procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override; procedure FollowFocus; virtual; + procedure PrepareCells (firstrow, lastrow, firstcol, lastcol : integer); virtual; property AlternateBGColor: TfpgColor read FAlternativeBGColor write SetAlternativeBGColor default clHilite1; property BorderStyle: TfpgEditBorderStyle read FBorderStyle write SetBorderStyle default ebsDefault; property DefaultColWidth: integer read FDefaultColWidth write SetDefaultColWidth default 64; @@ -585,76 +590,180 @@ var VHeight: integer; vw: integer; cw: integer; + vl: integer; i: integer; x: integer; + hmax: integer; + vmax: integer; + Hfits, showH : boolean; + Vfits, showV : boolean; + + procedure hideScrollbar (sb : TfpgScrollBar); + begin + with sb do + if Visible then + begin + Visible := False; + UpdateWindowPosition; + end; + end; + + procedure getVisWidth; + begin + if showV then + vw := HWidth - (FVScrollBar.Width-1) + else + vw := HWidth; + Hfits := vw >= cw; + end; + + procedure getVisLines; + var + hh : integer; // header height + begin + hh := 0; + if ShowHeader then inc (hh, FHeaderHeight+1); + if showH then inc (hh, FHScrollBar.Height); + vl := (VHeight - hh) div FDefaultRowHeight; + Vfits := vl >= RowCount; + end; + begin + // if we don't want any scrollbars, hide them and exit + if FScrollBarStyle = ssNone then + begin + hideScrollbar (FHScrollBar); + hideScrollbar (FVScrollBar); + exit; + end; + + // preliminary width/height calculations VHeight := Height - 4; HWidth := Width - 4; - - vw := VisibleWidth; cw := 0; for i := 0 to ColumnCount-1 do cw := cw + ColumnWidth[i]; - - // This needs improving while resizing - if cw > vw then - FHScrollBar.Visible := not (FScrollBarStyle in [ssNone, ssVertical]) - else - begin - FHScrollBar.Visible := False; - FFirstCol := 0; - FXOffset := 0; - end; + showV := False; + showH := False; + getVisWidth; + getVisLines; - // This needs improving while resizing - if (RowCount > VisibleLines) then - FVScrollBar.Visible := not (FScrollBarStyle in [ssNone, ssHorizontal]) - else - begin - FVScrollBar.Visible := False; - FFirstRow := 0; + // determine whether to show scrollbars for different configurations + case FScrollBarStyle of + ssHorizontal: + begin + hideScrollbar (FVScrollBar); + if not Hfits then + begin + showH := true; + getVisLines; + end; + end; + ssVertical: + begin + hideScrollbar (FHScrollBar); + if not Vfits then + begin + showV := true; + getVisWidth; + end; + end; + ssAutoBoth: + if not Vfits then + begin + showV := true; + getVisWidth; + if not Hfits then + begin + showH := true; + getVisLines; + getVisWidth; + end; + end + else if not Hfits then + begin + showH := true; + getVisLines; + if not Vfits then + begin + showV := true; + getVisWidth; + getVisLines; + end; + end; end; - if FVScrollBar.Visible then - begin + // set the scrollbar width/height space + if showV then Dec(HWidth, FVScrollBar.Width); + if showH then + Dec(VHeight, FHScrollBar.Height); + + // show or hide the scrollbars + + if showV then + begin + FVScrollBar.Visible := true; FVScrollBar.Min := 0; if RowCount > 0 then FVScrollBar.SliderSize := VisibleLines / RowCount else FVScrollBar.SliderSize := 0; - FVScrollBar.Max := RowCount-VisibleLines; + vmax := RowCount-VisibleLines; + if FFirstRow>vmax then + FFirstRow:=vmax; + FVScrollBar.Max := vmax; FVScrollBar.Position := FFirstRow; FVScrollBar.RepaintSlider; + FVScrollBar.Top := 2; + FVScrollBar.Left := Width - FVScrollBar.Width - 2; + FVScrollBar.Height := VHeight; + end + else + begin + FVScrollBar.Visible := false; + if Vfits then + FFirstRow := 0; + // if vertical doesn't fit and no scrollbar, do not change firstrow end; - - if FHScrollBar.Visible then + + if showH then begin - Dec(VHeight, FHScrollBar.Height); + FHScrollBar.Visible := true; FHScrollBar.Min := 0; if go_SmoothScroll in FOptions then begin - FHScrollBar.Max := cw - vw; + hmax := cw - vw; + FHScrollBar.Max := hmax; + if FXOffset>hmax then + FXOffset:=hmax; FHScrollBar.Position := FXOffset; - FHScrollBar.SliderSize := Width / TotalColumnWidth; + FHScrollBar.SliderSize := HWidth / TotalColumnWidth; + FHScrollBar.PageSize := 5; end else begin FHScrollBar.Max := ColumnCount-1; FHScrollBar.Position := FFirstCol; FHScrollBar.SliderSize := 1 / ColumnCount; + FHScrollBar.PageSize := 1; end; FHScrollBar.RepaintSlider; + FHScrollBar.Top := Height -FHScrollBar.Height - 2; + FHScrollBar.Left := 2; + FHScrollBar.Width := HWidth; + end + else + begin + FHScrollBar.Visible := false; + if Hfits then + begin + FFirstCol := 0; + FXOffset := 0; + end; + // if horizontal doesn't fit and no scrollbar, do not change firstcol/xoffset end; - FHScrollBar.Top := Height -FHScrollBar.Height - 2; - FHScrollBar.Left := 2; - FHScrollBar.Width := HWidth; - - FVScrollBar.Top := 2; - FVScrollBar.Left := Width - FVScrollBar.Width - 2; - FVScrollBar.Height := VHeight; - FVScrollBar.UpdateWindowPosition; FHScrollBar.UpdateWindowPosition; end; @@ -673,7 +782,9 @@ var clipr: TfpgRect; // clip rectangle drawstate: TfpgGridDrawState; cLeft: integer; - c: integer; + rTop: integer; + firstcol, lastcol, firstrow, lastrow : integer; + cWidths: array of integer; begin Canvas.ClearClipRect; @@ -704,32 +815,87 @@ begin r := clipr; cLeft := FMargin; // column starting point + rTop := FMargin; // row starting point + if go_SmoothScroll in FOptions then begin if FHScrollBar.Visible then Dec(cLeft, FHScrollBar.Position); - c := 0; + firstcol := 0; end else begin - c := FFirstCol; + firstcol := FFirstCol; + end; + + // calculate column widths, and first/last columns + if (ColumnCount <= 0) then + begin + firstcol := -1; + lastcol := -2; + end + else + begin + setlength (cWidths, ColumnCount); + r.Left := cLeft; + for col := firstcol to ColumnCount-1 do + begin + cWidths[col] := ColumnWidth[col]; + r.Width := cWidths[col]; + if (go_SmoothScroll in FOptions) and (r.Left <= clipr.Left) then + begin + firstcol := col; + if col>0 then inc (cLeft, cWidths[col-1]); + end; + lastcol := col; + if r.Right >= clipr.Right then + break; + inc (r.Left, r.Width); + end; + // first/last rows... + if (RowCount <= 0) then + begin + firstrow := -1; + lastrow := -2; + end + else + begin + if ShowHeader then + inc (r.Top, FHeaderHeight); + if r.Top > clipr.Bottom then + begin + firstrow := -1; + lastrow := -2; + end + else + begin + firstrow := FFirstRow; + lastrow := firstrow + (clipr.Bottom - r.Top) div DefaultRowHeight; + if lastrow >= RowCount then + lastrow := RowCount-1; + end; + end; end; + PrepareCells (firstrow, lastrow, firstcol, lastcol); + + r.Left := cLeft; + r.Top := rTop; + if (ColumnCount > 0) and ShowHeader then begin // Drawing horizontal headers - r.Left := cLeft; r.Height := FHeaderHeight; Canvas.SetFont(FHeaderFont); - for col := c to ColumnCount-1 do + for col := firstcol to lastcol do begin - r.Width := ColumnWidth[col]; + r.Width := cWidths[col]; Canvas.SetClipRect(clipr); Canvas.AddClipRect(r); DrawHeader(col, r, 0); inc(r.Left, r.Width); - if r.Left >= clipr.Right then - Break; // small optimization. Don't draw what we can't see + //if r.Left >= clipr.Right then + // Break; // optimization made obsolete by lastcol end; inc(r.Top, r.Height); end; @@ -740,13 +906,13 @@ begin r.Height := DefaultRowHeight; Canvas.SetFont(FFont); - for row := FFirstRow to RowCount-1 do + for row := firstrow to lastrow do begin r.Left := cLeft; - for col := c to ColumnCount-1 do + for col := firstcol to lastcol do begin drawstate := []; - r.Width := ColumnWidth[col]; + r.Width := cWidths[col]; Canvas.SetClipRect(clipr); if (row = FFocusRow) and (RowSelect or (col = FFocusCol)) and not (go_HideFocusRect in FOptions) then @@ -774,7 +940,6 @@ begin Include(drawstate, gdFocused); if (row = FFocusRow) and (col = FFocusCol) then Include(drawstate, gdSelected); - if DoDrawCellEvent(row, col, r, drawstate) then DrawCell(row, col, r, drawstate); @@ -783,13 +948,13 @@ begin DrawGrid(row, col, r, 0); inc(r.Left, r.Width); - if r.Left >= clipr.Right then - Break; // small optimization. Don't draw what we can't see + //if r.Left >= clipr.Right then + // Break; // optimization made obsolete by lastcol end; // Inc(r.Top, FDefaultRowHeight+1); inc(r.Top, r.Height); - if r.Top >= clipr.Bottom then - break; + //if r.Top >= clipr.Bottom then + // break; // optimization made obsolete by lastrow end; end; // item drawing @@ -1008,49 +1173,66 @@ end; procedure TfpgBaseGrid.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); var lRow: Integer; - lCol: Integer; begin inherited HandleMouseScroll(x, y, shiftstate, delta); lRow := FFirstRow; - lCol := FFirstCol; - if delta > 0 then // scroll down - inc(FFirstRow, abs(delta)*3) - else // scroll up - if FFirstRow > 0 then - dec(FFirstRow, abs(delta)*3); + // If vertical scrollbar is not visible, but + // horizontal is, Mouse wheel will scroll horizontally. :) + if FHScrollBar.Visible and (not FVScrollBar.Visible) then + begin + HandleMouseHorizScroll(x, y, shiftstate, delta); + Exit; + end; + + inc(FFirstRow, delta*3); // apply limits if FFirstRow > RowCount - VisibleLines then FFirstRow := RowCount - VisibleLines; if FFirstRow < 0 then FFirstRow := 0; - - // scroll left/right - // If vertical scrollbar is not visible, but - // horizontal is. Mouse wheel will scroll horizontally. :) - if FHScrollBar.Visible and (not FVScrollBar.Visible) then - begin - if delta > 0 then // scroll right - begin - if FFirstCol < (ColumnCount-1) then - inc(FFirstCol); - end - else - begin - if FFirstCol > 0 then - dec(FFirstCol); - end; - end; - if (lRow <> FFirstRow) or (lCol <> FFirstCol) then + if lRow <> FFirstRow then begin UpdateScrollBars; RePaint; end; end; +procedure TfpgBaseGrid.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); +var + old_val: Integer; +begin + inherited HandleMouseHorizScroll(x, y, shiftstate, delta); + + if go_SmoothScroll in Options then + begin + old_val := FXOffset; + inc(FXOffset, delta*FHScrollBar.ScrollStep); + if (FXOffset<0) then + FXOffset:=0; + // finding the maximum Xoffset is tricky, let updatescrollbars do it. + if (FXOffset=old_val) then + Exit; + end + else + begin + old_val := FFirstCol; + inc(FFirstCol, delta); + if FFirstCol<0 then + FFirstCol:=0 + else if FFirstCol > ColumnCount-1 then + FFirstCol:=ColumnCount-1; + if FFirstCol=old_val then + Exit; + end; + + UpdateScrollBars; + RePaint; +end; + procedure TfpgBaseGrid.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); var hh: integer; @@ -1283,6 +1465,11 @@ begin UpdateScrollBars; end; +procedure TfpgBaseGrid.PrepareCells(firstrow, lastrow, firstcol, lastcol: integer); +begin + // for descendents +end; + constructor TfpgBaseGrid.Create(AOwner: TComponent); begin Updating; @@ -1329,7 +1516,7 @@ begin FHScrollBar.Orientation := orHorizontal; FHScrollBar.Visible := False; FHScrollBar.OnScroll := @HScrollBarMove; - FHScrollBar.ScrollStep := 5; + FHScrollBar.ScrollStep := 20; end; destructor TfpgBaseGrid.Destroy; |