From 701873c5a99b5e4c24290efc7f07bfeda5d87cd9 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Wed, 17 Apr 2013 19:11:44 -0700 Subject: Grids: improve UpdateScrollbars for resizing etc --- src/gui/fpg_basegrid.pas | 122 +++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 108 insertions(+), 14 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index 51b50408..d7d6a6c6 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -585,34 +585,128 @@ var VHeight: integer; vw: integer; cw: integer; + vl: integer; i: integer; x: 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]; + showV := False; + showH := False; + getVisWidth; + getVisLines; + + // 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; - // This needs improving while resizing - if cw > vw then - FHScrollBar.Visible := not (FScrollBarStyle in [ssNone, ssVertical]) + if showH then + FHScrollBar.Visible := true else begin - FHScrollBar.Visible := False; - FFirstCol := 0; - FXOffset := 0; + 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; - - // This needs improving while resizing - if (RowCount > VisibleLines) then - FVScrollBar.Visible := not (FScrollBarStyle in [ssNone, ssHorizontal]) + + if showV then + FVScrollBar.Visible := true else begin - FVScrollBar.Visible := False; - FFirstRow := 0; + FVScrollBar.Visible := false; + if Vfits then + FFirstRow := 0; + // if vertical doesn't fit and no scrollbar, do not change firstrow end; if FVScrollBar.Visible then -- cgit v1.2.3-70-g09d2 From c0bbd17213034ceda7f078ac1d2adb0d5561a7d7 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Wed, 17 Apr 2013 22:45:01 -0700 Subject: Grids: basegrid updateScrollbars almost done --- src/gui/fpg_basegrid.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/gui') diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index d7d6a6c6..42e92053 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -730,7 +730,7 @@ begin begin FHScrollBar.Max := cw - vw; FHScrollBar.Position := FXOffset; - FHScrollBar.SliderSize := Width / TotalColumnWidth; + FHScrollBar.SliderSize := HWidth / TotalColumnWidth; end else begin -- cgit v1.2.3-70-g09d2 From f95f261dc0a36fc387cc7295d68cafc71410b0c9 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Wed, 17 Apr 2013 22:47:05 -0700 Subject: Grids: basegrid updateScrollbars done? --- src/gui/fpg_basegrid.pas | 66 ++++++++++++++++++++++++------------------------ 1 file changed, 33 insertions(+), 33 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index 42e92053..c86f3bb5 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -686,32 +686,17 @@ begin end; end; + // set the scrollbar width/height space + if showV then + Dec(HWidth, FVScrollBar.Width); if showH then - FHScrollBar.Visible := true - 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; + Dec(VHeight, FHScrollBar.Height); - if showV then - FVScrollBar.Visible := true - else - begin - FVScrollBar.Visible := false; - if Vfits then - FFirstRow := 0; - // if vertical doesn't fit and no scrollbar, do not change firstrow - end; + // show or hide the scrollbars - if FVScrollBar.Visible then + if showV then begin - Dec(HWidth, FVScrollBar.Width); + FVScrollBar.Visible := true; FVScrollBar.Min := 0; if RowCount > 0 then FVScrollBar.SliderSize := VisibleLines / RowCount @@ -720,11 +705,21 @@ begin FVScrollBar.Max := RowCount-VisibleLines; 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 @@ -739,16 +734,21 @@ begin FHScrollBar.SliderSize := 1 / ColumnCount; 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; -- cgit v1.2.3-70-g09d2 From 499be68f396eb7d31c835f57762b7175c56ded9a Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Thu, 18 Apr 2013 00:51:02 -0700 Subject: Grids: basegrid pre calculation, not drawing right --- src/gui/fpg_basegrid.pas | 86 +++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 71 insertions(+), 15 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index c86f3bb5..e7b98f98 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -767,7 +767,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; @@ -798,32 +800,86 @@ 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 and rows + 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[firstcol] := ColumnWidth[col]; + r.Width := cWidths[firstcol]; + lastcol := col; + if (go_SmoothScroll in FOptions) and (r.Left <= clipr.Left) then + firstcol := col; + if r.Right >= clipr.Right then + break; + inc (r.Left, r.Width); + end; + 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; + for row := firstrow to RowCount-1 do + begin + inc (r.Top, DefaultRowHeight); + if r.Top >= clipr.Bottom then + break; + lastrow := row; + end; + end; + end; end; + 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 firstcol/lastcol end; inc(r.Top, r.Height); end; @@ -834,13 +890,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 @@ -877,13 +933,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; // small optimization. Don't draw what we can't see 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; end; end; // item drawing -- cgit v1.2.3-70-g09d2 From fdbee2022e3ef8d514d951ac31872f69aa431084 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Thu, 18 Apr 2013 15:09:31 -0700 Subject: Grids: basegrid drawing right! Created PrepareCells function. Still preparing too many cells. --- src/gui/fpg_basegrid.pas | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index e7b98f98..c8e93092 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; @@ -137,6 +140,7 @@ type 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; @@ -825,12 +829,15 @@ begin r.Left := cLeft; for col := firstcol to ColumnCount-1 do begin - cWidths[firstcol] := ColumnWidth[col]; + cWidths[col] := ColumnWidth[col]; r.Width := cWidths[firstcol]; lastcol := col; if (go_SmoothScroll in FOptions) and (r.Left <= clipr.Left) then + begin firstcol := col; - if r.Right >= clipr.Right then + if col>0 then inc (cLeft, cWidths[col-1]); + end; + if r.Left >= clipr.Right then break; inc (r.Left, r.Width); end; @@ -854,15 +861,17 @@ begin lastrow := firstrow; for row := firstrow to RowCount-1 do begin + lastrow := row; inc (r.Top, DefaultRowHeight); if r.Top >= clipr.Bottom then break; - lastrow := row; end; end; end; end; + PrepareCells (firstrow, lastrow, firstcol, lastcol); + r.Left := cLeft; r.Top := rTop; @@ -924,7 +933,7 @@ begin Include(drawstate, gdFocused); if (row = FFocusRow) and (col = FFocusCol) then Include(drawstate, gdSelected); - +writeln (row, 'x', col, ' l:', r.Left, ' w:', r.Width, ' t:', r.Top, ' h:', r.Height); if DoDrawCellEvent(row, col, r, drawstate) then DrawCell(row, col, r, drawstate); @@ -942,7 +951,7 @@ begin // break; end; end; // item drawing - +writeln; Canvas.SetClipRect(clipr); Canvas.SetColor(FBackgroundColor); @@ -1433,6 +1442,11 @@ begin UpdateScrollBars; end; +procedure TfpgBaseGrid.PrepareCells(firstrow, lastrow, firstcol, lastcol: integer); +begin + // for descendents +end; + constructor TfpgBaseGrid.Create(AOwner: TComponent); begin Updating; -- cgit v1.2.3-70-g09d2 From b7ef0bcec9f195dabda7a5908c2c9a6e4c2affec Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Thu, 18 Apr 2013 19:19:04 -0700 Subject: Grids: basegrid working great with PrepareCells function and new optimizations --- src/gui/fpg_basegrid.pas | 29 ++++++++++++----------------- 1 file changed, 12 insertions(+), 17 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index c8e93092..9b52a8ee 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -817,7 +817,7 @@ begin firstcol := FFirstCol; end; - // calculate column widths, and first/last columns and rows + // calculate column widths, and first/last columns if (ColumnCount <= 0) then begin firstcol := -1; @@ -830,17 +830,18 @@ begin for col := firstcol to ColumnCount-1 do begin cWidths[col] := ColumnWidth[col]; - r.Width := cWidths[firstcol]; - lastcol := 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; - if r.Left >= clipr.Right then + 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; @@ -858,14 +859,9 @@ begin else begin firstrow := FFirstRow; - lastrow := firstrow; - for row := firstrow to RowCount-1 do - begin - lastrow := row; - inc (r.Top, DefaultRowHeight); - if r.Top >= clipr.Bottom then - break; - end; + lastrow := firstrow + (clipr.Bottom - r.Top) div DefaultRowHeight; + if lastrow >= RowCount then + lastrow := RowCount-1; end; end; end; @@ -888,7 +884,7 @@ begin DrawHeader(col, r, 0); inc(r.Left, r.Width); //if r.Left >= clipr.Right then - // Break; // optimization made obsolete by firstcol/lastcol + // Break; // optimization made obsolete by lastcol end; inc(r.Top, r.Height); end; @@ -933,7 +929,6 @@ begin Include(drawstate, gdFocused); if (row = FFocusRow) and (col = FFocusCol) then Include(drawstate, gdSelected); -writeln (row, 'x', col, ' l:', r.Left, ' w:', r.Width, ' t:', r.Top, ' h:', r.Height); if DoDrawCellEvent(row, col, r, drawstate) then DrawCell(row, col, r, drawstate); @@ -943,15 +938,15 @@ writeln (row, 'x', col, ' l:', r.Left, ' w:', r.Width, ' t:', r.Top, ' h:', r.He inc(r.Left, r.Width); //if r.Left >= clipr.Right then - // Break; // small optimization. Don't draw what we can't see + // Break; // optimization made obsolete by lastcol end; // Inc(r.Top, FDefaultRowHeight+1); inc(r.Top, r.Height); //if r.Top >= clipr.Bottom then - // break; + // break; // optimization made obsolete by lastrow end; end; // item drawing -writeln; + Canvas.SetClipRect(clipr); Canvas.SetColor(FBackgroundColor); -- cgit v1.2.3-70-g09d2 From e6ec10df9b5a02dd61063627e8bb353d7ccd5f75 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Thu, 18 Apr 2013 19:30:19 -0700 Subject: Grids: set horiz scrollbar pagesize to 5 for smoothscroll, 1 otherwise --- src/gui/fpg_basegrid.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/gui') diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index 9b52a8ee..3b0e445f 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -730,12 +730,14 @@ begin FHScrollBar.Max := cw - vw; FHScrollBar.Position := FXOffset; 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; -- cgit v1.2.3-70-g09d2 From cc2630b5035fc2d47e30318dfbd61cb91a239b94 Mon Sep 17 00:00:00 2001 From: Jean-Marc Levecque Date: Sat, 2 Mar 2013 22:02:40 +0100 Subject: Make special characters known by edit components --- src/gui/fpg_edit.pas | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) (limited to 'src/gui') diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas index f164ef76..c462f06e 100644 --- a/src/gui/fpg_edit.pas +++ b/src/gui/fpg_edit.pas @@ -94,6 +94,7 @@ type FVisibleText: TfpgString; FVisSelStartPx: integer; FVisSelEndPx: integer; + FSpecialChar: integer; function GetMarginAdjustment: integer; virtual; procedure DrawSelection; virtual; procedure DoOnChange; virtual; @@ -755,6 +756,38 @@ var prevval: string; begin prevval := Text; + if FSpecialChar> -1 then + begin + case FSpecialChar of + 58536: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ë'; + 'i': + AText:= 'ï'; + 'o': + AText:= 'ö'; + 'u': + AText:= 'ü'; + end; + 58462: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ê'; + 'i': + AText:= 'î'; + 'o': + AText:= 'ô'; + 'u': + AText:= 'û'; + end; + end; + FSpecialChar:= -1; + end; s := AText; if (not consumed) and (not ReadOnly) then @@ -798,6 +831,9 @@ begin hasChanged := False; fpgApplication.HideHint; + if (keycode= 58536) or (keycode= 58462) then + FSpecialChar:= keycode; + Consumed := True; case CheckClipBoardKey(keycode, shiftstate) of ckCopy: @@ -1070,6 +1106,7 @@ begin FPopupMenu := nil; FDefaultPopupMenu := nil; FOnChange := nil; + FSpecialChar := -1; end; destructor TfpgBaseEdit.Destroy; -- cgit v1.2.3-70-g09d2 From dff1483cdade46db13e5645bb849abef017a8013 Mon Sep 17 00:00:00 2001 From: Jean-Marc Levecque Date: Sat, 2 Mar 2013 23:17:12 +0100 Subject: Make special characters known by editcombobox --- src/gui/fpg_editcombo.pas | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) (limited to 'src/gui') diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 3887cd13..311d452f 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.pas @@ -87,6 +87,7 @@ type FSelStart: integer; FSelOffset: integer; FCursorPos: integer; + FSpecialChar: integer; procedure DoDropDown; override; function GetText: string; virtual; function HasText: boolean; virtual; @@ -523,6 +524,38 @@ var i: integer; begin prevval := FText; + if FSpecialChar> -1 then + begin + case FSpecialChar of + 58536: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ë'; + 'i': + AText:= 'ï'; + 'o': + AText:= 'ö'; + 'u': + AText:= 'ü'; + end; + 58462: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ê'; + 'i': + AText:= 'î'; + 'o': + AText:= 'ô'; + 'u': + AText:= 'û'; + end; + end; + FSpecialChar:= -1; + end; s := AText; consumed := False; if FText = '' then @@ -584,6 +617,9 @@ var begin hasChanged := False; + if (keycode= 58536) or (keycode= 58462) then + FSpecialChar:= keycode; + if not Enabled then consumed := False else @@ -883,6 +919,7 @@ begin FDrawOffset := 0; FSelectedItem := -1; // to allow typing if list is empty FNewItem := False; + FSpecialChar := -1; CalculateInternalButtonRect; end; -- cgit v1.2.3-70-g09d2 From 3efdc116e28a2db70f811670a2f3c0b62048558e Mon Sep 17 00:00:00 2001 From: Jean-Marc Levecque Date: Sat, 2 Mar 2013 23:31:39 +0100 Subject: Make special characters known by memo component --- src/gui/fpg_memo.pas | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) (limited to 'src/gui') diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index df16367b..71bcee56 100644 --- a/src/gui/fpg_memo.pas +++ b/src/gui/fpg_memo.pas @@ -98,6 +98,7 @@ type function GetSelectionText: TfpgString; procedure SetSelectionText(const AText: TfpgString); protected + FSpecialChar: integer; procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; @@ -479,6 +480,7 @@ begin FReadOnly := False; FUpdateCount := 0; FBorderStyle := ebsDefault; + FSpecialChar := -1; FLines := TfpgMemoStrings.Create(self); FFirstLine := 0; @@ -1060,6 +1062,38 @@ var begin inherited; prevval := Text; + if FSpecialChar> -1 then + begin + case FSpecialChar of + 58536: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ë'; + 'i': + AText:= 'ï'; + 'o': + AText:= 'ö'; + 'u': + AText:= 'ü'; + end; + 58462: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ê'; + 'i': + AText:= 'î'; + 'o': + AText:= 'ô'; + 'u': + AText:= 'û'; + end; + end; + FSpecialChar:= -1; + end; s := AText; if (not consumed) and (not ReadOnly) then @@ -1107,6 +1141,10 @@ begin fpgApplication.HideHint; Consumed := True; hasChanged := False; + + if (keycode= 58536) or (keycode= 58462) then + FSpecialChar:= keycode; + case CheckClipBoardKey(keycode, shiftstate) of ckCopy: begin -- cgit v1.2.3-70-g09d2 From fdc1a846f4a47a65de5983ee6fcf2462ffdce151 Mon Sep 17 00:00:00 2001 From: Jean-Marc Levecque Date: Sun, 3 Mar 2013 22:42:47 +0100 Subject: Use dead key codes for special accentuated characters --- src/gui/fpg_edit.pas | 18 +++++++++--------- src/gui/fpg_editcombo.pas | 16 ++++++++-------- src/gui/fpg_memo.pas | 16 ++++++++-------- 3 files changed, 25 insertions(+), 25 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas index c462f06e..01c52d4c 100644 --- a/src/gui/fpg_edit.pas +++ b/src/gui/fpg_edit.pas @@ -94,7 +94,7 @@ type FVisibleText: TfpgString; FVisSelStartPx: integer; FVisSelEndPx: integer; - FSpecialChar: integer; + FDeadKeyChar: integer; function GetMarginAdjustment: integer; virtual; procedure DrawSelection; virtual; procedure DoOnChange; virtual; @@ -756,10 +756,10 @@ var prevval: string; begin prevval := Text; - if FSpecialChar> -1 then + if FDeadKeyChar> -1 then begin - case FSpecialChar of - 58536: + case FDeadKeyChar of + keyDeadDiaeresis: case AText of 'a': AText:= 'â'; @@ -772,7 +772,7 @@ begin 'u': AText:= 'ü'; end; - 58462: + keyDeadCircumflex: case AText of 'a': AText:= 'â'; @@ -786,7 +786,7 @@ begin AText:= 'û'; end; end; - FSpecialChar:= -1; + FDeadKeyChar:= -1; end; s := AText; @@ -831,8 +831,8 @@ begin hasChanged := False; fpgApplication.HideHint; - if (keycode= 58536) or (keycode= 58462) then - FSpecialChar:= keycode; + if (keycode= keyDeadCircumflex) or (keycode= keyDeadDiaeresis) then + FDeadKeyChar:= keycode; Consumed := True; case CheckClipBoardKey(keycode, shiftstate) of @@ -1106,7 +1106,7 @@ begin FPopupMenu := nil; FDefaultPopupMenu := nil; FOnChange := nil; - FSpecialChar := -1; + FDeadKeyChar := -1; end; destructor TfpgBaseEdit.Destroy; diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 311d452f..72b804ef 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.pas @@ -87,7 +87,7 @@ type FSelStart: integer; FSelOffset: integer; FCursorPos: integer; - FSpecialChar: integer; + FDeadKeyChar: integer; procedure DoDropDown; override; function GetText: string; virtual; function HasText: boolean; virtual; @@ -524,10 +524,10 @@ var i: integer; begin prevval := FText; - if FSpecialChar> -1 then + if FDeadKeyChar> -1 then begin - case FSpecialChar of - 58536: + case FDeadKeyChar of + keyDeadDiaeresis: case AText of 'a': AText:= 'â'; @@ -540,7 +540,7 @@ begin 'u': AText:= 'ü'; end; - 58462: + keyDeadCircumflex: case AText of 'a': AText:= 'â'; @@ -554,7 +554,7 @@ begin AText:= 'û'; end; end; - FSpecialChar:= -1; + FDeadKeyChar:= -1; end; s := AText; consumed := False; @@ -618,7 +618,7 @@ begin hasChanged := False; if (keycode= 58536) or (keycode= 58462) then - FSpecialChar:= keycode; + FDeadKeyChar:= keycode; if not Enabled then consumed := False @@ -919,7 +919,7 @@ begin FDrawOffset := 0; FSelectedItem := -1; // to allow typing if list is empty FNewItem := False; - FSpecialChar := -1; + FDeadKeyChar := -1; CalculateInternalButtonRect; end; diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index 71bcee56..c0b227ae 100644 --- a/src/gui/fpg_memo.pas +++ b/src/gui/fpg_memo.pas @@ -98,7 +98,7 @@ type function GetSelectionText: TfpgString; procedure SetSelectionText(const AText: TfpgString); protected - FSpecialChar: integer; + FDeadKeyChar: integer; procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; @@ -480,7 +480,7 @@ begin FReadOnly := False; FUpdateCount := 0; FBorderStyle := ebsDefault; - FSpecialChar := -1; + FDeadKeyChar := -1; FLines := TfpgMemoStrings.Create(self); FFirstLine := 0; @@ -1062,10 +1062,10 @@ var begin inherited; prevval := Text; - if FSpecialChar> -1 then + if FDeadKeyChar> -1 then begin - case FSpecialChar of - 58536: + case FDeadKeyChar of + keyDeadDiaeresis: case AText of 'a': AText:= 'â'; @@ -1078,7 +1078,7 @@ begin 'u': AText:= 'ü'; end; - 58462: + keyDeadCircumflex: case AText of 'a': AText:= 'â'; @@ -1092,7 +1092,7 @@ begin AText:= 'û'; end; end; - FSpecialChar:= -1; + FDeadKeyChar:= -1; end; s := AText; @@ -1143,7 +1143,7 @@ begin hasChanged := False; if (keycode= 58536) or (keycode= 58462) then - FSpecialChar:= keycode; + FDeadKeyChar:= keycode; case CheckClipBoardKey(keycode, shiftstate) of ckCopy: -- cgit v1.2.3-70-g09d2 From 823c7db4e8374fb01985a0669642b03d5915726d Mon Sep 17 00:00:00 2001 From: Jean-Marc Levecque Date: Wed, 6 Mar 2013 14:11:29 +0100 Subject: Add common procedures in fpg_base for deadkeys --- src/corelib/fpg_base.pas | 64 +++++++++++++++++++++++++++++++++++++++++++++++ src/gui/fpg_edit.pas | 33 +++--------------------- src/gui/fpg_editcombo.pas | 33 +++--------------------- src/gui/fpg_memo.pas | 33 +++--------------------- 4 files changed, 73 insertions(+), 90 deletions(-) (limited to 'src/gui') diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas index 3eae947a..5158540e 100644 --- a/src/corelib/fpg_base.pas +++ b/src/corelib/fpg_base.pas @@ -744,6 +744,8 @@ type { Keyboard } function KeycodeToText(AKey: Word; AShiftState: TShiftState): string; function CheckClipboardKey(AKey: Word; AShiftstate: TShiftState): TClipboardKeyType; +function UseDeadKey(AChar: TfpgChar; AKey: word): TfpgChar; +function ReadDeadKey(AKey: word): integer; { Color } function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; @@ -965,6 +967,68 @@ begin end { if/else } end; +function UseDeadKey(AChar: TfpgChar; AKey: word): TfpgChar; +begin + case AKey of + keyDeadCircumflex: + case AChar of + 'a': + Result:= 'â'; + 'e': + Result:= 'ê'; + 'i': + Result:= 'î'; + 'o': + Result:= 'ô'; + 'u': + Result:= 'û'; + 'A': + Result:= 'Â'; + 'E': + Result:= 'Ê'; + 'I': + Result:= 'Î'; + 'O': + Result:= 'Ô'; + 'U': + Result:= 'Û'; + end; + keyDeadDiaeresis: + case AChar of + 'a': + Result:= 'ä'; + 'e': + Result:= 'ë'; + 'i': + Result:= 'ï'; + 'o': + Result:= 'ö'; + 'u': + Result:= 'ü'; + 'A': + Result:= 'Ä'; + 'E': + Result:= 'Ë'; + 'I': + Result:= 'Ï'; + 'O': + Result:= 'Ö'; + 'U': + Result:= 'Ü'; + end; + end; +end; + +function ReadDeadKey(AKey: word): integer; +begin + case AKey of + keyDeadCircumflex, keyDeadDiaeresis: + Result := AKey; + else + Result := -1; + end; +end; + function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; begin with Result do diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas index 01c52d4c..21e6895e 100644 --- a/src/gui/fpg_edit.pas +++ b/src/gui/fpg_edit.pas @@ -758,34 +758,7 @@ begin prevval := Text; if FDeadKeyChar> -1 then begin - case FDeadKeyChar of - keyDeadDiaeresis: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ë'; - 'i': - AText:= 'ï'; - 'o': - AText:= 'ö'; - 'u': - AText:= 'ü'; - end; - keyDeadCircumflex: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ê'; - 'i': - AText:= 'î'; - 'o': - AText:= 'ô'; - 'u': - AText:= 'û'; - end; - end; + AText:= UseDeadKey(AText, FDeadKeyChar); FDeadKeyChar:= -1; end; s := AText; @@ -831,8 +804,8 @@ begin hasChanged := False; fpgApplication.HideHint; - if (keycode= keyDeadCircumflex) or (keycode= keyDeadDiaeresis) then - FDeadKeyChar:= keycode; + if FDeadKeyChar = -1 then + FDeadKeyChar:= ReadDeadKey(keycode); Consumed := True; case CheckClipBoardKey(keycode, shiftstate) of diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 72b804ef..9145d641 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.pas @@ -526,34 +526,7 @@ begin prevval := FText; if FDeadKeyChar> -1 then begin - case FDeadKeyChar of - keyDeadDiaeresis: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ë'; - 'i': - AText:= 'ï'; - 'o': - AText:= 'ö'; - 'u': - AText:= 'ü'; - end; - keyDeadCircumflex: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ê'; - 'i': - AText:= 'î'; - 'o': - AText:= 'ô'; - 'u': - AText:= 'û'; - end; - end; + AText:= UseDeadKey(AText, FDeadKeyChar); FDeadKeyChar:= -1; end; s := AText; @@ -617,8 +590,8 @@ var begin hasChanged := False; - if (keycode= 58536) or (keycode= 58462) then - FDeadKeyChar:= keycode; + if FDeadKeyChar = -1 then + FDeadKeyChar:= ReadDeadKey(keycode); if not Enabled then consumed := False diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index c0b227ae..2769e4d4 100644 --- a/src/gui/fpg_memo.pas +++ b/src/gui/fpg_memo.pas @@ -1064,34 +1064,7 @@ begin prevval := Text; if FDeadKeyChar> -1 then begin - case FDeadKeyChar of - keyDeadDiaeresis: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ë'; - 'i': - AText:= 'ï'; - 'o': - AText:= 'ö'; - 'u': - AText:= 'ü'; - end; - keyDeadCircumflex: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ê'; - 'i': - AText:= 'î'; - 'o': - AText:= 'ô'; - 'u': - AText:= 'û'; - end; - end; + AText:= UseDeadKey(AText, FDeadKeyChar); FDeadKeyChar:= -1; end; s := AText; @@ -1142,8 +1115,8 @@ begin Consumed := True; hasChanged := False; - if (keycode= 58536) or (keycode= 58462) then - FDeadKeyChar:= keycode; + if FDeadKeyChar = -1 then + FDeadKeyChar:= ReadDeadKey(keycode); case CheckClipBoardKey(keycode, shiftstate) of ckCopy: -- cgit v1.2.3-70-g09d2 From 17ac1344ebb5cf742b2c959596d30732a0bd3a85 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Tue, 2 Apr 2013 11:56:03 +0100 Subject: Buttons & Styles now support hover effect on standard buttons too. Before we only had the mouse hover effect on Flat buttons. But now the Style can enable hover support for normal buttons too. Important for Win7 and MacOSX like themes. --- src/corelib/fpg_main.pas | 6 ++++++ src/gui/fpg_button.pas | 12 +++++++++--- 2 files changed, 15 insertions(+), 3 deletions(-) (limited to 'src/gui') diff --git a/src/corelib/fpg_main.pas b/src/corelib/fpg_main.pas index f90e6b4c..89c5da1d 100644 --- a/src/corelib/fpg_main.pas +++ b/src/corelib/fpg_main.pas @@ -214,6 +214,7 @@ type procedure DrawButtonFace(ACanvas: TfpgCanvas; r: TfpgRect; AFlags: TfpgButtonFlags); overload; function GetButtonBorders: TRect; virtual; function GetButtonShift: TPoint; virtual; + function HasButtonHoverEffect: boolean; virtual; { Menus } procedure DrawMenuBar(ACanvas: TfpgCanvas; r: TfpgRect; ABackgroundColor: TfpgColor); virtual; procedure DrawMenuRow(ACanvas: TfpgCanvas; r: TfpgRect; AFlags: TfpgMenuItemFlags); virtual; @@ -2340,6 +2341,11 @@ begin Result := Point(1, 1); end; +function TfpgStyle.HasButtonHoverEffect: boolean; +begin + Result := False; +end; + function TfpgStyle.GetControlFrameBorders: TRect; begin Result := Rect(2, 2, 2, 2); diff --git a/src/gui/fpg_button.pas b/src/gui/fpg_button.pas index 28db95d6..3bc026de 100644 --- a/src/gui/fpg_button.pas +++ b/src/gui/fpg_button.pas @@ -550,6 +550,12 @@ begin Include(lBtnFlags, btfHover) else if FFlat then Include(lBtnFlags, btfFlat); + + if (not FFlat) and (not FDown) and fpgStyle.HasButtonHoverEffect then + begin + if FState = 1 then + Include(lBtnFlags, btfHover); + end; end else begin @@ -558,7 +564,7 @@ begin Include(lBtnFlags, btfHover); end; - if not FFlat and FDefault then + if (not FFlat) and FDefault then Include(lBtnFlags, btfIsDefault); if FBackgroundColor <> clButtonFace then @@ -747,7 +753,7 @@ begin FDown := False; Repaint; end - else if FFlat then + else if FFlat or fpgStyle.HasButtonHoverEffect then begin if Enabled then Repaint; @@ -766,7 +772,7 @@ begin FDown := True; Repaint; end - else if FFlat then + else if FFlat or fpgStyle.HasButtonHoverEffect then begin if Enabled then Repaint; -- cgit v1.2.3-70-g09d2 From eb95e98e545143b89cbb791e561f905a757f24cf Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Mon, 8 Apr 2013 01:40:14 +0100 Subject: tree keyboard handling: we never tested for ShiftState --- src/gui/fpg_tree.pas | 111 ++++++++++++++++++++++++++------------------------- 1 file changed, 57 insertions(+), 54 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_tree.pas b/src/gui/fpg_tree.pas index 4a4316ac..8935ec36 100644 --- a/src/gui/fpg_tree.pas +++ b/src/gui/fpg_tree.pas @@ -1868,74 +1868,77 @@ var OldSelection: TfpgTreeNode; begin OldSelection := Selection; - case KeyCode of - keyRight: - begin - Consumed := True; - Selection.Expand; - DoExpand(Selection); - ResetScrollbar; - RePaint; - end; + if ShiftState = [] then + begin + case KeyCode of + keyRight: + begin + Consumed := True; + Selection.Expand; + DoExpand(Selection); + ResetScrollbar; + RePaint; + end; - keyLeft: - begin - Consumed := True; - Selection.Collapsed := true; - ResetScrollbar; - RePaint; - end; + keyLeft: + begin + Consumed := True; + Selection.Collapsed := true; + ResetScrollbar; + RePaint; + end; - keyUp: - begin - if Selection = nil then - Selection := RootNode.FirstSubNode - else - if Selection <> RootNode then + keyUp: + begin + if Selection = nil then + Selection := RootNode.FirstSubNode + else + if Selection <> RootNode then + begin + if NodeIsVisible(selection) then + begin + h := PrevVisualNode(Selection); + if (h <> RootNode) and (h <> nil) then + Selection := h; + end + else + begin + Selection := RootNode.FirstSubNode; + end; + end; + Consumed := True; + end; + + keyDown: + begin + Consumed := True; + if Selection = nil then + Selection := RootNode.FirstSubNode + else begin if NodeIsVisible(selection) then begin - h := PrevVisualNode(Selection); - if (h <> RootNode) and (h <> nil) then + h := NextVisualNode(Selection); + if (h <> nil) then Selection := h; end else - begin Selection := RootNode.FirstSubNode; - end; end; - Consumed := True; - end; + end; - keyDown: - begin - Consumed := True; - if Selection = nil then - Selection := RootNode.FirstSubNode - else + keyPageUp: begin - if NodeIsVisible(selection) then - begin - h := NextVisualNode(Selection); - if (h <> nil) then - Selection := h; - end - else - Selection := RootNode.FirstSubNode; + FVScrollbar.PageUp; end; - end; - - keyPageUp: - begin - FVScrollbar.PageUp; - end; - keyPageDown: - begin - FVScrollbar.PageDown; - end; - else - Consumed := False; + keyPageDown: + begin + FVScrollbar.PageDown; + end; + else + Consumed := False; + end; end; if Selection <> OldSelection then -- cgit v1.2.3-70-g09d2 From c84490ed3ed9278d7ac45e66b4b17b437bd258ab Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Mon, 8 Apr 2013 01:41:02 +0100 Subject: popupmenu: Adds a convenience function AddSeparator() I like less typing. ;-) --- src/gui/fpg_menu.pas | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'src/gui') diff --git a/src/gui/fpg_menu.pas b/src/gui/fpg_menu.pas index 8da9302f..91db5992 100644 --- a/src/gui/fpg_menu.pas +++ b/src/gui/fpg_menu.pas @@ -135,6 +135,7 @@ type destructor Destroy; override; procedure Close; override; function AddMenuItem(const AMenuName: TfpgString; const hotkeydef: string; OnClickProc: TNotifyEvent): TfpgMenuItem; + procedure AddSeparator; function MenuItemByName(const AMenuName: TfpgString): TfpgMenuItem; function MenuItem(const AMenuPos: integer): TfpgMenuItem; // added to allow for localization property BeforeShow: TNotifyEvent read FBeforeShow write FBeforeShow; @@ -1406,6 +1407,11 @@ begin end; end; +procedure TfpgPopupMenu.AddSeparator; +begin + AddMenuitem('-', '', nil); +end; + function TfpgPopupMenu.MenuItemByName(const AMenuName: TfpgString): TfpgMenuItem; var i: integer; -- cgit v1.2.3-70-g09d2 From 33c5d8cf5f14cadb89b2f82f3557fd9b0ab89348 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 17 Apr 2013 10:31:14 +0100 Subject: Revert "Add common procedures in fpg_base for deadkeys" This reverts commit ccfd4b2ae0a9dfae0d19ae7ba673118af70c75da. --- src/corelib/fpg_base.pas | 64 ----------------------------------------------- src/gui/fpg_edit.pas | 33 +++++++++++++++++++++--- src/gui/fpg_editcombo.pas | 33 +++++++++++++++++++++--- src/gui/fpg_memo.pas | 33 +++++++++++++++++++++--- 4 files changed, 90 insertions(+), 73 deletions(-) (limited to 'src/gui') diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas index 07d44191..f3e8f6db 100644 --- a/src/corelib/fpg_base.pas +++ b/src/corelib/fpg_base.pas @@ -747,8 +747,6 @@ type { Keyboard } function KeycodeToText(AKey: Word; AShiftState: TShiftState): string; function CheckClipboardKey(AKey: Word; AShiftstate: TShiftState): TClipboardKeyType; -function UseDeadKey(AChar: TfpgChar; AKey: word): TfpgChar; -function ReadDeadKey(AKey: word): integer; { Color } function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; @@ -973,68 +971,6 @@ begin end { if/else } end; -function UseDeadKey(AChar: TfpgChar; AKey: word): TfpgChar; -begin - case AKey of - keyDeadCircumflex: - case AChar of - 'a': - Result:= 'â'; - 'e': - Result:= 'ê'; - 'i': - Result:= 'î'; - 'o': - Result:= 'ô'; - 'u': - Result:= 'û'; - 'A': - Result:= 'Â'; - 'E': - Result:= 'Ê'; - 'I': - Result:= 'Î'; - 'O': - Result:= 'Ô'; - 'U': - Result:= 'Û'; - end; - keyDeadDiaeresis: - case AChar of - 'a': - Result:= 'ä'; - 'e': - Result:= 'ë'; - 'i': - Result:= 'ï'; - 'o': - Result:= 'ö'; - 'u': - Result:= 'ü'; - 'A': - Result:= 'Ä'; - 'E': - Result:= 'Ë'; - 'I': - Result:= 'Ï'; - 'O': - Result:= 'Ö'; - 'U': - Result:= 'Ü'; - end; - end; -end; - -function ReadDeadKey(AKey: word): integer; -begin - case AKey of - keyDeadCircumflex, keyDeadDiaeresis: - Result := AKey; - else - Result := -1; - end; -end; - function fpgColorToRGBTriple(const AColor: TfpgColor): TRGBTriple; begin with Result do diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas index 21e6895e..01c52d4c 100644 --- a/src/gui/fpg_edit.pas +++ b/src/gui/fpg_edit.pas @@ -758,7 +758,34 @@ begin prevval := Text; if FDeadKeyChar> -1 then begin - AText:= UseDeadKey(AText, FDeadKeyChar); + case FDeadKeyChar of + keyDeadDiaeresis: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ë'; + 'i': + AText:= 'ï'; + 'o': + AText:= 'ö'; + 'u': + AText:= 'ü'; + end; + keyDeadCircumflex: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ê'; + 'i': + AText:= 'î'; + 'o': + AText:= 'ô'; + 'u': + AText:= 'û'; + end; + end; FDeadKeyChar:= -1; end; s := AText; @@ -804,8 +831,8 @@ begin hasChanged := False; fpgApplication.HideHint; - if FDeadKeyChar = -1 then - FDeadKeyChar:= ReadDeadKey(keycode); + if (keycode= keyDeadCircumflex) or (keycode= keyDeadDiaeresis) then + FDeadKeyChar:= keycode; Consumed := True; case CheckClipBoardKey(keycode, shiftstate) of diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 9145d641..72b804ef 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.pas @@ -526,7 +526,34 @@ begin prevval := FText; if FDeadKeyChar> -1 then begin - AText:= UseDeadKey(AText, FDeadKeyChar); + case FDeadKeyChar of + keyDeadDiaeresis: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ë'; + 'i': + AText:= 'ï'; + 'o': + AText:= 'ö'; + 'u': + AText:= 'ü'; + end; + keyDeadCircumflex: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ê'; + 'i': + AText:= 'î'; + 'o': + AText:= 'ô'; + 'u': + AText:= 'û'; + end; + end; FDeadKeyChar:= -1; end; s := AText; @@ -590,8 +617,8 @@ var begin hasChanged := False; - if FDeadKeyChar = -1 then - FDeadKeyChar:= ReadDeadKey(keycode); + if (keycode= 58536) or (keycode= 58462) then + FDeadKeyChar:= keycode; if not Enabled then consumed := False diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index 2769e4d4..c0b227ae 100644 --- a/src/gui/fpg_memo.pas +++ b/src/gui/fpg_memo.pas @@ -1064,7 +1064,34 @@ begin prevval := Text; if FDeadKeyChar> -1 then begin - AText:= UseDeadKey(AText, FDeadKeyChar); + case FDeadKeyChar of + keyDeadDiaeresis: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ë'; + 'i': + AText:= 'ï'; + 'o': + AText:= 'ö'; + 'u': + AText:= 'ü'; + end; + keyDeadCircumflex: + case AText of + 'a': + AText:= 'â'; + 'e': + AText:= 'ê'; + 'i': + AText:= 'î'; + 'o': + AText:= 'ô'; + 'u': + AText:= 'û'; + end; + end; FDeadKeyChar:= -1; end; s := AText; @@ -1115,8 +1142,8 @@ begin Consumed := True; hasChanged := False; - if FDeadKeyChar = -1 then - FDeadKeyChar:= ReadDeadKey(keycode); + if (keycode= 58536) or (keycode= 58462) then + FDeadKeyChar:= keycode; case CheckClipBoardKey(keycode, shiftstate) of ckCopy: -- cgit v1.2.3-70-g09d2 From c26553007573f4b460523c0672b22a80f9461172 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 17 Apr 2013 10:31:17 +0100 Subject: Revert "Use dead key codes for special accentuated characters" This reverts commit 5ee5b79db4825a3b2afa03dde72ddbe7e46b3c47. --- src/gui/fpg_edit.pas | 18 +++++++++--------- src/gui/fpg_editcombo.pas | 16 ++++++++-------- src/gui/fpg_memo.pas | 16 ++++++++-------- 3 files changed, 25 insertions(+), 25 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas index 01c52d4c..c462f06e 100644 --- a/src/gui/fpg_edit.pas +++ b/src/gui/fpg_edit.pas @@ -94,7 +94,7 @@ type FVisibleText: TfpgString; FVisSelStartPx: integer; FVisSelEndPx: integer; - FDeadKeyChar: integer; + FSpecialChar: integer; function GetMarginAdjustment: integer; virtual; procedure DrawSelection; virtual; procedure DoOnChange; virtual; @@ -756,10 +756,10 @@ var prevval: string; begin prevval := Text; - if FDeadKeyChar> -1 then + if FSpecialChar> -1 then begin - case FDeadKeyChar of - keyDeadDiaeresis: + case FSpecialChar of + 58536: case AText of 'a': AText:= 'â'; @@ -772,7 +772,7 @@ begin 'u': AText:= 'ü'; end; - keyDeadCircumflex: + 58462: case AText of 'a': AText:= 'â'; @@ -786,7 +786,7 @@ begin AText:= 'û'; end; end; - FDeadKeyChar:= -1; + FSpecialChar:= -1; end; s := AText; @@ -831,8 +831,8 @@ begin hasChanged := False; fpgApplication.HideHint; - if (keycode= keyDeadCircumflex) or (keycode= keyDeadDiaeresis) then - FDeadKeyChar:= keycode; + if (keycode= 58536) or (keycode= 58462) then + FSpecialChar:= keycode; Consumed := True; case CheckClipBoardKey(keycode, shiftstate) of @@ -1106,7 +1106,7 @@ begin FPopupMenu := nil; FDefaultPopupMenu := nil; FOnChange := nil; - FDeadKeyChar := -1; + FSpecialChar := -1; end; destructor TfpgBaseEdit.Destroy; diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 72b804ef..311d452f 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.pas @@ -87,7 +87,7 @@ type FSelStart: integer; FSelOffset: integer; FCursorPos: integer; - FDeadKeyChar: integer; + FSpecialChar: integer; procedure DoDropDown; override; function GetText: string; virtual; function HasText: boolean; virtual; @@ -524,10 +524,10 @@ var i: integer; begin prevval := FText; - if FDeadKeyChar> -1 then + if FSpecialChar> -1 then begin - case FDeadKeyChar of - keyDeadDiaeresis: + case FSpecialChar of + 58536: case AText of 'a': AText:= 'â'; @@ -540,7 +540,7 @@ begin 'u': AText:= 'ü'; end; - keyDeadCircumflex: + 58462: case AText of 'a': AText:= 'â'; @@ -554,7 +554,7 @@ begin AText:= 'û'; end; end; - FDeadKeyChar:= -1; + FSpecialChar:= -1; end; s := AText; consumed := False; @@ -618,7 +618,7 @@ begin hasChanged := False; if (keycode= 58536) or (keycode= 58462) then - FDeadKeyChar:= keycode; + FSpecialChar:= keycode; if not Enabled then consumed := False @@ -919,7 +919,7 @@ begin FDrawOffset := 0; FSelectedItem := -1; // to allow typing if list is empty FNewItem := False; - FDeadKeyChar := -1; + FSpecialChar := -1; CalculateInternalButtonRect; end; diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index c0b227ae..71bcee56 100644 --- a/src/gui/fpg_memo.pas +++ b/src/gui/fpg_memo.pas @@ -98,7 +98,7 @@ type function GetSelectionText: TfpgString; procedure SetSelectionText(const AText: TfpgString); protected - FDeadKeyChar: integer; + FSpecialChar: integer; procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; @@ -480,7 +480,7 @@ begin FReadOnly := False; FUpdateCount := 0; FBorderStyle := ebsDefault; - FDeadKeyChar := -1; + FSpecialChar := -1; FLines := TfpgMemoStrings.Create(self); FFirstLine := 0; @@ -1062,10 +1062,10 @@ var begin inherited; prevval := Text; - if FDeadKeyChar> -1 then + if FSpecialChar> -1 then begin - case FDeadKeyChar of - keyDeadDiaeresis: + case FSpecialChar of + 58536: case AText of 'a': AText:= 'â'; @@ -1078,7 +1078,7 @@ begin 'u': AText:= 'ü'; end; - keyDeadCircumflex: + 58462: case AText of 'a': AText:= 'â'; @@ -1092,7 +1092,7 @@ begin AText:= 'û'; end; end; - FDeadKeyChar:= -1; + FSpecialChar:= -1; end; s := AText; @@ -1143,7 +1143,7 @@ begin hasChanged := False; if (keycode= 58536) or (keycode= 58462) then - FDeadKeyChar:= keycode; + FSpecialChar:= keycode; case CheckClipBoardKey(keycode, shiftstate) of ckCopy: -- cgit v1.2.3-70-g09d2 From e3d18098b36fb31dd445032dc1bdcd5f40ade0d8 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 17 Apr 2013 10:31:18 +0100 Subject: Revert "Make special characters known by memo component" This reverts commit d71020bc89474bb98aa49b62b769de2d6b20ca8d. --- src/gui/fpg_memo.pas | 38 -------------------------------------- 1 file changed, 38 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas index 71bcee56..df16367b 100644 --- a/src/gui/fpg_memo.pas +++ b/src/gui/fpg_memo.pas @@ -98,7 +98,6 @@ type function GetSelectionText: TfpgString; procedure SetSelectionText(const AText: TfpgString); protected - FSpecialChar: integer; procedure HandleKeyChar(var AText: TfpgChar; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override; procedure HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override; @@ -480,7 +479,6 @@ begin FReadOnly := False; FUpdateCount := 0; FBorderStyle := ebsDefault; - FSpecialChar := -1; FLines := TfpgMemoStrings.Create(self); FFirstLine := 0; @@ -1062,38 +1060,6 @@ var begin inherited; prevval := Text; - if FSpecialChar> -1 then - begin - case FSpecialChar of - 58536: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ë'; - 'i': - AText:= 'ï'; - 'o': - AText:= 'ö'; - 'u': - AText:= 'ü'; - end; - 58462: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ê'; - 'i': - AText:= 'î'; - 'o': - AText:= 'ô'; - 'u': - AText:= 'û'; - end; - end; - FSpecialChar:= -1; - end; s := AText; if (not consumed) and (not ReadOnly) then @@ -1141,10 +1107,6 @@ begin fpgApplication.HideHint; Consumed := True; hasChanged := False; - - if (keycode= 58536) or (keycode= 58462) then - FSpecialChar:= keycode; - case CheckClipBoardKey(keycode, shiftstate) of ckCopy: begin -- cgit v1.2.3-70-g09d2 From 41410c1d23395b940eed6cd970e779c6b900c256 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 17 Apr 2013 10:31:20 +0100 Subject: Revert "Make special characters known by editcombobox" This reverts commit c7b3cdcd025e2f8cc8db7db0cf01fdacefbe2255. --- src/gui/fpg_editcombo.pas | 37 ------------------------------------- 1 file changed, 37 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas index 311d452f..3887cd13 100644 --- a/src/gui/fpg_editcombo.pas +++ b/src/gui/fpg_editcombo.pas @@ -87,7 +87,6 @@ type FSelStart: integer; FSelOffset: integer; FCursorPos: integer; - FSpecialChar: integer; procedure DoDropDown; override; function GetText: string; virtual; function HasText: boolean; virtual; @@ -524,38 +523,6 @@ var i: integer; begin prevval := FText; - if FSpecialChar> -1 then - begin - case FSpecialChar of - 58536: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ë'; - 'i': - AText:= 'ï'; - 'o': - AText:= 'ö'; - 'u': - AText:= 'ü'; - end; - 58462: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ê'; - 'i': - AText:= 'î'; - 'o': - AText:= 'ô'; - 'u': - AText:= 'û'; - end; - end; - FSpecialChar:= -1; - end; s := AText; consumed := False; if FText = '' then @@ -617,9 +584,6 @@ var begin hasChanged := False; - if (keycode= 58536) or (keycode= 58462) then - FSpecialChar:= keycode; - if not Enabled then consumed := False else @@ -919,7 +883,6 @@ begin FDrawOffset := 0; FSelectedItem := -1; // to allow typing if list is empty FNewItem := False; - FSpecialChar := -1; CalculateInternalButtonRect; end; -- cgit v1.2.3-70-g09d2 From b09c7b3129741b799aca08544f0f8eab5d675af7 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 17 Apr 2013 10:31:22 +0100 Subject: Revert "Make special characters known by edit components" This reverts commit bff6c8c3b5071ae28ba3c10cf612c55e893926b4. --- src/gui/fpg_edit.pas | 37 ------------------------------------- 1 file changed, 37 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas index c462f06e..f164ef76 100644 --- a/src/gui/fpg_edit.pas +++ b/src/gui/fpg_edit.pas @@ -94,7 +94,6 @@ type FVisibleText: TfpgString; FVisSelStartPx: integer; FVisSelEndPx: integer; - FSpecialChar: integer; function GetMarginAdjustment: integer; virtual; procedure DrawSelection; virtual; procedure DoOnChange; virtual; @@ -756,38 +755,6 @@ var prevval: string; begin prevval := Text; - if FSpecialChar> -1 then - begin - case FSpecialChar of - 58536: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ë'; - 'i': - AText:= 'ï'; - 'o': - AText:= 'ö'; - 'u': - AText:= 'ü'; - end; - 58462: - case AText of - 'a': - AText:= 'â'; - 'e': - AText:= 'ê'; - 'i': - AText:= 'î'; - 'o': - AText:= 'ô'; - 'u': - AText:= 'û'; - end; - end; - FSpecialChar:= -1; - end; s := AText; if (not consumed) and (not ReadOnly) then @@ -831,9 +798,6 @@ begin hasChanged := False; fpgApplication.HideHint; - if (keycode= 58536) or (keycode= 58462) then - FSpecialChar:= keycode; - Consumed := True; case CheckClipBoardKey(keycode, shiftstate) of ckCopy: @@ -1106,7 +1070,6 @@ begin FPopupMenu := nil; FDefaultPopupMenu := nil; FOnChange := nil; - FSpecialChar := -1; end; destructor TfpgBaseEdit.Destroy; -- cgit v1.2.3-70-g09d2 From 8f91e7081f8b3b64e2dab0d8dfb0e0c16c7558a0 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Tue, 28 May 2013 00:41:47 -0700 Subject: horizontal scrolling, commit 1 --- src/corelib/fpg_widget.pas | 18 +++++++++++++++ src/corelib/x11/fpg_x11.pas | 47 +++++++++++++++++++++++++------------ src/gui/fpg_basegrid.pas | 56 ++++++++++++++++++++++++++------------------- 3 files changed, 84 insertions(+), 37 deletions(-) (limited to 'src/gui') 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 3b0e445f..cc8bf0a6 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -135,6 +135,7 @@ 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; @@ -1164,43 +1165,52 @@ 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 + + if lRow <> FFirstRow 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; + UpdateScrollBars; + RePaint; + end; +end; + +procedure TfpgBaseGrid.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); +var + lCol: Integer; +begin + inherited HandleMouseHorizScroll(x, y, shiftstate, delta); + + lCol := FFirstCol; + + if go_SmoothScroll in Options then + begin + ; + end + else + begin + inc(FFirstCol, delta); end; - if (lRow <> FFirstRow) or (lCol <> FFirstCol) then + if lCol <> FFirstCol then begin UpdateScrollBars; RePaint; -- cgit v1.2.3-70-g09d2 From 339c0f724270d2ce391a03f561746fbe5beeee5b Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Tue, 28 May 2013 01:07:29 -0700 Subject: Horizontal Scrolling working in X11, basegrid unit updated to use it --- examples/gui/gridtest/gridtest.lpi | 13 +++++++------ examples/gui/gridtest/gridtest.lpr | 3 +++ src/gui/fpg_basegrid.pas | 40 ++++++++++++++++++++++++++------------ 3 files changed, 38 insertions(+), 18 deletions(-) (limited to 'src/gui') diff --git a/examples/gui/gridtest/gridtest.lpi b/examples/gui/gridtest/gridtest.lpi index 8d6de301..06af36d7 100644 --- a/examples/gui/gridtest/gridtest.lpi +++ b/examples/gui/gridtest/gridtest.lpi @@ -1,7 +1,7 @@ - + @@ -9,11 +9,13 @@ - - + + + + @@ -39,15 +41,14 @@ - + - + diff --git a/examples/gui/gridtest/gridtest.lpr b/examples/gui/gridtest/gridtest.lpr index 465281b2..9fbce666 100644 --- a/examples/gui/gridtest/gridtest.lpr +++ b/examples/gui/gridtest/gridtest.lpr @@ -219,6 +219,9 @@ begin AddColumn('Column 1', 100, taLeftJustify); AddColumn('Col 2', 50, taCenter); AddColumn('Numbers', 150, taRightJustify); + AddColumn('Column 4', 150, taRightJustify); + AddColumn('Column 5', 150, taRightJustify); + AddColumn('Column 6', 150, taRightJustify); FontDesc := '#Grid'; HeaderFontDesc := '#GridHeader'; Hint := ''; diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas index cc8bf0a6..127403b3 100644 --- a/src/gui/fpg_basegrid.pas +++ b/src/gui/fpg_basegrid.pas @@ -593,6 +593,8 @@ var vl: integer; i: integer; x: integer; + hmax: integer; + vmax: integer; Hfits, showH : boolean; Vfits, showV : boolean; @@ -707,7 +709,10 @@ begin 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; @@ -728,7 +733,10 @@ begin 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 := HWidth / TotalColumnWidth; FHScrollBar.PageSize := 5; @@ -1195,26 +1203,34 @@ end; procedure TfpgBaseGrid.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); var - lCol: Integer; + old_val: Integer; begin inherited HandleMouseHorizScroll(x, y, shiftstate, delta); - lCol := FFirstCol; - 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; - if lCol <> FFirstCol then - begin - UpdateScrollBars; - RePaint; - end; + UpdateScrollBars; + RePaint; end; procedure TfpgBaseGrid.HandleMouseMove(x, y: integer; btnstate: word; shiftstate: TShiftState); @@ -1500,7 +1516,7 @@ begin FHScrollBar.Orientation := orHorizontal; FHScrollBar.Visible := False; FHScrollBar.OnScroll := @HScrollBarMove; - FHScrollBar.ScrollStep := 5; + FHScrollBar.ScrollStep := 20; end; destructor TfpgBaseGrid.Destroy; -- cgit v1.2.3-70-g09d2