paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 20:19:24 +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 object Form1: TForm1
Left = 161 Left = 161
Height = 251 Height = 257
Top = 137 Top = 137
Width = 220 Width = 220
Caption = 'Form1' Caption = 'Form1'
ClientHeight = 251 ClientHeight = 257
ClientWidth = 220 ClientWidth = 220
OnClick = FormClick OnClick = FormClick
OnCreate = FormCreate OnCreate = FormCreate
@ -12,16 +12,6 @@ object Form1: TForm1
OnMouseMove = FormMouseMove OnMouseMove = FormMouseMove
OnPaint = FormPaint OnPaint = FormPaint
LCLVersion = '0.9.31' 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 object Button1: TButton
Left = 96 Left = 96
Height = 25 Height = 25
@ -33,7 +23,7 @@ object Form1: TForm1
OnKeyPress = Button1KeyPress OnKeyPress = Button1KeyPress
OnKeyUp = Button1KeyUp OnKeyUp = Button1KeyUp
OnUTF8KeyPress = Button1UTF8KeyPress OnUTF8KeyPress = Button1UTF8KeyPress
TabOrder = 1 TabOrder = 0
end end
object ProgressBar1: TProgressBar object ProgressBar1: TProgressBar
Left = 72 Left = 72
@ -41,7 +31,7 @@ object Form1: TForm1
Top = 80 Top = 80
Width = 140 Width = 140
Position = 60 Position = 60
TabOrder = 2 TabOrder = 1
end end
object TrackBar1: TTrackBar object TrackBar1: TTrackBar
Left = 72 Left = 72
@ -49,7 +39,7 @@ object Form1: TForm1
Top = 112 Top = 112
Width = 140 Width = 140
Position = 0 Position = 0
TabOrder = 3 TabOrder = 2
end end
object CheckBox1: TCheckBox object CheckBox1: TCheckBox
Left = 72 Left = 72
@ -57,7 +47,7 @@ object Form1: TForm1
Top = 48 Top = 48
Width = 94 Width = 94
Caption = 'CheckBox1' Caption = 'CheckBox1'
TabOrder = 4 TabOrder = 3
end end
object Button2: TButton object Button2: TButton
Left = 96 Left = 96
@ -66,7 +56,7 @@ object Form1: TForm1
Width = 116 Width = 116
Caption = 'MessageBox' Caption = 'MessageBox'
OnClick = Button2Click OnClick = Button2Click
TabOrder = 5 TabOrder = 4
end end
object Button3: TButton object Button3: TButton
Left = 95 Left = 95
@ -75,16 +65,25 @@ object Form1: TForm1
Width = 117 Width = 117
Caption = 'Open Form2' Caption = 'Open Form2'
OnClick = Button3Click OnClick = Button3Click
TabOrder = 6 TabOrder = 5
end end
object Label1: TLabel object Label1: TLabel
Left = 94 Left = 24
Height = 18 Height = 18
Top = 223 Top = 199
Width = 43 Width = 43
Caption = 'Label1' Caption = 'Label1'
Font.Color = clBlue Font.Color = clBlue
ParentColor = False ParentColor = False
ParentFont = False ParentFont = False
end end
object btnShowInfo: TButton
Left = 96
Height = 25
Top = 226
Width = 116
Caption = 'Show Info in ADB'
OnClick = btnShowInfoClick
TabOrder = 6
end
end end

16
examples/androidlcl/mainform.pas
View File

@ -6,7 +6,8 @@ interface
uses uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
LCLProc, Arrow, StdCtrls, ComCtrls, LCLType, LCLIntf, InterfaceBase; LCLProc, Arrow, StdCtrls, ComCtrls, LCLType, LCLIntf, InterfaceBase,
lazdeviceapis;
type type
TSubControl = class; TSubControl = class;
@ -14,10 +15,10 @@ type
{ TForm1 } { TForm1 }
TForm1 = class(TForm) TForm1 = class(TForm)
Arrow1: TArrow;
Button1: TButton; Button1: TButton;
Button2: TButton; Button2: TButton;
Button3: TButton; Button3: TButton;
btnShowInfo: TButton;
CheckBox1: TCheckBox; CheckBox1: TCheckBox;
Label1: TLabel; Label1: TLabel;
ProgressBar1: TProgressBar; ProgressBar1: TProgressBar;
@ -29,6 +30,7 @@ type
); );
procedure Arrow1MouseUp(Sender: TObject; Button: TMouseButton; procedure Arrow1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
procedure btnShowInfoClick(Sender: TObject);
procedure Button1Click(Sender: TObject); procedure Button1Click(Sender: TObject);
procedure Button1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState 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])); DebugLn(Format('Arrow Mouse Up X=%d Y=%d', [X, Y]));
end; 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); procedure TForm1.Button1Click(Sender: TObject);
begin begin
DebugLn('Button1Click'); 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} 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} 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} 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} 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 // Other classes and objects
javaAndroidAppActivityClass: JClass = nil; javaAndroidAppActivityClass: JClass = nil;
javaJavaLandSystemClass: JClass = nil; javaJavaLandSystemClass: JClass = nil;
javaAndroidOSBuildClass: JClass = nil;
// Fields of our Activity // Fields of our Activity
// Strings // Strings

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

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

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

@ -1680,7 +1680,7 @@ begin
AList.Add(TObject(PtrUInt(EASTEUROPE_CHARSET))); AList.Add(TObject(PtrUInt(EASTEUROPE_CHARSET)));
end; end;
end; end;
end; end;*)
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: EnumFontFamiliesEx Function: EnumFontFamiliesEx
@ -1720,250 +1720,57 @@ end;
specified device. 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 var
EnumLogFont: TEnumLogFontEx;
Metric: TNewTextMetricEx;
FontList: TStringList; FontList: TStringList;
FontType: Integer;
FontDB: QFontDatabaseH;
i: Integer; 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 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; Result := 0;
Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler //Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler
FontDB := QFontDatabase_create();
// 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 try
ShellCtrls.TCustomShellTreeView.GetFilesInDir();
// In this case we want to list all fonts
if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and
(lpLogFont^.lfFaceName= '') and (lpLogFont^.lfFaceName= '') and
(lpLogFont^.lfPitchAndFamily = 0) then (lpLogFont^.lfPitchAndFamily = 0) then
begin
FontType := 0;
FontList := TStringList.create;
try
if QtGetFontFamiliesDefault(FontList) > 0 then
begin begin
for i := 0 to FontList.Count - 1 do for i := 0 to FontList.Count - 1 do
begin begin
EnumLogFont.elfLogFont.lfFaceName := FontList[i]; EnumLogFont.elfLogFont.lfFaceName := FontList[i];
Result := Callback(EnumLogFont, Metric, FontType, LParam); Result := Callback(EnumLogFont, Metric, FontType, LParam);
end; end;
end
else
begin
end; end;
finally finally
FontList.free; FontList.free;
end; end; }
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;
end; end;
{------------------------------------------------------------------------------ (*{------------------------------------------------------------------------------
Function: ExcludeClipRect Function: ExcludeClipRect
Params: none Params: none
Returns: Nothing Returns: Nothing

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

@ -313,9 +313,22 @@ begin
else Result:=False; else Result:=False;
end; end;
function TCocoaWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; function TCocoaWidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
var 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; fontManager : NSFontManager;
arr : NSArray; arr : NSArray;
fname : NSString; fname : NSString;
@ -323,10 +336,10 @@ var
ELogFont : TEnumLogFontEx; ELogFont : TEnumLogFontEx;
Metric : TNewTextMetricEx; Metric : TNewTextMetricEx;
FontName : AnsiString; FontName : AnsiString; }
begin begin
Result:=0; Result:=0;
if not Assigned(Callback) then Exit; { if not Assigned(Callback) then Exit;
fontManager:=NSFontManager.sharedFontManager; fontManager:=NSFontManager.sharedFontManager;
arr:=fontManager.availableFontFamilies; arr:=fontManager.availableFontFamilies;
for i:=0 to arr.count-1 do begin for i:=0 to arr.count-1 do begin
@ -344,22 +357,9 @@ begin
Break; Break;
end; end;
end; end;
arr.release; arr.release; }
end; 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} {$ifdef CD_UseNativeText}
function TCDWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; function TCDWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; 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; function TWin32WidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect; lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
begin begin
Result := MultiMon.EnumDisplayMonitors(hdc, lprcClip, lpfnEnum, dwData); 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; EnumFontFamProc: FontEnumProc; LParam: Lparam): longint;
begin begin
// TODO: do as EnumFontFamiliesEx // TODO: do as EnumFontFamiliesEx
@ -1239,6 +1239,7 @@ begin
Windows.FontEnumProc(EnumFontFamProc), LParam); Windows.FontEnumProc(EnumFontFamProc), LParam);
end; end;
(*
{$ifdef WindowsUnicodeSupport} {$ifdef WindowsUnicodeSupport}
type type
TProcRedirRec = record TProcRedirRec = record

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

@ -1680,7 +1680,7 @@ begin
AList.Add(TObject(PtrUInt(EASTEUROPE_CHARSET))); AList.Add(TObject(PtrUInt(EASTEUROPE_CHARSET)));
end; end;
end; end;
end; end;*)
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: EnumFontFamiliesEx Function: EnumFontFamiliesEx
@ -1720,179 +1720,20 @@ end;
specified device. 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 {var
EnumLogFont: TEnumLogFontEx; EnumLogFont: TEnumLogFontEx;
Metric: TNewTextMetricEx; Metric: TNewTextMetricEx;
FontList: TStringList; FontList: TStringList;
FontType: Integer; FontType: Integer;
FontDB: QFontDatabaseH;
i: Integer; i: Integer;
y: Integer; y: Integer;
AStyle: String; AStyle: String;
StylesCount: Integer; StylesCount: Integer;
StylesList: QStringListH; CharsetList: TFPList; }
ScriptList: QStringListH;
CharsetList: TFPList;
function QtGetFontFamiliesDefault(var List:TStringList;
const AWritingSystem: QFontDatabaseWritingSystem = QFontDatabaseAny):integer;
var
StrLst: QStringlistH;
WStr: WideString;
j: integer;
begin 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; Result := 0;
Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler { Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler
FontDB := QFontDatabase_create(); FontDB := QFontDatabase_create();
try try
if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and
@ -1959,11 +1800,10 @@ begin
end; end;
finally finally
QFontDatabase_destroy(FontDB); QFontDatabase_destroy(FontDB);
end; end; }
end; end;
(*{------------------------------------------------------------------------------
{------------------------------------------------------------------------------
Function: ExcludeClipRect Function: ExcludeClipRect
Params: none Params: none
Returns: Nothing 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 EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;
function EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer; override;*) function EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer; override;*)
procedure EnterCriticalSection(var CritSection: TCriticalSection); 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 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 ExtCreatePen(dwPenStyle, dwWidth: DWord; const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN; override;
function ExtSelectClipRGN(dc: hdc; rgn : hrgn; Mode : Longint) : Integer; 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; 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) TCDWSLazDeviceAPIs = class(TWSLazDeviceAPIs)
public public
//
class procedure RequestPositionInfo(AMethod: TLazPositionMethod); override; class procedure RequestPositionInfo(AMethod: TLazPositionMethod); override;
//
class procedure SendMessage(AMsg: TLazDeviceMessage); override; class procedure SendMessage(AMsg: TLazDeviceMessage); override;
//
class procedure StartReadingAccelerometerData(); override; class procedure StartReadingAccelerometerData(); override;
class procedure StopReadingAccelerometerData(); override; class procedure StopReadingAccelerometerData(); override;
// TLazDevice
class function GetDeviceManufacturer: string; override;
class function GetDeviceModel: string; override;
class procedure Vibrate(ADurationMS: Cardinal); override;
end; end;
implementation implementation
@ -76,6 +83,22 @@ class procedure TCDWSLazDeviceAPIs.StopReadingAccelerometerData;
begin begin
end; 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} {$endif}
{$ifdef CD_Android} {$ifdef CD_Android}
@ -126,6 +149,37 @@ begin
// Call the method // Call the method
javaEnvRef^^.CallVoidMethod(javaEnvRef, javaActivityObject, javaMethod_LCLDoStopReadingAccelerometer); javaEnvRef^^.CallVoidMethod(javaEnvRef, javaActivityObject, javaMethod_LCLDoStopReadingAccelerometer);
end; 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} {$endif}
end. end.

41
lcl/lazdeviceapis.pas
View File

@ -124,15 +124,54 @@ type
property OnPositionRetrieved: TNotifyEvent read FOnPositionRetrieved write FOnPositionRetrieved; property OnPositionRetrieved: TNotifyEvent read FOnPositionRetrieved write FOnPositionRetrieved;
end; 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 var
Accelerometer: TLazAccelerometer; Accelerometer: TLazAccelerometer;
Messaging: TLazMessaging; Messaging: TLazMessaging;
PositionInfo: TLazPositionInfo; PositionInfo: TLazPositionInfo;
Device: TLazDevice;
implementation implementation
uses wslazdeviceapis, wslclclasses; 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 } { TLazAccelerometer }
procedure TLazAccelerometer.StartReadingAccelerometerData; procedure TLazAccelerometer.StartReadingAccelerometerData;
@ -226,9 +265,11 @@ initialization
Accelerometer := TLazAccelerometer.Create; Accelerometer := TLazAccelerometer.Create;
Messaging := TLazMessaging.Create; Messaging := TLazMessaging.Create;
PositionInfo := TLazPositionInfo.Create; PositionInfo := TLazPositionInfo.Create;
Device := TLazDevice.Create;
finalization finalization
Accelerometer.Free; Accelerometer.Free;
Messaging.Free; Messaging.Free;
PositionInfo.Free; PositionInfo.Free;
Device.Free;
end. end.

21
lcl/widgetset/wslazdeviceapis.pas
View File

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