diff --git a/.gitattributes b/.gitattributes index f322ee35ea..f5ea6b05eb 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2692,6 +2692,7 @@ lcl/interfaces/wince/wincewscontrols.pp svneol=native#text/plain lcl/interfaces/wince/wincewscustomlistview.inc svneol=native#text/plain lcl/interfaces/wince/wincewsextctrls.pp svneol=native#text/plain lcl/interfaces/wince/wincewsforms.pp svneol=native#text/plain +lcl/interfaces/wince/wincewsmenus.pp svneol=native#text/plain lcl/interfaces/wince/wincewsspin.pp svneol=native#text/plain lcl/interfaces/wince/wincewsstdctrls.pp svneol=native#text/plain lcl/interfaces/wince/winext.pas svneol=native#text/plain diff --git a/lcl/interfaces/wince/interfaces.pp b/lcl/interfaces/wince/interfaces.pp index b5ee3b9573..bf92d8195b 100644 --- a/lcl/interfaces/wince/interfaces.pp +++ b/lcl/interfaces/wince/interfaces.pp @@ -25,7 +25,6 @@ unit Interfaces; {$mode objfpc}{$H+} -//{$define OldToolbar} interface diff --git a/lcl/interfaces/wince/wincecallback.inc b/lcl/interfaces/wince/wincecallback.inc index f6d39db117..29e0f7f7b3 100644 --- a/lcl/interfaces/wince/wincecallback.inc +++ b/lcl/interfaces/wince/wincecallback.inc @@ -13,6 +13,8 @@ * * ***************************************************************************** } +type +TWinControlAccess = class(TWinControl); {*************************************************************} { callback routines } @@ -39,7 +41,6 @@ Begin Assert(False, 'Trace:PropEnumProc - Exit'); End; - {------------------------------------------------------------------------------ Function: CallDefaultWindowProc Params: Window - The window that receives a message @@ -158,12 +159,11 @@ type Length : Integer; Position : Integer; UserData : Pointer; - end; - + end; + TCustomListViewAccess = class(TCustomListView) end; - {------------------------------------------------------------------------------ Function: WindowProc Params: Window - The window that receives a message @@ -240,31 +240,37 @@ Var Result := PageIndex; end; -//roozbeh:menus little tricky! function GetMenuItemObject: TObject; - var MenuInfo: MENUITEMINFO; - MainMenuHandle: HMENU; - PopupMenu: TPopupMenu; + var + MenuInfo: MENUITEMINFO; + MainMenuHandle: HMENU; + PopupMenu: TPopupMenu; + Index: Integer; begin Result:=nil; -(* MenuInfo.cbSize:=sizeof(MENUITEMINFO); + FillChar(MenuInfo,SizeOf(MenuInfo),0); + MenuInfo.cbSize:=sizeof(MENUITEMINFO); MenuInfo.fMask:=MIIM_DATA; {first we have to decide if the command is from a popup menu or from the window main menu} //if the 'PopupMenu' property exists, there is a big probability that the command is from a popup menu PopupMenu := WindowInfo^.PopupMenu; - if PopupMenu<>nil then //processing popup menu + if PopupMenu <> nil then //processing popup menu begin WindowInfo^.PopupMenu := nil; Result := PopupMenu.FindItem(LOWORD(WParam), fkCommand); end; if Result=nil then //if Result is still nil, process main menu begin - MainMenuHandle := GetMenu(Window); - if GetMenuItemInfo(MainMenuHandle, LOWORD(WParam), false, @MenuInfo) then - Result := TObject(MenuInfo.dwItemData); - end;*) + MainMenuHandle := SHFindMenuBar(Window); + // roozbeh : this is the only way we have + Index := MenuItemsList.IndexOf(IntToStr(LOWORD(WParam))); + if (Index >= 0) and (Index < MenuItemsList.Count) then + Result := MenuItemsList.Objects[Index]; + {if GetMenuItemInfo(MainMenuHandle, LOWORD(WParam), false, @MenuInfo) then + Result := TObject(MenuInfo.dwItemData);} + end; end; - + procedure SendPaintMessage; var DC: HDC; @@ -415,7 +421,13 @@ Var if not useDoubleBuffer then PaintMsg.DC := DC; if not needParentPaint and not isNotebook then - lWinControl.EraseBackground(PaintMsg.DC); + begin + // send through message to allow message override + //lWinControl.EraseBackground(PaintMsg.DC); + Include(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground); + lWinControl.Perform(LM_ERASEBKGND, PaintMsg.DC, 0); + Exclude(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground); + end; if ParentPaintWindow <> 0 then begin {$ifdef MSG_DEBUG} @@ -648,25 +660,32 @@ Var var lControl: TControl; BoundsOffset: TRect; + ACursor: TCursor; begin if (lWinControl <> nil) and not (csDesigning in lWinControl.ComponentState) and (Lo(LParam) = HTCLIENT) then begin Windows.GetCursorPos(@(Windows.POINT(P))); Windows.ScreenToClient(Window, @(Windows.POINT(P))); - if GetLCLClientBoundsOffset(lWinControl.Parent, BoundsOffset) then + if GetLCLClientBoundsOffset(lWinControl, BoundsOffset) then begin Dec(P.X, BoundsOffset.Left); Dec(P.Y, BoundsOffset.Top); end; - // statictext controls do not get WM_SETCURSOR messages... - lControl := lWinControl.ControlAtPos(P, false, true); - if lControl = nil then - lControl := lWinControl; - if lControl.Cursor <> crDefault then + ACursor := Screen.Cursor; + if ACursor = crDefault then begin -//roozbeh:currently strange problems with makeintresource -// Windows.SetCursor(Windows.LoadCursor(0, LclCursorToWin32CursorMap[lControl.Cursor])); + // statictext controls do not get WM_SETCURSOR messages... + lControl := lWinControl.ControlAtPos(P, [capfOnlyClientAreas, + capfAllowWinControls, capfHasScrollOffset]); + if lControl = nil then + lControl := lWinControl; + if lControl.Cursor <> crDefault then + ACursor := lControl.Cursor; + end; + if ACursor <> crDefault then + begin + Windows.SetCursor(Screen.Cursors[ACursor]); LMessage.Result := 1; end; end; @@ -988,6 +1007,7 @@ begin Windows.SetWindowPos(TWinCEWidgetSet(WidgetSet).AppHandle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); end; + // activate/deactivate main window if (Application <> nil) and (Application.MainForm <> nil) and Application.MainForm.HandleAllocated then @@ -1033,20 +1053,18 @@ begin End; WinProcess := false; End; - {WM_MENUCHAR: + WM_MENUCHAR: Begin PLMsg^.Result := FindMenuItemAccelerator(chr(LOWORD(WParam)), LParam); WinProcess := false; - End;} + End; WM_CLOSE: Begin if (Window = TWinCEWidgetSet(WidgetSet).AppHandle) and (Application.MainForm <> nil) then begin Windows.SendMessage(Application.MainForm.Handle, WM_CLOSE, 0, 0); - // Application.Terminate; - end - else begin + end else begin LMessage.Msg := LM_CLOSEQUERY; end; // default is to destroy window, inhibit @@ -1054,20 +1072,19 @@ begin End; WM_COMMAND: Begin - if LParam=0 then + if Hi(WParam) < 2 then //1 for accelerator 0 for menu + TargetObject := GetMenuItemObject else // menuitem or shortcut + TargetObject := nil; + if TargetObject is TMenuItem then begin - {menuitem or shortcut} - TargetObject := GetMenuItemObject; - if TargetObject is TMenuItem then + if (Hi(WParam) = 0) or (Hi(WParam) = 1) then begin - if (Hi(WParam) = 0) or (Hi(WParam) = 1) then - begin - LMessage.Msg := LM_ACTIVATE; - TargetObject.Dispatch(LMessage); - end; - lWinControl := nil; + LMessage.Msg := LM_ACTIVATE; + TargetObject.Dispatch(LMessage); end; - end else begin + lWinControl := nil; + end else + begin lWinControl := GetWindowInfo(LParam)^.WinControl; // buddy controls use 'awincontrol' to designate associated wincontrol if lWinControl = nil then @@ -1139,18 +1156,22 @@ begin ChildWinControl := ChildWindowInfo^.WinControl; if ChildWinControl = nil then ChildWinControl := ChildWindowInfo^.AWinControl; - if (Msg = WM_CTLCOLORSTATIC) or (Msg = WM_CTLCOLORBTN) - or (Msg = WM_CTLCOLORSCROLLBAR) then - begin - if GetNeedParentPaint(ChildWindowInfo, ChildWinControl) then - begin - // need to draw transparently, draw background - GetWin32ControlPos(LParam, Window, P.X, P.Y); - MoveWindowOrgEx(WParam, -P.X, -P.Y); - SendPaintMessage; - MoveWindowOrgEx(WParam, P.X, P.Y); - LMessage.Result := GetStockObject(HOLLOW_BRUSH); - SetBkMode(WParam, TRANSPARENT); + case Msg of + WM_CTLCOLORSTATIC, + WM_CTLCOLORBTN: begin + if GetNeedParentPaint(ChildWindowInfo, ChildWinControl) then + begin + // need to draw transparently, draw background + GetWin32ControlPos(LParam, Window, P.X, P.Y); + MoveWindowOrgEx(WParam, -P.X, -P.Y); + SendPaintMessage; + MoveWindowOrgEx(WParam, P.X, P.Y); + LMessage.Result := GetStockObject(HOLLOW_BRUSH); + SetBkMode(WParam, TRANSPARENT); + WinProcess := false; + end; + end; + WM_CTLCOLORSCROLLBAR: begin WinProcess := false; end; end; @@ -1206,8 +1227,7 @@ begin End;*) WM_DRAWITEM: Begin - { - roozbeh : no menus yet + if (WParam = 0) and (PDrawItemStruct(LParam)^.ctlType = ODT_MENU) then begin menuItem := TObject(PDrawItemStruct(LParam)^.itemData); @@ -1215,7 +1235,7 @@ begin begin DrawMenuItem(TMenuItem(menuItem), PDrawItemStruct(LParam)^._hDC, PDrawItemStruct(LParam)^.rcItem, PDrawItemStruct(LParam)^.itemState and ODS_SELECTED <> 0); end - end;} + end; // TODO: this could crash for a MenuItem. WindowInfo := GetWindowInfo(PDrawItemStruct(LParam)^.hwndItem); @@ -1538,6 +1558,8 @@ begin exit; + + // check if the window is an edit control of a combobox, if so, // redirect it to the combobox, not the edit control if GetWindowInfo(TargetWindow)^.isComboEdit then @@ -1689,7 +1711,7 @@ begin Result := 0; End; End; -{ WM_CONTEXTMENU: + WM_CONTEXTMENU: begin WinProcess := false; NotifyUserInput := True; @@ -1713,7 +1735,7 @@ begin LMMouse.YPos := 0; {TODO : Fix that in future because popup menu should appear near selected element of control} end; - end;} + end; WM_SETCURSOR: begin HandleSetCursor; @@ -1822,8 +1844,6 @@ begin End; WM_MEASUREITEM: Begin - { - roozbeh : no menues yet! if WParam = 0 then begin menuItem := TObject(PMeasureItemStruct(LParam)^.itemData); if menuItem is TMenuItem then @@ -1836,7 +1856,7 @@ begin Winprocess := False; end else DebugLn('WM_MEASUREITEM for a menuitem catched but menuitem is not TmenuItem'); - end;} + end; if LWinControl<>nil then begin if LWinControl is TCustomCombobox then begin LMessage.Msg := LM_MEASUREITEM; @@ -2112,9 +2132,7 @@ begin if PLMsg^.Result = 0 then DeliverMessage(lWinControl, PLMsg^); - // handle Ctrl-A for edit controls - if (PLMsg^.Result = 0) and (Msg = WM_KEYDOWN) and (WParam = Ord('A')) and (GetKeyState(VK_CONTROL) < 0) and (GetKeyState(VK_MENU) >= 0) then begin @@ -2284,3 +2302,7 @@ end; + + + + diff --git a/lcl/interfaces/wince/winceint.pp b/lcl/interfaces/wince/winceint.pp index 388db8c76d..d269274520 100644 --- a/lcl/interfaces/wince/winceint.pp +++ b/lcl/interfaces/wince/winceint.pp @@ -26,7 +26,7 @@ unit WinCEInt; {$mode objfpc}{$H+} -interface +Interface {$IFDEF Trace} {$ASSERTIONS ON} @@ -44,43 +44,8 @@ Uses Windows, Classes, ComCtrls, Controls, Buttons, Dialogs, DynHashArray, ExtCtrls, Forms, GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType, LMessages, StdCtrls, SysUtils, Graphics, Menus,Winceproc,WinCEWinAPIEmu,WinExt,WinCEDef; -//roozbeh:the following makes some errors in wincewinapih that some procedures cannot be overriden! -//also causes some nasty problems too.... -//why so many common names?just by changing units order program should not be ok or wrong...!! -//uses -// Windows,Classes, Types, ComCtrls, Controls, Buttons, Dialogs, ExtCtrls, Forms, -// GraphMath, GraphType, InterfaceBase, LCLIntf, LCLType, Winceproc, -// LMessages, StdCtrls, SysUtils, Graphics, Menus; -(*const - - IDC_ARROW = MakeIntResource(32512); - IDC_IBEAM = MakeIntResource(32513); - IDC_WAIT = MakeIntResource(32514); - IDC_CROSS = MakeIntResource(32515); - IDC_UPARROW = MakeIntResource(32516); - IDC_SIZE = MakeIntResource(32640); - IDC_ICON = MakeIntResource(32641); - IDC_SIZENWSE = MakeIntResource(32642); - IDC_SIZENESW = MakeIntResource(32643); - IDC_SIZEWE = MakeIntResource(32644); - IDC_SIZENS = MakeIntResource(32645); - IDC_SIZEALL = MakeIntResource(32646); - IDC_NO = MakeIntResource(32648); - IDC_HAND = MakeIntResource(32649); - IDC_APPSTARTING = MakeIntResource(32650); - IDC_HELP = MakeIntResource(32651); - -{ - These are add-ons, don't exist in windows itself! - IDC_NODROP = MakeIntResource(32767); - IDC_DRAG = MakeIntResource(32766); - IDC_HSPLIT = MakeIntResource(32765); - IDC_VSPLIT = MakeIntResource(32764); - IDC_MULTIDRAG = MakeIntResource(32763); - IDC_SQLWAIT = MakeIntResource(32762); - IDC_HANDPT = MakeIntResource(32761); -} +const IDC_NODROP = IDC_NO; IDC_DRAG = IDC_ARROW; IDC_HSPLIT = IDC_SIZEWE; @@ -89,14 +54,14 @@ Uses IDC_SQLWAIT = IDC_WAIT; IDC_HANDPT = IDC_HAND; - LclCursorToWin32CursorMap: array[crLow..crHigh] of PChar = ( + LclCursorToWin32CursorMap: array[crLow..crHigh] of PWideChar = ( // uni-direction cursors are mapped to bidirection win32 cursors IDC_SIZENWSE, IDC_SIZENS, IDC_SIZENESW, IDC_SIZEWE, IDC_SIZEWE, IDC_SIZENESW, IDC_SIZENS, IDC_SIZENWSE, IDC_SIZEALL, IDC_HANDPT, IDC_HELP, IDC_APPSTARTING, IDC_NO, IDC_SQLWAIT, IDC_MULTIDRAG, IDC_VSPLIT, IDC_HSPLIT, IDC_NODROP, IDC_DRAG, IDC_WAIT, IDC_UPARROW, IDC_SIZEWE, IDC_SIZENWSE, IDC_SIZENS, IDC_SIZENESW, IDC_SIZE, IDC_IBEAM, IDC_CROSS, - IDC_ARROW, IDC_ARROW, IDC_ARROW); *) + IDC_ARROW, IDC_ARROW, IDC_ARROW); type @@ -162,7 +127,7 @@ type Function WinRegister: Boolean; - public + Public { Creates a callback of Lazarus message Msg for Sender } Procedure SetCallback(Msg: LongInt; Sender: TObject); virtual; { Removes all callbacks for Sender } @@ -174,8 +139,8 @@ type Destructor Destroy; Override; { Initialize the API } procedure AppInit(var ScreenInfo: TScreenInfo); override; -// procedure AppMinimize; override; -// procedure AppRestore; override; + procedure AppMinimize; override; + procedure AppRestore; override; procedure AppBringToFront; override; procedure AppProcessMessages; override; procedure AppWaitMessage; override; @@ -265,7 +230,7 @@ Uses // WinCEWSGrids, // WinCEWSImgList, // WinCEWSMaskEdit, -// WinCEWSMenus,//roozbeh:not yet ready for use! + WinCEWSMenus, // WinCEWSPairSplitter, WinCEWSSpin, WinCEWSStdCtrls, diff --git a/lcl/interfaces/wince/wincelclintf.inc b/lcl/interfaces/wince/wincelclintf.inc index 2cb26fa348..f9565847e4 100644 --- a/lcl/interfaces/wince/wincelclintf.inc +++ b/lcl/interfaces/wince/wincelclintf.inc @@ -151,6 +151,30 @@ begin AHandler := nil; end; +{------------------------------------------------------------------------------ + Function: + Params: + + Returns: + + ------------------------------------------------------------------------------} +function TWinCEWidgetSet.CreateStandardCursor(ACursor: SmallInt): hCursor; +begin + Result := 0; + if ACursor < crLow then Exit; + if ACursor > crHigh then Exit; + + case ACursor of + crSqlWait..crDrag, + crHandPoint: + begin + // will be created later by CreateCursor + end; + else + Result := Windows.LoadCursor(0, LclCursorToWin32CursorMap[ACursor]); + end; +end; + procedure TWinCEWidgetSet.DrawArrow(Arrow: TComponent; Canvas: TPersistent); const { up, down, left, right } diff --git a/lcl/interfaces/wince/wincelclintfh.inc b/lcl/interfaces/wince/wincelclintfh.inc index 64c9173662..0a2b538ff6 100644 --- a/lcl/interfaces/wince/wincelclintfh.inc +++ b/lcl/interfaces/wince/wincelclintfh.inc @@ -35,6 +35,8 @@ function AddPipeEventHandler(AHandle: THandle; function AddProcessEventHandler(AHandle: THandle; AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; override; +function CreateStandardCursor(ACursor: SmallInt): hCursor; override; + procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); override; function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; override; diff --git a/lcl/interfaces/wince/wincelistsl.inc b/lcl/interfaces/wince/wincelistsl.inc index 57cd8fac98..ecad0bb425 100644 --- a/lcl/interfaces/wince/wincelistsl.inc +++ b/lcl/interfaces/wince/wincelistsl.inc @@ -148,9 +148,9 @@ Begin Windows.SendMessage(FWinCEList, FFlagResetContent, 0, 0); For Counter := 0 To (TStrings(Source).Count - 1) Do Begin - tmpStr := CreatePWideCharFromString(s[Counter]); + tmpStr := StringToPWideChar(s[Counter]); AnIndex := Windows.SendMessage(FWinCEList, FFlagAddString, 0, LPARAM(PWideChar(tmpStr))); //Insert - DisposePWideChar(tmpStr); + FreeMem(tmpStr); PutObject(AnIndex, S.Objects[Counter]); end; End @@ -249,12 +249,12 @@ var tmpS : PWideChar; Begin FLastInsertedIndex := Index; - tmpS := CreatePWideCharFromString(s); + tmpS := StringToPWideChar(s); If FSorted Then FLastInsertedIndex := Windows.SendMessage(FWinCEList, FFlagAddString, 0, LPARAM(PWideChar(tmpS))) Else Windows.SendMessage(FWinCEList, FFlagInsertString, Index, LPARAM(PWideChar(tmpS))); - DisposePWideChar(tmpS); + FreeMem(tmpS); End; procedure TWinCEListStringList.Put(Index: integer; const S: string); @@ -619,12 +619,12 @@ Procedure TWinCECListStringList.Insert(Index: Integer; Const S: String); var tmpS : PWideChar; Begin - tmpS := CreatePWideCharFromString(S); + tmpS := StringToPWideChar(S); If FSorted Then Windows.SendMessage(FWinCECList,LB_ADDSTRING, 0, LPARAM(PWideChar(tmpS))) Else Windows.SendMessage(FWinCECList,LB_INSERTSTRING, Index, LPARAM(PWideChar(tmpS))); - DisposePWideChar(tmpS); + FreeMem(tmpS); End; {------------------------------------------------------------------------------ @@ -644,3 +644,6 @@ End; {$H-} {$ENDIF} + + + diff --git a/lcl/interfaces/wince/wincememostrings.inc b/lcl/interfaces/wince/wincememostrings.inc index 0724d278b0..81756b4fa6 100644 --- a/lcl/interfaces/wince/wincememostrings.inc +++ b/lcl/interfaces/wince/wincememostrings.inc @@ -72,7 +72,7 @@ begin PWord(textbuf)^ := Word(fLength+1); SendMessage(fHandle, EM_GETLINE, Index, lparam(textbuf)); Result := WideStringToString(WideString(textbuf)); - DisposePWideChar(textbuf); + FreeMem(textbuf); end; end; @@ -127,10 +127,10 @@ begin //insert with LineEnding LineStart := GetLineStart(Index); NewLine := S+LineEnding; - tmpNewLine := CreatePWideCharFromString(NewLine); + tmpNewLine := StringToPWideChar(NewLine); SendMessage(fHandle, EM_SETSEL, LineStart, LineStart); SendMessage(fHandle, EM_REPLACESEL,0 , lparam(PWideChar(tmpNewLine))); - DisposePWideChar(tmpNewLine); + FreeMem(tmpNewLine); end else begin //append with a preceding LineEnding @@ -140,9 +140,9 @@ begin NewLine := LineEnding+S+LineEnding else NewLine := S+LineEnding; - tmpNewLine := CreatePWideCharFromString(NewLine); + tmpNewLine := StringToPWideChar(NewLine); SendMessage(fHandle, EM_REPLACESEL,0 , lparam(PWideChar(tmpNewLine))); - DisposePWideChar(tmpNewLine); + FreeMem(tmpNewLine); end; end; @@ -150,9 +150,9 @@ procedure TWinCEMemoStrings.SetText(TheText: PChar); var tmpTheText : PWideChar; begin - tmpTheText := CreatePWideCharFromString(TheText); + tmpTheText := StringToPWideChar(TheText); SendMessage(fHandle, WM_SETTEXT, 0, LPARAM(tmpTheText)); - DisposePWideChar(tmpTheText); + FreeMem(tmpTheText); end; {$ENDIF} diff --git a/lcl/interfaces/wince/winceobject.inc b/lcl/interfaces/wince/winceobject.inc index 7e8d0dd5cc..40f1afb94c 100644 --- a/lcl/interfaces/wince/winceobject.inc +++ b/lcl/interfaces/wince/winceobject.inc @@ -144,7 +144,7 @@ begin // Create parent of all windows, `button on taskbar' //does this work on wince?! - FAppHandle := CreateWindow(@ClsName, CreatePWideCharFromString(Application.Title), + FAppHandle := CreateWindow(@ClsName, StringToPWideChar(Application.Title), WS_POPUP or WS_CLIPSIBLINGS or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX, 0, {Windows.GetSystemMetrics(SM_CXSCREEN) div 2,} 0, {Windows.GetSystemMetrics(SM_CYSCREEN) div 2,} @@ -155,12 +155,16 @@ begin SendMessage(FAppHandle, WM_SETICON, ICON_BIG, Windows.LoadIcon(MainInstance, 'MAINICON')); // remove useless menuitems from sysmenu - //roozbeh:new stuff check it - {SysMenu := Windows.GetSystemMenu(FAppHandle, False); - Windows.DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND); - Windows.DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND); - Windows.DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND); -} + {} +// SysMenu := Windows.GetSystemMenu(FAppHandle, False); + +// Windows.DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND); + +// Windows.DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND); + +// Windows.DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND); + + // initialize ScreenInfo Handle := GetDesktopWindow; DC := Windows.GetDC(Handle); @@ -181,11 +185,11 @@ end; Minimizes the whole application to the taskbar ------------------------------------------------------------------------------} -{procedure TWinCEWidgetSet.AppMinimize; +procedure TWinCEWidgetSet.AppMinimize; begin - Windows.SendMessage(FAppHandle, WM_SYSCOMMAND, SC_MINIMIZE, 0); +// Windows.SendMessage(FAppHandle, WM_SYSCOMMAND, SC_MINIMIZE, 0); end; -} + {------------------------------------------------------------------------------ Method: TWinCEWidgetSet.AppRestore Params: None @@ -193,12 +197,12 @@ end; Restore minimized whole application from taskbar ------------------------------------------------------------------------------} -{ + procedure TWinCEWidgetSet.AppRestore; begin - Windows.SendMessage(FAppHandle, WM_SYSCOMMAND, SC_RESTORE, 0); +// Windows.SendMessage(FAppHandle, WM_SYSCOMMAND, SC_RESTORE, 0); end; -} + {------------------------------------------------------------------------------ Method: TWin32WidgetSet.AppBringToFront @@ -373,23 +377,6 @@ begin end; end; -{ -procedure TWinCEWidgetSet.AppRun(const ALoop: TApplicationMainLoop); -var - AMessage: TMsg; -begin - {$ifdef VerboseWinCE} - WriteLn('TWinCEWidgetSet.AppRun'); - {$endif} - -//roozbeh:why we dont have this in win32? - while Windows.GetMessage(@AMessage, 0, 0, 0) do - begin - Windows.TranslateMessage(@AMessage); - Windows.DispatchMessage(@AMessage); - end; -end; -} {------------------------------------------------------------------------------ Method: TWin32WidgetSet.AppWaitMessage Params: None @@ -402,7 +389,7 @@ procedure TWinCEWidgetSet.AppWaitMessage; var timeout,retVal: dword; begin -// RedrawMenus; + RedrawMenus; Assert(False, 'Trace:TWin32WidgetSet.WaitMessage - Start'); if FWaitPipeHandlers <> nil then timeout := 100 @@ -441,9 +428,9 @@ procedure TWinCEWidgetSet.AppSetTitle(const ATitle: string); var tmpText : PWideChar; begin - tmpText := CreatePWideCharFromString(ATitle); + tmpText := StringToPWideChar(ATitle); Windows.SetWindowText(FAppHandle, @tmpText); - DisposePWideChar(tmpText); + FreeMem(tmpText); end; @@ -518,8 +505,7 @@ begin if AMenu is TMainMenu then begin AWinControl := TWinControl(AMenu.Owner); -//roozbeh this is somehow very difficut to achieve for now! -// Windows.SetMenu(AWinControl.Handle, AMenu.Handle); + CeSetMenu(AWinControl.Handle, AMenu.Handle); AddToChangedMenus(AWinControl.Handle); end; end; diff --git a/lcl/interfaces/wince/winceproc.pp b/lcl/interfaces/wince/winceproc.pp index ee9a8ab65d..b26ce61417 100644 --- a/lcl/interfaces/wince/winceproc.pp +++ b/lcl/interfaces/wince/winceproc.pp @@ -42,9 +42,7 @@ Type ); end; -function CreatePWideCharFromString(inString : string): PWideChar; function WideStringToString(inWideString : WideString) : String; -procedure DisposePWideChar(inPWideChar : PWideChar); function WM_To_String(WM_Message: Integer): string; function WindowPosFlagsToString(Flags: UINT): string; procedure EventTrace(Message: String; Data: TObject); @@ -86,6 +84,7 @@ function DisableWindowsProc(Window: HWND; Data: LParam): LongBool; stdcall; procedure DisableApplicationWindows(Window: HWND); procedure EnableApplicationWindows(Window: HWND); procedure AddToChangedMenus(Window: HWnd); +procedure RedrawMenus; function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean; function GetControlText(AHandle: HWND): string; @@ -108,14 +107,6 @@ uses LCLIntf; //remove this unit when GetWindowSize is moved to TWSWinControl -function CreatePWideCharFromString(inString : string): PWideChar; -var -tmpWideChar : PWideChar; -begin - tmpWideChar := PWideChar(SysAllocStringLen(nil,Length(inString)));//it automatically reserves +1 to string! - MultiByteToWideChar(CP_ACP, 0, PChar(inString), -1, tmpWideChar, Length(inString)); - Result := tmpWideChar; -end; //well this is diffrent from normal string(widestring) or other rtl functions becouse it uses windows local codepage //better name for this?! @@ -134,10 +125,6 @@ begin StrDispose(tmpStr); end; -procedure DisposePWideChar(inPWideChar: PWideChar); -begin - SysFreeString(inPWideChar); -end; {------------------------------------------------------------------------------ Function: WM_To_String @@ -628,16 +615,16 @@ Begin If TWinControl(AObject).HandleAllocated Then Handle := TWinControl(AObject).Handle End -// Else If (AObject Is TMenuItem) Then -// Begin -// If TMenuItem(AObject).HandleAllocated Then -// Handle := TMenuItem(AObject).Handle -// End -// Else If (AObject Is TMenu) Then -// Begin -// If TMenu(AObject).HandleAllocated Then -// Handle := TMenu(AObject).Items.Handle -// End + Else If (AObject Is TMenuItem) Then + Begin + If TMenuItem(AObject).HandleAllocated Then + Handle := TMenuItem(AObject).Handle + End + Else If (AObject Is TMenu) Then + Begin + If TMenu(AObject).HandleAllocated Then + Handle := TMenu(AObject).Items.Handle + End // Else If (AObject Is TCommonDialog) Then // Begin // {If TCommonDialog(AObject).HandleAllocated Then } @@ -1001,7 +988,7 @@ var tmpText : PWideChar; begin Result := $FFFFFFFF; - tmpText := CreatePWideCharFromString(FileName); + tmpText := StringToPWideChar(FileName); lenBuf := GetFileVersionInfoSize(tmpText, lenBuf); if lenBuf > 0 then begin @@ -1013,11 +1000,9 @@ begin end; FreeMem(buf); end; - DisposePWideChar(tmpText); + FreeMem(tmpText); end; - - function AllocWindowInfo(Window: HWND): PWindowInfo; var WindowInfo: PWindowInfo; @@ -1029,7 +1014,6 @@ begin Result := WindowInfo; end; - function DisposeWindowInfo(Window: HWND): boolean; var WindowInfo: PWindowInfo; @@ -1043,7 +1027,6 @@ begin end; end; - function GetWindowInfo(Window: HWND): PWindowInfo; begin Result := PWindowInfo(WinCEWinAPIEmu.GetProp(Window{, PChar(dword(WindowInfoAtom))})); @@ -1102,7 +1085,6 @@ begin InDisableApplicationWindows := false; end; - procedure EnableApplicationWindows(Window: HWND); var WindowInfo: PWindowInfo; @@ -1117,7 +1099,43 @@ begin end; end; -(* +function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean; +var + textSize: Windows.SIZE; + winHandle: HWND; + canvasHandle: HDC; + oldFontHandle: HFONT; + tmpText : PWideChar; +begin + winHandle := AWinControl.Handle; + canvasHandle := GetDC(winHandle); + oldFontHandle := SelectObject(canvasHandle, Windows.SendMessage(winHandle, WM_GetFont, 0, 0)); + DeleteAmpersands(Text); + tmpText := StringToPWideChar(Text); + Result := Windows.GetTextExtentPoint32(canvasHandle, PWideChar(tmpText), Length(Text), @textSize); + FreeMem(tmpText); + if Result then + begin + Width := textSize.cx; + Height := textSize.cy; + end; + SelectObject(canvasHandle, oldFontHandle); + ReleaseDC(winHandle, canvasHandle); +end; + +function GetControlText(AHandle: HWND): string; +var + TextLen: dword; + tmpWideStr : PWideChar; +begin + TextLen := GetWindowTextLength(AHandle); + tmpWideStr := PWideChar(SysAllocStringLen(nil,TextLen + 1)); + GetWindowText(AHandle, PWideChar(tmpWideStr), TextLen + 1); + Result := WideStringToString(widestring(tmpWideStr)); + FreeMem(tmpWideStr); +end; + + {------------------------------------------------------------------------------- procedure AddToChangedMenus(Window: HWnd); @@ -1144,80 +1162,17 @@ begin DrawMenuBar(HWND(ChangedMenus[I])); ChangedMenus.Clear; end; -*) -function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean; -var - textSize: Windows.SIZE; - winHandle: HWND; - canvasHandle: HDC; - oldFontHandle: HFONT; - tmpText : PWideChar; -begin - winHandle := AWinControl.Handle; - canvasHandle := GetDC(winHandle); - oldFontHandle := SelectObject(canvasHandle, Windows.SendMessage(winHandle, WM_GetFont, 0, 0)); - DeleteAmpersands(Text); - tmpText := CreatePWideCharFromString(Text); - Result := Windows.GetTextExtentPoint32(canvasHandle, PWideChar(tmpText), Length(Text), @textSize); - DisposePWideChar(tmpText); - if Result then - begin - Width := textSize.cx; - Height := textSize.cy; - end; - SelectObject(canvasHandle, oldFontHandle); - ReleaseDC(winHandle, canvasHandle); -end; - -function GetControlText(AHandle: HWND): string; -var - TextLen: dword; - tmpWideStr : PWideChar; -begin - TextLen := GetWindowTextLength(AHandle); - tmpWideStr := PWideChar(SysAllocStringLen(nil,TextLen + 1)); - GetWindowText(AHandle, PWideChar(tmpWideStr), TextLen + 1); - Result := WideStringToString(widestring(tmpWideStr)); - DisposePWideChar(tmpWideStr); -end; - - -{------------------------------------------------------------------------------- - procedure AddToChangedMenus(Window: HWnd); - - Adds Window to the list of windows which need to redraw the main menu. --------------------------------------------------------------------------------} -procedure AddToChangedMenus(Window: HWnd); -begin - if ChangedMenus.IndexOf(Pointer(Window)) = -1 then // Window handle is not yet in the list - ChangedMenus.Add(Pointer(Window)); -end; - -{------------------------------------------------------------------------------ - Method: RedrawMenus - Params: None - Returns: Nothing - - Redraws all changed menus - ------------------------------------------------------------------------------} -{procedure RedrawMenus; -var - I: integer; -begin - for I := 0 to ChangedMenus.Count - 1 do - DrawMenuBar(HWND(ChangedMenus[I])); - ChangedMenus.Clear; -end;} - - initialization FillChar(DefaultWindowInfo, sizeof(DefaultWindowInfo), 0); DefaultWindowInfo.DrawItemIndex := -1; + ChangedMenus := TList.Create; finalization //roozbeh:unless i implement enumprop i should free my tpropertylist myself! + ChangedMenus.Free; end. + diff --git a/lcl/interfaces/wince/wincewinapi.inc b/lcl/interfaces/wince/wincewinapi.inc index 0d4177e0fc..617c87d293 100644 --- a/lcl/interfaces/wince/wincewinapi.inc +++ b/lcl/interfaces/wince/wincewinapi.inc @@ -503,6 +503,67 @@ Begin Assert(False, Format('Trace:[TWinCEWidgetSet.CreateCompatibleDC] DC: 0x%x --> 0x%x', [Integer(DC), Integer(Result)])); End; +{------------------------------------------------------------------------------ + Method: CreateCursor + Params: AInstance - handle to instance; ACursorInfo - pointer to Cursor Information record + Returns: handle to a created cursor + + Creates a cursor by color and mask bitmaps and other indo. + ------------------------------------------------------------------------------} +Function TWinCEWidgetSet.CreateCursor(ACursorInfo: PIconInfo): hCursor; +{var + ConvertedInfo: TIconInfo; + AData: PByte; + ADataSize: PtrUInt; + ABitmap : Windows.TBitmap; + ABitmapInfo: TBitmapInfo; + DC: HDC; + i: integer; +} +begin + Result := 0; + // TODO: GetDIBits, SetDIBits dependent +{ + // create a copy of info to prevent it changing + Move(ACursorInfo^, ConvertedInfo, SizeOf(TIconInfo)); + if (GetObject(ACursorInfo^.hbmMask, SizeOf(ABitmap), @ABitmap) > 0) then + begin + // create new mask bitmap + ConvertedInfo.hbmMask := Windows.CreateBitmap(ABitmap.bmWidth, + ABitmap.bmHeight, 1, 1, nil); + if ConvertedInfo.hbmMask <> 0 then + begin + FillChar(ABitmapInfo, SizeOf(ABitmapInfo), 0); + ABitmapInfo.bmiHeader.biSize := SizeOf(ABitmapInfo.bmiHeader); + ABitmapInfo.bmiHeader.biWidth := ABitmap.bmWidth; + ABitmapInfo.bmiHeader.biHeight := -ABitmap.bmHeight; + ABitmapInfo.bmiHeader.biPlanes := 1; + ABitmapInfo.bmiHeader.biBitCount := ABitmap.bmBitsPixel; + ABitmapInfo.bmiHeader.biCompression := BI_RGB; + ADataSize := ((ABitmap.bmWidthBytes+3) and not 3) * ABitmap.bmHeight; + GetMem(AData, ADataSize); + DC := GetDC(0); + // get mask data + GetDIBits(DC, ACursorInfo^.hbmMask, 0, ABitmap.bmHeight, AData, + Windows.BitmapInfo(ABitmapInfo), DIB_RGB_COLORS); + // convert it + for i := 0 to ADataSize - 1 do + (AData + i)^ := (AData + i)^ xor $FF; + // set to new mask bitmap + SetDIBits(DC, ConvertedInfo.hbmMask, 0, ABitmap.bmHeight, AData, + Windows.BitmapInfo(ABitmapInfo), DIB_RGB_COLORS); + ReleaseDC(0, DC); + // create cursor + Result := Windows.CreateIconIndirect(@ConvertedInfo); + // no more need new bitmap + DeleteObject(ConvertedInfo.hbmMask); + // and data + FreeMem(AData); + end; + end; +} +end; + {------------------------------------------------------------------------------ Method: CreateFontIndirect Params: LogFont - logical font record @@ -640,6 +701,20 @@ End; begin Result:=inherited DestroyCaret(Handle); end;} + +{------------------------------------------------------------------------------ + Method: DestroyCursor + Params: Handle - handle to the cursor object + Returns: If the function succeeds + + Destroys the cursor + ------------------------------------------------------------------------------} +Function TWinCEWidgetSet.DestroyCursor(Handle: hCursor): Boolean; +Begin + Result := False; + //Result := Boolean(Windows.DestroyCursor(Handle)); +End; + {------------------------------------------------------------------------------ Method: DrawFrameControl Params: DC - handle to device context @@ -699,9 +774,9 @@ WideStr : PWideChar; begin Assert(False, Format('trace:> [TWinCEWidgetSet.DrawText] DC:0x%x, Str:''%s'', Count: %d, Rect = %d,%d,%d,%d, Flags:%d', [DC, Str, Count, Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, Flags])); - WideStr := CreatePWideCharFromString(String(str)); + WideStr := StringToPWideChar(String(str)); Result := Windows.DrawText(DC, WideStr, Count, @Rect, Flags); - DisposePWideChar(WideStr); + FreeMem(WideStr); Assert(False, Format('trace:> [TWinCEWidgetSet.DrawText] DC:0x%x, Str:''%s'', Count: %d, Rect = %d,%d,%d,%d, Flags:%d', [DC, Str, Count, Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, Flags])); end; @@ -820,9 +895,9 @@ var pWideStr : PWideChar; Begin Assert(False, Format('trace:> [TWinCEWidgetSet.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count])); - pWideStr := CreatePWideCharFromString(string(Str)); + pWideStr := StringToPWideChar(string(Str)); Result := Boolean(Windows.ExtTextOut(DC, X, Y, Options, LPRECT(Rect), pWideStr, Count, Dx)); - DisposePWideChar(pWideStr); + FreeMem(pWideStr); Assert(False, Format('trace:< [TWinCEWidgetSet.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count])); End; @@ -1056,12 +1131,12 @@ end; {function TWinCEWidgetSet.GetCmdLineParamDescForInterface: string; begin Result:=inherited GetCmdLineParamDescForInterface; -end; +end;} function TWinCEWidgetSet.GetCursorPos(var lpPoint: TPoint): Boolean; begin - Result:=inherited GetCursorPos(lpPoint); -end;} + Result := Boolean(Windows.GetCursorPos(@LPPoint)); +end; {------------------------------------------------------------------------------ Method: GetDC @@ -1187,7 +1262,6 @@ end; function TWinCEWidgetSet.GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer; begin Result := 0; - //Result := Windows.GetDIBits(DC, Bitmap, StartScan, NumScans, Bits, Windows.PBitmapInfo(@BitInfo)^, Usage) end; {function TWinCEWidgetSet.GetBitmapBits(Bitmap: HBITMAP; Count: Longint; Bits: Pointer): Longint; @@ -1354,8 +1428,6 @@ begin Windows.DeleteObject(hMemBitmap); end; - - procedure TWinCEWidgetSet.AllocAndCopy(const BitmapInfo: Windows.TBitmap; const BitmapHandle: HBITMAP; const SrcRect: TRect; var Data: PByte; var Size: Cardinal); @@ -1793,9 +1865,9 @@ WideStr : PWideChar; Begin Assert(False, 'Trace:[TWinCEWidgetSet.GetTextExtentPoint] - Start'); Result := false; - WideStr := CreatePWideCharFromString(String(Str)); + WideStr := StringToPWideChar(String(Str)); Result := Boolean(Windows.GetTextExtentExPoint(DC, WideStr, Count, 0,nil,nil,@Size)); - DisposePWideChar(WideStr); + FreeMem(WideStr); Assert(False, 'Trace:[TWinCEWidgetSet.GetTextExtentPoint] - Exit'); End; @@ -2127,11 +2199,11 @@ Function TWinCEWidgetSet.MessageBox(HWnd: HWND; LPText, LPCaption: PChar; UType: var LPWCaption,LPWText : PWideChar; Begin - LPWCaption := CreatePWideCharFromString(String(LPCaption)); - LPWText := CreatePWideCharFromString(String(LPText)); + LPWCaption := StringToPWideChar(String(LPCaption)); + LPWText := StringToPWideChar(String(LPText)); Result := Windows.MessageBox(HWnd, LPWText, LPWCaption, UType); - DisposePWideChar(LPWCaption); - DisposePWideChar(LPWText); + FreeMem(LPWCaption); + FreeMem(LPWText); End; {------------------------------------------------------------------------------ @@ -2598,6 +2670,11 @@ begin Result:=inherited SetCaretRespondToFocus(handle, ShowHideOnFocus); end;} +function TWinCEWidgetSet.SetCursor(hCursor: HICON): HCURSOR; +begin + Result := Windows.SetCursor(hCursor); +end; + {------------------------------------------------------------------------------ Function: SetCursorPos Params: X: diff --git a/lcl/interfaces/wince/wincewinapiemu.pp b/lcl/interfaces/wince/wincewinapiemu.pp index b3426edbaf..3d160e431d 100644 --- a/lcl/interfaces/wince/wincewinapiemu.pp +++ b/lcl/interfaces/wince/wincewinapiemu.pp @@ -62,6 +62,7 @@ PBM_SETRANGE32=WM_USER+6; var SYSCOLOR_55AABrush : HBRUSH; + function DrawState(dc:HDC ; hbr : HBRUSH ; func: DRAWSTATEPROC ; lp:LPARAM; wp:WPARAM;x,y,cx,cy:integer;flags:UINT) : boolean; function GetTopWindow(hWnd:HWND):HWND; @@ -88,7 +89,6 @@ h55AABitmap : HBITMAP;//when free it?! ThePropertyLists : PTPropertyListWindows; - function SetProp(_hWnd:HWND; {lpString:LPCSTR;} hData:HANDLE):WINBOOL; var pPrevPropertyLists,pPropertyLists : PTPropertyListWindows; @@ -451,3 +451,6 @@ finalization // FreePropList;//roozbeh:best place to call?! end. + + + diff --git a/lcl/interfaces/wince/wincewinapih.inc b/lcl/interfaces/wince/wincewinapih.inc index 467a51be86..c9ad74d3e6 100644 --- a/lcl/interfaces/wince/wincewinapih.inc +++ b/lcl/interfaces/wince/wincewinapih.inc @@ -68,6 +68,7 @@ function CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH; override; function CreateCaret(Handle : HWND; Bitmap : hBitmap; width, Height : Integer) : Boolean; override; function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; override; function CreateCompatibleDC(DC: HDC): HDC; override; +function CreateCursor(ACursorInfo: PIconInfo): hCursor; Override; function CreateDIBitmap(DC: HDC; var InfoHeader: TBitmapInfoHeader;dwUsage: DWORD; InitBits: PChar; var InitInfo: TBitmapInfo; wUsage: UINT): HBITMAP; override; function CreateDIBSection(DC: HDC; const p2: tagBitmapInfo; p3: UINT; var p4: Pointer; p5: THandle; p6: DWORD): HBITMAP; Override; @@ -84,6 +85,7 @@ function DeleteDC(hDC: HDC): Boolean; override; function DeleteObject(GDIObject: HGDIOBJ): Boolean; override; //function DestroyCaret(Handle : HWND): Boolean; override; Function DrawFrameControl(DC: HDC; const Rect : TRect; uType, uState : Cardinal) : Boolean; override; +function DestroyCursor(Handle: hCursor): Boolean; Override; function DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal; grfFlags: Cardinal): Boolean; override; function DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer; Override; @@ -119,8 +121,8 @@ Function GetClientBounds(handle : HWND; var Rect : TRect) : Boolean; override; Function GetClientRect(handle : HWND; var Rect : TRect) : Boolean; override; Function GetClipBox(DC : hDC; lpRect : PRect) : Longint; override; Function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; override; -{Function GetCmdLineParamDescForInterface: string; override; -function GetCursorPos(var lpPoint: TPoint): Boolean; override;} +{Function GetCmdLineParamDescForInterface: string; override;} +function GetCursorPos(var lpPoint: TPoint): Boolean; override; function GetDC(hWnd: HWND): HDC; override; function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; override; {function GetDesignerDC(WindowHandle: HWND): HDC; override;} @@ -200,8 +202,9 @@ Function SetBkMode(DC: HDC; bkMode : Integer) : Integer; override; function SetCapture(AHandle: HWND): HWND; override; function SetCaretPos(X, Y: Integer): Boolean; override; function SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean; override; -function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; override; -function SetCursorPos(X, Y: Integer): Boolean; override;} +function SetCaretRespondToFocus(handle: HWND; ShowHideOnFocus: boolean): Boolean; override;} +function SetCursor(hCursor: HICON): HCURSOR; override; +//function SetCursorPos(X, Y: Integer): Boolean; override; function SetFocus(hWnd: HWND): HWND; override; //Function SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean; override; function SetROP2(DC: HDC; Mode: Integer): Integer; override; @@ -229,3 +232,7 @@ Function WindowFromPoint(Point : TPoint) : HWND; override; //##apiwiz##eps## // Do not remove, no wizard declaration after this line + + + + diff --git a/lcl/interfaces/wince/wincewsbuttons.pp b/lcl/interfaces/wince/wincewsbuttons.pp index a54ce5b3ed..8c8f46021c 100644 --- a/lcl/interfaces/wince/wincewsbuttons.pp +++ b/lcl/interfaces/wince/wincewsbuttons.pp @@ -119,7 +119,7 @@ begin // Flags := Flags or BS_PUSHBUTTON; Flags := WS_CHILD or WS_VISIBLE; pClassName := @ButtonClsName; - WindowTitle := CreatePWideCharFromString(StrCaption); + WindowTitle := StringToPWideChar(StrCaption); Left := AWinControl.Left; Top := AWinControl.Top; Width := AWinControl.Width; @@ -175,9 +175,9 @@ class procedure TWinCEWSButton.SetText(const AWinControl: TWinControl; const ATe var tmpStr : PWideChar; begin - tmpstr := CreatePWideCharFromString(AText); + tmpstr := StringToPWideChar(AText); Windows.SetWindowText(AWinControl.Handle,tmpStr); - DisposePWideChar(tmpStr); + FreeMem(tmpStr); end; { TWinCEWSBitBtn } @@ -345,9 +345,9 @@ begin BitBtnDC := GetDC(BitBtnHandle); hdcNewBitmap := CreateCompatibleDC(BitBtnDC); OldFontHandle := SelectObject(hdcNewBitmap, BitBtn.Font.Handle); - tmpWideText := CreatePWideCharFromString(ButtonCaption); + tmpWideText := StringToPWideChar(ButtonCaption); GetTextExtentPoint32(hdcNewBitmap, tmpWideText, Length(ButtonCaption), @TextSize); - DisposePWideChar(tmpWideText); + FreeMem(tmpWideText); // calculate size of new bitmap case BitBtnLayout of blGlyphLeft, blGlyphRight: @@ -577,9 +577,9 @@ begin TWinCEWSWinControl.SetBounds(AWinControl, ALeft, ATop, AWidth, AHeight); if TCustomBitBtn(AWinControl).Spacing = -1 then begin - pwCaption := CreatePWideCharFromString(AWinControl.Caption); + pwCaption := StringToPWideChar(AWinControl.Caption); DrawBitBtnImage(TCustomBitBtn(AWinControl), pwCaption); - DisposePWideChar(pwCaption); + FreeMem(pwCaption); end; end; @@ -589,9 +589,9 @@ var pwCaption : PWideChar; begin TWinCEWSWinControl.SetFont(AWinControl, AFont); - pwCaption := CreatePWideCharFromString(AWinControl.Caption); + pwCaption := StringToPWideChar(AWinControl.Caption); DrawBitBtnImage(TCustomBitBtn(AWinControl), pwCaption); - DisposePWideChar(pwCaption); + FreeMem(pwCaption); end; class procedure TWinCEWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn; @@ -599,9 +599,9 @@ class procedure TWinCEWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn; var pwCaption : PWideChar; begin - pwCaption := CreatePWideCharFromString(ABitBtn.Caption); + pwCaption := StringToPWideChar(ABitBtn.Caption); DrawBitBtnImage(ABitBtn, pwCaption); - DisposePWideChar(pwCaption); + FreeMem(pwCaption); end; class procedure TWinCEWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn; @@ -609,9 +609,9 @@ class procedure TWinCEWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn; var pwCaption : PWideChar; begin - pwCaption := CreatePWideCharFromString(ABitBtn.Caption); + pwCaption := StringToPWideChar(ABitBtn.Caption); DrawBitBtnImage(ABitBtn, pwCaption); - DisposePWideChar(pwCaption); + FreeMem(pwCaption); end; class procedure TWinCEWSBitBtn.SetMargin(const ABitBtn: TCustomBitBtn; @@ -619,9 +619,9 @@ class procedure TWinCEWSBitBtn.SetMargin(const ABitBtn: TCustomBitBtn; var pwCaption : PWideChar; begin - pwCaption := CreatePWideCharFromString(ABitBtn.Caption); + pwCaption := StringToPWideChar(ABitBtn.Caption); DrawBitBtnImage(ABitBtn, pwCaption); - DisposePWideChar(pwCaption); + FreeMem(pwCaption); end; class procedure TWinCEWSBitBtn.SetSpacing(const ABitBtn: TCustomBitBtn; @@ -629,18 +629,18 @@ class procedure TWinCEWSBitBtn.SetSpacing(const ABitBtn: TCustomBitBtn; var pwCaption : PWideChar; begin - pwCaption := CreatePWideCharFromString(ABitBtn.Caption); + pwCaption := StringToPWideChar(ABitBtn.Caption); DrawBitBtnImage(ABitBtn, pwCaption); - DisposePWideChar(pwCaption); + FreeMem(pwCaption); end; class procedure TWinCEWSBitBtn.SetText(const AWinControl: TWinControl; const AText: string); var pwCaption : PWideChar; begin - pwCaption := CreatePWideCharFromString(AText); + pwCaption := StringToPWideChar(AText); DrawBitBtnImage(TCustomBitBtn(AWinControl), pwCaption); - DisposePWideChar(pwCaption); + FreeMem(pwCaption); end; diff --git a/lcl/interfaces/wince/wincewscomctrls.pp b/lcl/interfaces/wince/wincewscomctrls.pp index b775d43280..ef1da2fbbc 100644 --- a/lcl/interfaces/wince/wincewscomctrls.pp +++ b/lcl/interfaces/wince/wincewscomctrls.pp @@ -257,9 +257,9 @@ begin pbLowered: BevelType := 0; pbRaised: BevelType := Windows.SBT_POPOUT; end; - pwText := CreatePWideCharFromString(Text); + pwText := StringToPWideChar(Text); Windows.SendMessage(StatusPanel.StatusBar.Handle, SB_SETTEXT, StatusPanel.Index or BevelType, LPARAM(pwText)); - DisposePWideChar(pwText); + FreeMem(pwText); end; procedure UpdateStatusBarPanelWidths(const StatusBar: TStatusBar); @@ -352,9 +352,9 @@ tmpSimpleText : PWideChar; begin if AStatusBar.SimplePanel then begin - tmpSimpleText := CreatePWideCharFromString(AStatusBar.SimpleText); + tmpSimpleText := StringToPWideChar(AStatusBar.SimpleText); Windows.SendMessage(AStatusBar.Handle, SB_SETTEXT, 255, LPARAM(PWideChar(tmpSimpleText))); - DisposePWideChar(tmpSimpleText); + FreeMem(tmpSimpleText); end else UpdateStatusBarPanel(AStatusBar.Panels[PanelIndex]); @@ -485,7 +485,7 @@ begin Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!'); If (AControl is TWinControl) Then Begin - PStr := CreatePWideCharFromString(TToolButton(AControl).Caption); + PStr := StringToPWideChar(TToolButton(AControl).Caption); End Else Begin @@ -509,7 +509,7 @@ begin SendMessage(TWinControl(AControl).Parent.Handle, TB_BUTTONSTRUCTSIZE, SizeOf(TBBUTTON), 0); SendMessage(TWinControl(AControl).Parent.Handle, TB_ADDBUTTONS, 1, LParam(LPTBButton(@tbb))); - DisposePWideChar(PStr); + FreeMem(PStr); Assert(False, 'Trace:!!!!!!!!!!!!!!!!!!!!!!!!!'); end; diff --git a/lcl/interfaces/wince/wincewscontrols.pp b/lcl/interfaces/wince/wincewscontrols.pp index 526b42baa9..1acf75280f 100644 --- a/lcl/interfaces/wince/wincewscontrols.pp +++ b/lcl/interfaces/wince/wincewscontrols.pp @@ -176,7 +176,7 @@ begin SubClassWndProc := @WindowProc; WindowTitle := nil; - StrCaption := CreatePWideCharFromString(AWinControl.Caption); + StrCaption := StringToPWideChar(AWinControl.Caption); WindowTitle := nil; Height := AWinControl.Height; Left := AWinControl.Left; @@ -447,9 +447,9 @@ var begin if not WSCheckHandleAllocated(AWincontrol, 'SetText') then Exit; - tmpStr := CreatePWideCharFromString(AText); + tmpStr := StringToPWideChar(AText); Windows.SetWindowText(AWinControl.Handle, PWideChar(tmpStr)); - DisposePWideChar(tmpStr); + FreeMem(tmpStr); end; class procedure TWinCEWSWinControl.ConstraintsChange(const AWinControl: TWinControl); diff --git a/lcl/interfaces/wince/wincewscustomlistview.inc b/lcl/interfaces/wince/wincewscustomlistview.inc index 3a00ca67b4..cd2e5c2134 100644 --- a/lcl/interfaces/wince/wincewscustomlistview.inc +++ b/lcl/interfaces/wince/wincewscustomlistview.inc @@ -110,10 +110,10 @@ begin then Exit; lvc.Mask := LVCF_TEXT; - lvc.pszText := CreatePWideCharFromString(AColumn.Caption); + lvc.pszText := StringToPWideChar(AColumn.Caption); ListView_InsertColumn(ALV.Handle, AIndex, lvc); - DisposePWideChar(lvc.pszText); + FreeMem(lvc.pszText); end; class procedure TWinCEWSCustomListView.ColumnMove(const ALV: TCustomListView; const AOldIndex, ANewIndex: Integer; const AColumn: TListColumn); @@ -195,10 +195,10 @@ begin then Exit; lvc.Mask := LVCF_TEXT; - lvc.pszText := CreatePWideCharFromString(ACaption); + lvc.pszText := StringToPWideChar(ACaption); ListView_SetColumn(ALV.Handle, AIndex, lvc); - DisposePWideChar(lvc.pszText); + FreeMem(lvc.pszText); end; class procedure TWinCEWSCustomListView.ColumnSetImage(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AImageIndex: Integer); @@ -302,10 +302,10 @@ begin lvi.Mask := LVIF_TEXT; lvi.iItem := AIndex; lvi.iSubItem := 0; - lvi.pszText := CreatePWideCharFromString(AItem.Caption); + lvi.pszText := StringToPWideChar(AItem.Caption); ListView_InsertItem(ALV.Handle, lvi); - DisposePWideChar(lvi.pszText); + FreeMem(lvi.pszText); end; class procedure TWinCEWSCustomListView.ItemSetImage(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex, AImageIndex: Integer); @@ -345,9 +345,9 @@ begin if not WSCheckHandleAllocated(ALV, 'ItemSetText') then Exit; - tmpAText := CreatePWideCharFromString(AText); + tmpAText := StringToPWideChar(AText); ListView_SetItemText(ALV.Handle, AIndex, ASubIndex, PWideChar(tmpAText)); - DisposePWideChar(tmpAText); + FreeMem(tmpAText); end; class procedure TWinCEWSCustomListView.ItemShow(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const PartialOK: Boolean); @@ -748,3 +748,6 @@ begin Windows.InvalidateRect(AHandle, nil, true);} end; + + + diff --git a/lcl/interfaces/wince/wincewsmenus.pp b/lcl/interfaces/wince/wincewsmenus.pp new file mode 100644 index 0000000000..63f5dc99fd --- /dev/null +++ b/lcl/interfaces/wince/wincewsmenus.pp @@ -0,0 +1,821 @@ +{ + ***************************************************************************** + * WinCEWSMenus.pp * + * --------------- * + * * + * * + ***************************************************************************** + + ***************************************************************************** + * * + * This file is part of the Lazarus Component Library (LCL) * + * * + * See the file COPYING.modifiedLGPL, 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. * + * * + ***************************************************************************** +} +unit WinCEWSMenus; + +{$mode objfpc}{$H+} + +interface + +uses +//////////////////////////////////////////////////// +// I M P O R T A N T +//////////////////////////////////////////////////// +// To get as little as posible circles, +// uncomment only when needed for registration +//////////////////////////////////////////////////// + Menus, Forms, +//////////////////////////////////////////////////// + WSMenus, WSLCLClasses, + Windows, Controls, Classes, SysUtils, WinceInt, WinceProc, InterfaceBase, LCLProc; + +type + + { TWinCEWSMenuItem } + + TWinCEWSMenuItem = class(TWSMenuItem) + private + protected + public + class procedure AttachMenu(const AMenuItem: TMenuItem); override; + class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override; + class procedure DestroyHandle(const AMenuItem: TMenuItem); override; + class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override; + class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); override; + class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override; + class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override; + end; + + { TWin32WSMenu } + + TWinCEWSMenu = class(TWSMenu) + private + protected + public + class function CreateHandle(const AMenu: TMenu): HMENU; override; + end; + + { TWin32WSMainMenu } + + TWinCEWSMainMenu = class(TWSMainMenu) + private + protected + public + end; + + { TWin32WSPopupMenu } + + TWinCEWSPopupMenu = class(TWSPopupMenu) + private + protected + public + class function CreateHandle(const AMenu: TMenu): HMENU; override; + class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override; + end; + + function MenuItemSize(aMenuItem: TMenuItem; aHDC: HDC): TSize; + procedure DrawMenuItem(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean); + function FindMenuItemAccelerator(const ACharCode: char; const AMenuHandle: HMENU): integer; + +const +//having left or right submenus [true,false] means right have submenu,left doesnt have + MenuBarIDS : array[false..true,false..true] of integer =((101,105),(106,107)); + MenuBarID_L = 40052; + MenuBarID_R = 40053; + +var + MenuItemsList : TStringList; + + procedure CeSetMenu(Wnd: HWND; Menu: HMENU); + +implementation + +uses strutils; + +{.$R wincemenures.res} + +{ helper routines } + +const + SpaceBetweenIcons = 5; + +var + menuiteminfosize : DWORD = 0; + +type + TCaptionFlags = (cfBold, cfUnderline); + TCaptionFlagsSet = set of TCaptionFlags; + + + + +//menus + +const +SPI_GETPLATFORMTYPE = 257;//roozbeh : should be moved to windows unit + +function WStrCmp( W1, W2: PWideChar ): Integer; +var + counter: Integer; +Begin + counter := 0; + While W1[counter] = W2[counter] do + Begin + if (W2[counter] = #0) or (W1[counter] = #0) then + break; + Inc(counter); + end; + Result := ord(W1[counter]) - ord(W2[counter]); +end; + + +function IsSmartPhone : Boolean; +var +buf:array[0..255] of WideChar; +s:widestring; +begin +Result := false; +if SystemParametersInfo(SPI_GETPLATFORMTYPE,sizeof(buf),@buf,0) then + if WStrCmp(@buf,PWideChar('SmartPhone')) = 0 then + Result := true + else + Result := false//roozbeh : either it is 'PocketPC' or something else :) +else + if GetLastError=ERROR_ACCESS_DENIED then + Result := true; +end; + +//both menus are popup menus or submenus +procedure CeMakeMenuesSame(SrcMenu,dstMenu : HMENU); +var +i: integer; +mi: MENUITEMINFO; +buf: array[0..255] of WideChar; +fState:integer; +hPop : HMENU; +uIDNewItem : integer; +begin +while RemoveMenu(dstMenu,0,MF_BYPOSITION) do ; +i:=0; +mi.cbSize:=SizeOf(mi); +mi.fMask:=MIIM_SUBMENU or MIIM_TYPE or MIIM_ID or MIIM_STATE; +mi.dwTypeData:=@buf; + +while GetMenuItemInfo(srcMenu, i, True, mi) do begin + buf[mi.cch]:=#0; + fState:=MF_STRING; + if mi.fState and MFS_DISABLED <> 0 then + fState:=fState or MF_GRAYED ; + if mi.fState and MFS_CHECKED <> 0 then + fState:=fState or MF_CHECKED; + uIDNewItem := mi.wID; + if mi.hSubMenu <> 0 then + begin + uIDNewItem := mi.hSubMenu; + fstate := fstate or MF_POPUP; + end; + AppendMenu(dstMenu,fState,uIDNewItem,@buf); + inc(i); +end; +end; + +procedure CeSetMenu(Wnd: HWND; Menu: HMENU); +var + mbi: SHMENUBARINFO; + mi: MENUITEMINFO; + tb: TBButton; + tbbi : TBBUTTONINFO; + i: integer; + buf: array[0..255] of WideChar; + R, BR: TRect; + hr : HResult; + hasLMenu,hasRMenu : boolean; + MenuBarRLID : integer; +begin + hasLMenu := false; + hasRMenu := false; + FillChar(mi, SizeOf(mi), 0); + with mi do begin + cbSize:=SizeOf(mi); + fMask:=MIIM_SUBMENU or MIIM_TYPE or MIIM_ID or MIIM_STATE; + dwTypeData:=@buf; + end; + + if Menu <> 0 then begin + if GetMenuItemInfo(Menu, 0, True, mi) then//does it have left menu? + hasLMenu := True; + if GetMenuItemInfo(Menu, 1, True, mi) then//does it have right menu? + hasRMenu := True; + end; + + GetWindowRect(Wnd, BR); + mbi.hwndMB:=SHFindMenuBar(Wnd); + FillChar(mbi, SizeOf(mbi), 0); + with mbi do begin + cbSize:=SizeOf(mbi); + hwndParent:=Wnd; + dwFlags:=SHCMBF_HMENU; + nToolBarId:=MenuBarIDS[hasLMenu,hasRMenu]; + hInstRes:=HINSTANCE; + end; + + {if found a menubar check if it matches number of buttons of previous menubar...} + if (mbi.hwndMB = 0) or ( + (not ((boolean(SendMessage (mbi.hwndMB, TB_COMMANDTOINDEX, MenuBarID_L, 0) + 1)) xor (hasLMenu))) and + (not ((boolean(SendMessage (mbi.hwndMB, TB_COMMANDTOINDEX, MenuBarID_R, 0) + 1)) xor (hasRMenu)))) + then begin + if not SHCreateMenuBar(@mbi) then + begin + //MsgBox('not ok',0); + exit; + end; + end; + while SendMessage(mbi.hwndMB, TB_DELETEBUTTON, 0, 0) <> 0 do ; + + with mi do begin + cbSize:=SizeOf(mi); + fMask:=MIIM_SUBMENU or MIIM_TYPE or MIIM_ID or MIIM_STATE; + dwTypeData:=@buf; + end; + + if Menu <> 0 then begin + i:=0; + while True do begin + mi.cch:=SizeOf(buf); + if not GetMenuItemInfo(Menu, i, True, @mi) then + break; + buf[mi.cch]:=#0; + FillChar(tb, SizeOf(tb), 0); + tb.iBitmap:=I_IMAGENONE; + tb.idCommand:=mi.wID; + tb.iString:=SendMessage(mbi.hwndMB, TB_ADDSTRING, 0, LPARAM(@buf)); + if mi.fState and MFS_DISABLED = 0 then + tb.fsState:=TBSTATE_ENABLED; + if mi.fState and MFS_CHECKED <> 0 then + tb.fsState:=tb.fsState or TBSTATE_CHECKED; + if mi.hSubMenu <> 0 then + tb.fsStyle:=TBSTYLE_DROPDOWN or $0080 or TBSTYLE_AUTOSIZE + else + tb.fsStyle:=TBSTYLE_BUTTON or TBSTYLE_AUTOSIZE; + tb.dwData:=mi.hSubMenu; + {roozbeh : this wont work on 2002/2003...should i uncomment it or not?works this way anyway} + SendMessage(mbi.hwndMB, TB_INSERTBUTTON, i, LPARAM(@tb)); + //MsgBox('i = ' + int2str(i),0); + + if (IsSmartphone) and (i < 2) then{Smartphones can have only 2 buttons!} + begin + case i of + 0: MenuBarRLID := MenuBarID_L; + 1 : MenuBarRLID := MenuBarID_R; + end; + tbbi.cbSize := sizeof(tbbi); + tbbi.pszText := @buf; + tbbi.dwMask := TBIF_TEXT; + SendMessage(mbi.hwndMB,TB_SETBUTTONINFO,MenuBarRLID,LPARAM(@tbbi)); + tbbi.dwMask := TBIF_LPARAM; + SendMessage (mbi.hwndMB, TB_GETBUTTONINFO, MenuBarRLID, LPARAM(@tbbi)); + CeMakeMenuesSame(mi.hSubMenu,HMENU(tbbi.lParam)); + end; + + Inc(i); + end; + end; + + GetWindowRect(mbi.hwndMB, R); +// if BR.Bottom > R.Top then +// SetWindowPos(wnd, 0, 0, 0, BR.Right - BR.Left, R.Top - BR.Top, SWP_NOZORDER or SWP_NOREPOSITION or SWP_NOMOVE); + +//DrawMenuBar(wnd); +end; + + + +(* Returns index of the character in the menu item caption that is displayed + as underlined and is therefore the hot key of the menu item. + If the caption does not contain any underlined character, 0 is returned. + If there are more "underscored" characters in the caption, the last one is returned. + Does some Windows API function exists which can do the same? + AnUnderlinedChar - character which tells that tne following character should be underlined + ACaption - menu item caption which is parsed *) +function SearchMenuItemHotKeyIndex(const AnUnderlinedChar: char; ACaption: string): integer; +var position: integer; +begin + position := pos(AnUnderlinedChar, ACaption); + Result := 0; + // if aChar is on the last position then there is nothing to underscore, ignore this character + while (position > 0) and (position < length(ACaption)) do + begin + // two 'AnUnderlinedChar' characters together are not valid hot key, they are replaced by one + if ACaption[position + 1] <> AnUnderlinedChar then + Result := position + 1; + position := posEx(AnUnderlinedChar, ACaption, position + 2); + end; +end; + +function FindMenuItemAccelerator(const ACharCode: char; const AMenuHandle: HMENU): integer; +var MenuItemIndex: integer; + ItemInfo: MENUITEMINFO; + FirstMenuItem: TMenuItem; + SiblingMenuItem: TmenuItem; + HotKeyIndex: integer; + i: integer; +begin + Result := MakeLResult(0, 0); + MenuItemIndex := -1; + ItemInfo.cbSize := menuiteminfosize; + ItemInfo.fMask := MIIM_DATA; + if not GetMenuItemInfo(AMenuHandle, 0, true, @ItemInfo) then Exit; + FirstMenuItem := TMenuItem(ItemInfo.dwItemData); + if FirstMenuItem = nil then exit; + i := 0; + while (i < FirstMenuItem.Parent.Count) and (MenuItemIndex < 0) do + begin + SiblingMenuItem := FirstMenuItem.Parent.Items[i]; + HotKeyIndex := SearchMenuItemHotKeyIndex('&', SiblingMenuItem.Caption); + if (HotKeyIndex > 0) and + (Upcase(ACharCode) = Upcase(SiblingMenuItem.Caption[HotKeyIndex])) then + MenuItemIndex := i; + inc(i); + end; + if MenuItemIndex > -1 then Result := MakeLResult(MenuItemIndex, 2) + else Result := MakeLResult(0, 0); +end; + + +function GetMenuItemFont(const aFlags: TCaptionFlagsSet): HFONT; +var + lf: LOGFONT; + ncm: NONCLIENTMETRICS; +begin + ncm.cbSize:= sizeof(ncm); + if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncm), @ncm, 0) then + lf:= ncm.lfMenuFont + else + GetObject(GetStockObject(DEFAULT_GUI_FONT), sizeof(LOGFONT), @lf); + if cfUnderline in aFlags then lf.lfUnderline := 1 + else lf.lfUnderline := 0; + if cfBold in aFlags then + begin + if lf.lfWeight<=400 then + lf.lfWeight:= lf.lfWeight + 300 + else + lf.lfWeight:= lf.lfWeight + 100; + end; + Result := CreateFontIndirect(@lf); +end; + +(* Get the menu item caption including shortcut *) +function CompleteMenuItemCaption(const aMenuItem: TMenuItem): string; +begin + Result := aMenuItem.Caption; + if aMenuItem.shortCut <> scNone then + Result := Result + ShortCutToText(aMenuItem.shortCut); +end; + +(* Get the maximum length of the given string in pixels *) +function StringSize(const aCaption: String; const aHDC: HDC; const aDecoration:TCaptionFlagsSet): TSize; +var oldFont: HFONT; + newFont: HFONT; + tmpRect: Windows.RECT; + wCaption : WideString; +begin + tmpRect.right := 0; + tmpRect.left := 0; + newFont := getMenuItemFont(aDecoration); + oldFont := SelectObject(aHDC, newFont); + wCaption := aCaption; + DrawText(aHDC, pWideChar(wCaption), length(aCaption), TmpRect, DT_CALCRECT); + SelectObject(aHDC, oldFont); + DeleteObject(newFont); + Result.cx := TmpRect.right - TmpRect.left; + Result.cy := TmpRect.Bottom - TmpRect.Top; +end; + +function LeftIconPosition: integer; +begin + Result := GetSystemMetrics(SM_CXMENUCHECK); +end; + +function MenuIconWidth(const AMenuItem: TMenuItem): integer; +var + SiblingMenuItem : TMenuItem; + i : integer; + RequiredWidth: integer; +begin + Result := 0; + for i:= 0 to AMenuItem.Parent.Count -1 do begin + SiblingMenuItem := AMenuItem.Parent.Items[i]; + if SiblingMenuItem.HasIcon then begin + RequiredWidth := SiblingMenuItem.Bitmap.Width; + if RequiredWidth > Result then + Result := RequiredWidth; + end; + end; + Result := Result + LeftIconPosition; +end; + +function MenuItemSize(aMenuItem: TMenuItem; aHDC: HDC): TSize; +var + decoration: TCaptionFlagsSet; + minimumHeight: Integer; +begin + if aMenuItem.Default then + decoration := [cfBold] + else + decoration := []; + Result := StringSize(CompleteMenuItemCaption(aMenuItem), aHDC, decoration); + if not aMenuItem.IsInMenuBar then + Inc(Result.cx, MenuIconWidth(aMenuItem) + (2 * spaceBetweenIcons)); + if aMenuItem.ShortCut <> scNone then + Inc(Result.cx, spaceBetweenIcons); + + minimumHeight := GetSystemMetrics(SM_CYMENU); + if not aMenuItem.IsInMenuBar then + Dec(minimumHeight, 2); + if aMenuItem.IsLine then + Result.cy := 10 // it is a separator + else + begin + if aMenuItem.hasIcon and (aMenuItem.bitmap.height > Result.cy) then + Result.cy := aMenuItem.bitmap.height; + Inc(Result.cy, 2); + if Result.cy < minimumHeight then + Result.cy := minimumHeight; + end; +end; + +function LeftCaptionPosition(const aMenuItemLength: integer; const anElementLength: integer; const AMenuItem: TMenuItem): integer; +begin + if AMenuItem.IsInMenuBar then Result := (aMenuItemLength - anElementLength) div 2 + else Result := MenuIconWidth(AMenuItem) + SpaceBetweenIcons; +end; + +function TopPosition(const aMenuItemHeight: integer; const anElementHeight: integer): integer; +begin + Result := (aMenuItemHeight - anElementHeight) div 2; +end; + +function BackgroundColorMenu(const aSelected: boolean; const aInMainMenu: boolean): COLORREF; +var IsFlatMenu: Windows.BOOL; +begin + if aSelected then + Result := GetSysColor(COLOR_HIGHLIGHT) + // SPI_GETFLATMENU = 0x1022, it is not yet defined in the FPC + else if aInMainMenu and (SystemParametersInfo($1022, 0, @IsFlatMenu, 0)) and IsFlatMenu then // COLOR_MENUBAR is not supported on Windows version < XP + Result := GetSysColor(COLOR_MENUBAR) + else + Result := GetSysColor(COLOR_MENU); +end; + +function TextColorMenu(const aSelected: boolean; const anEnabled: boolean): COLORREF; +begin + if anEnabled then + begin + if aSelected then + Result := GetSysColor(COLOR_HIGHLIGHTTEXT) + else + Result := GetSysColor(COLOR_MENUTEXT); + end else + Result := GetSysColor(COLOR_GRAYTEXT); +end; + +procedure DrawSeparator(const aHDC: HDC; const aRect: Windows.RECT); +var separatorRect: Windows.RECT; +begin + separatorRect.left := aRect.left; + separatorRect.right := aRect.right; + separatorRect.top := aRect.top + (aRect.bottom - aRect.top) div 2 - 1; + separatorRect.bottom := separatorRect.top + 2; + DrawEdge(aHDC, separatorRect, BDR_SUNKENOUTER, BF_RECT); +end; + +procedure DrawMenuItemCheckMark(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean); +var checkMarkWidth: integer; + checkMarkHeight: integer; + hdcMem: HDC; + monoBitmap: HBITMAP; + oldBitmap: HBITMAP; + checkMarkShape: integer; + checkMarkRect: Windows.RECT; +begin + hdcMem := CreateCompatibleDC(aHDC); + checkMarkWidth := GetSystemMetrics(SM_CXMENUCHECK); + checkMarkHeight := GetSystemMetrics(SM_CYMENUCHECK); + monoBitmap := CreateBitmap(checkMarkWidth, checkMarkHeight, 1, 1, nil); + oldBitmap := SelectObject(hdcMem, monoBitmap); + checkMarkRect.left := 0; + checkMarkRect.top := 0; + checkMarkRect.right := checkMarkWidth; + checkMarkRect.bottom := checkMarkHeight; + if aMenuItem.RadioItem then checkMarkShape := DFCS_MENUBULLET + else checkMarkShape := DFCS_MENUCHECK; + DrawFrameControl(hdcMem, @checkMarkRect, DFC_MENU, checkMarkShape); + BitBlt(aHDC, aRect.left, aRect.top + topPosition(aRect.bottom - aRect.top, checkMarkRect.bottom - checkMarkRect.top), checkMarkWidth, checkMarkHeight, hdcMem, 0, 0, SRCCOPY); + SelectObject(hdcMem, oldBitmap); + DeleteObject(monoBitmap); + DeleteDC(hdcMem); +end; + +procedure DrawMenuItemText(const aMenuItem: TMenuItem; const aHDC: HDC; aRect: Windows.RECT; const aSelected: boolean); +var crText: COLORREF; + crBkgnd: COLORREF; + TmpLength: integer; + TmpHeight: integer; + oldFont: HFONT; + newFont: HFONT; + decoration: TCaptionFlagsSet; + shortCutText: string; + WorkRect: Windows.RECT; + wCaption : WideString; +begin + crText := TextColorMenu(aSelected, aMenuItem.Enabled); + crBkgnd := BackgroundColorMenu(aSelected, aMenuItem.IsInMenuBar); + SetTextColor(aHDC, crText); + SetBkColor(aHDC, crBkgnd); + if aMenuItem.Default then decoration := [cfBold] + else decoration := []; + newFont := getMenuItemFont(decoration); + oldFont := SelectObject(aHDC, newFont); + ExtTextOut(aHDC, 0, 0, ETO_OPAQUE, @aRect, PWideChar(''), 0, nil); + TmpLength := aRect.right - aRect.left; + TmpHeight := aRect.bottom - aRect.top; + wCaption := aMenuItem.Caption; + DrawText(aHDC, pWideChar(wCaption), length(aMenuItem.Caption), WorkRect, DT_CALCRECT); + Inc(aRect.Left, leftCaptionPosition(TmpLength, WorkRect.Right - WorkRect.Left, aMenuItem)); + Inc(aRect.Top, topPosition(TmpHeight, WorkRect.Bottom - WorkRect.Top)); + DrawText(aHDC, pWideChar(wCaption), length(aMenuItem.Caption), aRect, 0); + if aMenuItem.ShortCut <> scNone then + begin + shortCutText := ShortCutToText(aMenuItem.ShortCut); + Dec(aRect.Right, GetSystemMetrics(SM_CXMENUCHECK)); + wCaption := shortCutText; + DrawText(aHDC, pWideChar(wCaption), Length(shortCutText), aRect, DT_RIGHT); + end; + SelectObject(aHDC, oldFont); + DeleteObject(newFont); +end; + +procedure DrawMenuItemIcon(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean); +var hdcMem: HDC; + hbmpOld: HBITMAP; +begin + hdcMem := aMenuItem.Bitmap.Canvas.Handle; + hbmpOld := SelectObject(hdcMem, aMenuItem.Bitmap.Handle); + TWinCEWidgetSet(WidgetSet).MaskBlt(aHDC, aRect.left + LeftIconPosition, aRect.top + TopPosition(aRect.bottom - aRect.top, aMenuItem.Bitmap.Height), aMenuItem.Bitmap.Width, aMenuItem.Bitmap.Height, hdcMem, 0, 0, aMenuItem.Bitmap.MaskHandle, 0, 0); + SelectObject(hdcMem, hbmpOld); +end; + +procedure DrawMenuItem(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean); +begin + if aMenuItem.IsLine then + DrawSeparator(aHDC, aRect) + else begin + DrawMenuItemText(aMenuItem, aHDC, aRect, aSelected); + if aMenuItem.Checked then + DrawMenuItemCheckMark(aMenuItem, aHDC, aRect, aSelected); + if aMenuItem.hasIcon then + DrawMenuItemIcon(aMenuItem, aHDC, aRect, aSelected); + end; +end; + + +procedure TriggerFormUpdate(const AMenuItem: TMenuItem); +var + lMenu: TMenu; +begin + lMenu := AMenuItem.GetParentMenu; + if (lMenu<>nil) and (lMenu.Parent<>nil) + and (lMenu.Parent is TCustomForm) + and TCustomForm(lMenu.Parent).HandleAllocated + and not (csDestroying in lMenu.Parent.ComponentState) then + AddToChangedMenus(TCustomForm(lMenu.Parent).Handle); +end; + +function ChangeMenuFlag(const AMenuItem: TMenuItem; Flag: Integer; Value: boolean): boolean; +var + MenuInfo: MENUITEMINFO; + wCaption : WideString; +begin + MenuInfo.cbSize := menuiteminfosize; + MenuInfo.fMask := MIIM_TYPE; + MenuInfo.dwTypeData := nil; // don't retrieve caption + GetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo); + if Value then + MenuInfo.fType := MenuInfo.fType or Flag + else + MenuInfo.fType := MenuInfo.fType and (not Flag); + wCaption := AMenuItem.Caption; + MenuInfo.dwTypeData := PWideChar(wCaption); + Result := SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo); + TriggerFormUpdate(AMenuItem); +end; + +{ TWinCEWSMenuItem } + +procedure UpdateCaption(const AMenuItem: TMenuItem; ACaption: String); +var + MenuInfo: MENUITEMINFO; + wCaption : WideString; +begin + wCaption := ACaption; + with MenuInfo do + begin + cbsize := menuiteminfosize; + if ACaption <> '-' then + begin + fType := MFT_STRING; + fMask:=MIIM_TYPE; + dwTypeData:=PWideChar(wCaption); + cch := Length(aCaption); + end + else fType := MFT_SEPARATOR; + end; + SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo); + with MenuInfo do + begin + cbsize := menuiteminfosize; + fMask := MIIM_TYPE; + fType := MFT_OWNERDRAW; + dwTypeData:=PWideChar(wCaption); + cch := Length(aCaption); + end; + SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo); + TriggerFormUpdate(AMenuItem); +end; + +class procedure TWinCEWSMenuItem.AttachMenu(const AMenuItem: TMenuItem); +var + MenuInfo: MENUITEMINFO; + ParentMenuHandle: HMenu; + ParentOfParent: HMenu; + wCaption : WideString; + fstate,cmd : integer; + i : integer; +begin + ParentMenuHandle := AMenuItem.Parent.Handle; + + {Following part fixes the case when an item is added in runtime + but the parent item has not defined the submenu flag (hSubmenu=0) } + if AMenuItem.Parent.Parent<>nil then + begin + ParentOfParent := AMenuItem.Parent.Parent.Handle; + with MenuInfo do begin + cbSize := menuiteminfosize; + fMask:=MIIM_SUBMENU; + end; + GetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, + false, @MenuInfo); + if MenuInfo.hSubmenu=0 then // the parent menu item is not yet defined with submenu flag + begin + //roozbeh: wont work on smartphones...i guess i have to remove and add new one with submenu flag + //not yet found time to do....not so hard + MenuInfo.hSubmenu:=ParentMenuHandle; + SetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, + false, @MenuInfo); + end; + end; + + begin + fState:=MF_STRING or MF_BYPOSITION; + if AMenuItem.Enabled then fState:=fState or MF_ENABLED else fstate:=fState or MF_GRAYED; + if AMenuItem.Checked then fState:=fState or MF_CHECKED; + cmd:=AMenuItem.Command; {value may only be 16 bit wide!} + if (AMenuItem.Count > 0) then + begin + cmd := AMenuItem.Handle; + fState := fState or MF_POPUP; + end else + + if not AMenuItem.IsLine then + begin + //fState:=fState or MF_OWNERDRAW;//roozbeh:couldnt make ownerdrawn menus work so far! + end else begin + fState:=(fState xor MF_STRING) or MF_SEPARATOR; + end; + //dwTypeData := PWideChar(AMenuItem); + //if AMenuItem.RadioItem then fType := fType or MFT_RADIOCHECK; + //if AMenuItem.RightJustify then fType := fType or MFT_RIGHTJUSTIFY; + end; +//roozbeh..i really doubt this works! + wCaption := AmenuItem.Caption; + + i := 0; + // if fState and MF_STRING = MF_STRING then + if dword(InsertMenu(ParentMenuHandle,AMenuItem.Parent.VisibleIndexOf(AMenuItem), + fState , cmd, PWideChar(wCaption))) = 0 then i := Windows.GetLastError; +// else +// if dword(InsertMenu(ParentMenuHandle,AMenuItem.Parent.VisibleIndexOf(AMenuItem), +// fState , cmd, PWideChar(AMenuItem))) = 0 then i := Windows.GetLastError; + + //if i<> 0 then + //writeln('error insert ',i); + + FillChar(MenuInfo,SizeOf(MenuInfo),0); + MenuInfo.cbSize := SizeOf(MenuInfo); + MenuInfo.fMask := MIIM_DATA; + MenuInfo.dwItemData := PtrInt(AMenuItem); + MenuItemsList.AddObject(IntToStr(AMenuItem.Command),AMenuItem); +{roozbeh : setmenuiteminfo wont work always...using tstringlist or better lists is what i can only think of} +// if SetMenuItemInfo(ParentMenuHandle, AMenuItem.Command,false, @MenuInfo) = boolean(0) then +// i:= AMenuItem.Command; +// if SetMenuItemInfo(ParentMenuHandle, AMenuItem.Parent.VisibleIndexOf(AMenuItem),true, @MenuInfo) = boolean(0) then +// i:=GetLastError; + + +// DebugLn('InsertMenuItem failed with error: ', IntToStr(Windows.GetLastError)); + TriggerFormUpdate(AMenuItem); +end; + +class function TWinCEWSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU; +begin + Result := CreatePopupMenu; +end; + +class procedure TWinCEWSMenuItem.DestroyHandle(const AMenuItem: TMenuItem); +begin + if Assigned(AMenuItem.Parent) then + DeleteMenu(AMenuItem.Parent.Handle, AMenuItem.Command, MF_BYCOMMAND); + DestroyMenu(AMenuItem.Handle); + TriggerFormUpdate(AMenuItem); +end; + +class procedure TWinCEWSMenuItem.SetCaption(const AMenuItem: TMenuItem; const ACaption: string); +begin + UpdateCaption(AMenuItem, aCaption); +end; + +class procedure TWinCEWSMenuItem.SetShortCut(const AMenuItem: TMenuItem; + const OldShortCut, NewShortCut: TShortCut); +begin + UpdateCaption(AMenuItem, aMenuItem.Caption); +end; + +class function TWinCEWSMenuItem.SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; +var + EnableFlag: Integer; +begin + if Enabled then EnableFlag := MF_ENABLED + else EnableFlag := MF_GRAYED; + EnableFlag := EnableFlag or MF_BYCOMMAND; + Result := Boolean(Windows.EnableMenuItem(AMenuItem.Parent.Handle, AMenuItem.Command, EnableFlag)); + TriggerFormUpdate(AMenuItem); +end; + +class function TWinCEWSMenuItem.SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; +begin + Result := ChangeMenuFlag(AMenuItem, MFT_RIGHTJUSTIFY, Justified); +end; + + +{ TWinCEWSMenu } + +class function TWinCEWSMenu.CreateHandle(const AMenu: TMenu): HMENU; +begin + Result := CreateMenu; +end; + +{ TWinCEWSPopupMenu } + +class function TWinCEWSPopupMenu.CreateHandle(const AMenu: TMenu): HMENU; +begin + Result := CreatePopupMenu; +end; + +class procedure TWinCEWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, Y: integer); +var + MenuHandle: HMENU; + AppHandle: HWND; +begin + MenuHandle := APopupMenu.Handle; + AppHandle := TWinCEWidgetSet(WidgetSet).AppHandle; + GetWindowInfo(AppHandle)^.PopupMenu := APopupMenu; + TrackPopupMenuEx(MenuHandle, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON, + X, Y, AppHandle, Nil); +end; + +initialization + + menuiteminfosize:=sizeof(TMenuItemInfo); + MenuItemsList := TStringList.Create; +//////////////////////////////////////////////////// +// I M P O R T A N T +//////////////////////////////////////////////////// +// To improve speed, register only classes +// which actually implement something +//////////////////////////////////////////////////// + RegisterWSComponent(TMenuItem, TWinCEWSMenuItem); + RegisterWSComponent(TMenu, TWinCEWSMenu); +// RegisterWSComponent(TMainMenu, TWin32WSMainMenu); + RegisterWSComponent(TPopupMenu, TWinCEWSPopupMenu); +//////////////////////////////////////////////////// +finalization + MenuItemsList.Free; +end. diff --git a/lcl/interfaces/wince/wincewsspin.pp b/lcl/interfaces/wince/wincewsspin.pp index f632808c95..0163fdbbb6 100644 --- a/lcl/interfaces/wince/wincewsspin.pp +++ b/lcl/interfaces/wince/wincewsspin.pp @@ -107,9 +107,9 @@ var begin editHandle := GetBuddyWindow(ASpinHandle); newValueText := FloatToStrF(ANewValue, ffFixed, 20, ADecimalPlaces); - pwnewValueText := CreatePWideCharFromString(newValueText); + pwnewValueText := StringToPWideChar(newValueText); Windows.SendMessage(editHandle, WM_SETTEXT, 0, Windows.LPARAM(PWideChar(pwnewValueText))); - DisposePWideChar(pwnewValueText); + FreeMem(pwnewValueText); end; class function TWinCEWSCustomFloatSpinEdit.CreateHandle(const AWinControl: TWinControl; diff --git a/lcl/interfaces/wince/wincewsstdctrls.pp b/lcl/interfaces/wince/wincewsstdctrls.pp index 7fd89202e3..4a0d698f88 100644 --- a/lcl/interfaces/wince/wincewsstdctrls.pp +++ b/lcl/interfaces/wince/wincewsstdctrls.pp @@ -723,12 +723,12 @@ var begin Assert(False, Format('Trace:TWin32WSCustomComboBox.SetText --> %S', [AText])); Handle := AWinControl.Handle; - pwAText := CreatePWideCharFromString(AText); + pwAText := StringToPWideChar(AText); if TCustomComboBox(AWinControl).ReadOnly then Windows.SendMessage(Handle, CB_SELECTSTRING, -1, LPARAM(pwAText)) else Windows.SendMessage(Handle, WM_SETTEXT, 0, LPARAM(pwAText)); - DisposePWideChar(pwAText); + FreeMem(pwAText); end; class function TWinCEWSCustomComboBox.GetItems(const ACustomComboBox: TCustomComboBox): TStrings; @@ -791,7 +791,7 @@ begin WriteLn('TWinCEWSCustomEdit.CreateHandle'); {$endif} - Str := CreatePWideCharFromString(AWinControl.Caption); + Str := StringToPWideChar(AWinControl.Caption); hwnd := CreateWindow( @EditClsName, // Name of the registered class @@ -808,7 +808,7 @@ begin if (hwnd = 0) then WriteLn('CreateWindow failed'); - DisposePWideChar(Str); + FreeMem(Str); Result := hwnd; end; @@ -943,9 +943,9 @@ class procedure TWinCEWSCustomMemo.SetText(const AWinControl: TWinControl; const var tmpWideStr : PWideChar; begin - tmpWideStr := CreatePWideCharFromString(AText); + tmpWideStr := StringToPWideChar(AText); SendMessage(AWinControl.Handle, WM_SETTEXT, 0, LPARAM(PWideChar(tmpWideStr))); - DisposePWideChar(tmpWideStr); + FreeMem(tmpWideStr); end; class procedure TWinCEWSCustomMemo.SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); @@ -979,13 +979,13 @@ begin with Params do begin pClassName := @LabelClsName; - WindowTitle := CreatePWideCharFromString(AWinControl.Caption);//roozbeh..we already have this in strcaptiob..whats the diffrence? + WindowTitle := StringToPWideChar(AWinControl.Caption);//roozbeh..we already have this in strcaptiob..whats the diffrence? Flags := WS_CHILD or WS_VISIBLE or WS_TABSTOP or SS_LEFT;//Flags or CalcStaticTextFlags(TCustomStaticText(AWinControl).Alignment);//is ws_child included? end; // create window FinishCreateWindow(AWinControl, Params, false); - DisposePWideChar(Params.WindowTitle); + FreeMem(Params.WindowTitle); Result := Params.Window; end; @@ -1023,7 +1023,7 @@ begin with Params do begin pClassName := 'BUTTON'; - WindowTitle := CreatePWideCharFromString(AWinControl.Caption); + WindowTitle := StringToPWideChar(AWinControl.Caption); if TCustomCheckBox(AWinControl).AllowGrayed then Flags := Flags Or BS_AUTO3STATE else @@ -1031,7 +1031,7 @@ begin end; // create window FinishCreateWindow(AWinControl, Params, false); - DisposePWideChar(Params.WindowTitle); + FreeMem(Params.WindowTitle); Result := Params.Window; end; @@ -1121,14 +1121,14 @@ begin with Params do begin pClassName := @ButtonClsName; - WindowTitle := CreatePWideCharFromString(AWinControl.Caption); + WindowTitle := StringToPWideChar(AWinControl.Caption); // BS_AUTORADIOBUTTON may hang the application, // if the radiobuttons are not consecutive controls.//roozbeh:is it so in wince? Flags := Flags or BS_AUTORADIOBUTTON; end; // create window FinishCreateWindow(AWinControl, Params, false); - DisposePWideChar(Params.WindowTitle); + FreeMem(Params.WindowTitle); Result := Params.Window; end; diff --git a/lcl/interfaces/wince/winext.pas b/lcl/interfaces/wince/winext.pas index c3d2c978dd..8e6edf559b 100644 --- a/lcl/interfaces/wince/winext.pas +++ b/lcl/interfaces/wince/winext.pas @@ -68,10 +68,6 @@ Const GA_ROOT = 2; { The window's owner } GA_ROOTOWNER = 3; - { Application starting cursor } - IDC_APPSTARTING = 32650; - { Hand cursor } - IDC_HAND = 32649; { Get the progress bar range } PBM_GETRANGE = 1031; { Smooth progrss bar }