paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-13 23:56:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

Improves wince menus, see bug #17090

Browse Source 
git-svn-id: trunk@26986 -
This commit is contained in:
sekelsenmat 2010-08-03 07:47:31 +00:00
parent e96aee5bab
commit 6e88a7c284
6 changed files with 45 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/include/wincontrol.inc
View File

@ -4701,8 +4701,7 @@ var
{$ENDIF}
begin
{$ifdef DEBUG_WINDOW_ORG}
DbgAppendToFile(ExtractFilePath(ParamStr(0)) + '1.log',
':> [TWinControl.PaintControls] A');
DebugLn(':> [TWinControl.PaintControls] A');
{$endif}
//DebugLn('[TWinControl.PaintControls] ',Name,':',ClassName,' DC=',DbgS(DC,8));
@ -4720,8 +4719,7 @@ begin
if FControls <> nil then
begin
{$ifdef DEBUG_WINDOW_ORG}
DbgAppendToFile(ExtractFilePath(ParamStr(0)) + '1.log',
':> [TWinControl.PaintControls] B');
DebugLn(':> [TWinControl.PaintControls] B');
{$endif}
I := 0;
if First <> nil then
@ -4734,7 +4732,7 @@ begin
begin
TempControl := TControl(FControls.Items[I]);
{$ifdef DEBUG_WINDOW_ORG}
DbgAppendToFile(ExtractFilePath(ParamStr(0)) + '1.log',
DebugLn(
Format(':> [TWinControl.PaintControls] C DC=%d TempControl=%s Left=%d Top=%d Width=%d Height=%d',
[DC, TempControl.Name, TempControl.Left, TempControl.Top, TempControl.Width, TempControl.Height]));
{$endif}
@ -4749,7 +4747,7 @@ begin
SaveIndex := SaveDC(DC);
{$ifdef DEBUG_WINDOW_ORG}
DbgAppendToFile(ExtractFilePath(ParamStr(0)) + '1.log',
DebugLn(
Format(':> [TWinControl.PaintControls] Control=%s Left=%d Top=%d Width=%d Height=%d',
[Self.Name, Left, Top, Width, Height]));
{$endif}

16
lcl/interfaces/wince/wincecallback.inc
View File

@ -1024,7 +1024,21 @@ begin
case Lo(WParam) Of
WA_ACTIVE, WA_CLICKACTIVE:
begin
LMessage.Msg := LM_ACTIVATE
LMessage.Msg := LM_ACTIVATE;
// Upon activation of a form, rebuild it's menu
if lWinControl is TCustomForm then
begin
if (lWinControl as TCustomForm).Menu <> nil then
begin
TWinCEWidgetset(Widgetset).SetMenu(lWinControl.Handle,
(lWinControl as TCustomForm).Menu.Handle);
end
else
begin
TWinCEWidgetset(Widgetset).SetMenu(lWinControl.Handle, 0);
end;
end;
end;
WA_INACTIVE:
begin

12
lcl/interfaces/wince/wincewinapi.inc
View File

@ -2933,9 +2933,15 @@ var
i: Integer;
begin
Result := False;
for i := 0 to WinCEWSMenus.MenuHandleList.Count - 1 do
if WinCEWSMenus.MenuHandleList.Items[i] = Pointer(AMenuHandle) then Break;
lLCLMenu := TMenu(MenuLCLObjectList.Items[i]);
if AMenuHandle = 0 then
lLCLMenu := nil
else
begin
for i := 0 to WinCEWSMenus.MenuHandleList.Count - 1 do
if WinCEWSMenus.MenuHandleList.Items[i] = Pointer(AMenuHandle) then Break;
lLCLMenu := TMenu(MenuLCLObjectList.Items[i]);
end;
CeSetMenu(AWindowHandle, AMenuHandle, lLCLMenu);
AddToChangedMenus(AWindowHandle);

2
lcl/interfaces/wince/wincewsforms.pp
View File

@ -461,7 +461,7 @@ var
begin
TWinCEWSWinControl.ShowHide(AWinControl);
// In atPDA mode, if there is no menu installed, we need to remove
// In atKeyPadDevice mode, if there is no menu installed, we need to remove
// the menu of the previously focused application, otherwise it will
// remain visible
if (Application.ApplicationType = atKeyPadDevice) and

14
lcl/interfaces/wince/wincewsmenus.pp
View File

@ -138,6 +138,7 @@ var
tbbi: TBBUTTONINFO;
i, j, k, lIndex: integer;
buf: array[0..255] of WideChar;
wbuf: widestring;
R, BR, WR: TRect;
LeftMenuCount: Integer = -1;
RightMenuCount: Integer = -1;
@ -324,7 +325,11 @@ begin
// Remove any present buttons, for example the one from the .rc file
// Careful that using TB_DELETEBUTTON doesnt work here
while RemoveMenu(HMENU(tbbi.lParam), 0, MF_BYPOSITION) do DebugLn('[CeSetMenu] RemoveMenu');
while RemoveMenu(HMENU(tbbi.lParam), 0, MF_BYPOSITION) do
{$ifdef VerboseWinCEMenu}
DebugLn('[CeSetMenu] RemoveMenu')
{$endif}
;
{$ifdef VerboseWinCEMenu}
DebugLn(Format('[CeSetMenu] Installing %d Subitems', [LCLMenu.Items.Items[j].Count]));
@ -386,7 +391,12 @@ begin
// Update the MenuItem Command to use latter
TMenuItemAccess(LCLMenu.Items.Items[j]).FCommand := mi.wID;
buf[mi.cch]:=#0;
// Setting the caption
// old code: buf[mi.cch]:=#0;
wbuf := UTF8Decode(LCLMenu.Items.Items[j].Caption);
buf := wbuf;
buf[Length(wbuf)] := #0;
FillChar(tb, SizeOf(tb), 0);
tb.iBitmap:=I_IMAGENONE;
tb.idCommand := mi.wID;

6
lcl/lclproc.pas
View File

@ -359,6 +359,8 @@ implementation
uses gettext;
const
Str_LCL_Debug_File = 'lcldebug.log';
var
InterfaceInitializationHandlers: TFPList = nil;
@ -2151,7 +2153,7 @@ end;
procedure DebugLn(const s: string);
begin
{$ifdef WinCE}
DbgAppendToFile(ExtractFilePath(ParamStr(0)) + '1.log', s);
DbgAppendToFile(ExtractFilePath(ParamStr(0)) + Str_LCL_Debug_File, s);
{$else}
if not Assigned(DebugText) then exit;
writeln(DebugText^, ConvertLineEndings(s));
@ -2273,7 +2275,7 @@ end;
procedure DBGOut(const s: string);
begin
{$ifdef WinCE}
DbgAppendToFileWithoutLn(ExtractFilePath(ParamStr(0)) + '1.log', s);
DbgAppendToFileWithoutLn(ExtractFilePath(ParamStr(0)) + Str_LCL_Debug_File, s);
{$else}
if Assigned(DebugText) then
write(DebugText^, s);