Hello,
This patch tryes to fix the X button close problem, but isn´t fully
successfull. I´m not sure if the problem is with my code or the
compiler, so it should be suitable anyway.
It also fixes typos, does various little improvements to the code,
including some important fixes.
The full name of the person who submitted the last CE patch is "Roozbeh
GHolizadeh". Please add his name to the contributors list.
thanks,
Felipe
Index: lcl/interfaces/wince/wincecallback.inc
===================================================================
--- lcl/interfaces/wince/wincecallback.inc (revision 9143)
+++ lcl/interfaces/wince/wincecallback.inc (working copy)
@@ -866,7 +866,8 @@
if (Window = TWinCEWidgetSet(WidgetSet).AppHandle) and
(Application.MainForm <> nil) then
begin
- Windows.SendMessage(Application.MainForm.Handle, WM_CLOSE, 0, 0);
+ Application.Terminate;
+// Windows.SendMessage(Application.MainForm.Handle, WM_CLOSE, 0, 0);
end else begin
LMessage.Msg := LM_CLOSEQUERY;
end;
Index: lcl/interfaces/wince/winceint.pp
===================================================================
--- lcl/interfaces/wince/winceint.pp (revision 9143)
+++ lcl/interfaces/wince/winceint.pp (working copy)
@@ -105,6 +105,8 @@
TWinCEWidgetSet = class(TWidgetSet)
private
+ AppTerminated: Boolean;
+
FAppHandle: HWND;//roozbeh:in win32 it was parrent of all..a window on
taskbar
FMetrics: TNonClientMetrics;
Index: lcl/interfaces/wince/winceobject.inc
===================================================================
--- lcl/interfaces/wince/winceobject.inc (revision 9143)
+++ lcl/interfaces/wince/winceobject.inc (working copy)
@@ -125,6 +125,7 @@
LPSzMenuName := nil;
LPSzClassName := @ClsName;
end;
+
Result := Windows.RegisterClass(@WindowClass) <> 0;
End;
@@ -171,7 +172,7 @@
WriteLn('TWinCEWidgetSet.AppRun');
{$endif}
- while Windows.GetMessage(@AMessage, 0, 0, 0) do
+ while Windows.GetMessage(@AMessage, 0, 0, 0) and (not AppTerminated) do
begin
Windows.TranslateMessage(@AMessage);
Windows.DispatchMessage(@AMessage);
@@ -185,7 +186,7 @@
procedure TWinCEWidgetSet.AppTerminate;
begin
-
+ AppTerminated := True;
end;
function TWinCEWidgetSet.InitHintFont(HintFont: TObject): Boolean;
Index: lcl/interfaces/wince/winceproc.pp
===================================================================
--- lcl/interfaces/wince/winceproc.pp (revision 9143)
+++ lcl/interfaces/wince/winceproc.pp (working copy)
@@ -406,107 +406,106 @@
//it depends heavilly on windowinfos for everything
//unfortunatly there are not setprop or removeprops exist on wince...so we
have to implement something similar!
type
-PTPropertyListWindows = ^TPropertyListWindows;
-TPropertyListWindows = record
-WindowHWND : HWND;
-WindowInfo : HANDLE;//if you want to make it just like windows this also
should be an array!
-NextPropertyListWindows : PTPropertyListWindows;
-end;
+ PTPropertyListWindows = ^TPropertyListWindows;
+ TPropertyListWindows = record
+ WindowHWND : HWND;
+ WindowInfo : HANDLE;//if you want to make it just like windows this also
should be an array!
+ NextPropertyListWindows : PTPropertyListWindows;
+ end;
var
-ThePropertyLists : PTPropertyListWindows;
+ ThePropertyLists : PTPropertyListWindows;
function SetProp(hWnd:HWND; {lpString:LPCSTR;} hData:HANDLE):WINBOOL;
var
-pPrevPropertyLists,pPropertyLists : PTPropertyListWindows;
+ pPrevPropertyLists,pPropertyLists : PTPropertyListWindows;
begin
-Result := true;
-if ThePropertyLists = nil then
- begin
- New(ThePropertyLists);
- writeln('new called + '+ inttostr(longint(ThePropertyLists)));
- ThePropertyLists^.WindowInfo := 0;
- ThePropertyLists^.WindowHWND := 0;
- ThePropertyLists^.NextPropertyListWindows := nil;
- end;
-pPropertyLists := ThePropertyLists;
-pPrevPropertyLists := nil;
-repeat
-if (pPropertyLists^.WindowHWND = hWnd) or (pPropertyLists^.WindowHWND = 0) then
- begin
- pPropertyLists^.WindowInfo := hData;
- pPropertyLists^.WindowHWND := hWnd;//if it was 0 then make it hwnd
- break;
- end;
-pPrevPropertyLists := pPropertyLists;
-pPropertyLists := pPropertyLists^.NextPropertyListWindows;
-until pPropertyLists = nil;
+ Result := true;
+ if ThePropertyLists = nil then
+ begin
+ New(ThePropertyLists);
+ writeln('new called + '+ inttostr(longint(ThePropertyLists)));
+ ThePropertyLists^.WindowInfo := 0;
+ ThePropertyLists^.WindowHWND := 0;
+ ThePropertyLists^.NextPropertyListWindows := nil;
+ end;
+ pPropertyLists := ThePropertyLists;
+ pPrevPropertyLists := nil;
+ repeat
+ if (pPropertyLists^.WindowHWND = hWnd) or (pPropertyLists^.WindowHWND = 0)
then
+ begin
+ pPropertyLists^.WindowInfo := hData;
+ pPropertyLists^.WindowHWND := hWnd;//if it was 0 then make it hwnd
+ break;
+ end;
+ pPrevPropertyLists := pPropertyLists;
+ pPropertyLists := pPropertyLists^.NextPropertyListWindows;
+ until pPropertyLists = nil;
-if pPropertyLists = nil then//not found in previously created ones
-begin
-New(pPrevPropertyLists^.NextPropertyListWindows);
-pPropertyLists := pPrevPropertyLists^.NextPropertyListWindows;
+ if pPropertyLists = nil then//not found in previously created ones
+ begin
+ New(pPrevPropertyLists^.NextPropertyListWindows);
+ pPropertyLists := pPrevPropertyLists^.NextPropertyListWindows;
-pPropertyLists^.NextPropertyListWindows := nil;
-pPropertyLists^.WindowHWND := hWnd;
-pPropertyLists^.WindowInfo := hData;
+ pPropertyLists^.NextPropertyListWindows := nil;
+ pPropertyLists^.WindowHWND := hWnd;
+ pPropertyLists^.WindowInfo := hData;
+ end;
end;
-end;
-
function GetProp(hWnd:HWND{; lpString:LPCSTR}):HANDLE;
var
-pPropertyLists : PTPropertyListWindows;
+ pPropertyLists : PTPropertyListWindows;
begin
-Result := 0;
-pPropertyLists := ThePropertyLists;
-if pPropertyLists = nil then
-begin
-writeln('getprop called with nil list');
-exit;
+ Result := 0;
+ pPropertyLists := ThePropertyLists;
+ if pPropertyLists = nil then
+ begin
+ writeln('getprop called with nil list');
+ exit;
+ end;
+ //writeln('getprop ok');
+ repeat
+ if (pPropertyLists^.WindowHWND = hWnd) then
+ begin
+ result := pPropertyLists^.WindowInfo;
+ break;
+ end;
+ pPropertyLists := pPropertyLists^.NextPropertyListWindows;
+ until pPropertyLists = nil;
end;
-//writeln('getprop ok');
-repeat
-if (pPropertyLists^.WindowHWND = hWnd) then
- begin
- result := pPropertyLists^.WindowInfo;
- break;
- end;
-pPropertyLists := pPropertyLists^.NextPropertyListWindows;
-until pPropertyLists = nil;
-end;
function RemoveProp(hWnd:HWND{; lpString:LPCSTR}):HANDLE;
var
-pPrevPropertyLists,pPropertyLists : PTPropertyListWindows;
+ pPrevPropertyLists,pPropertyLists : PTPropertyListWindows;
begin
-exit;
-writeln('remove called');
-Result := 0;
-pPropertyLists := ThePropertyLists;
-pPrevPropertyLists := nil;
-if pPropertyLists = nil then exit;
-repeat
-if (pPropertyLists^.WindowHWND = hWnd) then
- begin
- result := pPropertyLists^.WindowInfo;
- if pPrevPropertyLists <> nil then
+ exit;
+ writeln('remove called');
+ Result := 0;
+ pPropertyLists := ThePropertyLists;
+ pPrevPropertyLists := nil;
+ if pPropertyLists = nil then exit;
+ repeat
+ if (pPropertyLists^.WindowHWND = hWnd) then
begin
- pPrevPropertyLists^.NextPropertyListWindows :=
pPropertyLists^.NextPropertyListWindows;
- Dispose(pPropertyLists);
- end
- else
+ result := pPropertyLists^.WindowInfo;
+ if pPrevPropertyLists <> nil then
+ begin
+ pPrevPropertyLists^.NextPropertyListWindows :=
pPropertyLists^.NextPropertyListWindows;
+ Dispose(pPropertyLists);
+ end
+ else
begin//now the list contain nothing
Dispose(pPropertyLists);
ThePropertyLists := nil;
end;
- break;
- end;
-pPrevPropertyLists := pPropertyLists;
-pPropertyLists := pPropertyLists^.NextPropertyListWindows;
-until pPropertyLists = nil;
+ break;
+ end;
+ pPrevPropertyLists := pPropertyLists;
+ pPropertyLists := pPropertyLists^.NextPropertyListWindows;
+ until pPropertyLists = nil;
end;
@@ -537,8 +536,8 @@
function GetWindowInfo(Window: HWND): PWindowInfo;
begin
Result := PWindowInfo(GetProp(Window{, PChar(dword(WindowInfoAtom))}));
- if Result = nil then
- Result := @DefaultWindowInfo;
+
+ if Result = nil then Result := @DefaultWindowInfo;
end;
{-----------------------------------------------------------------------------
Index: lcl/interfaces/wince/wincewinapi.inc
===================================================================
--- lcl/interfaces/wince/wincewinapi.inc (revision 9143)
+++ lcl/interfaces/wince/wincewinapi.inc (working copy)
@@ -1965,7 +1965,7 @@
end;
end;
}
-//roozbeh:is this usefull in wince?
+ //roozbeh:is this usefull in wince?
LM_MOUSEWHEEL:
begin
// provide default wheel scrolling functionality
@@ -1977,12 +1977,10 @@
TLMessage(Message).Result := CallDefaultWindowProc(Handle,
WM_GETDLGCODE, 0, 0);
end;
-{$ifdef PassWin32MessagesToLCL}
else
if TLMessage(Message).Msg >= WM_USER then
with TLMessage(Message) do
Result := CallDefaultWindowProc(Handle, Msg, WParam, LParam);
-{$endif}
end;
end;
Index: lcl/interfaces/wince/wincewsbuttons.pp
===================================================================
--- lcl/interfaces/wince/wincewsbuttons.pp (revision 9143)
+++ lcl/interfaces/wince/wincewsbuttons.pp (working copy)
@@ -47,7 +47,7 @@
// class procedure ActiveDefaultButtonChanged(const AButton:
TCustomButton); override;
class function GetText(const AWinControl: TWinControl; var AText:
String): Boolean; override;
// class procedure SetShortcut(const AButton: TCustomButton; const
OldShortcut, NewShortcut: TShortcut); override;
-// class procedure SetText(const AWinControl: TWinControl; const AText:
String); override;
+ class procedure SetText(const AWinControl: TWinControl; const AText:
String); override;
// class procedure GetPreferredSize(const AWinControl: TWinControl;
// var PreferredWidth, PreferredHeight: integer);
override;
end;
@@ -92,6 +92,7 @@
// general initialization of Params
PrepareCreateWindow(AWinControl, Params);
+
// customization of Params
with Params do
begin
@@ -108,30 +109,14 @@
Height := AWinControl.Height;
Parent := AWinControl.Parent.Handle;
MenuHandle := 0;
- end;
+ end;
+
// create window
FinishCreateWindow(AWinControl, Params, false);
Result := Params.Window;
-{ MultiByteToWideChar(CP_ACP, 0, PChar(AWinControl.Caption), -1, @Str, 256);
+// MultiByteToWideChar(CP_ACP, 0, PChar(AWinControl.Caption), -1, @Str, 256);
- Result := CreateWindow(
- @ButtonClsName, // Name of the registered class
- @Str, // Title of the window
- WS_CHILD or WS_VISIBLE, // Style of the window
- AWinControl.Left, // x-position (at beginning)
- AWinControl.Top, // y-position (at beginning)
- AWinControl.Width, // window width
- AWinControl.Height, // window height
- AWinControl.Parent.Handle, // handle to parent or owner window
- 0, // handle to menu
- System.hInstance, // handle to application instance
- nil); } // pointer to window-creation data
-
-// Result := CreateWindow(Params.pClassName, Params.WindowTitle, WS_CHILD
or WS_VISIBLE,
-// Params.Left, Params.Top, Params.Width, Params.Height,
Params.Parent, 0, System.HInstance, Nil);
-
-// if (Result = 0) then WriteLn('Create Button failed');
{$ifdef VerboseWinCE}
WriteLn('End Create Button. Handle = ' + IntToStr(Result) +
' Left ' + IntToStr(AWinControl.Left) +
@@ -166,10 +151,10 @@
Params: None
Returns: Nothing
------------------------------------------------------------------------------}
-{class procedure TWinCEWSButton.SetText(const AWinControl: TWinControl; const
AText: String);
+class procedure TWinCEWSButton.SetText(const AWinControl: TWinControl; const
AText: String);
begin
end;
-}
+
initialization
////////////////////////////////////////////////////
Index: lcl/interfaces/wince/wincewscontrols.pp
===================================================================
--- lcl/interfaces/wince/wincewscontrols.pp (revision 9143)
+++ lcl/interfaces/wince/wincewscontrols.pp (working copy)
@@ -219,9 +219,21 @@
end else begin
MenuHandle := HMENU(nil);
end;
- Window := CreateWindowEx(FlagsEx, pClassName, WindowTitle, Flags,
- Left, Top, Width, Height, Parent, MenuHandle, System.HInstance, Nil);
+ Window := CreateWindowEx(
+ FlagsEx, // Extra Flags
+ pClassName, // Name of the registered class
+ WindowTitle, // Title of the window
+ Flags, // Style of the window
+ Left, // x-position (at beginning)
+ Top, // y-position (at beginning)
+ Width, // window width
+ Height, // window height
+ Parent, // handle to parent or owner window
+ MenuHandle, // handle to menu
+ System.HInstance, // handle to application instance
+ nil); // pointer to window-creation data
+
if Window = 0 then
begin
Writeln('failed to create wince control, error: '+
IntToStr(GetLastError()));
@@ -430,14 +442,14 @@
procedure TWinCEWSWinControl.SetText(const AWinControl: TWinControl; const
AText: string);
var
-tmpStr : PWideChar;
-Begin
+ tmpStr : PWideChar;
+begin
if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then Exit;
tmpStr := CreatePWideCharFromString(AText);
Windows.SetWindowText(AWinControl.Handle, PWideChar(tmpStr));
DisposePWideChar(tmpStr);
-End;
+end;
procedure TWinCEWSWinControl.ConstraintsChange(const AWinControl: TWinControl);
begin
Index: lcl/interfaces/wince/wincewsforms.pp
===================================================================
--- lcl/interfaces/wince/wincewsforms.pp (revision 9143)
+++ lcl/interfaces/wince/wincewsforms.pp (working copy)
@@ -145,7 +145,7 @@
uses Winceint;
-{ TWin32WSCustomForm }
+{ TWinCEWSCustomForm }
function CalcBorderIconsFlags(const AForm: TCustomForm): dword;
var
@@ -195,6 +195,7 @@
{$endif}
// general initialization of Params
PrepareCreateWindow(AWinControl, Params);
+
// customization of Params
with Params do
begin
@@ -209,6 +210,7 @@
Height:=CW_USEDEFAULT;
Width:=CW_USEDEFAULT;
end;
+
// create window
FinishCreateWindow(AWinControl, Params, false);
Result := Params.Window;
@@ -219,7 +221,7 @@
end;
procedure TWinCEWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
- const ABorderIcons: TBorderIcons);
+ const ABorderIcons: TBorderIcons);
begin
UpdateWindowStyle(AForm.Handle, CalcBorderIconsFlags(AForm),
WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX);
Index: lcl/interfaces/wince/wincewsstdctrls.pp
===================================================================
--- lcl/interfaces/wince/wincewsstdctrls.pp (revision 9143)
+++ lcl/interfaces/wince/wincewsstdctrls.pp (working copy)
@@ -279,7 +279,7 @@
MultiByteToWideChar(CP_ACP, 0, PChar(AWinControl.Caption), -1, @Str, 256);
- Result := CreateWindow(
+ hwnd := CreateWindow(
@EditClsName, // Name of the registered class
@Str, // Title of the window
WS_CHILD or WS_VISIBLE, // Style of the window
@@ -415,6 +415,7 @@
// general initialization of Params
PrepareCreateWindow(AWinControl, Params);
+
// customization of Params
with Params do
begin
@@ -422,10 +423,11 @@
WindowTitle :=
CreatePWideCharFromString(AWinControl.Caption);//roozbeh..we already have this
in strcaptiob..whats the diffrence?
Flags := Flags or
CalcStaticTextFlags(TCustomStaticText(AWinControl).Alignment);//is ws_child
included?
end;
+
// create window
FinishCreateWindow(AWinControl, Params, false);
+
Result := Params.Window;
-
end;
procedure TWinCEWSCustomStaticText.SetAlignment(
