From 486f4f48ff250ce64ab532a302b6bbd6c05c4050 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Mon, 27 May 2013 22:59:46 -0700 Subject: Scroll-Frame! --- src/gui/fpg_scrollbar.pas | 2 +- src/gui/fpg_scrollframe.pas | 405 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 406 insertions(+), 1 deletion(-) create mode 100644 src/gui/fpg_scrollframe.pas (limited to 'src/gui') diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas index dd0a4c7c..29a37449 100644 --- a/src/gui/fpg_scrollbar.pas +++ b/src/gui/fpg_scrollbar.pas @@ -39,7 +39,7 @@ uses type TScrollNotifyEvent = procedure(Sender: TObject; position: integer) of object; - TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth); + TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth, ssBothVisible); TfpgScrollBarPart = (sbpNone, sbpUpBack, sbpPageUpBack, sbpSlider, sbpDownForward, sbpPageDownForward); diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas new file mode 100644 index 00000000..335b97a8 --- /dev/null +++ b/src/gui/fpg_scrollframe.pas @@ -0,0 +1,405 @@ +unit fpg_scrollframe; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, + SysUtils, + fpg_base, + fpg_main, + fpg_widget, + fpg_panel, + fpg_scrollbar; + +type + + TfpgScrollFrame = class; + + { TfpgAutoSizingFrame } + + TfpgAutoSizingFrame = class (TfpgFrame) + private + FMarginBR : integer; + FParentScrollFrame : TfpgScrollFrame; // it's actually the grandparent + procedure SetMarginBR (AValue: integer); + procedure UpdatePos; + public + procedure AdjustDimsFor (w : TfpgWindow; updatewp: boolean = true); + procedure AdjustDimsWithout (w : TfpgWindow); + procedure RecalcFrameSize; + property MarginBR : integer read FMarginBR write SetMarginBR; // bottom-right margin + property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame; + end; + + TfpgASFrameClass = class of TfpgAutoSizingFrame; + + { TfpgScrollFrame } + + TfpgScrollFrame = class (TfpgFrame) + private + FContentFrame : TfpgAutoSizingFrame; + FScrollFrame : TfpgFrame; + FHScrollBar : TfpgScrollBar; + FVScrollBar : TfpgScrollBar; + FScrollBarStyle : TfpgScrollStyle; + function GetXOffset: integer; + function GetYOffset: integer; + procedure SetXOffset (x: integer); + procedure SetYOffset (y: integer); + protected + procedure HandleResize(awidth, aheight: TfpgCoord); override; + procedure HandleShow; override; + procedure HScrollBarMove(Sender: TObject; position: integer); + procedure VScrollBarMove(Sender: TObject; position: integer); + procedure UpdateScrollbars; virtual; + property XOffset : integer read GetXOffset write SetXOffset; // these do not... + property YOffset : integer read GetYOffset write SetYOffset; // ...updatewindowposition + public + constructor Create (AOwner: TComponent); override; + constructor Create (AOwner: TComponent; ContentFrameType: TfpgASFrameClass); virtual; + procedure AfterCreate; override; + property ContentFrame : TfpgAutoSizingFrame read FContentFrame write FContentFrame; + end; + +implementation + +{ TfpgAutoSizingFrame } + +procedure TfpgAutoSizingFrame.SetMarginBR(AValue: integer); +begin + if FMarginBR=AValue then Exit; + FMarginBR:=AValue; + RecalcFrameSize; +end; + +procedure TfpgAutoSizingFrame.UpdatePos; +begin + UpdateWindowPosition; + if ParentScrollFrame is TfpgScrollFrame then + ParentScrollFrame.UpdateScrollbars; +end; + +procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWindow; updatewp: boolean = true); +var + new_w, new_h: integer; +begin + new_w := w.Right+MarginBR+1; + new_h := w.Bottom+MarginBR+1; + if (Width < new_w) or (Height < new_h) then + begin + HandleResize(new_w, new_h); + if updatewp then + UpdatePos; + end; +end; + +procedure TfpgAutoSizingFrame.AdjustDimsWithout (w: TfpgWindow); +begin + if (Width = w.Right+MarginBR+1) + or (Height = w.Bottom+MarginBR+1) then + RecalcFrameSize; +end; + +procedure TfpgAutoSizingFrame.RecalcFrameSize; +var + i : integer; + c : TComponent; + max_w, max_h : integer; + this_need : integer; + par : TfpgWidget; +begin + if ComponentCount=0 then + Exit; + max_w := 1; + max_h := 1; + for i := 0 to ComponentCount-1 do begin + c := Components[i]; + if c is TfpgWindow then + begin + this_need := TfpgWindow(c).right+MarginBR+1; + if (this_need>max_w) then + max_w := this_need; + this_need := TfpgWindow(c).bottom+MarginBR+1; + if (this_need>max_h) then + max_h := this_need; + end; + end; + HandleResize(max_w, max_h); + UpdatePos; +end; + + +{ TfpgScrollFrame } + +function TfpgScrollFrame.GetXOffset: integer; +begin + result := -FContentFrame.Left; +end; + +function TfpgScrollFrame.GetYOffset: integer; +begin + result := -FContentFrame.Top; +end; + +procedure TfpgScrollFrame.SetXOffset (x: integer); +begin + if ContentFrame.Left = -x then + Exit; + FContentFrame.Left := -x; +end; + +procedure TfpgScrollFrame.SetYOffset (y: integer); +begin + if ContentFrame.Top = -y then + Exit; + FContentFrame.Top := -y; +end; + +procedure TfpgScrollFrame.HandleResize(awidth, aheight: TfpgCoord); +begin + inherited HandleResize(awidth, aheight); + if (csLoading in ComponentState) or (csUpdating in ComponentState) then + Exit; //==> + if HasHandle then + UpdateScrollBars; +end; + +procedure TfpgScrollFrame.HandleShow; +begin + inherited HandleShow; + if (csLoading in ComponentState) then + Exit; + UpdateScrollBars; +end; + +procedure TfpgScrollFrame.HScrollBarMove (Sender: TObject; position: integer); +begin + if position = XOffset then + Exit; + XOffset := position; + FContentFrame.UpdateWindowPosition; +end; + +procedure TfpgScrollFrame.VScrollBarMove (Sender: TObject; position: integer); +begin + if position = YOffset then + Exit; + YOffset := position; + FContentFrame.UpdateWindowPosition; +end; + +procedure TfpgScrollFrame.UpdateScrollbars; +var + contentWidth, contentHeight: integer; + visWidth, visHeight: integer; + Hfits, Vfits : boolean; + showHsb, showVsb : boolean; + prevHideHsb, prevHideVsb : boolean; + + procedure hideScrollbar (sb : TfpgScrollBar); + begin + with sb do + if Visible then + begin + Visible := False; + UpdateWindowPosition; + end; + end; + + procedure getVisWidth; + begin + if showVsb then + visWidth := Width - (FVScrollBar.Width-1) + else + visWidth := Width; + Hfits := visWidth >= contentWidth + end; + + procedure getVisHeight; + begin + if showHsb then + visHeight := Height - (FHScrollBar.Height-1) + else + visHeight := Height; + Vfits := visHeight >= contentHeight; + end; + +begin + if (csLoading in ComponentState) or (csUpdating in ComponentState) then + Exit; //==> + + // 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 + prevHideHsb := not FHScrollBar.Visible; + prevHideVsb := not FVScrollBar.Visible; + showVsb := (FScrollBarStyle = ssBothVisible); + showHsb := showVsb; + contentWidth := ContentFrame.Width; + contentHeight := ContentFrame.Height; + getVisWidth; + getVisHeight; + + // determine whether to show scrollbars for different configurations + case FScrollBarStyle of + ssHorizontal: + begin + hideScrollbar (FVScrollBar); + if not Hfits then + begin + showHsb := true; + getVisHeight; + end; + end; + ssVertical: + begin + hideScrollbar (FHScrollBar); + if not Vfits then + begin + showVsb := true; + getVisWidth; + end; + end; + ssAutoBoth: + if not Vfits then + begin + showVsb := true; + getVisWidth; + if not Hfits then + begin + showHsb := true; + getVisHeight; + getVisWidth; + end; + end + else if not Hfits then + begin + showHsb := true; + getVisHeight; + if not Vfits then + begin + showVsb := true; + getVisWidth; + getVisHeight; + end; + end; + end; + + // show or hide the scrollbars + + if showVsb then with FVScrollBar do + begin + if prevHideVsb then + Position := 0; + Visible := true; + Min := 0; + Max := contentHeight - visHeight; // may set position! + YOffset := Position; + if contentHeight > 0 then + SliderSize := visHeight / contentHeight + else + SliderSize := 0; + RepaintSlider; + Top := 0; + Left := visWidth; + Height := visHeight; + PageSize:= visHeight; + end + else + begin + FVScrollBar.Visible := false; + if Vfits then // if vertical doesn't fit and no scrollbar, do not change offset + YOffset := 0; + end; + + if showHsb then with FHScrollBar do + begin + if prevHideHsb then + Position := 0; + Visible := true; + Min := 0; + Max := contentWidth - visWidth; // may set position! + XOffset := Position; + if contentWidth > 0 then + SliderSize := visWidth / contentWidth + else + SliderSize := 0; + RepaintSlider; + Top := visHeight; + Left := 0; + Width := visWidth; + PageSize:= visWidth; + end + else + begin + FHScrollBar.Visible := false; + if Hfits then // if horizontal doesn't fit and no scrollbar, do not change offset + XOffset := 0; + end; + + FVScrollBar.UpdateWindowPosition; + FHScrollBar.UpdateWindowPosition; + + FScrollFrame.SetPosition(0, 0, visWidth, visHeight); + FScrollFrame.UpdateWindowPosition; + + FContentFrame.UpdateWindowPosition; +end; + +constructor TfpgScrollFrame.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FScrollFrame := TfpgFrame.Create(self); + FScrollFrame.SetPosition(0, 0, 1, 1); + + FContentFrame := TfpgAutoSizingFrame.Create(FScrollFrame); + FContentFrame.SetPosition(0, 0, 1, 1); + FContentFrame.ParentScrollFrame := self; +end; + +constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASFrameClass); +begin + inherited Create(AOwner); + + FScrollFrame := TfpgFrame.Create(self); + FScrollFrame.Left := 0; + FScrollFrame.Top := 0; + + FContentFrame := ContentFrameType.Create(FScrollFrame); + FContentFrame.Left := 0; + FContentFrame.Top := 0; + FContentFrame.ParentScrollFrame := self; +end; + +procedure TfpgScrollFrame.AfterCreate; +begin + inherited AfterCreate; + + FVScrollBar := TfpgScrollBar.Create(self); + with FVScrollBar do begin + Orientation := orVertical; + OnScroll := @VScrollBarMove; + Position := 0; + end; + + FHScrollBar := TfpgScrollBar.Create(self); + with FHScrollBar do begin + Orientation := orHorizontal; + OnScroll := @HScrollBarMove; + Position := 0; + end; + + FScrollBarStyle := ssAutoBoth; +end; + + +end. -- cgit v1.2.3-70-g09d2 From 4823d681953279fbdf6081695f55b250d098aee7 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Mon, 27 May 2013 23:52:32 -0700 Subject: renamed FScrollFrame (bad name) to FVisibleArea --- src/gui/fpg_scrollframe.pas | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index 335b97a8..d10c69fd 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -40,7 +40,7 @@ type TfpgScrollFrame = class (TfpgFrame) private FContentFrame : TfpgAutoSizingFrame; - FScrollFrame : TfpgFrame; + FVisibleArea : TfpgFrame; FHScrollBar : TfpgScrollBar; FVScrollBar : TfpgScrollBar; FScrollBarStyle : TfpgScrollStyle; @@ -348,8 +348,8 @@ begin FVScrollBar.UpdateWindowPosition; FHScrollBar.UpdateWindowPosition; - FScrollFrame.SetPosition(0, 0, visWidth, visHeight); - FScrollFrame.UpdateWindowPosition; + FVisibleArea.SetPosition(0, 0, visWidth, visHeight); + FVisibleArea.UpdateWindowPosition; FContentFrame.UpdateWindowPosition; end; @@ -358,10 +358,10 @@ constructor TfpgScrollFrame.Create(AOwner: TComponent); begin inherited Create(AOwner); - FScrollFrame := TfpgFrame.Create(self); - FScrollFrame.SetPosition(0, 0, 1, 1); + FVisibleArea := TfpgFrame.Create(self); + FVisibleArea.SetPosition(0, 0, 1, 1); - FContentFrame := TfpgAutoSizingFrame.Create(FScrollFrame); + FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea); FContentFrame.SetPosition(0, 0, 1, 1); FContentFrame.ParentScrollFrame := self; end; @@ -370,11 +370,11 @@ constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASF begin inherited Create(AOwner); - FScrollFrame := TfpgFrame.Create(self); - FScrollFrame.Left := 0; - FScrollFrame.Top := 0; + FVisibleArea := TfpgFrame.Create(self); + FVisibleArea.Left := 0; + FVisibleArea.Top := 0; - FContentFrame := ContentFrameType.Create(FScrollFrame); + FContentFrame := ContentFrameType.Create(FVisibleArea); FContentFrame.Left := 0; FContentFrame.Top := 0; FContentFrame.ParentScrollFrame := self; -- 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 From 4a87dba6e869e8091cc2bf19d90b0349c4c1fad9 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Tue, 28 May 2013 16:29:34 -0700 Subject: Scroll-Frame: mousewheel scrolling is working, but only when both scrollbars are visible --- examples/gui/scrollframe/frame_test.lpr | 2 +- src/gui/fpg_scrollframe.pas | 75 ++++++++++++++++++++++++++++++--- 2 files changed, 69 insertions(+), 8 deletions(-) (limited to 'src/gui') diff --git a/examples/gui/scrollframe/frame_test.lpr b/examples/gui/scrollframe/frame_test.lpr index 3fd804f5..596664e6 100644 --- a/examples/gui/scrollframe/frame_test.lpr +++ b/examples/gui/scrollframe/frame_test.lpr @@ -100,7 +100,7 @@ var begin fpgApplication.Initialize; form := TfpgForm.Create(nil); - form.SetPosition(0,0,380,360); + form.SetPosition(0,0,480,260); outer_frame := TfpgScrollFrame.Create(form, t_sample_frame); outer_frame.Align:=alClient; outer_frame.ContentFrame.RecalcFrameSize; diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index d10c69fd..c98ca6df 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -25,9 +25,14 @@ type FParentScrollFrame : TfpgScrollFrame; // it's actually the grandparent procedure SetMarginBR (AValue: integer); procedure UpdatePos; + protected + procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; public - procedure AdjustDimsFor (w : TfpgWindow; updatewp: boolean = true); - procedure AdjustDimsWithout (w : TfpgWindow); + procedure AdjustDimsFor (w : TfpgWidget; updatewp: boolean = true); + procedure AdjustDimsWithout (w : TfpgWidget); procedure RecalcFrameSize; property MarginBR : integer read FMarginBR write SetMarginBR; // bottom-right margin property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame; @@ -49,6 +54,10 @@ type procedure SetXOffset (x: integer); procedure SetYOffset (y: integer); protected + procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; + procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; + delta: smallint); override; procedure HandleResize(awidth, aheight: TfpgCoord); override; procedure HandleShow; override; procedure HScrollBarMove(Sender: TObject; position: integer); @@ -81,10 +90,24 @@ begin ParentScrollFrame.UpdateScrollbars; end; -procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWindow; updatewp: boolean = true); +procedure TfpgAutoSizingFrame.HandleMouseScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + ParentScrollFrame.HandleMouseScroll(x, y, shiftstate, delta); +end; + +procedure TfpgAutoSizingFrame.HandleMouseHorizScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + ParentScrollFrame.HandleMouseHorizScroll(x, y, shiftstate, delta); +end; + +procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWidget; updatewp: boolean = true); var new_w, new_h: integer; begin + if not w.Visible then + Exit; new_w := w.Right+MarginBR+1; new_h := w.Bottom+MarginBR+1; if (Width < new_w) or (Height < new_h) then @@ -95,7 +118,7 @@ begin end; end; -procedure TfpgAutoSizingFrame.AdjustDimsWithout (w: TfpgWindow); +procedure TfpgAutoSizingFrame.AdjustDimsWithout (w: TfpgWidget); begin if (Width = w.Right+MarginBR+1) or (Height = w.Bottom+MarginBR+1) then @@ -116,12 +139,14 @@ begin max_h := 1; for i := 0 to ComponentCount-1 do begin c := Components[i]; - if c is TfpgWindow then + if c is TfpgWidget then begin - this_need := TfpgWindow(c).right+MarginBR+1; + if not TfpgWidget(c).Visible then + continue; + this_need := TfpgWidget(c).right+MarginBR+1; if (this_need>max_w) then max_w := this_need; - this_need := TfpgWindow(c).bottom+MarginBR+1; + this_need := TfpgWidget(c).bottom+MarginBR+1; if (this_need>max_h) then max_h := this_need; end; @@ -157,6 +182,40 @@ begin FContentFrame.Top := -y; end; +procedure TfpgScrollFrame.HandleMouseScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +var + old_val, new_val : integer; +begin + inherited HandleMouseScroll(x, y, shiftstate, delta); + with FVScrollBar do + begin + if not Visible then + Exit; + Position:=Position+delta*ScrollStep; + if YOffset=Position then + Exit; + YOffset:=Position; + end; + UpdateScrollbars; +end; + +procedure TfpgScrollFrame.HandleMouseHorizScroll(x, y: integer; + shiftstate: TShiftState; delta: smallint); +begin + inherited HandleMouseHorizScroll(x, y, shiftstate, delta); + with FHScrollBar do + begin + if not Visible then + Exit; + Position:=Position+delta*ScrollStep; + if XOffset=Position then + Exit; + XOffset:=Position; + end; + UpdateScrollbars; +end; + procedure TfpgScrollFrame.HandleResize(awidth, aheight: TfpgCoord); begin inherited HandleResize(awidth, aheight); @@ -389,6 +448,7 @@ begin Orientation := orVertical; OnScroll := @VScrollBarMove; Position := 0; + ScrollStep := 10; end; FHScrollBar := TfpgScrollBar.Create(self); @@ -396,6 +456,7 @@ begin Orientation := orHorizontal; OnScroll := @HScrollBarMove; Position := 0; + ScrollStep := 10; end; FScrollBarStyle := ssAutoBoth; -- cgit v1.2.3-70-g09d2 From 8d5cbfcff09528a7038e78f672de862dadd5fd34 Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Tue, 28 May 2013 16:44:44 -0700 Subject: Scroll-frame: mousewheel scrolling working completely now. Scrolling within the VisibleArea but outside the ContentFrame was not passing scroll events to the ParentScrollFrame. --- src/gui/fpg_scrollframe.pas | 75 ++++++++++++++++++++++++++------------------- 1 file changed, 43 insertions(+), 32 deletions(-) (limited to 'src/gui') diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index c98ca6df..8e5bc769 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -17,25 +17,32 @@ type TfpgScrollFrame = class; - { TfpgAutoSizingFrame } + { TfpgEmbeddingFrame } - TfpgAutoSizingFrame = class (TfpgFrame) + TfpgEmbeddingFrame = class (TfpgFrame) + // The purpose of the EmbeddingFrame is to pass scroll events to the ParentScrollFrame private - FMarginBR : integer; - FParentScrollFrame : TfpgScrollFrame; // it's actually the grandparent - procedure SetMarginBR (AValue: integer); - procedure UpdatePos; + FParentScrollFrame : TfpgScrollFrame; protected procedure HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; procedure HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override; + public + property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame; + end; + + { TfpgAutoSizingFrame } + + TfpgAutoSizingFrame = class (TfpgEmbeddingFrame) + private + FMarginBR : integer; + procedure SetMarginBR (AValue: integer); public procedure AdjustDimsFor (w : TfpgWidget; updatewp: boolean = true); procedure AdjustDimsWithout (w : TfpgWidget); procedure RecalcFrameSize; property MarginBR : integer read FMarginBR write SetMarginBR; // bottom-right margin - property ParentScrollFrame : TfpgScrollFrame read FParentScrollFrame write FParentScrollFrame; end; TfpgASFrameClass = class of TfpgAutoSizingFrame; @@ -45,7 +52,7 @@ type TfpgScrollFrame = class (TfpgFrame) private FContentFrame : TfpgAutoSizingFrame; - FVisibleArea : TfpgFrame; + FVisibleArea : TfpgEmbeddingFrame; FHScrollBar : TfpgScrollBar; FVScrollBar : TfpgScrollBar; FScrollBarStyle : TfpgScrollStyle; @@ -72,36 +79,34 @@ type property ContentFrame : TfpgAutoSizingFrame read FContentFrame write FContentFrame; end; -implementation -{ TfpgAutoSizingFrame } +implementation -procedure TfpgAutoSizingFrame.SetMarginBR(AValue: integer); -begin - if FMarginBR=AValue then Exit; - FMarginBR:=AValue; - RecalcFrameSize; -end; -procedure TfpgAutoSizingFrame.UpdatePos; -begin - UpdateWindowPosition; - if ParentScrollFrame is TfpgScrollFrame then - ParentScrollFrame.UpdateScrollbars; -end; +{ TfpgEmbeddingFrame } -procedure TfpgAutoSizingFrame.HandleMouseScroll(x, y: integer; +procedure TfpgEmbeddingFrame.HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); begin ParentScrollFrame.HandleMouseScroll(x, y, shiftstate, delta); end; -procedure TfpgAutoSizingFrame.HandleMouseHorizScroll(x, y: integer; +procedure TfpgEmbeddingFrame.HandleMouseHorizScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); begin ParentScrollFrame.HandleMouseHorizScroll(x, y, shiftstate, delta); end; + +{ TfpgAutoSizingFrame } + +procedure TfpgAutoSizingFrame.SetMarginBR(AValue: integer); +begin + if FMarginBR=AValue then Exit; + FMarginBR:=AValue; + RecalcFrameSize; +end; + procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWidget; updatewp: boolean = true); var new_w, new_h: integer; @@ -114,7 +119,10 @@ begin begin HandleResize(new_w, new_h); if updatewp then - UpdatePos; + if ParentScrollFrame is TfpgScrollFrame then + ParentScrollFrame.UpdateScrollbars + else + UpdateWindowPosition; end; end; @@ -152,7 +160,10 @@ begin end; end; HandleResize(max_w, max_h); - UpdatePos; + if ParentScrollFrame is TfpgScrollFrame then + ParentScrollFrame.UpdateScrollbars + else + UpdateWindowPosition; end; @@ -417,8 +428,9 @@ constructor TfpgScrollFrame.Create(AOwner: TComponent); begin inherited Create(AOwner); - FVisibleArea := TfpgFrame.Create(self); + FVisibleArea := TfpgEmbeddingFrame.Create(self); FVisibleArea.SetPosition(0, 0, 1, 1); + FVisibleArea.ParentScrollFrame := self; FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea); FContentFrame.SetPosition(0, 0, 1, 1); @@ -429,13 +441,12 @@ constructor TfpgScrollFrame.Create(AOwner: TComponent; ContentFrameType: TfpgASF begin inherited Create(AOwner); - FVisibleArea := TfpgFrame.Create(self); - FVisibleArea.Left := 0; - FVisibleArea.Top := 0; + FVisibleArea := TfpgEmbeddingFrame.Create(self); + FVisibleArea.SetPosition(0, 0, 1, 1); + FVisibleArea.ParentScrollFrame := self; FContentFrame := ContentFrameType.Create(FVisibleArea); - FContentFrame.Left := 0; - FContentFrame.Top := 0; + FContentFrame.SetPosition(0, 0, 1, 1); FContentFrame.ParentScrollFrame := self; end; -- cgit v1.2.3-70-g09d2 From 451114d2008f0b3750bc9840099287b87cff247c Mon Sep 17 00:00:00 2001 From: David Laurence Emerson Date: Tue, 28 May 2013 20:50:51 -0700 Subject: Scroll-frame: fixed a couple bugs with RecalcFrameSize --- examples/gui/scrollframe/frame_test.lpr | 4 +--- src/gui/fpg_scrollframe.pas | 15 +++++++++++---- 2 files changed, 12 insertions(+), 7 deletions(-) (limited to 'src/gui') diff --git a/examples/gui/scrollframe/frame_test.lpr b/examples/gui/scrollframe/frame_test.lpr index 596664e6..252f8a07 100644 --- a/examples/gui/scrollframe/frame_test.lpr +++ b/examples/gui/scrollframe/frame_test.lpr @@ -89,7 +89,6 @@ begin 'Click to embed another Scroll-Frame here', @click_embed_button); OnPaint:=@paint_my_stuff; create_buttons(self); - RecalcFrameSize; end; @@ -100,10 +99,9 @@ var begin fpgApplication.Initialize; form := TfpgForm.Create(nil); - form.SetPosition(0,0,480,260); + form.SetPosition(0,0,380,360); outer_frame := TfpgScrollFrame.Create(form, t_sample_frame); outer_frame.Align:=alClient; - outer_frame.ContentFrame.RecalcFrameSize; try form.Show; fpgApplication.Run; diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas index 8e5bc769..fd467c46 100644 --- a/src/gui/fpg_scrollframe.pas +++ b/src/gui/fpg_scrollframe.pas @@ -39,6 +39,7 @@ type FMarginBR : integer; procedure SetMarginBR (AValue: integer); public + procedure AfterConstruction; override; procedure AdjustDimsFor (w : TfpgWidget; updatewp: boolean = true); procedure AdjustDimsWithout (w : TfpgWidget); procedure RecalcFrameSize; @@ -107,6 +108,12 @@ begin RecalcFrameSize; end; +procedure TfpgAutoSizingFrame.AfterConstruction; +begin + inherited AfterConstruction; + RecalcFrameSize; +end; + procedure TfpgAutoSizingFrame.AdjustDimsFor (w: TfpgWidget; updatewp: boolean = true); var new_w, new_h: integer; @@ -429,11 +436,11 @@ begin inherited Create(AOwner); FVisibleArea := TfpgEmbeddingFrame.Create(self); - FVisibleArea.SetPosition(0, 0, 1, 1); + FVisibleArea.HandleMove(0, 0); FVisibleArea.ParentScrollFrame := self; FContentFrame := TfpgAutoSizingFrame.Create(FVisibleArea); - FContentFrame.SetPosition(0, 0, 1, 1); + FContentFrame.HandleMove(0, 0); FContentFrame.ParentScrollFrame := self; end; @@ -442,11 +449,11 @@ begin inherited Create(AOwner); FVisibleArea := TfpgEmbeddingFrame.Create(self); - FVisibleArea.SetPosition(0, 0, 1, 1); + FVisibleArea.HandleMove(0, 0); FVisibleArea.ParentScrollFrame := self; FContentFrame := ContentFrameType.Create(FVisibleArea); - FContentFrame.SetPosition(0, 0, 1, 1); + FContentFrame.HandleMove(0, 0); FContentFrame.ParentScrollFrame := self; end; -- cgit v1.2.3-70-g09d2