{********************************************************************}
{                                                                    }
{ written by TMS Software                                            }
{            copyright © 2013                                        }
{            Email : info@tmssoftware.com                            }
{            Web : http://www.tmssoftware.com                        }
{                                                                    }
{ The source code is given as is. The author is not responsible      }
{ for any possible damage done due to the use of this code.          }
{ The complete source code remains property of the author and may    }
{ not be distributed, published, given or sold in any form as such.  }
{ No parts of the source code can be included in any other component }
{ or application without written authorization of the author.        }
{********************************************************************}

unit FMX.TMSBaseControl;

interface

{$I TMSDEFS.INC}

uses
  FMX.Types, Types, FMX.Objects, Classes, FMX.Dialogs, UITypes,
  FMX.Controls ,UIConsts, FMX.Styles, FMX.StdCtrls, FMX.Edit
  {$IFDEF DELPHIXE5_LVL}
  , FMX.Graphics
  {$ENDIF}
  {$IFNDEF IOS}
  {$IFNDEF MACOS}
  {$IFNDEF ANDROID}
  ,Windows
  {$ENDIF}
  {$ENDIF}
  {$ENDIF}
  {$IFDEF IOS}
  ,iOSApi.UIKit, iOSApi.Foundation
  {$ENDIF}
  ;

type
  TTMSFMXBaseShape = class(TShape)
  published
    property RotationAngle;
    property RotationCenter;
    property Align;
    property Position;
    property Width;
    property Height;
    property Padding;
    property Anchors;
    property ClipChildren default False;
    property ClipParent default False;
    property Cursor default crDefault;
    property DesignVisible default True;
    property DragMode default TDragMode.dmManual;
    property EnableDragHighlight default True;
    property Enabled default True;
    property Fill;
    property Locked default False;
    property HitTest default True;
    property Margins;
    property Opacity;
    property PopupMenu;
    property Scale;
    property StrokeThickness stored false;
    property StrokeCap stored false;
    property StrokeDash stored false;
    property StrokeJoin stored false;
    property Stroke;
    property Visible default True;
    property OnApplyStyleLookup;
    property OnDragEnter;
    property OnDragLeave;
    property OnDragOver;
    property OnDragDrop;
    property OnDragEnd;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnPainting;
    property OnPaint;
    property OnResize;
  end;

  TTMSFMXBaseCollection = class(TCollection)
  procedure Delete(Index: Integer);
  end;

  TTMSFMXBaseControl = class(TStyledControl)
  private
    FAppliedStyle: Boolean;
    FStrokeJoin: TStrokeJoin;
    FStrokeThickness: Single;
    FStrokeCap: TStrokeCap;
    FStrokeDash: TStrokeDash;
    FFill: TBrush;
    FStroke: TBrush;
    procedure SetFill(const Value: TBrush);
    procedure SetStroke(const Value: TBrush);
    procedure SetStrokeCap(const Value: TStrokeCap);
    procedure SetStrokeDash(const Value: TStrokeDash);
    procedure SetStrokeJoin(const Value: TStrokeJoin);
    procedure SetStrokeThickness(const Value: Single);
  protected
    function GetInstance: NativeUInt; virtual;
    function GetClassStyleName: String; virtual;
    procedure ApplyAdditionalStyle(AControl: TFMXObject); virtual;
    function GetStyleObject: TFMXObject; override;
    function LoadFromAResource: TFMXObject;

    property Fill: TBrush read FFill write SetFill;
    property Stroke: TBrush read FStroke write SetStroke;
    property StrokeThickness: Single read FStrokeThickness write SetStrokeThickness;
    {$IFDEF DELPHIXE6_LVL}
    property StrokeCap: TStrokeCap read FStrokeCap write SetStrokeCap default TStrokeCap.Flat;
    property StrokeDash: TStrokeDash read FStrokeDash write SetStrokeDash default TStrokeDash.Solid;
    property StrokeJoin: TStrokeJoin read FStrokeJoin write SetStrokeJoin default TStrokeJoin.Miter;
    {$ELSE}
    property StrokeCap: TStrokeCap read FStrokeCap write SetStrokeCap default TStrokeCap.scFlat;
    property StrokeDash: TStrokeDash read FStrokeDash write SetStrokeDash default TStrokeDash.sdSolid;
    property StrokeJoin: TStrokeJoin read FStrokeJoin write SetStrokeJoin default TStrokeJoin.sjMiter;
    {$ENDIF}
    procedure ApplyStyle; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure Update; virtual;
  published
    property Align;
    property Anchors;
    property CanParentFocus;
    property ClipChildren default False;
    property ClipParent default False;
    property Cursor default crDefault;
    property DesignVisible default True;
    property DisableFocusEffect default True;
    property DragMode default TDragMode.dmManual;
    property EnableDragHighlight default True;
    property Enabled default True;
    property Locked default False;
    property Height;
    property HitTest default True;
    property Margins;
    property Opacity;
    property Padding;
    property PopupMenu;
    property Position;
    property RotationAngle;
    property RotationCenter;
    property Scale;
    property StyleLookup;
    property TabOrder;
    property Visible default True;
    property Width;
    property OnApplyStyleLookup;
    property OnDragEnter;
    property OnDragLeave;
    property OnDragOver;
    property OnDragDrop;
    property OnDragEnd;
    property OnKeyDown;
    property OnKeyUp;
    property OnCanFocus;
    property OnClick;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnPainting;
    property OnPaint;
    property OnResize;
  end;

{$EXTERNALSYM Hiword}
function Hiword(L: DWORD): integer;
{$EXTERNALSYM LoWord}
function LoWord(L: DWORD): Integer;
{$EXTERNALSYM MakeWord}
function MakeWord(b1,b2: integer): integer;
{$EXTERNALSYM MakeLong}
function MakeLong(i1,i2: integer): integer;
procedure CloneChildrenBase(Source, Destination: TFMXObject);

function FindRCData(ModuleHandle: HMODULE  ; Name:string): boolean;
function PointInRect(const P: TPointF; const Rect: TRectF): Boolean;

const
  TMSPlatforms = pidWin32 or pidWin64 or pidOSX32 or pidiOSSimulator or pidiOSDevice or pidAndroid;

implementation

var
  FTrial: Integer = 0;

{$IFDEF FREEWARE}
function Scramble(s:string): string;
var
  r:string;
  i: integer;
  c: char;
  b: byte;
begin
  r := '';
  {$IFDEF DELPHI_LLVM}
  for i := 0 to length(s) - 1 do
  {$ELSE}
  for i := 1 to length(s) do
  {$ENDIF}
  begin
    b := ord(s[i]);
    b := (b and $E0) + ((b and $1F) xor 5);
    c := chr(b);
    r := r + c;
  end;
  Result := r;
end;
{$ENDIF}

function PointInRect(const P: TPointF; const Rect: TRectF): Boolean;
begin
  Result := (P.X >= Rect.Left) and (P.X <= Rect.Right) and (P.Y >= Rect.Top) and (P.Y <= Rect.Bottom);
end;

function Hiword(L: DWORD): integer;
begin
  Result := L shr 16;
end;

function LoWord(L: DWORD): Integer;
begin
  Result := L AND $FFFF;
end;

function MakeWord(b1,b2: integer): integer;
begin
  Result := b1 or b2 shl 8;
end;

function MakeLong(i1,i2: integer): integer;
begin
  Result := i1 or i2 shl 16;
end;

procedure CloneChildrenBase(Source, Destination: TFMXObject);
var
  i: integer;
  fmxclone: TFmxObject;
begin
  for I := 0 to Source.ChildrenCount - 1 do
  begin
    fmxclone := Source.Children[I].Clone(Destination);
    Destination.AddObject(fmxclone);
    CloneChildrenBase(Source.Children[I], fmxclone);
  end;
end;

{ TTMSFMXBaseControl }

procedure TTMSFMXBaseControl.ApplyAdditionalStyle(AControl: TFMXObject);
begin
//
end;

{$IFDEF IOS}
function GetSharedApplication: UIApplication;
begin
  Result := TUIApplication.Wrap(TUIApplication.OCClass.sharedApplication);
end;
{$ENDIF}

procedure TTMSFMXBaseControl.ApplyStyle;
{$IFDEF FREEWARE}
var
{$IFDEF IOS}
  vw: UIViewController;
  alert: UIAlertView;
{$ENDIF}
  str: string;
{$ENDIF}
begin
  inherited;
  {$IFDEF FREEWARE}
  {$IFDEF IOS}
  vw := GetSharedApplication.keyWindow.rootViewController;
  if Assigned(vw) and Assigned(vw.view.window) and vw.isViewLoaded and (FTrial = 0) then
  begin
    str := Scramble('Duuilfdqljk%pv`v%qwldi%s`wvljk%jc%QHV%vjcqrdw`%fjhujk`kqv+')+#13#10+Scramble('Fjkqdfq%QHV%vjcqrdw`%mqqu?**rrr+qhvvjcqrdw`+fjh%cjw%sdila%ilf`kvlkb+');
    alert := TUIAlertView.Wrap(TUIAlertView.Wrap(TUIAlertView.OCClass.alloc).initWithTitle(NSStr(''), NSStr(str), nil, NSStr('OK'), nil));
    alert.show;
    alert.release;
    FTrial := 1;
  end;
  {$ENDIF}
  {$IFDEF ANDROID}
  if (FTrial = 0) then
  begin
    str := Scramble('Duuilfdqljk%pv`v%qwldi%s`wvljk%jc%QHV%vjcqrdw`%fjhujk`kqv+')+#13#10+Scramble('Fjkqdfq%QHV%vjcqrdw`%mqqu?**rrr+qhvvjcqrdw`+fjh%cjw%sdila%ilf`kvlkb+');
    ShowMessage(str);
    FTrial := 1;
  end;
  {$ENDIF}
  {$ENDIF}
  Update;
end;

constructor TTMSFMXBaseControl.Create(AOwner: TComponent);
begin
  inherited;
  FAppliedStyle := False;
  FStrokeThickness := 1;
  {$IFDEF DELPHIXE6_LVL}
  FFill := TBrush.Create(TBrushKind.None, claWhite);
  FStroke := TBrush.Create(TBrushKind.None, claSilver);
  FStrokeCap := TStrokeCap.Flat;
  FStrokeDash := TStrokeDash.Solid;
  FStrokeJoin := TStrokeJoin.Miter;
  {$ELSE}
  FFill := TBrush.Create(TBrushKind.bkNone, claWhite);
  FStroke := TBrush.Create(TBrushKind.bkNone, claSilver);
  FStrokeCap := TStrokeCap.scFlat;
  FStrokeDash := TStrokeDash.sdSolid;
  FStrokeJoin := TStrokeJoin.sjMiter;
  {$ENDIF}
end;

destructor TTMSFMXBaseControl.Destroy;
begin
  FFill.Free;
  FStroke.Free;
  inherited;
end;

function TTMSFMXBaseControl.GetClassStyleName: String;
begin
  Result := ClassName + 'style';
  Delete(Result, 1, 1);
end;

function TTMSFMXBaseControl.GetInstance: NativeUInt;
begin
  Result := HInstance;
end;

function TTMSFMXBaseControl.GetStyleObject: TFMXObject;
var
  obj: TFMXObject;
begin
  obj := inherited GetStyleObject;

  if not Assigned(obj) then
  begin
    // not found in default or custom style book, so create from resource
    obj := LoadFromAResource;

    if Assigned(obj) then
      ApplyAdditionalStyle(obj);
  end;

  Result := obj;
end;

function FindRCData(ModuleHandle: HMODULE  ; Name:string): boolean;
begin
  Result := FindResource(ModuleHandle, PChar(Name), PChar(RT_RCDATA)) <> 0;
end;

function TTMSFMXBaseControl.LoadFromAResource: TFmxObject;
var
  str: String;
  hst: NativeUInt;
begin
  Result := nil;
  // create resource class name
  str := GetClassStyleName;
  hst := GetInstance;

  if FindRCData(hst, str) then
    {$IFDEF DELPHIXE6_LVL}
    Result := TStyleStreaming.LoadFromResource(hst, str, RT_RCDATA);
    {$ELSE}
    Result := TStyleManager.LoadFromResource(hst, str, RT_RCDATA);
    {$ENDIF}
end;

procedure TTMSFMXBaseControl.Paint;
begin
  inherited;
  Canvas.Fill.Assign(Fill);
  Canvas.Stroke.Assign(Stroke);
  Canvas.StrokeThickness := StrokeThickness;
  Canvas.StrokeCap := StrokeCap;
  Canvas.StrokeDash := StrokeDash;
  Canvas.StrokeJoin := StrokeJoin;
  Canvas.DrawRect(BoundsRect, 0, 0, AllCorners, AbsoluteOpacity);
  Canvas.FillRect(BoundsRect, 0, 0, AllCorners, AbsoluteOpacity);
end;

procedure TTMSFMXBaseControl.SetFill(const Value: TBrush);
begin
  if FFill <> Value then
  begin
    FFill.Assign(Value);
    Repaint;
  end;
end;

procedure TTMSFMXBaseControl.SetStroke(const Value: TBrush);
begin
  if FStroke <> Value then
  begin
    FStroke.Assign(Value);
    Repaint;
  end;
end;

procedure TTMSFMXBaseControl.SetStrokeCap(const Value: TStrokeCap);
begin
  if FStrokeCap <> Value then
  begin
    FStrokeCap := Value;
    Repaint;
  end;
end;

procedure TTMSFMXBaseControl.SetStrokeDash(const Value: TStrokeDash);
begin
  if FStrokeDash <> Value then
  begin
    FStrokeDash := Value;
    Repaint;
  end;
end;

procedure TTMSFMXBaseControl.SetStrokeJoin(const Value: TStrokeJoin);
begin
  if FStrokeJoin <> Value then
  begin
    FStrokeJoin := Value;
    Repaint;
  end;
end;

procedure TTMSFMXBaseControl.SetStrokeThickness(const Value: Single);
begin
  if FStrokeThickness <> Value then
  begin
    FStrokeThickness := Value;
    Repaint;
  end;
end;

procedure TTMSFMXBaseControl.Update;
begin
//
end;

{ TTMSFMXBaseCollection }

procedure TTMSFMXBaseCollection.Delete(Index: Integer);
begin
  {$IFDEF DELPHI_LLVM}
  Items[Index].Release;
  {$ELSE}
  Items[Index].Free;
  {$ENDIF}
end;

initialization
begin
  RegisterFmxClasses([TTMSFMXBaseControl, TTMSFMXBaseShape]);

{$IFNDEF DELPHI_LLVM}
{$IFDEF FREEWARE}
{$IFNDEF MACOS}
   if  (FindWindow(PChar(Scramble('QDuuilfdqljk')), nil) = 0) OR
       (FindWindow(PChar(Scramble('QDuuGplia`w')), nil) = 0) then
{$ENDIF}
   begin
     MessageDlg(Scramble('Duuilfdqljk%pv`v%qwldi%s`wvljk%jc%QHV%vjcqrdw`%fjhujk`kqv+')+#13#10+Scramble('Fjkqdfq%QHV%vjcqrdw`%mqqu?**rrr+qhvvjcqrdw`+fjh%cjw%sdila%ilf`kvlkb+'), TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], 0);
   end;
{$ENDIF}
{$ENDIF}
end;


end.
