RAD Studio [Emailx45] My test with VertScrollBox and Memo or similar components where trying roll the screen using the Memo component as begin of action

emailx45

Свой
Регистрация
5 Май 2008
Сообщения
3,581
Реакции
2,450
Credits
706
Testing VertScrollBox component and Memo or similar components where trying roll the screen using the Memo component as begin of action
by Emailx45
  • You will notice that VertScrollBox does its job, which is to scroll the screen vertically.
  • Now, click and hold on Memo1 and try to scroll the screen! It doesn't roll!
  • Now click once on Memo2 (left) to enter it (the cursor will be flashing), now try to scroll the screen. You will notice that it rolls.
  • By doing a Double-Click, you disable HitTest, however, VertScrollBox now works. And, you can even type in this memo.
  • Now click once on Memo3 (on the right), and, you will notice that it is not possible to scroll the screen.
  • Now test the button to enable Memo1's HitTest. And, see that it is now possible to scroll the screen.
For more information, see the code and its Help System.

[SHOWTOGROUPS=4,20,22]
Как увидеть ссылки? | How to see hidden links?


NOTE: // HitTest:
// Enables the control to capture mouse events.
// -----------------------------------------------
// If you set HitTest to True, this control captures all mouse events.
// The example below shows the use of HitTest for an OnClick event.
//
// If you set HitTest to False, the mouse events will pass through this control,
// so that a control laid out behind (colocado atrás) this one receives the
// mouse events instead of this control.
//
// Note: The HitTest enables all mouse-related events, which also include the display
// of Hints and Hint-related events.
// For most controls, HitTest is True by default.
//
// However, this is not true for all the controls:
// For example, for TLabel and TPathLabel, HitTest is False by default;
// these two controls do not capture the mouse-related events unless you
// set HitTest to True.

Код:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 405
  ClientWidth = 359
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnCreate = FormCreate
  Touch.InteractiveGestures = [Zoom, Pan, Rotate, TwoFingerTap, PressAndTap, LongTap, DoubleTap]
  OnGesture = prcMyGenericProcGesture
  DesignerMasterStyle = 0
  object VertScrollBox1: TVertScrollBox
    Touch.InteractiveGestures = []
    Align = Client
    Size.Width = 359.000000000000000000
    Size.Height = 365.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 1
    Viewport.Width = 343.000000000000000000
    Viewport.Height = 365.000000000000000000
    object Memo1: TMemo
      Touch.InteractiveGestures = [LongTap]
      DataDetectorTypes = []
      Lines.Strings = (
        'HitTest is False for design-time'
        'Entry and Double-Click dont works'
        'because the HitTest initial, or be,'
        'VertScrollBox receive the mouse'
        'events... then, this memo dont'
        'receive the clicks')
      HitTest = False
      Position.X = -32.000000000000000000
      Position.Y = 8.000000000000000000
      Size.Width = 233.000000000000000000
      Size.Height = 169.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 0
      OnEnter = Memo1Enter
      OnExit = Memo1Exit
      OnDblClick = Memo1DblClick
      Viewport.Width = 229.000000000000000000
      Viewport.Height = 165.000000000000000000
    end
    object Memo2: TMemo
      Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
      DataDetectorTypes = []
      Lines.Strings = (
        'HitTest is True for design-time')
      Position.X = 168.000000000000000000
      Position.Y = 312.000000000000000000
      Size.Width = 233.000000000000000000
      Size.Height = 209.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 1
      Viewport.Width = 229.000000000000000000
      Viewport.Height = 205.000000000000000000
    end
    object Memo3: TMemo
      Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
      DataDetectorTypes = []
      Lines.Strings = (
        'HitTest is True for design-time')
      Position.X = -40.000000000000000000
      Position.Y = 272.000000000000000000
      Size.Width = 193.000000000000000000
      Size.Height = 545.000000000000000000
      Size.PlatformDefault = False
      TabOrder = 2
      OnEnter = Memo3Enter
      OnExit = Memo3Exit
      OnDblClick = Memo3DblClick
      Viewport.Width = 189.000000000000000000
      Viewport.Height = 541.000000000000000000
    end
    object spdbtnEnableHitTestMemo1Please: TSpeedButton
      Position.X = -32.000000000000000000
      Position.Y = 184.000000000000000000
      Size.Width = 233.000000000000000000
      Size.Height = 22.000000000000000000
      Size.PlatformDefault = False
      Text = 'spdbtnEnableHitTestMemo1Please'
      OnClick = spdbtnEnableHitTestMemo1PleaseClick
    end
  end
  object ToolBar1: TToolBar
    Size.Width = 359.000000000000000000
    Size.Height = 40.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 2
    object Label1: TLabel
      Align = VertCenter
      AutoSize = True
      StyledSettings = [Family, Style, FontColor]
      Position.Y = 13.000000000000000000
      Size.Width = 359.000000000000000000
      Size.Height = 14.000000000000000000
      Size.PlatformDefault = False
      TextSettings.Font.Size = 10.000000000000000000
      TextSettings.HorzAlign = Center
      Text = 'Label1'
      TabOrder = 0
    end
  end
end

Код:
unit uFormMain;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.ScrollBox,
  FMX.Memo,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.Layouts,
  FMX.Gestures;

type
  TForm1 = class(TForm)
    VertScrollBox1: TVertScrollBox;
    ToolBar1: TToolBar;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Label1: TLabel;
    spdbtnEnableHitTestMemo1Please: TSpeedButton;
    procedure Memo3Enter(Sender: TObject);
    procedure Memo3Exit(Sender: TObject);
    procedure Memo3DblClick(Sender: TObject);
    //
    procedure prcMyGenericProcGesture(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean);
    procedure Memo1DblClick(Sender: TObject);
    procedure Memo1Enter(Sender: TObject);
    procedure Memo1Exit(Sender: TObject);
    procedure spdbtnEnableHitTestMemo1PleaseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses
  System.TypInfo;

// HitTest:
// Enables the control to capture mouse events.
// -----------------------------------------------
// If you set HitTest to True, this control captures all mouse events.
// The example below shows the use of HitTest for an OnClick event.
//
// If you set HitTest to False, the mouse events will pass through this control,
// so that a control laid out behind (colocado atrás) this one receives the
// mouse events instead of this control.
//
// Note: The HitTest enables all mouse-related events, which also include the display
// of Hints and Hint-related events.
// For most controls, HitTest is True by default.
//
// However, this is not true for all the controls:
// For example, for TLabel and TPathLabel, HitTest is False by default;
// these two controls do not capture the mouse-related events unless you
// set HitTest to True.

var
  lTextDesignTimeForMemo1: string = '';

procedure TForm1.FormCreate(Sender: TObject);
begin
  lTextDesignTimeForMemo1 := Memo1.Text;
end;

procedure TForm1.Memo1DblClick(Sender: TObject);
begin
  // Forcing the Memo receive the mouse events again
  TMemo(Sender).HitTest := true;
  //
  TMemo(Sender).Text := 'HitTest is True now';
end;

procedure TForm1.Memo1Enter(Sender: TObject);
begin
  // Forcing control laid out behind this one receives the mouse events instead
  // of this control.
  TMemo(Sender).HitTest := false;
  //
  TMemo(Sender).Text := 'HitTest is False now';
end;

procedure TForm1.Memo1Exit(Sender: TObject);
begin
  // Forcing the Memo receive the mouse events again
  TMemo(Sender).HitTest := true;
  //
  TMemo(Sender).Text := 'HitTest is True now';
end;

procedure TForm1.Memo3DblClick(Sender: TObject);
begin
  // Forcing the Memo receive the mouse events again
  TMemo(Sender).HitTest := true;
  //
  TMemo(Sender).Text := 'HitTest is True now';
end;

procedure TForm1.Memo3Enter(Sender: TObject);
begin
  // Forcing control laid out behind this one receives the mouse events instead
  // of this control.
  TMemo(Sender).HitTest := false;
  //
  TMemo(Sender).Text := 'HitTest is False now';
end;

procedure TForm1.Memo3Exit(Sender: TObject);
begin
  // Forcing the Memo receive the mouse events again
  TMemo(Sender).HitTest := true;
  //
  TMemo(Sender).Text := 'HitTest is True now';
end;

procedure TForm1.prcMyGenericProcGesture(Sender: TObject; { }
  const EventInfo: TGestureEventInfo;                     { }
  var Handled: Boolean);
//
  procedure prcLabelUpdate(lGestID: Integer; lGestName: string; lObj: IControl);
  begin
    if not(lObj = nil) then
      Label1.Text := Format('GestID=[%d = %s] [%s]', [lGestID, lGestName, lObj.GetObject.ClassName])
    else
      Label1.Text := Format('GestID=[%d = %s] [%s]', [lGestID, lGestName, 'nil']);
  end;

//
var
  lObj: IControl;
begin
  lObj := Self.ObjectAtPoint(ClientToScreen(EventInfo.Location)); // obj touched
  //
  case EventInfo.GestureID of
    igiFirst:
      prcLabelUpdate(igiFirst, 'igiFirst', lObj);
    igiLast:
      prcLabelUpdate(igiLast, 'igiLast', lObj);
    igiBegin:
      prcLabelUpdate(igiBegin, 'igiBegin', lObj);
    igiEnd:
      prcLabelUpdate(igiEnd, 'igiEnd', lObj);
    igiZoom:
      prcLabelUpdate(igiZoom, 'igiZoom', lObj);
    igiPan:
      prcLabelUpdate(igiPan, 'igiPan', lObj);
    igiRotate:
      prcLabelUpdate(igiRotate, 'igiRotate', lObj);
    igiTwoFingerTap:
      prcLabelUpdate(igiTwoFingerTap, 'igiTwoFingerTap', lObj);
    igiPressAndTap:
      prcLabelUpdate(igiPressAndTap, 'igiPressAndTap', lObj);
    igiLongTap:
      prcLabelUpdate(igiLongTap, 'igiLongTap', lObj);
    igiDoubleTap:
      prcLabelUpdate(igiDoubleTap, 'igiDoubleTap', lObj);
  else
    prcLabelUpdate(0, '0', nil); // testing... or others real values!
  end;
end;

procedure TForm1.spdbtnEnableHitTestMemo1PleaseClick(Sender: TObject);
begin
  if not Memo1.HitTest then
  begin
    Memo1.HitTest := true;
    Memo1.Text    := lTextDesignTimeForMemo1;
  end else begin
    Memo1.HitTest      := false;
    TMemo(Sender).Text := 'HitTest is False now';
  end;
end;

end.
[/SHOWTOGROUPS]