diff --git a/.gitattributes b/.gitattributes index 7cc37b8813..1c60df4f5e 100644 --- a/.gitattributes +++ b/.gitattributes @@ -4815,6 +4815,9 @@ lcl/include/winfileutil.inc svneol=native#text/plain lcl/inipropstorage.pas svneol=native#text/pascal lcl/interfacebase.pp svneol=native#text/pascal lcl/interfaces/LAYOUT.txt svneol=native#text/plain +lcl/interfaces/android/Makefile.fpc svneol=native#text/text +lcl/interfaces/android/androidint.pas svneol=native#text/pascal +lcl/interfaces/android/androidobject.inc svneol=native#text/pascal lcl/interfaces/carbon/Makefile.compiled svneol=native#text/plain lcl/interfaces/carbon/README.txt svneol=native#text/plain lcl/interfaces/carbon/agl.pp svneol=native#text/plain diff --git a/lcl/interfacebase.pp b/lcl/interfacebase.pp index bc4e75340c..60d2abf6b4 100644 --- a/lcl/interfacebase.pp +++ b/lcl/interfacebase.pp @@ -63,7 +63,8 @@ type lpQT, lpfpGUI, lpNoGUI, - lpCocoa + lpCocoa, + lpAndroid ); TLCLPlatforms = set of TLCLPlatform; diff --git a/lcl/interfaces/Makefile.fpc b/lcl/interfaces/Makefile.fpc index fd83cc49f1..e525801c5e 100644 --- a/lcl/interfaces/Makefile.fpc +++ b/lcl/interfaces/Makefile.fpc @@ -2,7 +2,7 @@ main=lcl [target] -dirs=gtk gtk2 win32 wince qt carbon fpgui nogui cocoa +dirs=gtk gtk2 win32 wince qt carbon fpgui nogui cocoa android [default] dir=$(LCL_PLATFORM) diff --git a/lcl/interfaces/android/Makefile.fpc b/lcl/interfaces/android/Makefile.fpc new file mode 100644 index 0000000000..9c401e8169 --- /dev/null +++ b/lcl/interfaces/android/Makefile.fpc @@ -0,0 +1,35 @@ +[package] +main=lcl + +[require] +packages=rtl + +[target] +units=interfaces + +[compiler] +options=-gl -dqt +unitdir=../../units/$(CPU_TARGET)-$(OS_TARGET) . +unittargetdir=../../units/$(CPU_TARGET)-$(OS_TARGET)/android + +[clean] +files=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) \ + $(wildcard $(COMPILER_UNITTARGETDIR)/*$(PPUEXT)) \ + $(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) \ + $(wildcard $(COMPILER_UNITTARGETDIR)/*.lfm) \ + $(wildcard $(COMPILER_UNITTARGETDIR)/*.res) \ + $(wildcard $(COMPILER_UNITTARGETDIR)/*.compiled) \ + $(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT)) + +[rules] +.PHONY: cleartarget compiled all + +cleartarget: + -$(DEL) $(COMPILER_UNITTARGETDIR)/interfaces$(PPUEXT) \ + $(COMPILER_UNITTARGETDIR)/interfaces$(OEXT) + +compiled: + $(COPY) Makefile.compiled $(COMPILER_UNITTARGETDIR)/LCL.compiled + +all: cleartarget $(COMPILER_UNITTARGETDIR) interfaces$(PPUEXT) compiled + diff --git a/lcl/interfaces/android/androidint.pas b/lcl/interfaces/android/androidint.pas new file mode 100644 index 0000000000..0ead9b6118 --- /dev/null +++ b/lcl/interfaces/android/androidint.pas @@ -0,0 +1,189 @@ +{ + /*************************************************************************** + androidint.pp - Android Interface Object + ------------------- + ***************************************************************************/ + + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.modifiedLGPL.txt, included in this distribution, * + * for details about the copyright. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * + * * + ***************************************************************************** +} + +unit androidint; + +{$mode objfpc}{$H+} + +interface + +{.$I androiddefines.inc} + +uses +{ // Android Bindings + // FPC + Classes, SysUtils, Math, Types, maps, + // LCL} + InterfaceBase, LCLProc, LCLType, LMessages, LCLMessageGlue, LCLStrConsts; +{ Controls, ExtCtrls, Forms, + Dialogs, StdCtrls, Comctrls, LCLIntf, GraphType, GraphUtil, Themes, + Arrow, CheckLst, + // WS + qtproc;} + +type + { TAndroidWidgetSet } + + TAndroidWidgetSet = Class(TWidgetSet) + private +{ App: QApplicationH; + + // cache for WindowFromPoint + FLastWFPMousePos: TPoint; + FLastWFPResult: HWND; + + FEatNextDeactivate: Boolean; + FOverrideCursor: TObject; + SavedDCList: TFPList; + CriticalSection: TRTLCriticalSection; + SavedHandlesList: TMap; + FSocketEventMap: TMap; + StayOnTopList: TMap; + // global hooks + FAppEvenFilterHook: QObject_hookH; + FAppFocusChangedHook: QApplication_hookH; + + // default application font name (FamilyName for "default" font) + FDefaultAppFontName: WideString; + + FDockImage: QRubberBandH; + FDragImageList: QWidgetH; + FDragHotSpot: TPoint; + FDragImageLock: Boolean; + FCachedColors: array[0..MAX_SYS_COLORS] of PLongWord; + FSysColorBrushes: array[0..MAX_SYS_COLORS] of HBrush; + procedure ClearCachedColors; + procedure SetOverrideCursor(const AValue: TObject); + procedure QtRemoveStayOnTop(const ASystemTopAlso: Boolean = False); + procedure QtRestoreStayOnTop(const ASystemTopAlso: Boolean = False); + procedure SetDefaultAppFontName; + protected + FStockNullBrush: HBRUSH; + FStockBlackBrush: HBRUSH; + FStockLtGrayBrush: HBRUSH; + FStockGrayBrush: HBRUSH; + FStockDkGrayBrush: HBRUSH; + FStockWhiteBrush: HBRUSH; + + FStockNullPen: HPEN; + FStockBlackPen: HPEN; + FStockWhitePen: HPEN; + FStockSystemFont: HFONT; + FStockDefaultDC: HDC; + + function CreateThemeServices: TThemeServices; override; + function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; + procedure FocusChanged(old: QWidgetH; now: QWidgetH); cdecl; + procedure OnWakeMainThread(Sender: TObject);} + public + function LCLPlatform: TLCLPlatform; override; + function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; override; + // Application + procedure AppInit(var ScreenInfo: TScreenInfo); override; + procedure AppRun(const ALoop: TApplicationMainLoop); override; + procedure AppWaitMessage; override; + procedure AppProcessMessages; override; + procedure AppTerminate; override; + procedure AppMinimize; override; + procedure AppRestore; override; + procedure AppBringToFront; override; + procedure AppSetIcon(const Small, Big: HICON); override; + procedure AppSetTitle(const ATitle: string); override; + function AppRemoveStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; override; + function AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; override; + public + constructor Create; override; + destructor Destroy; override; + + function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override; + procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override; + procedure DCRedraw(CanvasHandle: HDC); override; + procedure DCSetAntialiasing(CanvasHandle: HDC; AEnabled: Boolean); override; + procedure SetDesigning(AComponent: TComponent); override; + + // create and destroy + function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle; override; + function DestroyTimer(TimerHandle: THandle): boolean; override; + + // device contexts + function IsValidDC(const DC: HDC): Boolean; virtual; + function IsValidGDIObject(const GDIObject: HGDIOBJ): Boolean; virtual; + +{ // qt object handles map + procedure AddHandle(AHandle: TObject); + procedure RemoveHandle(AHandle: TObject); + function IsValidHandle(AHandle: HWND): Boolean; + + // cache for WindowFromPoint to reduce very expensive calls + // of QApplication_widgetAt() inside WindowFromPoint(). + function IsWidgetAtCache(AHandle: HWND): Boolean; + procedure InvalidateWidgetAtCache; + function IsValidWidgetAtCachePointer: Boolean; + function GetWidgetAtCachePoint: TPoint; + + // drag image list + function DragImageList_BeginDrag(AImage: QImageH; AHotSpot: TPoint): Boolean; + procedure DragImageList_EndDrag; + function DragImageList_DragMove(X, Y: Integer): Boolean; + function DragImageList_SetVisible(NewVisible: Boolean): Boolean; + public + function CreateDefaultFont: HFONT; virtual; + function GetDefaultAppFontName: WideString; + function GetQtDefaultDC: HDC; virtual; + procedure DeleteDefaultDC; virtual; + procedure SetQtDefaultDC(Handle: HDC); virtual; + procedure InitStockItems; + procedure FreeStockItems; + procedure FreeSysColorBrushes(const AInvalidateHandlesOnly: Boolean = False); + + property DragImageLock: Boolean read FDragImageLock write FDragImageLock; + property OverrideCursor: TObject read FOverrideCursor write SetOverrideCursor;} + +// {$I qtwinapih.inc} +// {$I qtlclintfh.inc} + end; + + +var + AndroidWidgetSet: TAndroidWidgetSet; + +implementation + +{uses +//////////////////////////////////////////////////// +// I M P O R T A N T +//////////////////////////////////////////////////// +// To get as little as possible circles, +// uncomment only those units with implementation +//////////////////////////////////////////////////// + AndroidWSFactory, + AndroidCaret, + AndroidThemes, +//////////////////////////////////////////////////// + Graphics, buttons, Menus, + // Bindings + qtprivate, qtwidgets, qtobjects;} + + +{$I androidobject.inc} +//{$I qtwinapi.inc} +//{$I qtlclintf.inc} + +end. diff --git a/lcl/interfaces/android/androidobject.inc b/lcl/interfaces/android/androidobject.inc new file mode 100644 index 0000000000..259d4732c5 --- /dev/null +++ b/lcl/interfaces/android/androidobject.inc @@ -0,0 +1,324 @@ +{%MainUnit androidint.pas} +{ + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.modifiedLGPL.txt, included in this distribution, * + * for details about the copyright. * + * * + * This program is distributed in the hope that it will be useful, * + * but WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * + * * + ***************************************************************************** +} +//--------------------------------------------------------------- + +{------------------------------------------------------------------------------ + Method: TAndroidWidgetSet.Create + Params: None + Returns: Nothing + + Constructor for the class. + ------------------------------------------------------------------------------} +constructor TAndroidWidgetSet.Create; +begin +{ FLastWFPMousePos := Point(MaxInt, MaxInt); + FLastWFPResult := 0; + + inherited Create; + + App := QApplication_Create(@argc, argv); + InitStockItems; + QtWidgetSet := Self; + ClearCachedColors; + FDockImage := nil; + FDragImageLock := False; + System.InitCriticalSection(CriticalSection); + SavedHandlesList := TMap.Create(TMapIdType(ituPtrSize), SizeOf(TObject)); + FSocketEventMap := TMap.Create(TMapIdType(its4), SizeOf(Pointer)); + StayOnTopList := nil; + FEatNextDeactivate := False;} +end; + +{------------------------------------------------------------------------------ + Method: TAndroidWidgetSet.Destroy + Params: None + Returns: Nothing + + Destructor for the class. + ------------------------------------------------------------------------------} +destructor TAndroidWidgetSet.Destroy; +begin +{ if FDockImage <> nil then + QRubberBand_destroy(FDockImage); + DestroyGlobalCaret; + Clipboard.Free; + FreeStockItems; + FreeSysColorBrushes; + QtDefaultPrinter.Free; + QtWidgetSet := nil; + + if SavedDCList<>nil then + SavedDCList.Free; + + QtDefaultContext.Free; + QtScreenContext.Free; + + ClearCachedColors; + + if StayOnTopList <> nil then + begin + StayOnTopList.Free; + StayOnTopList := nil; + end; + + if SavedHandlesList <> nil then + begin + SavedHandlesList.Free; + SavedHandlesList := nil; + end; + FSocketEventMap.Free; + + System.DoneCriticalsection(CriticalSection);} + + inherited Destroy; +end; + +{------------------------------------------------------------------------------ + Method: TAndroidWidgetSet.Destroy + Params: None + Returns: Nothing + + Creates a new timer and sets the callback event. + ------------------------------------------------------------------------------} +function TAndroidWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc): THandle; +begin +end; + +{------------------------------------------------------------------------------ + Method: TAndroidWidgetSet.Destroy + Params: None + Returns: Nothing + + Destroys a timer. + ------------------------------------------------------------------------------} +function TAndroidWidgetSet.DestroyTimer(TimerHandle: THandle): boolean; +begin +end; + +{------------------------------------------------------------------------------ + Method: TAndroidWidgetSet.AppInit + Params: None + Returns: Nothing + + Initializes the application + ------------------------------------------------------------------------------} +procedure TAndroidWidgetSet.AppInit(var ScreenInfo: TScreenInfo); +begin +// WakeMainThread := @OnWakeMainThread; + + { + check whether this hook crashes on linux & darwin and why it is so + we need this hook to catch release messages + } +{ // install global event filter + FAppEvenFilterHook := QObject_hook_create(App); + QObject_hook_hook_events(FAppEvenFilterHook, @EventFilter); + + // install focus change slot + + FAppFocusChangedHook := QApplication_hook_create(App); + QApplication_hook_hook_focusChanged(FAppFocusChangedHook, @FocusChanged); + + + ScreenDC := GetDC(0); + try + ScreenInfo.PixelsPerInchX := GetDeviceCaps(ScreenDC, LOGPIXELSX); + ScreenInfo.PixelsPerInchY := GetDeviceCaps(ScreenDC, LOGPIXELSY); + ScreenInfo.ColorDepth := GetDeviceCaps(ScreenDC, BITSPIXEL); + finally + ReleaseDC(0, ScreenDC); + end; + + QtDefaultPrinter;} + // initialize default app font name +// SetDefaultAppFontName; +end; + +{------------------------------------------------------------------------------ + Method: TAndroidWidgetSet.AppRun + Params: None + Returns: Nothing + + Enter the main message loop + ------------------------------------------------------------------------------} +procedure TAndroidWidgetSet.AppRun(const ALoop: TApplicationMainLoop); +begin + // use LCL loop +// if Assigned(ALoop) then +// ALoop; +end; + +{------------------------------------------------------------------------------ + Method: TAndroidWidgetSet.AppWaitMessage + Params: None + Returns: Nothing + + Waits until a message arrives, processes that and returns control out of the function + + Utilized on Modal dialogs + ------------------------------------------------------------------------------} +procedure TAndroidWidgetSet.AppWaitMessage; +begin + {we cannot call directly processEvents() with this flag + since it produces AV's sometimes, so better check is there + any pending event.} +// QCoreApplication_processEvents(QEventLoopWaitForMoreEvents); +end; + +{------------------------------------------------------------------------------ + Method: TAndroidWidgetSet.AppProcessMessages + Params: None + Returns: Nothing + + Processes all messages on the quoue + ------------------------------------------------------------------------------} +procedure TAndroidWidgetSet.AppProcessMessages; +begin + {we must use QEventLoopDefferedDeletion because of SlotClose. + Normal forms are NOT closed without this ...} +// QCoreApplication_processEvents(QEventLoopAllEvents); +end; + +{------------------------------------------------------------------------------ + Method: TAndroidWidgetSet.AppTerminate + Params: None + Returns: Nothing + + Implements Application.Terminate and MainForm.Close. + ------------------------------------------------------------------------------} +procedure TAndroidWidgetSet.AppTerminate; +begin + // free hooks +// QObject_hook_destroy(FAppEvenFilterHook); +// QApplication_hook_destroy(FAppFocusChangedHook); + +// QCoreApplication_quit; +end; + +procedure TAndroidWidgetSet.AppMinimize; +begin +end; + +procedure TAndroidWidgetSet.AppRestore; +begin +end; + +procedure TAndroidWidgetSet.AppBringToFront; +begin +end; + +procedure TAndroidWidgetSet.AppSetIcon(const Small, Big: HICON); +begin +end; + + +procedure TAndroidWidgetSet.AppSetTitle(const ATitle: string); +begin +end; + +function TAndroidWidgetSet.AppRemoveStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; +begin +end; + +function TAndroidWidgetSet.AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; +begin +end; + +function TAndroidWidgetSet.LCLPlatform: TLCLPlatform; +begin + Result:= lpQT; +end; + +function TAndroidWidgetSet.GetLCLCapability(ACapability: TLCLCapability): PtrUInt; +begin +(* case ACapability of + lcCanDrawOutsideOnPaint: Result := LCL_CAPABILITY_NO; + lcDragDockStartOnTitleClick: Result := + {$ifdef MSWINDOWS} LCL_CAPABILITY_YES {$else} LCL_CAPABILITY_NO {$endif}; + lcNeedMininimizeAppWithMainForm: Result := + {$ifdef HASX11} LCL_CAPABILITY_YES {$else} LCL_CAPABILITY_NO {$endif}; + else + Result := inherited GetLCLCapability(ACapability); + end;*) +end; + +function TAndroidWidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; +begin +end; + +procedure TAndroidWidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); +begin +end; + +procedure TAndroidWidgetSet.DCRedraw(CanvasHandle: HDC); +begin + // TODO: implement me +end; + +procedure TAndroidWidgetSet.DCSetAntialiasing(CanvasHandle: HDC; AEnabled: Boolean); +begin +end; + +procedure TAndroidWidgetSet.SetDesigning(AComponent: TComponent); +begin + +end; + +{------------------------------------------------------------------------------ + Function: TAndroidWidgetSet.IsValidDC + Params: DC - handle to a device context (TQtDeviceContext) + Returns: True - if the DC is valid + ------------------------------------------------------------------------------} +function TAndroidWidgetSet.IsValidDC(const DC: HDC): Boolean; +begin + Result := (DC <> 0); +end; + +{------------------------------------------------------------------------------ + Function: TAndroidWidgetSet.IsValidGDIObject + Params: GDIObject - handle to a GDI Object (TQtFont, TQtBrush, etc) + Returns: True - if the DC is valid + + Remark: All handles for GDI objects must be pascal objects so we can + distinguish between them + ------------------------------------------------------------------------------} +function TAndroidWidgetSet.IsValidGDIObject(const GDIObject: HGDIOBJ): Boolean; +var + aObject: TObject; +begin + Result := False; + + if GDIObject = 0 then Exit; + +{ aObject := TObject(GDIObject); + try + if aObject is TObject then + begin + Result := + (aObject is TQtFont) or + (aObject is TQtBrush) or + (aObject is TQtImage) or + (aObject is TQtPen) or + (aObject is TQTRegion); + end; + except + DebugLn(['Gdi object: ', GDIObject, ' is not an object!']); + raise; + end;} +end; + + +//------------------------------------------------------------------------