Adds virtual keyboard support to LCL-CustomDrawn-Android

git-svn-id: trunk@34221 -
This commit is contained in:
sekelsenmat 2011-12-16 14:31:57 +00:00
parent c98cb37eba
commit 3270436597
18 changed files with 1136 additions and 226 deletions

4
.gitattributes vendored
View File

@ -5449,6 +5449,10 @@ lcl/interfaces/customdrawn/customdrawn_x11proc.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawndefines.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnint.pas svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnlclintf.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnlclintf_android.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnlclintf_cocoa.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnlclintf_win.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnlclintf_x11.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnlclintfh.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnobject.inc svneol=native#text/pascal
lcl/interfaces/customdrawn/customdrawnobject_android.inc svneol=native#text/pascal

View File

@ -7,6 +7,7 @@ import android.widget.*;
import android.util.*;
import android.graphics.*;
import android.view.*;
import android.view.inputmethod.InputMethodManager;
public class LCLActivity extends Activity
{
@ -227,6 +228,18 @@ public class LCLActivity extends Activity
LocalHandler.removeCallbacks(lcltimerid);
};
public void LCLDoHideVirtualKeyboard()
{
InputMethodManager localInputManager = (InputMethodManager)getSystemService(Context.INPUT_METHOD_SERVICE);
localInputManager.hideSoftInputFromWindow(lclsurface.getWindowToken(), 0);
};
public void LCLDoShowVirtualKeyboard()
{
InputMethodManager localInputManager = (InputMethodManager)getSystemService(Context.INPUT_METHOD_SERVICE);
localInputManager.showSoftInput(lclsurface, 0);
};
// -------------------------------------------
// Fields exported to the Pascal side for easier data communication
// -------------------------------------------

View File

@ -30,6 +30,9 @@ object Form1: TForm1
Caption = 'Move Progress'
OnClick = Button1Click
OnKeyDown = Button1KeyDown
OnKeyPress = Button1KeyPress
OnKeyUp = Button1KeyUp
OnUTF8KeyPress = Button1UTF8KeyPress
TabOrder = 1
end
object ProgressBar1: TProgressBar

View File

@ -32,6 +32,9 @@ type
procedure Button1Click(Sender: TObject);
procedure Button1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
procedure Button1KeyPress(Sender: TObject; var Key: char);
procedure Button1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Button1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormClick(Sender: TObject);
@ -146,7 +149,25 @@ procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
DebugLn('[TForm1.Button1KeyDown] '+ LCLProc.DbgsVKCode(Key));
Caption := LCLProc.DbgsVKCode(Key);
// Caption := 'KeyDown ' + LCLProc.DbgsVKCode(Key);
end;
procedure TForm1.Button1KeyPress(Sender: TObject; var Key: char);
begin
DebugLn('KeyPress: ' + Key);
end;
procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
DebugLn('[TForm1.Button1KeyUp] '+ LCLProc.DbgsVKCode(Key));
// Caption := 'KeyUp ' + LCLProc.DbgsVKCode(Key);
end;
procedure TForm1.Button1UTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
begin
DebugLn('UTF8KeyPress: ' + UTF8Key);
Caption := UTF8Key;
end;
procedure TForm1.Button2Click(Sender: TObject);
@ -161,6 +182,7 @@ end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Form2.Show;
DebugLn('Button3Click');
end;
procedure TForm1.FormCreate(Sender: TObject);

View File

@ -148,6 +148,11 @@
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2"/>
</Debugging>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>

View File

@ -252,7 +252,8 @@ type
csOwnedChildrenNotSelectable, // child controls owned by this control are NOT selectable in the designer
csAutoSize0x0, // if the preferred size is 0x0 then control is shrinked ot 0x0
csAutoSizeKeepChildLeft, // when AutoSize=true do not move children horizontally
csAutoSizeKeepChildTop // when AutoSize=true do not move children vertically
csAutoSizeKeepChildTop, // when AutoSize=true do not move children vertically
csRequiresKeyboardInput // If the device has no physical keyboard then show the virtual keyboard when this control gets focus (therefore available only to TWinControl descendents)
);
TControlStyle = set of TControlStyleType;

View File

@ -1596,7 +1596,7 @@ begin
Width := 80;
Height := 25;
TabStop := True;
ControlStyle := ControlStyle - [csAcceptsControls];
ControlStyle := ControlStyle - [csAcceptsControls] + [csRequiresKeyboardInput];
// State information
FEditState.VisibleTextStart := Point(1, 1);

View File

@ -68,7 +68,7 @@ begin
inherited Create(AOwner);
//FCompStyle is set here because TEdit inherits from this.
//TCustomMemo also inherits from here but it's create changes fcompstyle to csMemo
ControlStyle := ControlStyle - [csCaptureMouse];
ControlStyle := ControlStyle - [csCaptureMouse] + [csRequiresKeyboardInput];
FCompStyle := csEdit;
FMaxLength := 0;
FHideSelection := True;

View File

@ -280,6 +280,8 @@ var
javaMethod_LCLDoShowMessageBox: jmethodid = nil;
javaMethod_LCLDoCreateTimer: jmethodid = nil;
javaMethod_LCLDoDestroyTimer: jmethodid = nil;
javaMethod_LCLDoHideVirtualKeyboard: jmethodid = nil;
javaMethod_LCLDoShowVirtualKeyboard: jmethodid = nil;
// This is utilized to store the information such as invalidate requests in events
eventResult: jint;
@ -311,18 +313,22 @@ uses
{$include wincallback.inc}
{$I customdrawnobject_win.inc}
{$I customdrawnwinapi_win.inc}
{$I customdrawnlclintf_win.inc}
{$endif}
{$ifdef CD_Cocoa}
{$I customdrawnobject_cocoa.inc}
{$I customdrawnwinapi_cocoa.inc}
{$I customdrawnlclintf_cocoa.inc}
{$endif}
{$ifdef CD_X11}
{$I customdrawnobject_x11.inc}
{$I customdrawnwinapi_x11.inc}
{$I customdrawnlclintf_x11.inc}
{$endif}
{$ifdef CD_Android}
{$I customdrawnobject_android.inc}
{$I customdrawnwinapi_android.inc}
{$I customdrawnlclintf_android.inc}
{$endif}
end.

View File

@ -105,69 +105,6 @@ begin
Result := nil;
end;*)
// This code is for platforms which use the non-native dialogs
{$ifndef CD_Android}
function TCDWidgetSet.AskUser(const DialogCaption, DialogMessage: string;
DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
{const
ButtonResults : array[mrNone..mrYesToAll] of Longint = (
-1, idButtonOK, idButtonCancel, idButtonAbort, idButtonRetry,
idButtonIgnore, idButtonYes,idButtonNo, idButtonAll, idButtonNoToAll,
idButtonYesToAll);
var
BtnIdx, BtnID: LongInt;
QtMessageBox: TQtMessageBox;}
begin
{ ReleaseCapture;
QtMessageBox := TQtMessageBox.Create(nil);
QtMessageBox.AttachEvents;
try
{Convert LCL "id" button values to Qt values}
for BtnIdx := 0 to Buttons.Count - 1 do
begin
with Buttons[BtnIdx] do
begin
if (ModalResult >= Low(ButtonResults)) and (ModalResult <= High(ButtonResults)) then
BtnID := ButtonResults[ModalResult]
else
BtnID := -1;
if (BtnID >= Low(IdButtonToQtStandardButton)) and
(BtnID <= High(IdButtonToQtStandardButton)) and
(IdButtonToQtStandardButton[BtnID] <> QMessageBoxNoButton) then
QtMessageBox.AddButton(Caption, IdButtonToQtStandardButton[BtnID], ModalResult, Default, Cancel)
else
QtMessageBox.AddButton(Caption, ModalResult, Default, Cancel);
end;
end;
if DialogCaption <> '' then
QtMessageBox.Title := DialogCaption
else
case DialogType of
idDialogWarning: QtMessageBox.Title := rsMtWarning;
idDialogError: QtMessageBox.Title := rsMtError;
idDialogInfo : QtMessageBox.Title := rsMtInformation;
idDialogConfirm : QtMessageBox.Title := rsMtConfirmation;
end;
QtMessageBox.MessageStr := DialogMessage;
case DialogType of
idDialogWarning: QtMessageBox.MsgBoxType := QMessageBoxWarning;
idDialogError: QtMessageBox.MsgBoxType := QMessageBoxCritical;
idDialogInfo : QtMessageBox.MsgBoxType := QMessageBoxInformation;
idDialogConfirm : QtMessageBox.MsgBoxType := QMessageBoxQuestion;
else
QtMessageBox.MsgBoxType := QMessageBoxNoIcon;
end;
Result := QtMessageBox.exec;
finally
QtMessageBox.Free;
end;}
end;
{$endif}
{------------------------------------------------------------------------------
Function: CreateEmptyRegion
Params:
@ -336,69 +273,6 @@ begin
Result := TQtDesignWidget(WindowHandle).DesignContext = DC;
end;*)
{------------------------------------------------------------------------------
Function: PromptUser
Params:
Returns:
Note: Qt appears to map Esc key to Cancel button, so no need for EscapeResult.
------------------------------------------------------------------------------}
{$ifndef CD_Android}
function TCDWidgetSet.PromptUser(const DialogCaption : string;
const DialogMessage : string;
DialogType : LongInt;
Buttons : PLongInt;
ButtonCount : LongInt;
DefaultIndex : LongInt;
EscapeResult : LongInt) : LongInt;
{var
BtnIdx, BtnID: LongInt;
QtMessageBox: TQtMessageBox;}
begin
(* ReleaseCapture;
QtMessageBox := TQtMessageBox.Create(nil);
QtMessageBox.AttachEvents;
try
{Convert LCL "id" button values to Qt values}
for BtnIdx := 0 to ButtonCount-1 do
begin
BtnID := Buttons[BtnIdx];
if (BtnID >= Low(IdButtonToQtStandardButton)) and
(BtnID <= High(IdButtonToQtStandardButton)) and
(IdButtonToQtStandardButton[BtnID] <> QMessageBoxNoButton) then
QtMessageBox.AddButton(GetButtonCaption(BtnID), IdButtonToQtStandardButton[BtnID], BtnID, BtnIdx = DefaultIndex, BtnId = EscapeResult)
else
QtMessageBox.AddButton(GetButtonCaption(BtnID), BtnID, BtnIdx = DefaultIndex, BtnId = EscapeResult);
end;
if DialogCaption <> '' then
QtMessageBox.Title := DialogCaption
else
case DialogType of
idDialogWarning: QtMessageBox.Title := rsMtWarning;
idDialogError: QtMessageBox.Title := rsMtError;
idDialogInfo : QtMessageBox.Title := rsMtInformation;
idDialogConfirm : QtMessageBox.Title := rsMtConfirmation;
end;
QtMessageBox.MessageStr := DialogMessage;
case DialogType of
idDialogWarning: QtMessageBox.MsgBoxType := QMessageBoxWarning;
idDialogError: QtMessageBox.MsgBoxType := QMessageBoxCritical;
idDialogInfo : QtMessageBox.MsgBoxType := QMessageBoxInformation;
idDialogConfirm : QtMessageBox.MsgBoxType := QMessageBoxQuestion;
else
QtMessageBox.MsgBoxType := QMessageBoxNoIcon;
end;
Result := QtMessageBox.exec;
finally
QtMessageBox.Free;
end;*)
end;
{$endif}
function TCDWidgetSet.RadialPie(DC: HDC; x1, y1, x2, y2, Angle1, Angle2: Integer
): Boolean;
begin

View File

@ -0,0 +1,346 @@
{%MainUnit customdrawnint.pas}
{******************************************************************************
All CustomDrawn interface support routines
Initial Revision : Sat Jan 17 19:00:00 2004
!! Keep alphabetical !!
******************************************************************************
Implementation
******************************************************************************
*****************************************************************************
* *
* 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. *
* *
*****************************************************************************
}
//##apiwiz##sps## // Do not remove
function TCDWidgetSet.AskUser(const DialogCaption, DialogMessage: string; DialogType:
LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
begin
Result := 0;
end;
(*{------------------------------------------------------------------------------
Function: CreateEmptyRegion
Params:
Returns: valid empty region
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateEmptyRegion: hRGN;
begin
Result:= HRGN(TQtRegion.Create(True));
end;
{------------------------------------------------------------------------------
Function: CreateStandardCursor
Params:
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateStandardCursor(ACursor: SmallInt): HCURSOR;
var
CursorShape: QtCursorShape;
begin
Result := 0;
if ACursor < crLow then Exit;
if ACursor > crHigh then Exit;
// TODO: map is better
case ACursor of
crNone : CursorShape := QtBlankCursor;
crArrow : CursorShape := QtArrowCursor;
crCross : CursorShape := QtCrossCursor;
crIBeam : CursorShape := QtIBeamCursor;
crSizeAll : CursorShape := QtSizeAllCursor;
crSizeNESW : CursorShape := QtSizeBDiagCursor;
crSizeNS : CursorShape := QtSizeVerCursor;
crSizeNWSE : CursorShape := QtSizeFDiagCursor;
crSizeWE : CursorShape := QtSizeHorCursor;
crSizeNW : CursorShape := QtSizeFDiagCursor;
crSizeN : CursorShape := QtSizeVerCursor;
crSizeNE : CursorShape := QtSizeBDiagCursor;
crSizeW : CursorShape := QtSizeHorCursor;
crSizeE : CursorShape := QtSizeHorCursor;
crSizeSW : CursorShape := QtSizeBDiagCursor;
crSizeS : CursorShape := QtSizeVerCursor;
crSizeSE : CursorShape := QtSizeFDiagCursor;
crUpArrow : CursorShape := QtUpArrowCursor;
crHourGlass : CursorShape := QtWaitCursor;
crHSplit : CursorShape := QtSplitHCursor;
crVSplit : CursorShape := QtSplitVCursor;
crNo : CursorShape := QtForbiddenCursor;
crAppStart : CursorShape := QtBusyCursor;
crHelp : CursorShape := QtWhatsThisCursor;
crHandPoint : CursorShape := QtPointingHandCursor;
else
CursorShape := QtCursorShape(-1);
end;
if CursorShape <> QtCursorShape(-1) then
Result := HCURSOR(TQtCursor.Create(CursorShape));
end;
function TQtWidgetSet.CreateRubberBand(const ARect: TRect; const ABrush: HBrush): HWND;
begin
// todo: think of ABrush
Result := HWND(QRubberBand_create(QRubberBandRectangle));
QRubberBand_setGeometry(QRubberBandH(Result), @ARect);
QWidget_show(QRubberBandH(Result));
end;
procedure TQtWidgetSet.DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
begin
if FDockImage = nil then
FDockImage := QRubberBand_create(QRubberBandRectangle);
QRubberBand_setGeometry(FDockImage, @ANewRect);
case AOperation of
disShow: QWidget_show(FDockImage);
disHide: QWidget_hide(FDockImage);
end;
end;
procedure TQtWidgetSet.DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer);
var
QtDC: TQtDeviceContext absolute DC;
X, Y: Integer;
W, H: Integer;
begin
if not IsValidDC(DC) then
exit;
QtDC.save;
try
W := (R.Right - R.Left - 1) div DX;
H := (R.Bottom - R.Top - 1) div DY;
for X := 0 to W do
for Y := 0 to H do
QtDC.drawPoint(R.Left + X * DX, R.Top + Y * DY + 1);
finally
QtDC.restore;
end;
end;
procedure TQtWidgetSet.DestroyRubberBand(ARubberBand: HWND);
begin
QWidget_destroy(QRubberBandH(ARubberBand));
end;*)
(*
{------------------------------------------------------------------------------
Function: FontIsMonoSpace
Params:
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.FontIsMonoSpace(Font: HFont): Boolean;
var
QtFontInfo: QFontInfoH;
begin
Result := IsValidGDIObject(Font);
if Result then
begin
QtFontInfo := QFontInfo_create(TQtFont(Font).FHandle);
try
Result := QFontInfo_fixedPitch(QtFontInfo);
finally
QFontInfo_destroy(QtFontInfo);
end;
end;
end;*)
procedure TCDWidgetSet.HideVirtualKeyboard();
begin
DebugLn('[TCDWidgetSet.HideVirtualKeyboard]');
// Call the method
javaEnvRef^^.CallVoidMethod(javaEnvRef, javaActivityObject, javaMethod_LCLDoHideVirtualKeyboard);
end;
function TCDWidgetSet.PromptUser(const DialogCaption : string;
const DialogMessage : string;
DialogType : LongInt;
Buttons : PLongInt;
ButtonCount : LongInt;
DefaultIndex : LongInt;
EscapeResult : LongInt) : LongInt;
var
lJavaString: jstring;
BtnIndex, BtnKind: Integer;
BtnText: string;
begin
{$ifdef VerboseCDWinAPI}
DebugLn(Format('[TCDWidgetSet.PromptUser] javaEnvRef=%x DialogCaption=%s '
+ 'DialogMessage=%s DialogType=%d ButtonCount=%d',
[PtrInt(javaEnvRef), DialogCaption, DialogMessage, DialogType, ButtonCount]));
{$endif}
Result := 0; // The real result goes to Application.OnMessageDialogExecute
if (javaEnvRef = nil) then Exit;
// Prepare the input
// String fields
lJavaString :=javaEnvRef^^.NewStringUTF(javaEnvRef, PChar(DialogMessage));
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lcltext, lJavaString);
lJavaString :=javaEnvRef^^.NewStringUTF(javaEnvRef, PChar(DialogCaption));
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lcltitle, lJavaString);
// Read the buttons
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton1, -1);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton2, -1);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton3, -1);
for BtnIndex := 0 to ButtonCount - 1 do
begin
BtnKind := Buttons[BtnIndex];
{$ifdef VerboseCDWinAPI}
DebugLn(Format(':[TCDWidgetSet.PromptUser] BtnKind=%d', [BtnKind]));
{$endif}
case BtnKind of
idButtonOK: BtnText := RemoveAccelChars(rsMbOK);
idButtonCancel: BtnText := RemoveAccelChars(rsMbCancel);
idButtonAbort: BtnText := RemoveAccelChars(rsMbAbort);
idButtonRetry: BtnText := RemoveAccelChars(rsMbRetry);
idButtonIgnore: BtnText := RemoveAccelChars(rsMbIgnore);
idButtonYes: BtnText := RemoveAccelChars(rsMbYes);
idButtonNo: BtnText := RemoveAccelChars(rsMbNo);
idButtonAll: BtnText := RemoveAccelChars(rsMbAll);
idButtonNoToAll: BtnText := RemoveAccelChars(rsMbNoToAll);
idButtonYesToAll:BtnText := RemoveAccelChars(rsMbYesToAll);
end;
lJavaString :=javaEnvRef^^.NewStringUTF(javaEnvRef, PChar(BtnText));
case BtnIndex of
0:
begin
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lclbutton1str, lJavaString);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton1, BtnKind);
end;
1:
begin
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lclbutton2str, lJavaString);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton2, BtnKind);
end;
2:
begin
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lclbutton3str, lJavaString);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton3, BtnKind);
end;
end;
end;
// Call the method
javaEnvRef^^.CallVoidMethod(javaEnvRef, javaActivityObject, javaMethod_LCLDoShowMessageBox);
end;
(*{------------------------------------------------------------------------------
Function: RawImage_FromDevice
Params: ADC:
ARect:
ARawImage:
Returns:
This function is utilized when the function TBitmap.LoadFromDevice is called
The main use for this function is to get a screenshot. It may have other uses,
but this is the only one implemented here.
MWE: exept for the desktop, there is always a bitmep selected in the DC.
So get this internal bitmap and pass it to RawImage_FromBitmap
------------------------------------------------------------------------------}
function TQtWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean;
var
Desc: TRawImageDescription absolute ARawImage.Description;
//SrcWidth, SrcHeight: Integer;
WinID: Cardinal;
DCSize: TSize;
Pixmap: TQtPixmap;
Image: QImageH;
Context: TQtDeviceContext;
procedure RawImage_FromImage(AImage: QImageH);
begin
ARawImage.DataSize := QImage_numBytes(AImage);
ARawImage.Data := GetMem(ARawImage.DataSize);
Move(QImage_bits(AImage)^, ARawImage.Data^, ARawImage.DataSize);
ARawImage.Mask := nil;
end;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:> [WinAPI GetRawImageFromDevice] SrcDC: ', dbghex(ADC),
' SrcWidth: ', dbgs(ARect.Right - ARect.Left),
' SrcHeight: ', dbgs(ARect.Bottom - ARect.Top));
{$endif}
// todo: copy only passed rectangle
Result := True;
ARawImage.Init;
FillStandardDescription(ARawImage.Description);
Context := TQtDeviceContext(ADC);
with DCSize, Context.getDeviceSize do
begin
cx := x;
cy := y;
end;
if Context.Parent <> nil then
begin
Pixmap := TQtPixmap.Create(@DCSize);
WinID := QWidget_winId(Context.Parent);
try
// if you have dual monitors then getDeviceSize return
// more width than screen width, but grabWindow will only grab one
// screen, so its width will be less
// Solution: we can either pass prefered size to grabWindow or
// correct Description size after. I see the first solution as more correct.
Pixmap.grabWindow(WinID, 0, 0, DCSize.cx, DCSize.cy);
Image := QImage_Create;
Pixmap.toImage(Image);
RawImage_FromImage(Image);
QImage_destroy(Image);
finally
Pixmap.Free;
end;
end else
begin
if Context.vImage <> nil then
RawImage_FromImage(Context.vImage.FHandle)
else
if Context.ParentPixmap <> nil then
begin
Image := QImage_create();
QPixmap_toImage(Context.ParentPixmap, Image);
RawImage_FromImage(Image);
QImage_destroy(Image);
end else
Result := False;
end;
// In this case we use the size of the context
Desc.Width := DCSize.cx;
Desc.Height := DCSize.cy;
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:< [WinAPI GetRawImageFromDevice]');
{$endif}
end;*)
procedure TCDWidgetSet.ShowVirtualKeyboard;
begin
DebugLn('[TCDWidgetSet.ShowVirtualKeyboard]');
// Call the method
javaEnvRef^^.CallVoidMethod(javaEnvRef, javaActivityObject, javaMethod_LCLDoShowVirtualKeyboard);
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line

View File

@ -0,0 +1,232 @@
{%MainUnit customdrawnint.pas}
{******************************************************************************
All CustomDrawn interface support routines
Initial Revision : Sat Jan 17 19:00:00 2004
!! Keep alphabetical !!
******************************************************************************
Implementation
******************************************************************************
*****************************************************************************
* *
* 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. *
* *
*****************************************************************************
}
//##apiwiz##sps## // Do not remove
function TCDWidgetSet.AskUser(const DialogCaption, DialogMessage: string;
DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
begin
end;
(*{------------------------------------------------------------------------------
Function: CreateEmptyRegion
Params:
Returns: valid empty region
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateEmptyRegion: hRGN;
begin
Result:= HRGN(TQtRegion.Create(True));
end;
{------------------------------------------------------------------------------
Function: CreateStandardCursor
Params:
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateStandardCursor(ACursor: SmallInt): HCURSOR;
var
CursorShape: QtCursorShape;
begin
Result := 0;
if ACursor < crLow then Exit;
if ACursor > crHigh then Exit;
// TODO: map is better
case ACursor of
crNone : CursorShape := QtBlankCursor;
crArrow : CursorShape := QtArrowCursor;
crCross : CursorShape := QtCrossCursor;
crIBeam : CursorShape := QtIBeamCursor;
crSizeAll : CursorShape := QtSizeAllCursor;
crSizeNESW : CursorShape := QtSizeBDiagCursor;
crSizeNS : CursorShape := QtSizeVerCursor;
crSizeNWSE : CursorShape := QtSizeFDiagCursor;
crSizeWE : CursorShape := QtSizeHorCursor;
crSizeNW : CursorShape := QtSizeFDiagCursor;
crSizeN : CursorShape := QtSizeVerCursor;
crSizeNE : CursorShape := QtSizeBDiagCursor;
crSizeW : CursorShape := QtSizeHorCursor;
crSizeE : CursorShape := QtSizeHorCursor;
crSizeSW : CursorShape := QtSizeBDiagCursor;
crSizeS : CursorShape := QtSizeVerCursor;
crSizeSE : CursorShape := QtSizeFDiagCursor;
crUpArrow : CursorShape := QtUpArrowCursor;
crHourGlass : CursorShape := QtWaitCursor;
crHSplit : CursorShape := QtSplitHCursor;
crVSplit : CursorShape := QtSplitVCursor;
crNo : CursorShape := QtForbiddenCursor;
crAppStart : CursorShape := QtBusyCursor;
crHelp : CursorShape := QtWhatsThisCursor;
crHandPoint : CursorShape := QtPointingHandCursor;
else
CursorShape := QtCursorShape(-1);
end;
if CursorShape <> QtCursorShape(-1) then
Result := HCURSOR(TQtCursor.Create(CursorShape));
end;
{------------------------------------------------------------------------------
Function: FontIsMonoSpace
Params:
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.FontIsMonoSpace(Font: HFont): Boolean;
var
QtFontInfo: QFontInfoH;
begin
Result := IsValidGDIObject(Font);
if Result then
begin
QtFontInfo := QFontInfo_create(TQtFont(Font).FHandle);
try
Result := QFontInfo_fixedPitch(QtFontInfo);
finally
QFontInfo_destroy(QtFontInfo);
end;
end;
end;*)
procedure TCDWidgetSet.HideVirtualKeyboard();
begin
end;
{------------------------------------------------------------------------------
Function: PromptUser
Params:
Returns:
------------------------------------------------------------------------------}
function TCDWidgetSet.PromptUser(const DialogCaption : string;
const DialogMessage : string;
DialogType : LongInt;
Buttons : PLongInt;
ButtonCount : LongInt;
DefaultIndex : LongInt;
EscapeResult : LongInt) : LongInt;
begin
end;
(*{------------------------------------------------------------------------------
Function: RawImage_FromDevice
Params: ADC:
ARect:
ARawImage:
Returns:
This function is utilized when the function TBitmap.LoadFromDevice is called
The main use for this function is to get a screenshot. It may have other uses,
but this is the only one implemented here.
MWE: exept for the desktop, there is always a bitmep selected in the DC.
So get this internal bitmap and pass it to RawImage_FromBitmap
------------------------------------------------------------------------------}
function TQtWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean;
var
Desc: TRawImageDescription absolute ARawImage.Description;
//SrcWidth, SrcHeight: Integer;
WinID: Cardinal;
DCSize: TSize;
Pixmap: TQtPixmap;
Image: QImageH;
Context: TQtDeviceContext;
procedure RawImage_FromImage(AImage: QImageH);
begin
ARawImage.DataSize := QImage_numBytes(AImage);
ARawImage.Data := GetMem(ARawImage.DataSize);
Move(QImage_bits(AImage)^, ARawImage.Data^, ARawImage.DataSize);
ARawImage.Mask := nil;
end;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:> [WinAPI GetRawImageFromDevice] SrcDC: ', dbghex(ADC),
' SrcWidth: ', dbgs(ARect.Right - ARect.Left),
' SrcHeight: ', dbgs(ARect.Bottom - ARect.Top));
{$endif}
// todo: copy only passed rectangle
Result := True;
ARawImage.Init;
FillStandardDescription(ARawImage.Description);
Context := TQtDeviceContext(ADC);
with DCSize, Context.getDeviceSize do
begin
cx := x;
cy := y;
end;
if Context.Parent <> nil then
begin
Pixmap := TQtPixmap.Create(@DCSize);
WinID := QWidget_winId(Context.Parent);
try
// if you have dual monitors then getDeviceSize return
// more width than screen width, but grabWindow will only grab one
// screen, so its width will be less
// Solution: we can either pass prefered size to grabWindow or
// correct Description size after. I see the first solution as more correct.
Pixmap.grabWindow(WinID, 0, 0, DCSize.cx, DCSize.cy);
Image := QImage_Create;
Pixmap.toImage(Image);
RawImage_FromImage(Image);
QImage_destroy(Image);
finally
Pixmap.Free;
end;
end else
begin
if Context.vImage <> nil then
RawImage_FromImage(Context.vImage.FHandle)
else
if Context.ParentPixmap <> nil then
begin
Image := QImage_create();
QPixmap_toImage(Context.ParentPixmap, Image);
RawImage_FromImage(Image);
QImage_destroy(Image);
end else
Result := False;
end;
// In this case we use the size of the context
Desc.Width := DCSize.cx;
Desc.Height := DCSize.cy;
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:< [WinAPI GetRawImageFromDevice]');
{$endif}
end;*)
procedure TCDWidgetset.ShowVirtualKeyboard();
begin
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line

View File

@ -0,0 +1,233 @@
{%MainUnit customdrawnint.pas}
{******************************************************************************
All CustomDrawn interface support routines
Initial Revision : Sat Jan 17 19:00:00 2004
!! Keep alphabetical !!
******************************************************************************
Implementation
******************************************************************************
*****************************************************************************
* *
* 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. *
* *
*****************************************************************************
}
//##apiwiz##sps## // Do not remove
function TCDWidgetSet.AskUser(const DialogCaption, DialogMessage: string;
DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
begin
end;
(*{------------------------------------------------------------------------------
Function: CreateEmptyRegion
Params:
Returns: valid empty region
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateEmptyRegion: hRGN;
begin
Result:= HRGN(TQtRegion.Create(True));
end;
{------------------------------------------------------------------------------
Function: CreateStandardCursor
Params:
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateStandardCursor(ACursor: SmallInt): HCURSOR;
var
CursorShape: QtCursorShape;
begin
Result := 0;
if ACursor < crLow then Exit;
if ACursor > crHigh then Exit;
// TODO: map is better
case ACursor of
crNone : CursorShape := QtBlankCursor;
crArrow : CursorShape := QtArrowCursor;
crCross : CursorShape := QtCrossCursor;
crIBeam : CursorShape := QtIBeamCursor;
crSizeAll : CursorShape := QtSizeAllCursor;
crSizeNESW : CursorShape := QtSizeBDiagCursor;
crSizeNS : CursorShape := QtSizeVerCursor;
crSizeNWSE : CursorShape := QtSizeFDiagCursor;
crSizeWE : CursorShape := QtSizeHorCursor;
crSizeNW : CursorShape := QtSizeFDiagCursor;
crSizeN : CursorShape := QtSizeVerCursor;
crSizeNE : CursorShape := QtSizeBDiagCursor;
crSizeW : CursorShape := QtSizeHorCursor;
crSizeE : CursorShape := QtSizeHorCursor;
crSizeSW : CursorShape := QtSizeBDiagCursor;
crSizeS : CursorShape := QtSizeVerCursor;
crSizeSE : CursorShape := QtSizeFDiagCursor;
crUpArrow : CursorShape := QtUpArrowCursor;
crHourGlass : CursorShape := QtWaitCursor;
crHSplit : CursorShape := QtSplitHCursor;
crVSplit : CursorShape := QtSplitVCursor;
crNo : CursorShape := QtForbiddenCursor;
crAppStart : CursorShape := QtBusyCursor;
crHelp : CursorShape := QtWhatsThisCursor;
crHandPoint : CursorShape := QtPointingHandCursor;
else
CursorShape := QtCursorShape(-1);
end;
if CursorShape <> QtCursorShape(-1) then
Result := HCURSOR(TQtCursor.Create(CursorShape));
end;*)
(*{------------------------------------------------------------------------------
Function: FontIsMonoSpace
Params:
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.FontIsMonoSpace(Font: HFont): Boolean;
var
QtFontInfo: QFontInfoH;
begin
Result := IsValidGDIObject(Font);
if Result then
begin
QtFontInfo := QFontInfo_create(TQtFont(Font).FHandle);
try
Result := QFontInfo_fixedPitch(QtFontInfo);
finally
QFontInfo_destroy(QtFontInfo);
end;
end;
end;*)
procedure TCDWidgetSet.HideVirtualKeyboard();
begin
end;
{------------------------------------------------------------------------------
Function: PromptUser
Params:
Returns:
------------------------------------------------------------------------------}
function TCDWidgetSet.PromptUser(const DialogCaption : string;
const DialogMessage : string;
DialogType : LongInt;
Buttons : PLongInt;
ButtonCount : LongInt;
DefaultIndex : LongInt;
EscapeResult : LongInt) : LongInt;
begin
end;
(*{------------------------------------------------------------------------------
Function: RawImage_FromDevice
Params: ADC:
ARect:
ARawImage:
Returns:
This function is utilized when the function TBitmap.LoadFromDevice is called
The main use for this function is to get a screenshot. It may have other uses,
but this is the only one implemented here.
MWE: exept for the desktop, there is always a bitmep selected in the DC.
So get this internal bitmap and pass it to RawImage_FromBitmap
------------------------------------------------------------------------------}
function TQtWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean;
var
Desc: TRawImageDescription absolute ARawImage.Description;
//SrcWidth, SrcHeight: Integer;
WinID: Cardinal;
DCSize: TSize;
Pixmap: TQtPixmap;
Image: QImageH;
Context: TQtDeviceContext;
procedure RawImage_FromImage(AImage: QImageH);
begin
ARawImage.DataSize := QImage_numBytes(AImage);
ARawImage.Data := GetMem(ARawImage.DataSize);
Move(QImage_bits(AImage)^, ARawImage.Data^, ARawImage.DataSize);
ARawImage.Mask := nil;
end;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:> [WinAPI GetRawImageFromDevice] SrcDC: ', dbghex(ADC),
' SrcWidth: ', dbgs(ARect.Right - ARect.Left),
' SrcHeight: ', dbgs(ARect.Bottom - ARect.Top));
{$endif}
// todo: copy only passed rectangle
Result := True;
ARawImage.Init;
FillStandardDescription(ARawImage.Description);
Context := TQtDeviceContext(ADC);
with DCSize, Context.getDeviceSize do
begin
cx := x;
cy := y;
end;
if Context.Parent <> nil then
begin
Pixmap := TQtPixmap.Create(@DCSize);
WinID := QWidget_winId(Context.Parent);
try
// if you have dual monitors then getDeviceSize return
// more width than screen width, but grabWindow will only grab one
// screen, so its width will be less
// Solution: we can either pass prefered size to grabWindow or
// correct Description size after. I see the first solution as more correct.
Pixmap.grabWindow(WinID, 0, 0, DCSize.cx, DCSize.cy);
Image := QImage_Create;
Pixmap.toImage(Image);
RawImage_FromImage(Image);
QImage_destroy(Image);
finally
Pixmap.Free;
end;
end else
begin
if Context.vImage <> nil then
RawImage_FromImage(Context.vImage.FHandle)
else
if Context.ParentPixmap <> nil then
begin
Image := QImage_create();
QPixmap_toImage(Context.ParentPixmap, Image);
RawImage_FromImage(Image);
QImage_destroy(Image);
end else
Result := False;
end;
// In this case we use the size of the context
Desc.Width := DCSize.cx;
Desc.Height := DCSize.cy;
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:< [WinAPI GetRawImageFromDevice]');
{$endif}
end;*)
procedure TCDWidgetset.ShowVirtualKeyboard();
begin
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line

View File

@ -0,0 +1,233 @@
{%MainUnit customdrawnint.pas}
{******************************************************************************
All CustomDrawn interface support routines
Initial Revision : Sat Jan 17 19:00:00 2004
!! Keep alphabetical !!
******************************************************************************
Implementation
******************************************************************************
*****************************************************************************
* *
* 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. *
* *
*****************************************************************************
}
//##apiwiz##sps## // Do not remove
function TCDWidgetSet.AskUser(const DialogCaption, DialogMessage: string;
DialogType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
begin
end;
(*{------------------------------------------------------------------------------
Function: CreateEmptyRegion
Params:
Returns: valid empty region
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateEmptyRegion: hRGN;
begin
Result:= HRGN(TQtRegion.Create(True));
end;
{------------------------------------------------------------------------------
Function: CreateStandardCursor
Params:
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.CreateStandardCursor(ACursor: SmallInt): HCURSOR;
var
CursorShape: QtCursorShape;
begin
Result := 0;
if ACursor < crLow then Exit;
if ACursor > crHigh then Exit;
// TODO: map is better
case ACursor of
crNone : CursorShape := QtBlankCursor;
crArrow : CursorShape := QtArrowCursor;
crCross : CursorShape := QtCrossCursor;
crIBeam : CursorShape := QtIBeamCursor;
crSizeAll : CursorShape := QtSizeAllCursor;
crSizeNESW : CursorShape := QtSizeBDiagCursor;
crSizeNS : CursorShape := QtSizeVerCursor;
crSizeNWSE : CursorShape := QtSizeFDiagCursor;
crSizeWE : CursorShape := QtSizeHorCursor;
crSizeNW : CursorShape := QtSizeFDiagCursor;
crSizeN : CursorShape := QtSizeVerCursor;
crSizeNE : CursorShape := QtSizeBDiagCursor;
crSizeW : CursorShape := QtSizeHorCursor;
crSizeE : CursorShape := QtSizeHorCursor;
crSizeSW : CursorShape := QtSizeBDiagCursor;
crSizeS : CursorShape := QtSizeVerCursor;
crSizeSE : CursorShape := QtSizeFDiagCursor;
crUpArrow : CursorShape := QtUpArrowCursor;
crHourGlass : CursorShape := QtWaitCursor;
crHSplit : CursorShape := QtSplitHCursor;
crVSplit : CursorShape := QtSplitVCursor;
crNo : CursorShape := QtForbiddenCursor;
crAppStart : CursorShape := QtBusyCursor;
crHelp : CursorShape := QtWhatsThisCursor;
crHandPoint : CursorShape := QtPointingHandCursor;
else
CursorShape := QtCursorShape(-1);
end;
if CursorShape <> QtCursorShape(-1) then
Result := HCURSOR(TQtCursor.Create(CursorShape));
end;*)
(*{------------------------------------------------------------------------------
Function: FontIsMonoSpace
Params:
Returns:
------------------------------------------------------------------------------}
function TQtWidgetSet.FontIsMonoSpace(Font: HFont): Boolean;
var
QtFontInfo: QFontInfoH;
begin
Result := IsValidGDIObject(Font);
if Result then
begin
QtFontInfo := QFontInfo_create(TQtFont(Font).FHandle);
try
Result := QFontInfo_fixedPitch(QtFontInfo);
finally
QFontInfo_destroy(QtFontInfo);
end;
end;
end;*)
procedure TCDWidgetSet.HideVirtualKeyboard();
begin
end;
{------------------------------------------------------------------------------
Function: PromptUser
Params:
Returns:
------------------------------------------------------------------------------}
function TCDWidgetSet.PromptUser(const DialogCaption : string;
const DialogMessage : string;
DialogType : LongInt;
Buttons : PLongInt;
ButtonCount : LongInt;
DefaultIndex : LongInt;
EscapeResult : LongInt) : LongInt;
begin
end;
(*{------------------------------------------------------------------------------
Function: RawImage_FromDevice
Params: ADC:
ARect:
ARawImage:
Returns:
This function is utilized when the function TBitmap.LoadFromDevice is called
The main use for this function is to get a screenshot. It may have other uses,
but this is the only one implemented here.
MWE: exept for the desktop, there is always a bitmep selected in the DC.
So get this internal bitmap and pass it to RawImage_FromBitmap
------------------------------------------------------------------------------}
function TCDWidgetSet.RawImage_FromDevice(out ARawImage: TRawImage; ADC: HDC; const ARect: TRect): Boolean;
var
Desc: TRawImageDescription absolute ARawImage.Description;
//SrcWidth, SrcHeight: Integer;
WinID: Cardinal;
DCSize: TSize;
Pixmap: TQtPixmap;
Image: QImageH;
Context: TQtDeviceContext;
procedure RawImage_FromImage(AImage: QImageH);
begin
ARawImage.DataSize := QImage_numBytes(AImage);
ARawImage.Data := GetMem(ARawImage.DataSize);
Move(QImage_bits(AImage)^, ARawImage.Data^, ARawImage.DataSize);
ARawImage.Mask := nil;
end;
begin
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:> [WinAPI GetRawImageFromDevice] SrcDC: ', dbghex(ADC),
' SrcWidth: ', dbgs(ARect.Right - ARect.Left),
' SrcHeight: ', dbgs(ARect.Bottom - ARect.Top));
{$endif}
// todo: copy only passed rectangle
Result := True;
ARawImage.Init;
FillStandardDescription(ARawImage.Description);
Context := TQtDeviceContext(ADC);
with DCSize, Context.getDeviceSize do
begin
cx := x;
cy := y;
end;
if Context.Parent <> nil then
begin
Pixmap := TQtPixmap.Create(@DCSize);
WinID := QWidget_winId(Context.Parent);
try
// if you have dual monitors then getDeviceSize return
// more width than screen width, but grabWindow will only grab one
// screen, so its width will be less
// Solution: we can either pass prefered size to grabWindow or
// correct Description size after. I see the first solution as more correct.
Pixmap.grabWindow(WinID, 0, 0, DCSize.cx, DCSize.cy);
Image := QImage_Create;
Pixmap.toImage(Image);
RawImage_FromImage(Image);
QImage_destroy(Image);
finally
Pixmap.Free;
end;
end else
begin
if Context.vImage <> nil then
RawImage_FromImage(Context.vImage.FHandle)
else
if Context.ParentPixmap <> nil then
begin
Image := QImage_create();
QPixmap_toImage(Context.ParentPixmap, Image);
RawImage_FromImage(Image);
QImage_destroy(Image);
end else
Result := False;
end;
// In this case we use the size of the context
Desc.Width := DCSize.cx;
Desc.Height := DCSize.cy;
{$ifdef VerboseQtWinAPI}
WriteLn('Trace:< [WinAPI GetRawImageFromDevice]');
{$endif}
end;*)
procedure TCDWidgetset.ShowVirtualKeyboard();
begin
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line

View File

@ -40,14 +40,16 @@ function CreateEmptyRegion: hRGN; override;
function CreateRubberBand(const ARect: TRect; const ABrush: HBrush = 0): HWND; override;
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); override;
procedure DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); override;
procedure DestroyRubberBand(ARubberBand: HWND); override;
procedure DestroyRubberBand(ARubberBand: HWND); override;*)
function FontCanUTF8(Font: HFont): boolean; override;
(*function FontCanUTF8(Font: HFont): boolean; override; // Dont implement, deprecated
function FontIsMonoSpace(Font: HFont): boolean; override;
function GetDesignerDC(WindowHandle: HWND): HDC; override;
function GetDesignerDC(WindowHandle: HWND): HDC; override;*)
function IntfSendsUTF8KeyPress: boolean; override;
procedure HideVirtualKeyboard();
(*function IntfSendsUTF8KeyPress: boolean; override;
function IsDesignerDC(WindowHandle: HWND; DC: HDC): Boolean; override;*)
function PromptUser(const DialogCaption : string;
@ -75,6 +77,7 @@ procedure RemoveProcessEventHandler(var AHandler: PProcessEventHandler); overrid
procedure SetEventHandlerFlags(AHandler: PEventHandler; NewFlags: dword); override;
procedure SetRubberBandRect(const ARubberBand: HWND; const ARect: TRect); override;*)
procedure ShowVirtualKeyboard();
// No need to implement this one as the default is redirecting to ExtTextOut
// which already handles UTF-8

View File

@ -22,22 +22,39 @@ end;
procedure TCDWidgetSet.CDSetFocusToControl(ALCLControl, AIntfControl: TWinControl);
var
lForm: TWinControl;
lForm, OldFocusedControl: TWinControl;
begin
if (CDWidgetset.FocusedControl <> ALCLControl) then
OldFocusedControl := FocusedControl;
if (FocusedControl <> ALCLControl) then
begin
// First kill focus in the previous control
if CDWidgetset.FocusedControl <> nil then
LCLSendKillFocusMsg(CDWidgetset.FocusedControl);
CDWidgetset.FocusedControl := ALCLControl;
if FocusedControl <> nil then
LCLSendKillFocusMsg(FocusedControl);
FocusedControl := ALCLControl;
LCLSendSetFocusMsg(ALCLControl);
// The same for intf controls
if CDWidgetset.FocusedIntfControl <> nil then
LCLSendKillFocusMsg(CDWidgetset.FocusedIntfControl);
CDWidgetset.FocusedIntfControl := AIntfControl;
if FocusedIntfControl <> nil then
LCLSendKillFocusMsg(FocusedIntfControl);
FocusedIntfControl := AIntfControl;
if AIntfControl <> nil then LCLSendSetFocusMsg(AIntfControl);
// Verify if the virtual keyboard needs to be shown/hidden
// Only show if there is no hardware keyboard, but hide always in case
// the user flopped the keyboard in the mean time
if OldFocusedControl <> nil then
begin
if (csRequiresKeyboardInput in OldFocusedControl.ControlStyle)
and (not (csRequiresKeyboardInput in ALCLControl.ControlStyle)) then
HideVirtualKeyboard();
if (not (csRequiresKeyboardInput in OldFocusedControl.ControlStyle))
and (csRequiresKeyboardInput in ALCLControl.ControlStyle) then
ShowVirtualKeyboard();
end
else if csRequiresKeyboardInput in ALCLControl.ControlStyle then
ShowVirtualKeyboard();
// Invalidate the entire window to reflect the focus change
lForm := Forms.GetParentForm(ALCLControl);
LCLIntf.InvalidateRect(lForm.Handle, nil, False);

View File

@ -296,6 +296,8 @@ begin
javaMethod_LCLDoShowMessageBox := javaEnvRef^^.GetMethodID(javaEnvRef, javaActivityClass, 'LCLDoShowMessageBox', '()V');
javaMethod_LCLDoCreateTimer := javaEnvRef^^.GetMethodID(javaEnvRef, javaActivityClass, 'LCLDoCreateTimer', '()V');
javaMethod_LCLDoDestroyTimer := javaEnvRef^^.GetMethodID(javaEnvRef, javaActivityClass, 'LCLDoDestroyTimer', '()V');
javaMethod_LCLDoHideVirtualKeyboard := javaEnvRef^^.GetMethodID(javaEnvRef, javaActivityClass, 'LCLDoHideVirtualKeyboard', '()V');
javaMethod_LCLDoShowVirtualKeyboard := javaEnvRef^^.GetMethodID(javaEnvRef, javaActivityClass, 'LCLDoShowVirtualKeyboard', '()V');
__android_log_write(ANDROID_LOG_INFO, 'lclapp', 'JNI_OnLoad finished');
result:=JNI_VERSION_1_4;// 1_6 is another option

View File

@ -6677,88 +6677,4 @@ begin
FLastWFPMousePos := APoint;
end;*)
// In the end routines from customdrawnlclintfh.inc
function TCDWidgetSet.AskUser(const DialogCaption, DialogMessage: string; DialogType:
LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;
begin
Result := 0;
end;
function TCDWidgetSet.PromptUser(const DialogCaption : string;
const DialogMessage : string;
DialogType : LongInt;
Buttons : PLongInt;
ButtonCount : LongInt;
DefaultIndex : LongInt;
EscapeResult : LongInt) : LongInt;
var
lJavaString: jstring;
BtnIndex, BtnKind: Integer;
BtnText: string;
begin
{$ifdef VerboseCDWinAPI}
DebugLn(Format('[TCDWidgetSet.PromptUser] javaEnvRef=%x DialogCaption=%s '
+ 'DialogMessage=%s DialogType=%d ButtonCount=%d',
[PtrInt(javaEnvRef), DialogCaption, DialogMessage, DialogType, ButtonCount]));
{$endif}
Result := 0; // The real result goes to Application.OnMessageDialogExecute
if (javaEnvRef = nil) then Exit;
// Prepare the input
// String fields
lJavaString :=javaEnvRef^^.NewStringUTF(javaEnvRef, PChar(DialogMessage));
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lcltext, lJavaString);
lJavaString :=javaEnvRef^^.NewStringUTF(javaEnvRef, PChar(DialogCaption));
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lcltitle, lJavaString);
// Read the buttons
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton1, -1);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton2, -1);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton3, -1);
for BtnIndex := 0 to ButtonCount - 1 do
begin
BtnKind := Buttons[BtnIndex];
{$ifdef VerboseCDWinAPI}
DebugLn(Format(':[TCDWidgetSet.PromptUser] BtnKind=%d', [BtnKind]));
{$endif}
case BtnKind of
idButtonOK: BtnText := RemoveAccelChars(rsMbOK);
idButtonCancel: BtnText := RemoveAccelChars(rsMbCancel);
idButtonAbort: BtnText := RemoveAccelChars(rsMbAbort);
idButtonRetry: BtnText := RemoveAccelChars(rsMbRetry);
idButtonIgnore: BtnText := RemoveAccelChars(rsMbIgnore);
idButtonYes: BtnText := RemoveAccelChars(rsMbYes);
idButtonNo: BtnText := RemoveAccelChars(rsMbNo);
idButtonAll: BtnText := RemoveAccelChars(rsMbAll);
idButtonNoToAll: BtnText := RemoveAccelChars(rsMbNoToAll);
idButtonYesToAll:BtnText := RemoveAccelChars(rsMbYesToAll);
end;
lJavaString :=javaEnvRef^^.NewStringUTF(javaEnvRef, PChar(BtnText));
case BtnIndex of
0:
begin
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lclbutton1str, lJavaString);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton1, BtnKind);
end;
1:
begin
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lclbutton2str, lJavaString);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton2, BtnKind);
end;
2:
begin
javaEnvRef^^.SetObjectField(javaEnvRef, javaActivityObject, JavaField_lclbutton3str, lJavaString);
javaEnvRef^^.SetIntField(javaEnvRef, javaActivityObject, JavaField_lclbutton3, BtnKind);
end;
end;
end;
// Call the method
javaEnvRef^^.CallVoidMethod(javaEnvRef, javaActivityObject, javaMethod_LCLDoShowMessageBox);
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line