Adds a callback for Android OnCreate and also implements TTimer in X11

git-svn-id: trunk@34350 -

examples/androidlcl/androidlcltest.lpr

@@ -1,17 +1,13 @@
 library androidlcltest;
 
 {$mode objfpc}{$H+}
-{$define Android}
 
 uses
-  {$ifdef Android}
   customdrawnint,
-  {$endif}
   Interfaces,
   Forms,
   mainform, secondform;
 
-{$ifdef Android}
 exports
   Java_com_pascal_lclproject_LCLActivity_LCLOnTouch name 'Java_com_pascal_lcltest_LCLActivity_LCLOnTouch',
   Java_com_pascal_lclproject_LCLActivity_LCLDrawToBitmap name 'Java_com_pascal_lcltest_LCLActivity_LCLDrawToBitmap',
@@ -22,11 +18,16 @@ exports
   Java_com_pascal_lclproject_LCLActivity_LCLOnConfigurationChanged name 'Java_com_pascal_lclproject_LCLActivity_LCLOnConfigurationChanged',
   JNI_OnLoad name 'JNI_OnLoad',
   JNI_OnUnload name 'JNI_OnUnload';
-{$endif}
 
+procedure MyActivityOnCreate;
 begin
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.CreateForm(TForm2, Form2);
+  Application.Run;
+end;
+
+begin
+  CDWidgetset.ActivityOnCreate := @MyActivityOnCreate;
 end.
 

examples/androidlcl/mainform.lfm

@@ -1,7 +1,7 @@
 object Form1: TForm1
-  Left = 326
+  Left = 932
   Height = 251
-  Top = 166
+  Top = 220
   Width = 220
   Caption = 'Form1'
   ClientHeight = 251

examples/androidlcl/secondform.lfm

@@ -1,7 +1,7 @@
 object Form2: TForm2
-  Left = 323
+  Left = 1158
   Height = 259
-  Top = 171
+  Top = 220
   Width = 320
   Caption = 'Form2'
   ClientHeight = 259

lcl/interfaces/customdrawn/customdrawndefines.inc

@@ -12,7 +12,7 @@
 
 
 // Check if a backend which can be utilized in multiple-systems is already defined
-{$if defined(CD_X11)}
+{$if defined(CD_X11) or defined(CD_Android)}
 {$else}
   // Choosing the default backend
   {$ifdef Windows}
@@ -32,7 +32,7 @@
 {$endif}
 
 // Default options for various backends
-{$ifdef CD_Android}
+{$if defined(CD_Android)}
   {$define CD_UseNativeText}
 {$endif}
 

lcl/interfaces/customdrawn/customdrawnint.pas

@@ -33,7 +33,7 @@ uses
   fpimage, fpcanvas, fpimgcanv, ctypes,
   {$ifdef CD_Windows}Windows, customdrawn_WinProc,{$endif}
   {$ifdef CD_Cocoa}MacOSAll, CocoaAll, CocoaPrivate, CocoaGDIObjects,{$endif}
-  {$ifdef CD_X11}X, XLib, XUtil, customdrawn_x11proc,{unitxft, Xft font support}{$endif}
+  {$ifdef CD_X11}X, XLib, XUtil, BaseUnix, customdrawn_x11proc,{$ifdef CD_UseNativeText}unitxft,{$endif}{$endif}
   {$ifdef CD_Android}
   customdrawn_androidproc, jni, bitmap, log, keycodes,
   {$endif}
@@ -179,6 +179,9 @@ type
     ScreenBitmapWidth: Integer;
     ScreenImage: TLazIntfImage;
 
+    // Android Activity callbacks
+    ActivityOnCreate: TProcedure;
+
     constructor Create; override;
     destructor Destroy; override;
 

lcl/interfaces/customdrawn/customdrawnobject_android.inc

@@ -119,7 +119,9 @@ begin
   Screen.UpdateScreen(); // Any values read before LCLOnCreate are wrong
   // Update the font size
   CDWidgetset.DefaultFontAndroidSize := Round(16 * (Screen.PixelsPerInch / 125));
-  Application.Run;
+  // Now inform the application
+  if Assigned(CDWidgetset.ActivityOnCreate) then CDWidgetset.ActivityOnCreate()
+  else Application.Run; // <- Support for older code up to 21 dezember
 end;
 
 // This one is for all simple dialogs: MessageBox, PromptUser (MessageDlg) and AskUser

lcl/interfaces/customdrawn/customdrawnobject_x11.inc

@@ -151,17 +151,8 @@ var
 begin
   while (DoBreakRun = False) do
   begin
-{    if Assigned(OnIdle) then
-    begin
-      if not XCheckMaskEvent(FDisplay, MaxInt, @XEvent) then
-      begin
-        if Assigned(OnIdle) then OnIdle(Self);
-
-        continue;
-      end;
-    end
-    else}
-      XNextEvent(FDisplay, @XEvent);
+    AppWaitMessage();
+    XNextEvent(FDisplay, @XEvent);
 
     // According to a comment in X.h, the valid event types start with 2!
     if XEvent._type >= 2 then
@@ -412,11 +403,55 @@ end;*)
   Params:  None
   Returns: Nothing
 
-  Passes execution control to Windows
+  Passes execution control to X11, but processes timer messages while waiting
  ------------------------------------------------------------------------------}
-//roozbeh:new update...whole procedure body is added.what is it?
 procedure TCDWidgetSet.AppWaitMessage;
+var
+  // timer variables
+  rfds: baseunix.TFDSet;
+  xconnnum, selectresult: integer;
+  needToWait: Boolean;
+  lTimer: TCDTimer;
+  lTimeoutInterval: Integer; // miliseconds
+  i: Integer;
 begin
+  {$ifndef CD_X11_DISABLETIMERS}
+  lTimeoutInterval := 50;
+  while True do
+  begin
+    xconnnum := XConnectionNumber(FDisplay);
+    XFlush(FDisplay);
+
+    needToWait := True;
+    if XPending(FDisplay) > 0 then Exit; // We have a X message to process
+
+    if needToWait then  // No X messages to process (we are idle). So do a timeout wait
+    begin
+      //if Assigned(FOnIdle) then
+      //  OnIdle(self);
+      fpFD_ZERO(rfds);
+      fpFD_SET(xconnnum, rfds);
+      selectresult := fpSelect(xconnnum + 1, @rfds, nil, nil, lTimeoutInterval);
+
+      // Process all timers
+      for i := 0 to GetTimerCount()-1 do
+      begin
+        lTimer := GetTimer(i);
+        Inc(lTimer.NativeHandle, lTimeoutInterval);
+        if lTimer.NativeHandle >= lTimer.Interval then
+        begin
+          lTimer.TimerFunc();
+          lTimer.NativeHandle := 0;
+        end;
+      end;
+
+      if selectresult <> 0 then  // We got a X event or the timeout happened
+        Exit
+      else
+        Continue; // nothing further to do here!
+    end;
+  end;
+  {$endif}
 end;
 
 {------------------------------------------------------------------------------
@@ -426,7 +461,6 @@ end;
 
   Tells Windows to halt and destroy
  ------------------------------------------------------------------------------}
-
 procedure TCDWidgetSet.AppTerminate;
 begin
   //DebugLn('Trace:TWinCEWidgetSet.AppTerminate - Start');
@@ -467,7 +501,14 @@ end;
     The TimerCallBackProc calls the TimerFunc.
  ------------------------------------------------------------------------------}
 function TCDWidgetSet.CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle;
+var
+  lTimer: TCDTimer;
 begin
+  lTimer := TCDTimer.Create;
+  lTimer.Interval := Interval;
+  lTimer.TimerFunc := TimerFunc;
+  AddTimer(lTimer);
+  Result := THandle(lTimer);
 end;
 
 {------------------------------------------------------------------------------
@@ -476,7 +517,14 @@ end;
   Returns:
  ------------------------------------------------------------------------------}
 function TCDWidgetSet.DestroyTimer(TimerHandle: THandle) : boolean;
+var
+  lTimer: TCDTimer absolute TimerHandle;
 begin
+  if TimerHandle <> 0 then
+  begin
+    RemoveTimer(lTimer);
+    lTimer.Free;
+  end;
 end;
 (*
 procedure TWinCEWidgetSet.HandleWakeMainThread(Sender: TObject);

lcl/interfaces/customdrawn/customdrawnproc.pas

@@ -79,7 +79,7 @@ type
 
   TCDTimer = class
   public
-    NativeHandle: PtrInt;
+    NativeHandle: PtrInt; // The X11 timer uses this to store the current time which is summed up to the next interval
     Interval: integer;
     TimerFunc: TWSTimerProc;
   end;
@@ -135,6 +135,8 @@ function RemoveAccelChars(AStr: string): string;
 
 procedure InitTimersList();
 procedure AddTimer(ATimer: TCDTimer);
+function GetTimer(AIndex: Integer): TCDTimer;
+function GetTimerCount(): Integer;
 procedure RemoveTimer(ATimer: TCDTimer);
 function FindTimerWithNativeHandle(ANativeHandle: PtrInt): TCDTimer;
 
@@ -605,6 +607,18 @@ begin
   TimersList.Add(ATimer);
 end;
 
+function GetTimer(AIndex: Integer): TCDTimer;
+begin
+  InitTimersList();
+  Result := TCDTimer(TimersList.Items[AIndex]);
+end;
+
+function GetTimerCount: Integer;
+begin
+  InitTimersList();
+  Result := TimersList.Count;
+end;
+
 procedure RemoveTimer(ATimer: TCDTimer);
 begin
   InitTimersList();

lcl/interfaces/customdrawn/customdrawnwinapi.inc

@@ -3990,7 +3990,7 @@ end;
   Returns: True on success
  ------------------------------------------------------------------------------}
 function TCDWidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar; Count,
-  MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize
+  MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: Types.TSize
   ): Boolean;
 {var
   i: Integer;
@@ -4058,7 +4058,7 @@ end;
   Params:  none
   Returns: Nothing
  ------------------------------------------------------------------------------}
-function TCDWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
+function TCDWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: Types.TSize): Boolean;
 var
   LazDC: TLazCanvas absolute DC;
 begin

lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc

@@ -2175,21 +2175,42 @@ end;*)
   Function: ExtTextOut
   Params:  none
   Returns: Nothing
-
-
  ------------------------------------------------------------------------------}
 function TCDWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
   Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
 var
-  WideStr: WideString;
-//  QtDC: TQtDeviceContext absolute DC;
-  B: Boolean;
+  FontData: PXftFont;
+  Descriptor, lText: string;
+  extents: TXGlyphInfo;
+  XftDraw: PXftDraw;
+  LazDC: TLazCanvas absolute DC;
 begin
   {$ifdef VerboseQtWinAPI}
     WriteLn('[WinAPI ExtTextOut]');
   {$endif}
 
   Result := False;
+{  lText := StrPas(Str);
+  if UTF8Length(lText) < 1 then Exit(True);
+
+  // Create the handle
+  // 'Arial-10');
+  Descriptor := 'Sans-10';
+  FontData := XftFontOpenName(FDisplay, XDefaultScreen(FDisplay), PChar(Descriptor));
+  if not Assigned(FontData) then raise Exception.Create('[TCDWidgetSet.ExtTextOut] X11: Error creating font');
+
+  XftDraw := XftDrawCreate(FDisplay, Handle,
+    XDefaultVisual(GFApplication.Handle, XDefaultScreen(GFApplication.Handle)),
+    XDefaultColormap(GFApplication.Handle, XDefaultScreen(GFApplication.Handle)));
+
+  // Draw
+  XftDrawSetClip(FXftDraw, FRegion);
+  XftDrawStringUtf8(FXftDraw, FXftColor, TX11Font(FFont).FontData, APosition.x,
+    Aposition.y + TX11Font(FFont).GetAscent, PChar(AText), Length(AText));
+
+  // Cleanup
+  XftFontClose(FDisplay, FontData);    }
+  Result := True;
 
 {  if ((Options and (ETO_OPAQUE + ETO_CLIPPED)) <> 0) and (Rect = nil) then
     exit;
@@ -4079,9 +4100,11 @@ end;*)
   Returns: Nothing
  ------------------------------------------------------------------------------}
 function TCDWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
-{var
-  WideStr: WideString;
-  QtDC: TQtDeviceContext absolute DC;}
+var
+  FontData: PXftFont;
+  Descriptor: string;
+  extents: TXGlyphInfo;
+  LazDC: TLazCanvas absolute DC;
 begin
   {$ifdef VerboseCDWinAPI}
     DebugLn('[WinAPI GetTextExtentPoint]');
@@ -4089,13 +4112,29 @@ begin
 
   Result := False;
 
-{  if not IsValidDC(DC) then Exit;
+  // Create the handle
+  // 'Arial-10');
+  Descriptor := 'Sans-10';
+  FontData := XftFontOpenName(FDisplay, XDefaultScreen(FDisplay), PChar(Descriptor));
+  if not Assigned(FontData) then raise Exception.Create('[TCDWidgetSet.GetTextExtentPoint] X11: Error creating font');
 
-  WideStr := GetUtf8String(Str);
-  Size.cx := QtDC.Metrics.width(@WideStr, Count);
-  Size.cy := QtDC.Metrics.height;
+  // Get the size
+  if Length(AText) = 0 then
+  begin
+    Size.cx := 0;
+    Size.cy := 0;
+  end
+  else
+  begin
+    XftTextExtentsUtf8(FDisplay, FontData, Str, Count, extents);
+    Size.cx := extents.xOff;
+    Size.cy := extents.yOff;
+  end;
 
-  Result := True;  }
+  // Cleanup
+  XftFontClose(FDisplay, FontData);
+
+  Result := True;
 end;
 
 {------------------------------------------------------------------------------
@@ -4105,64 +4144,57 @@ end;
   Returns: If successfull
  ------------------------------------------------------------------------------}
 function TCDWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
+var
+  FontData: PXftFont;
+  Descriptor: string;
+  LazDC: TLazCanvas absolute DC;
 begin
   {$ifdef VerboseCDWinAPI}
     WriteLn('[WinAPI GetTextMetrics]');
   {$endif}
 
   Result := IsValidDC(DC);
+  if not Result then Exit;
 
-{  if Result then
-  begin
-    QtFontMetrics := QtDC.Metrics;
-    TM.tmHeight := QtFontMetrics.height;
-    TM.tmAscent := QtFontMetrics.ascent;
-    TM.tmDescent := QtFontMetrics.descent;
-    TM.tmInternalLeading := 0;
-    TM.tmExternalLeading := QtFontMetrics.leading;
-    {this is due qt bug in fontmetrics::averageCharWidth() under Mac
-     http://trolltech.com/developer/task-tracker/index_html?method=entry&id=169440 }
-    {$IFDEF DARWIN}
-    TM.tmAveCharWidth := QtFontMetrics.charWidth('x',0);
-    {$ELSE}
-    TM.tmAveCharWidth := QtFontMetrics.averageCharWidth;
-    {$ENDIF}
-
-    TM.tmMaxCharWidth := QtFontMetrics.maxWidth;
-    FontWeight := QtDC.font.getWeight;
-    case FontWeight of
-      25: TM.tmWeight := FW_LIGHT;
-      50: TM.tmWeight := FW_NORMAL;
-      63: TM.tmWeight := FW_SEMIBOLD;
-      75: TM.tmWeight := FW_BOLD;
-      87: TM.tmWeight := FW_HEAVY;
-      else
-        TM.tmWeight := Round(FontWeight * 9.5);
-    end;
-    TM.tmOverhang := 0;
-    TM.tmDigitizedAspectX := 0;
-    TM.tmDigitizedAspectY := 0;
-    TM.tmFirstChar := 'a';
-    TM.tmLastChar := 'z';
-    TM.tmDefaultChar := 'x';
-    TM.tmBreakChar := '?';
-    TM.tmItalic := Ord(QtDC.Font.getItalic);
-    TM.tmUnderlined := Ord(QtDC.Font.getUnderline);
-    TM.tmStruckOut := Ord(QtDC.Font.getStrikeOut);
-
-    QtDC.font.family(@FontFamily);
-
-    { Defaults to a TrueType font.
-      Note that the meaning of the FIXED_PITCH constant is the opposite of
-      the name implies, according to MSDN docs. Just a small inconsistency
-      on Windows API that we have to mimic. }
-    if QtDC.font.fixedPitch then
-      TM.tmPitchAndFamily := TRUETYPE_FONTTYPE
+  TM.tmHeight := 10;//QtFontMetrics.height;
+  TM.tmAscent := FontData^.Ascent;
+  TM.tmDescent := FontData^.Descent;
+  TM.tmInternalLeading := 0;
+//  TM.tmExternalLeading := QtFontMetrics.leading;
+//  TM.tmAveCharWidth := QtFontMetrics.charWidth('x',0);
+//  TM.tmMaxCharWidth := QtFontMetrics.maxWidth;
+{  case FontWeight of
+    25: TM.tmWeight := FW_LIGHT;
+    50: TM.tmWeight := FW_NORMAL;
+    63: TM.tmWeight := FW_SEMIBOLD;
+    75: TM.tmWeight := FW_BOLD;
+    87: TM.tmWeight := FW_HEAVY;
     else
-      TM.tmPitchAndFamily := FIXED_PITCH or TRUETYPE_FONTTYPE;
+      TM.tmWeight := Round(FontWeight * 9.5);
+  end;}
+  TM.tmOverhang := 0;
+  TM.tmDigitizedAspectX := 0;
+  TM.tmDigitizedAspectY := 0;
+  TM.tmFirstChar := 'a';
+  TM.tmLastChar := 'z';
+  TM.tmDefaultChar := 'x';
+  TM.tmBreakChar := '?';
+  TM.tmItalic := 0;//Ord(QtDC.Font.getItalic);
+  TM.tmUnderlined := 0;//Ord(QtDC.Font.getUnderline);
+  TM.tmStruckOut := 0;//Ord(QtDC.Font.getStrikeOut);
 
-    TM.tmCharSet := DEFAULT_CHARSET;
-  end;                   }
+//  QtDC.font.family(@FontFamily);
+
+  { Defaults to a TrueType font.
+    Note that the meaning of the FIXED_PITCH constant is the opposite of
+    the name implies, according to MSDN docs. Just a small inconsistency
+    on Windows API that we have to mimic. }
+//  if QtDC.font.fixedPitch then
+//    TM.tmPitchAndFamily := TRUETYPE_FONTTYPE
+//  else
+    TM.tmPitchAndFamily := FIXED_PITCH or TRUETYPE_FONTTYPE;
+
+  TM.tmCharSet := DEFAULT_CHARSET;
 end;
 {$endif}
 

lcl/interfaces/customdrawn/customdrawnwinapih.inc

@@ -136,8 +136,8 @@ function GetSysColor(nIndex: Integer): DWORD; override;
 //function GetSysColorBrush(nIndex: Integer): HBrush; override;
 function GetSystemMetrics(nIndex: Integer): Integer; override;
 function GetTextColor(DC: HDC) : TColorRef; Override;
-function GetTextExtentExPoint(DC: HDC; Str: PChar; Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: TSize): Boolean; override;
-function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean; override;
+function GetTextExtentExPoint(DC: HDC; Str: PChar; Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger; var Size: Types.TSize): Boolean; override;
+function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: Types.TSize): Boolean; override;
 function GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;  override;
 (*function GetViewPortExtEx(DC: HDC; Size: PSize): Integer; override;
 function GetViewPortOrgEx(DC: HDC; P: PPoint): Integer; override;