paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 21:18:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

Adds a new object to lazdevicepias: Device and it starts with manufacturer and model info showing in Android and already predicts vibration capabilities. Starts opening the implementation of font enumeration in lcl-customdrawn

Browse Source 
git-svn-id: trunk@35291 -
This commit is contained in:
sekelsenmat 2012-02-10 13:39:06 +00:00
parent 50472302a3
commit 913c5364a6
13 changed files with 217 additions and 440 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
examples/androidlcl/mainform.lfm
View File

@ -1,10 +1,10 @@
object Form1: TForm1
Left = 161
Height = 251
Height = 257
Top = 137
Width = 220
Caption = 'Form1'
ClientHeight = 251
ClientHeight = 257
ClientWidth = 220
OnClick = FormClick
OnCreate = FormCreate
@ -12,16 +12,6 @@ object Form1: TForm1
OnMouseMove = FormMouseMove
OnPaint = FormPaint
LCLVersion = '0.9.31'
object Arrow1: TArrow
Left = 0
Height = 58
Top = 64
Width = 79
OnClick = Arrow1Click
OnMouseMove = Arrow1MouseMove
OnMouseDown = Arrow1MouseDown
OnMouseUp = Arrow1MouseUp
end
object Button1: TButton
Left = 96
Height = 25
@ -33,7 +23,7 @@ object Form1: TForm1
OnKeyPress = Button1KeyPress
OnKeyUp = Button1KeyUp
OnUTF8KeyPress = Button1UTF8KeyPress
TabOrder = 1
TabOrder = 0
end
object ProgressBar1: TProgressBar
Left = 72
@ -41,7 +31,7 @@ object Form1: TForm1
Top = 80
Width = 140
Position = 60
TabOrder = 2
TabOrder = 1
end
object TrackBar1: TTrackBar
Left = 72
@ -49,7 +39,7 @@ object Form1: TForm1
Top = 112
Width = 140
Position = 0
TabOrder = 3
TabOrder = 2
end
object CheckBox1: TCheckBox
Left = 72
@ -57,7 +47,7 @@ object Form1: TForm1
Top = 48
Width = 94
Caption = 'CheckBox1'
TabOrder = 4
TabOrder = 3
end
object Button2: TButton
Left = 96
@ -66,7 +56,7 @@ object Form1: TForm1
Width = 116
Caption = 'MessageBox'
OnClick = Button2Click
TabOrder = 5
TabOrder = 4
end
object Button3: TButton
Left = 95
@ -75,16 +65,25 @@ object Form1: TForm1
Width = 117
Caption = 'Open Form2'
OnClick = Button3Click
TabOrder = 6
TabOrder = 5
end
object Label1: TLabel
Left = 94
Left = 24
Height = 18
Top = 223
Top = 199
Width = 43
Caption = 'Label1'
Font.Color = clBlue
ParentColor = False
ParentFont = False
end
object btnShowInfo: TButton
Left = 96
Height = 25
Top = 226
Width = 116
Caption = 'Show Info in ADB'
OnClick = btnShowInfoClick
TabOrder = 6
end
end

16
examples/androidlcl/mainform.pas
View File

@ -6,7 +6,8 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
LCLProc, Arrow, StdCtrls, ComCtrls, LCLType, LCLIntf, InterfaceBase;
LCLProc, Arrow, StdCtrls, ComCtrls, LCLType, LCLIntf, InterfaceBase,
lazdeviceapis;
type
TSubControl = class;
@ -14,10 +15,10 @@ type
{ TForm1 }
TForm1 = class(TForm)
Arrow1: TArrow;
Button1: TButton;
Button2: TButton;
Button3: TButton;
btnShowInfo: TButton;
CheckBox1: TCheckBox;
Label1: TLabel;
ProgressBar1: TProgressBar;
@ -29,6 +30,7 @@ type
);
procedure Arrow1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btnShowInfoClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
@ -139,6 +141,16 @@ begin
DebugLn(Format('Arrow Mouse Up X=%d Y=%d', [X, Y]));
end;
procedure TForm1.btnShowInfoClick(Sender: TObject);
//var
// i: Integer;
begin
//for i := 0 to Screen.Fonts.Count - 1 do
// DebugLn(Screen.Fonts.Strings[i]);
DebugLn('Device.Manufacturer='+Device.Manufacturer);
DebugLn('Device.Model='+Device.Model);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DebugLn('Button1Click');

2
lcl/interfaces/customdrawn/android/jni.pas
View File

@ -371,7 +371,7 @@ type va_list=pointer;
NewStringUTF:function(Env:PJNIEnv;const UTF:pchar):JString;{$ifdef mswindows}stdcall;{$else}cdecl;{$endif}
GetStringUTFLength:function(Env:PJNIEnv;Str:JString):JSize;{$ifdef mswindows}stdcall;{$else}cdecl;{$endif}
GetStringUTFChars:function(Env:PJNIEnv;Str:JString;var IsCopy:JBoolean):pchar;{$ifdef mswindows}stdcall;{$else}cdecl;{$endif}
GetStringUTFChars:function(Env:PJNIEnv;Str:JString; IsCopy: PJBoolean):pchar;{$ifdef mswindows}stdcall;{$else}cdecl;{$endif}
ReleaseStringUTFChars:procedure(Env:PJNIEnv;Str:JString;const Chars:pchar);{$ifdef mswindows}stdcall;{$else}cdecl;{$endif}
GetArrayLength:function(Env:PJNIEnv;AArray:JArray):JSize;{$ifdef mswindows}stdcall;{$else}cdecl;{$endif}

1
lcl/interfaces/customdrawn/customdrawnint.pas
View File

@ -285,6 +285,7 @@ var
// Other classes and objects
javaAndroidAppActivityClass: JClass = nil;
javaJavaLandSystemClass: JClass = nil;
javaAndroidOSBuildClass: JClass = nil;
// Fields of our Activity
// Strings

1
lcl/interfaces/customdrawn/customdrawnobject_android.inc
View File

@ -388,6 +388,7 @@ begin
// Now other classes
javaAndroidAppActivityClass := javaEnvRef^^.FindClass(javaEnvRef,'android/app/Activity');
javaJavaLandSystemClass := javaEnvRef^^.FindClass(javaEnvRef,'java/lang/System');
javaAndroidOSBuildClass := javaEnvRef^^.FindClass(javaEnvRef,'android/os/Build');
// Register Pascal exported calls
if javaEnvRef^^.RegisterNatives(javaEnvRef, javaActivityClass, @NativeMethods[0],length(NativeMethods))<0 then

263
lcl/interfaces/customdrawn/customdrawnwinapi_android.inc
View File

@ -1680,7 +1680,7 @@ begin
AList.Add(TObject(PtrUInt(EASTEUROPE_CHARSET)));
end;
end;
end;
end;*)
{------------------------------------------------------------------------------
Function: EnumFontFamiliesEx
@ -1720,250 +1720,57 @@ end;
specified device.
------------------------------------------------------------------------------}
function TQtWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
function TCDWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
var
EnumLogFont: TEnumLogFontEx;
Metric: TNewTextMetricEx;
FontList: TStringList;
FontType: Integer;
FontDB: QFontDatabaseH;
i: Integer;
y: Integer;
AStyle: String;
StylesCount: Integer;
StylesList: QStringListH;
ScriptList: QStringListH;
CharsetList: TFPList;
function QtGetFontFamiliesDefault(var List:TStringList;
const AWritingSystem: QFontDatabaseWritingSystem = QFontDatabaseAny):integer;
var
StrLst: QStringlistH;
WStr: WideString;
j: integer;
begin
Result := -1;
StrLst := QStringList_create;
try
QFontDatabase_families(FontDB, StrLst, AWritingSystem);
Result := QStringList_size(StrLst);
for j := 0 to Result - 1 do
begin
QStringList_at(StrLst, @WStr, j);
List.Add(UTF16ToUTF8(WStr));
end;
finally
QStringList_destroy(StrLst);
end;
end;
function QtGetFontFamilies(var List: TStringList;
const APitch: Byte;
const AFamilyName: String;
const AWritingSystem: QFontDatabaseWritingSystem = QFontDatabaseAny): Integer;
var
StrLst: QStringlistH;
NewList: QStringListH;
WStr: WideString;
j: integer;
begin
Result := -1;
StrLst := QStringList_create();
NewList := QStringList_create();
try
QFontDatabase_families(FontDB, StrLst, AWritingSystem);
for j := 0 to QStringList_size(StrLst) - 1 do
begin
QStringList_at(StrLst, @WStr, j);
if APitch <> DEFAULT_PITCH then
begin
case APitch of
FIXED_PITCH, MONO_FONT:
begin
if QFontDatabase_isFixedPitch(FontDB, @WStr) then
QStringList_append(NewList, @WStr);
end;
VARIABLE_PITCH:
begin
if QFontDatabase_isScalable(FontDB, @WStr) then
QStringList_append(NewList, @WStr);
end;
end;
end else
QStringList_append(NewList, @WStr);
end;
if AFamilyName <> '' then
begin
for j := QStringList_size(NewList) - 1 downto 0 do
begin
QStringList_at(NewList, @WStr, j);
if UTF16ToUTF8(WStr) <> AFamilyName then
QStringList_removeAt(NewList, j);
end;
end;
for j := 0 to QStringList_size(NewList) - 1 do
begin
QStringList_at(NewList, @WStr, j);
List.Add(UTF16ToUTF8(WStr));
end;
Result := List.Count;
finally
QStringList_destroy(StrLst);
QStringList_destroy(NewList);
end;
end;
function GetStyleAt(AIndex: Integer): String;
var
WStr: WideString;
begin
Result := '';
if (AIndex >= 0) and (AIndex < QStringList_size(StylesList)) then
begin
QStringList_at(StylesList, @WStr, AIndex);
Result := UTF16ToUTF8(WStr);
end;
end;
function GetWritingSystems(AFontName: String; AList: QStringListH;
ACharsetList: TFPList): Boolean;
var
WStr: WideString;
Arr: TPtrIntArray;
j: Integer;
begin
Result := False;
QStringList_clear(AList);
if Assigned(CharSetList) then
CharSetList.Clear;
WStr := UTF8ToUTF16(AFontName);
QFontDatabase_writingSystems(FontDB, @Arr, @WStr);
Result := length(Arr) > 0;
for j := 0 to High(Arr) do
begin
if Assigned(ACharsetList) then
QtCharsetToCharset(QFontDatabaseWritingSystem(Arr[j]), ACharsetList);
QFontDatabase_writingSystemName(@WStr, QFontDatabaseWritingSystem(Arr[j]));
QStringList_append(AList, @WStr);
end;
end;
function FillLogFontA(AFontName: String; var ALogFontA: TLogFontA;
var AMetric: TNewTextMetricEx; var AFontType: Integer;
out AStyle: String): Integer;
var
Font: QFontH;
WStr: WideString;
begin
WStr := UTF8ToUTF16(AFontName);
Font := QFont_create(@WStr);
ALogFontA.lfItalic := Byte(QFont_italic(Font));
ALogFontA.lfWeight := QFont_weight(Font);
ALogFontA.lfHeight := QFont_pointSize(Font);
ALogFontA.lfUnderline := Byte(QFont_underline(Font));
ALogFontA.lfStrikeOut := Byte(QFont_strikeOut(Font));
if QFont_styleStrategy(Font) = QFontPreferBitmap then
AFontType := AFontType or RASTER_FONTTYPE;
if QFont_styleStrategy(Font) = QFontPreferDevice then
AFontType := AFontType or DEVICE_FONTTYPE;
if not (QFont_styleStrategy(Font) = QFontPreferDefault) then
AFontType := AFontType and not TRUETYPE_FONTTYPE;
QStringList_clear(StylesList);
QFontDatabase_styles(FontDB, StylesList, @WStr);
AStyle := '';
Result := QStringList_size(StylesList);
if Result > 0 then
AStyle := GetStyleAt(0);
// fill script and charset list
GetWritingSystems(AFontName, ScriptList, CharsetList);
QFont_destroy(Font);
end;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI EnumFontFamiliesEx] Charset=',lpLogFont^.lfCharSet,
' face ',lpLogFont^.lfFaceName,' pitchAndFamily=',lpLogFont^.lfPitchAndFamily);
{$endif}
Result := 0;
Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler
FontDB := QFontDatabase_create();
//Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler
// Read all font files from /system/fonts/*.ttf
{ Example from HTC Wildfire:
-rw-r--r-- root root 117072 2010-05-27 23:49 DroidSansMono.ttf
-rw-r--r-- root root 191032 2010-05-27 23:49 DroidSans-Bold.ttf
-rw-r--r-- root root 184836 2010-05-27 23:49 DroidSerif-Bold.ttf
-rw-r--r-- root root 1160880 2010-05-27 23:49 gcsh00d-hkscs.ttf
-rw-r--r-- root root 189916 2010-05-27 23:49 DroidSerif-BoldItalic.ttf
-rw-r--r-- root root 6880 2010-05-27 23:49 Clockopia.ttf
-rw-r--r-- root root 190044 2010-05-27 23:49 DroidSans.ttf
-rw-r--r-- root root 177176 2010-05-27 23:49 DroidSerif-Italic.ttf
-rw-r--r-- root root 172532 2010-05-27 23:49 DroidSerif-Regular.ttf
-rw-r--r-- root root 3640264 2011-03-10 14:10 DroidSansFallback.ttf
-rw-r--r-- root root 3538916 2008-08-01 14:00 mfont.mbf
-rw-r--r-- root root 36028 2008-08-01 14:00 DroidSansThai.ttf
-rw-r--r-- root root 23076 2008-08-01 14:00 DroidSansHebrew.ttf
-rw-r--r-- root root 35908 2008-08-01 14:00 DroidSansArabic.ttf
-rw-r--r-- root root 12292 2008-08-01 14:00 ARDJ-KK.ttf
}
{ FontList := TStringList.create;
try
ShellCtrls.TCustomShellTreeView.GetFilesInDir();
// In this case we want to list all fonts
if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and
(lpLogFont^.lfFaceName= '') and
(lpLogFont^.lfPitchAndFamily = 0) then
begin
FontType := 0;
FontList := TStringList.create;
try
if QtGetFontFamiliesDefault(FontList) > 0 then
begin
for i := 0 to FontList.Count - 1 do
begin
EnumLogFont.elfLogFont.lfFaceName := FontList[i];
Result := Callback(EnumLogFont, Metric, FontType, LParam);
end;
end;
finally
FontList.free;
for i := 0 to FontList.Count - 1 do
begin
EnumLogFont.elfLogFont.lfFaceName := FontList[i];
Result := Callback(EnumLogFont, Metric, FontType, LParam);
end;
end else
end
else
begin
Result := 0;
FontType := TRUETYPE_FONTTYPE;
FontList := TStringList.create;
StylesList := QStringList_create();
ScriptList := QStringList_create();
CharsetList := TFPList.Create;
try
if QtGetFontFamilies(FontList, lpLogFont^.lfPitchAndFamily,
lpLogFont^.lfFaceName, CharsetToQtCharSet(lpLogFont^.lfCharSet)) > 0 then
begin
StylesList := QStringList_create();
for i := 0 to FontList.Count - 1 do
begin
EnumLogFont.elfLogFont.lfFaceName := FontList[i];
EnumLogFont.elfLogFont.lfPitchAndFamily := lpLogFont^.lfPitchAndFamily;
EnumLogFont.elfFullName := FontList[i];
StylesCount := FillLogFontA(FontList[i], EnumLogFont.elfLogFont, Metric, FontType,
AStyle);
EnumLogFont.elfStyle := AStyle;
if CharSetList.Count > 0 then
EnumLogFont.elfLogFont.lfCharSet := PtrUInt(CharsetList.Items[0]);
Result := Callback(EnumLogFont, Metric, FontType, LParam);
for y := 1 to StylesCount - 1 do
begin
AStyle := GetStyleAt(y);
EnumLogFont.elfStyle := AStyle;
Result := Callback(EnumLogFont, Metric, FontType, LParam);
end;
for y := 1 to CharsetList.Count - 1 do
begin
EnumLogFont.elfLogFont.lfCharSet := PtrUInt(CharsetList.Items[y]);
Result := Callback(EnumLogFont, Metric, FontType, LParam);
end;
end;
end;
finally
FontList.free;
QStringList_destroy(StylesList);
CharSetList.Free;
end;
end;
finally
QFontDatabase_destroy(FontDB);
end;
FontList.free;
end; }
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: ExcludeClipRect
Params: none
Returns: Nothing

36
lcl/interfaces/customdrawn/customdrawnwinapi_cocoa.inc
View File

@ -313,9 +313,22 @@ begin
else Result:=False;
end;
function TCocoaWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
function TCocoaWidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
var
i: integer;
begin
Result := True;
for i := 0 to NSScreen.screens.count - 1 do
begin
Result := Result and lpfnEnum(HMONITOR(NSScreen.screens.objectAtIndex(i)), 0, nil, dwData);
if not Result then break;
end;
end;*)
function TCDWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
{var
fontManager : NSFontManager;
arr : NSArray;
fname : NSString;
@ -323,10 +336,10 @@ var
ELogFont : TEnumLogFontEx;
Metric : TNewTextMetricEx;
FontName : AnsiString;
FontName : AnsiString; }
begin
Result:=0;
if not Assigned(Callback) then Exit;
{ if not Assigned(Callback) then Exit;
fontManager:=NSFontManager.sharedFontManager;
arr:=fontManager.availableFontFamilies;
for i:=0 to arr.count-1 do begin
@ -344,22 +357,9 @@ begin
Break;
end;
end;
arr.release;
arr.release; }
end;
function TCocoaWidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
var
i: integer;
begin
Result := True;
for i := 0 to NSScreen.screens.count - 1 do
begin
Result := Result and lpfnEnum(HMONITOR(NSScreen.screens.objectAtIndex(i)), 0, nil, dwData);
if not Result then break;
end;
end;*)
{$ifdef CD_UseNativeText}
function TCDWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;

5
lcl/interfaces/customdrawn/customdrawnwinapi_win.inc
View File

@ -1229,9 +1229,9 @@ end;
function TWin32WidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
begin
Result := MultiMon.EnumDisplayMonitors(hdc, lprcClip, lpfnEnum, dwData);
end;
end;*)
function TWin32WidgetSet.EnumFontFamilies(DC: HDC; Family: Pchar;
function TCDWidgetSet.EnumFontFamilies(DC: HDC; Family: Pchar;
EnumFontFamProc: FontEnumProc; LParam: Lparam): longint;
begin
// TODO: do as EnumFontFamiliesEx
@ -1239,6 +1239,7 @@ begin
Windows.FontEnumProc(EnumFontFamProc), LParam);
end;
(*
{$ifdef WindowsUnicodeSupport}
type
TProcRedirRec = record

174
lcl/interfaces/customdrawn/customdrawnwinapi_x11.inc
View File

@ -1680,7 +1680,7 @@ begin
AList.Add(TObject(PtrUInt(EASTEUROPE_CHARSET)));
end;
end;
end;
end;*)
{------------------------------------------------------------------------------
Function: EnumFontFamiliesEx
@ -1720,179 +1720,20 @@ end;
specified device.
------------------------------------------------------------------------------}
function TQtWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
var
function TCDWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
{var
EnumLogFont: TEnumLogFontEx;
Metric: TNewTextMetricEx;
FontList: TStringList;
FontType: Integer;
FontDB: QFontDatabaseH;
i: Integer;
y: Integer;
AStyle: String;
StylesCount: Integer;
StylesList: QStringListH;
ScriptList: QStringListH;
CharsetList: TFPList;
function QtGetFontFamiliesDefault(var List:TStringList;
const AWritingSystem: QFontDatabaseWritingSystem = QFontDatabaseAny):integer;
var
StrLst: QStringlistH;
WStr: WideString;
j: integer;
begin
Result := -1;
StrLst := QStringList_create;
try
QFontDatabase_families(FontDB, StrLst, AWritingSystem);
Result := QStringList_size(StrLst);
for j := 0 to Result - 1 do
begin
QStringList_at(StrLst, @WStr, j);
List.Add(UTF16ToUTF8(WStr));
end;
finally
QStringList_destroy(StrLst);
end;
end;
function QtGetFontFamilies(var List: TStringList;
const APitch: Byte;
const AFamilyName: String;
const AWritingSystem: QFontDatabaseWritingSystem = QFontDatabaseAny): Integer;
var
StrLst: QStringlistH;
NewList: QStringListH;
WStr: WideString;
j: integer;
begin
Result := -1;
StrLst := QStringList_create();
NewList := QStringList_create();
try
QFontDatabase_families(FontDB, StrLst, AWritingSystem);
for j := 0 to QStringList_size(StrLst) - 1 do
begin
QStringList_at(StrLst, @WStr, j);
if APitch <> DEFAULT_PITCH then
begin
case APitch of
FIXED_PITCH, MONO_FONT:
begin
if QFontDatabase_isFixedPitch(FontDB, @WStr) then
QStringList_append(NewList, @WStr);
end;
VARIABLE_PITCH:
begin
if QFontDatabase_isScalable(FontDB, @WStr) then
QStringList_append(NewList, @WStr);
end;
end;
end else
QStringList_append(NewList, @WStr);
end;
if AFamilyName <> '' then
begin
for j := QStringList_size(NewList) - 1 downto 0 do
begin
QStringList_at(NewList, @WStr, j);
if UTF16ToUTF8(WStr) <> AFamilyName then
QStringList_removeAt(NewList, j);
end;
end;
for j := 0 to QStringList_size(NewList) - 1 do
begin
QStringList_at(NewList, @WStr, j);
List.Add(UTF16ToUTF8(WStr));
end;
Result := List.Count;
finally
QStringList_destroy(StrLst);
QStringList_destroy(NewList);
end;
end;
function GetStyleAt(AIndex: Integer): String;
var
WStr: WideString;
begin
Result := '';
if (AIndex >= 0) and (AIndex < QStringList_size(StylesList)) then
begin
QStringList_at(StylesList, @WStr, AIndex);
Result := UTF16ToUTF8(WStr);
end;
end;
function GetWritingSystems(AFontName: String; AList: QStringListH;
ACharsetList: TFPList): Boolean;
var
WStr: WideString;
Arr: TPtrIntArray;
j: Integer;
begin
Result := False;
QStringList_clear(AList);
if Assigned(CharSetList) then
CharSetList.Clear;
WStr := UTF8ToUTF16(AFontName);
QFontDatabase_writingSystems(FontDB, @Arr, @WStr);
Result := length(Arr) > 0;
for j := 0 to High(Arr) do
begin
if Assigned(ACharsetList) then
QtCharsetToCharset(QFontDatabaseWritingSystem(Arr[j]), ACharsetList);
QFontDatabase_writingSystemName(@WStr, QFontDatabaseWritingSystem(Arr[j]));
QStringList_append(AList, @WStr);
end;
end;
function FillLogFontA(AFontName: String; var ALogFontA: TLogFontA;
var AMetric: TNewTextMetricEx; var AFontType: Integer;
out AStyle: String): Integer;
var
Font: QFontH;
WStr: WideString;
begin
WStr := UTF8ToUTF16(AFontName);
Font := QFont_create(@WStr);
ALogFontA.lfItalic := Byte(QFont_italic(Font));
ALogFontA.lfWeight := QFont_weight(Font);
ALogFontA.lfHeight := QFont_pointSize(Font);
ALogFontA.lfUnderline := Byte(QFont_underline(Font));
ALogFontA.lfStrikeOut := Byte(QFont_strikeOut(Font));
if QFont_styleStrategy(Font) = QFontPreferBitmap then
AFontType := AFontType or RASTER_FONTTYPE;
if QFont_styleStrategy(Font) = QFontPreferDevice then
AFontType := AFontType or DEVICE_FONTTYPE;
if not (QFont_styleStrategy(Font) = QFontPreferDefault) then
AFontType := AFontType and not TRUETYPE_FONTTYPE;
QStringList_clear(StylesList);
QFontDatabase_styles(FontDB, StylesList, @WStr);
AStyle := '';
Result := QStringList_size(StylesList);
if Result > 0 then
AStyle := GetStyleAt(0);
// fill script and charset list
GetWritingSystems(AFontName, ScriptList, CharsetList);
QFont_destroy(Font);
end;
CharsetList: TFPList; }
begin
{$ifdef VerboseQtWinAPI}
WriteLn('[WinAPI EnumFontFamiliesEx] Charset=',lpLogFont^.lfCharSet,
' face ',lpLogFont^.lfFaceName,' pitchAndFamily=',lpLogFont^.lfPitchAndFamily);
{$endif}
Result := 0;
Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler
{ Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler
FontDB := QFontDatabase_create();
try
if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and
@ -1959,11 +1800,10 @@ begin
end;
finally
QFontDatabase_destroy(FontDB);
end;
end; }
end;
{------------------------------------------------------------------------------
(*{------------------------------------------------------------------------------
Function: ExcludeClipRect
Params: none
Returns: Nothing

4
lcl/interfaces/customdrawn/customdrawnwinapih.inc
View File

@ -85,9 +85,9 @@ function Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; override;
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;
function EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer; override;*)
procedure EnterCriticalSection(var CritSection: TCriticalSection); override;
(*function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; override;
//function EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool; override;
function EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; override;
function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; override;
(*function ExcludeClipRect(dc: hdc; Left, Top, Right, Bottom : Integer) : Integer; override;
function ExtCreatePen(dwPenStyle, dwWidth: DWord; const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN; override;
function ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer; override;*)
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;

54
lcl/interfaces/customdrawn/customdrawnwslazdeviceapis.pas
View File

@ -45,10 +45,17 @@ type
TCDWSLazDeviceAPIs = class(TWSLazDeviceAPIs)
public
//
class procedure RequestPositionInfo(AMethod: TLazPositionMethod); override;
//
class procedure SendMessage(AMsg: TLazDeviceMessage); override;
//
class procedure StartReadingAccelerometerData(); override;
class procedure StopReadingAccelerometerData(); override;
// TLazDevice
class function GetDeviceManufacturer: string; override;
class function GetDeviceModel: string; override;
class procedure Vibrate(ADurationMS: Cardinal); override;
end;
implementation
@ -76,6 +83,22 @@ class procedure TCDWSLazDeviceAPIs.StopReadingAccelerometerData;
begin
end;
class function TCDWSLazDeviceAPIs.GetDeviceManufacturer: string;
begin
Result := '';
end;
class function TCDWSLazDeviceAPIs.GetDeviceModel: string;
begin
Result := '';
end;
class procedure TCDWSLazDeviceAPIs.Vibrate(ADurationMS: Cardinal);
begin
end;
{$endif}
{$ifdef CD_Android}
@ -126,6 +149,37 @@ begin
// Call the method
javaEnvRef^^.CallVoidMethod(javaEnvRef, javaActivityObject, javaMethod_LCLDoStopReadingAccelerometer);
end;
class function TCDWSLazDeviceAPIs.GetDeviceManufacturer: string;
var
lFieldID: JFieldID;
lJavaString: JString;
lNativeString: PChar;
begin
lFieldID := javaEnvRef^^.GetStaticFieldID(javaEnvRef, javaAndroidOSBuildClass, 'MANUFACTURER', 'Ljava/lang/String;');
lJavaString := JString(javaEnvRef^^.GetStaticObjectField(javaEnvRef, javaAndroidOSBuildClass, lFieldID));
lNativeString := javaEnvRef^^.GetStringUTFChars(javaEnvRef, lJavaString, nil);
Result := lNativeString;
javaEnvRef^^.ReleaseStringUTFChars(javaEnvRef, lJavaString, lNativeString);
end;
class function TCDWSLazDeviceAPIs.GetDeviceModel: string;
var
lFieldID: JFieldID;
lJavaString: JString;
lNativeString: PChar;
begin
lFieldID := javaEnvRef^^.GetStaticFieldID(javaEnvRef, javaAndroidOSBuildClass, 'MODEL', 'Ljava/lang/String;');
lJavaString := JString(javaEnvRef^^.GetStaticObjectField(javaEnvRef, javaAndroidOSBuildClass, lFieldID));
lNativeString := javaEnvRef^^.GetStringUTFChars(javaEnvRef, lJavaString, nil);
Result := lNativeString;
javaEnvRef^^.ReleaseStringUTFChars(javaEnvRef, lJavaString, lNativeString);
end;
class procedure TCDWSLazDeviceAPIs.Vibrate(ADurationMS: Cardinal);
begin
end;
{$endif}
end.

41
lcl/lazdeviceapis.pas
View File

@ -124,15 +124,54 @@ type
property OnPositionRetrieved: TNotifyEvent read FOnPositionRetrieved write FOnPositionRetrieved;
end;
// TLazDevice
TLazDevice = class
private
function GetDeviceManufacturer: string;
function GetDeviceModel: string;
public
procedure Vibrate(ADurationMS: Cardinal);
property Manufacturer: string read GetDeviceManufacturer;
property Model: string read GetDeviceModel;
end;
var
Accelerometer: TLazAccelerometer;
Messaging: TLazMessaging;
PositionInfo: TLazPositionInfo;
Device: TLazDevice;
implementation
uses wslazdeviceapis, wslclclasses;
{ TLazDevice }
function TLazDevice.GetDeviceManufacturer: string;
var
WidgetsetClass: TWSLazDeviceAPIsClass;
begin
WidgetsetClass := TWSLazDeviceAPIsClass(GetWSLazDeviceAPIs());
Result := WidgetsetClass.GetDeviceManufacturer();
end;
function TLazDevice.GetDeviceModel: string;
var
WidgetsetClass: TWSLazDeviceAPIsClass;
begin
WidgetsetClass := TWSLazDeviceAPIsClass(GetWSLazDeviceAPIs());
Result := WidgetsetClass.GetDeviceModel();
end;
procedure TLazDevice.Vibrate(ADurationMS: Cardinal);
var
WidgetsetClass: TWSLazDeviceAPIsClass;
begin
WidgetsetClass := TWSLazDeviceAPIsClass(GetWSLazDeviceAPIs());
WidgetsetClass.Vibrate(ADurationMS);
end;
{ TLazAccelerometer }
procedure TLazAccelerometer.StartReadingAccelerometerData;
@ -226,9 +265,11 @@ initialization
Accelerometer := TLazAccelerometer.Create;
Messaging := TLazMessaging.Create;
PositionInfo := TLazPositionInfo.Create;
Device := TLazDevice.Create;
finalization
Accelerometer.Free;
Messaging.Free;
PositionInfo.Free;
Device.Free;
end.

21
lcl/widgetset/wslazdeviceapis.pas
View File

@ -54,9 +54,15 @@ type
TWSLazDeviceAPIs = class(TWSObject)
public
class procedure RequestPositionInfo(AMethod: TLazPositionMethod); virtual;
//
class procedure SendMessage(AMsg: TLazDeviceMessage); virtual;
//
class procedure StartReadingAccelerometerData(); virtual;
class procedure StopReadingAccelerometerData(); virtual;
// TLazDevice
class function GetDeviceManufacturer: string; virtual;
class function GetDeviceModel: string; virtual;
class procedure Vibrate(ADurationMS: Cardinal); virtual;
end;
{ WidgetSetRegistration }
@ -101,4 +107,19 @@ begin
end;
class function TWSLazDeviceAPIs.GetDeviceManufacturer: string;
begin
Result := '';
end;
class function TWSLazDeviceAPIs.GetDeviceModel: string;
begin
Result := '';
end;
class procedure TWSLazDeviceAPIs.Vibrate(ADurationMS: Cardinal);
begin
end;
end.