Thursday, September 17, 2015

Dragging Rectangles on Firemonkey Form

Delphi DX10 

For the perennial question of how to move objects around the form at run time, here is a method for dragging Rectangles (or any shapes) around on the form with the mouse or touch.

Considerations:

We need a Layout in the background to use as a coordinate system that can be turned on and off. 

We need to set Rectangle.Hittest:= true so we can pick it.

We need to set Layout.Hittest := false to start with or it will interfere with picking the rectangles.

When we pick a rectangle, we need to capture the mouse events of the Layout so we can use the coordinates MouseMove and MouseUp to stop. We will do this with Layout1.Root.Captured := Layout1;

Use the Layout X,Y MouseMove coordinates to move rectangle.

Use Layout MouseUp event to end dragging. Layout mouse capture is turned off and we can pick the next rectangle.


unit File: Mainunit.pas

unit Mainunit;

interface


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

type
  TMainForm = class(TForm)
    Layout1: TLayout;
    Rectangle1: TRectangle;
    procedure Rectangle1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure Layout1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure Layout1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation


{$R *.fmx}

const
  MAX_RECTANGLES = 10;
  RECT_WIDTH = 80;
  RECT_HEIGHT = 80;

var
  Grab: boolean = false;
  Offset: tpointf;
  MovingRectangle: TRectangle;
  RectArray: array [0 .. MAX_RECTANGLES] of TRectangle;

procedure TMainForm.FormCreate(Sender: TObject);
var
  I: integer;
  TitleRect: TRectangle;
  TitleLabel: TLabel;
begin
  Layout1.HitTest := false; // want to pick rectangles
  for I := Low(RectArray) to high(RectArray) do
  begin
    RectArray[I] := TRectangle.Create(self);
    RectArray[I].Parent := Layout1;
    RectArray[I].OnMouseDown := Rectangle1MouseDown;
    RectArray[I].OnMouseUp := Layout1MouseUp;
    RectArray[I].Width := RECT_WIDTH;
    RectArray[I].Height := RECT_HEIGHT;
    RectArray[I].fill.Color := random($FFFFFF) or $FF000000;
    RectArray[I].Position.X := random(trunc(Layout1.Width - RECT_WIDTH));
    RectArray[I].Position.Y := random(trunc(Layout1.Height - RECT_HEIGHT));

    TitleRect := TRectangle.Create(self);
    TitleRect.fill.Color := Talphacolorrec.White;
    TitleRect.Position.X := 0;
    TitleRect.Position.Y := 0;
    TitleRect.Width := RECT_WIDTH;
    TitleRect.Height := 16;
    TitleRect.HitTest := false;

    TitleLabel := TLabel.Create(self);
    TitleLabel.StyledSettings:=[];
    TitleLabel.Font.Size:=12;
    TitleLabel.Text := 'Caption ' + I.ToString;
    TitleRect.AddObject(TitleLabel);

    RectArray[I].AddObject(TitleRect);
  end;
end;

procedure TMainForm.Layout1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if Grab and (ssleft in Shift) then
  begin
    // keep from dragging off Layout
    if X > (Layout1.Width + Offset.X - RECT_WIDTH) then
      X := Layout1.Width + Offset.X - RECT_WIDTH;
    if Y > (Layout1.Height + Offset.Y - RECT_HEIGHT) then
      Y := Layout1.Height + Offset.Y - RECT_HEIGHT;
    if X < Offset.X then
      X := Offset.X;
    if Y < Offset.Y then
      Y := Offset.Y;

    MovingRectangle.Position.X := X - Offset.X;
    MovingRectangle.Position.Y := Y - Offset.Y;
  end;
end;

procedure TMainForm.Layout1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  Grab := false;
  // MouseUp automatically turns off mouse capture of Layout1
end;

procedure TMainForm.Rectangle1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
  X, Y: Single);
begin
  MovingRectangle := Sender as TRectangle;
  Offset.X := X;
  Offset.Y := Y;
  // sets mouse capture to Layout1
  Layout1.Root.Captured := Layout1;
  MovingRectangle.BringToFront; // optional
  MovingRectangle.Repaint;
  Grab := true;
end;

end.



FMX File: Mainunit.FMX

object MainForm: TMainForm
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = Single
  Caption = 'Form33'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  DesignerMasterStyle = 0
  object Layout1: TLayout
    Anchors = [akLeft, akTop, akRight, akBottom]
    HitTest =
False    
    Position.X = 30.000000000000000000
    Position.Y = 30.000000000000000000
    Size.Width = 579.000000000000000000
    Size.Height = 421.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 0
    OnMouseMove = Layout1MouseMove
    OnMouseUp = Layout1MouseUp
    object Rectangle1: TRectangle
      Align = Client
      Fill.Color = claAntiquewhite
      HitTest = False
      Size.Width = 579.000000000000000000
      Size.Height = 421.000000000000000000
      Size.PlatformDefault = False
    end
  end
end



DPR File:
program DragRectangles;

uses
  System.StartUpCopy,
  FMX.Forms,
  Mainunit in 'Mainunit.pas' {MainForm};

{$R *.res}

begin
  ReportMemoryLeaksOnShutdown := DebugHook <> 0;
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.


Works in Windows, OSX, IOS, Android

Download DX10 Source code: DragRectangles.zip

Form Shown on Screens:



You can test when the rectangle you are moving lands on top of another one.
Just replace the TMainForm.Layout1MouseUp procedure with this one:

procedure TMainForm.Layout1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  I: integer;
  BottomRectangle: TRectangle;

  function PointInRect(X, Y { top rect corner coords in layout1 } : Single; BotRect: TRectangle): boolean;
  begin
    if (X >= BotRect.Position.X) and (X <= (BotRect.Position.X + BotRect.Width)) and (Y >= BotRect.Position.Y)
      and (Y <= BotRect.Position.Y + BotRect.Height) then
      result := true
    else
      result := false;
  end;

  function RectangleOnTop(TopRect, BotRect: TRectangle): boolean;
  var
    X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single;
  begin
    // 4 corners
    // 1-------2
    // 3-------4
    result := false;
    X1 := TopRect.Position.X; // these are the four corners according in layout1 coords
    Y1 := TopRect.Position.Y; // of the top moving rect
    X2 := X1 + TopRect.Width;
    Y2 := Y1;
    X3 := X1;
    Y3 := Y1 + TopRect.Height;
    X4 := X2;
    Y4 := Y3;

    // check 4 corners of top rect
    if PointInRect(X1, Y1, BotRect) or PointInRect(X2, Y2, BotRect) or PointInRect(X3, Y3, BotRect) or
      PointInRect(X4, Y4, BotRect) then
      result := true;
  end;

begin
  Grab := false;
  // MouseUp automatically turns off mouse capture of Layout1

  // check to see if over another rectangle
  for I := Low(RectArray) to high(RectArray) do
  begin
    if MovingRectangle <> RectArray[I] then
    begin
      if RectangleOnTop(MovingRectangle, RectArray[I]) then
      begin
        BottomRectangle := RectArray[I];
        beep;
        showmessage('Over Rect ' + TLabel(BottomRectangle.Children.Items[0].Children.Items[0]).Text);
        break;
      end;
    end;
  end;
end;

 

Wednesday, December 17, 2014

Using Custom Fonts in Android - Delphi

Android

XE7

 You should be able to use any True Type Font in an android app.

Example using the font Script MT Bold. This font is in the Windows Font Folder. The font file name is SCRIPTBL.TTF.

1. copy SCRIPTBL.TTF to the project folder.
2. In Deployment window, add SCRIPTBL.TTF file. Set Remote Path to .\assets\internal\
Set Remote Name to .SCRIPTBL.ttf (make the ttf extension lower case so we can hard code it into the program)
 


3. Load FMX.FontGlyphs.Android.pas into the editor. ( the file is in C:\Program Files (x86)\Embarcadero\Studio\15.0\source\fmx)
If it is read only, right click in editor and turn off Read-Only.
Save the file to the project folder. Don't change the file name. Then you can edit it in the Delphi editor.
  A. Add System.IOUtils to the uses clause.
  B. Go to procedure TAndroidFontGlyphManager.LoadResource;
  • Add a var FontFile: string;
  • There is a line in the procedure that says:Typeface := TJTypeface.JavaClass.create(FamilyName, TypefaceFlag);
  • Replace that line with:
 FontFile := TPath.GetDocumentsPath + PathDelim + CurrentSettings.Family + '.ttf';
 if FileExists(FontFile) then
   Typeface := TJTypeface.JavaClass.createFromFile(StringToJString(FontFile))
   else
     Typeface := TJTypeface.JavaClass.Create(FamilyName, TypefaceFlag); 
This will make it look for a font file by that name first.

4. For each component you want to use this font on, set the TextSettings Font Family property to SCRIPTBL
This is the name of the font file without the file extension. Don't put "SCRIPTBL.ttf" and don't put "Script MT Bold".
You will have to type or paste it in to the property box.

Note: filenames in Android are case sensitive, so you have to get them all the same.

This is a form with label, textbox, memo, checkbox, radio button:


How to Use Custom Fonts in IOS - Delphi


IOS

XE7

You should be able to use any True Type Font in your IOS app.

Example using the font Script MT Bold. This font is in the Windows Font Folder. The font file name is SCRIPTBL.TTF.

1. Copy SCRIPTBL.TTF to the project folder.
2. Compile the app for IOS so that it makes an info.plist file in the debug folder.
3. Open the info.plist file in the Delphi editor. Save it as custom.info.plist in the project folder.
Add another key in it:
 <key>UIAppFonts</key>
 <array>
 <string>SCRIPTBL.TTF</string>
 </array>

This tells IOS to be able to use the additional font file. IOS will automatically look for it in the bundle.

4. In the Deployment page, add SCRIPTBL.TTF with Remote Path of .\



5. Add your custom plist file with Remote Name of info.plist



6. Uncheck the deployment of the old info.plist



This will substitute the info plist with your font info in it.

For each component, set the TextSettins Font Family property to Script MT Bold. Since this font is already installed in Windows, you can choose it off the dropdown list.

This is a form with label, textbox, memo, checkbox, radio button.