paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-13 12:09:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

Identation fixes.

Browse Source 
git-svn-id: trunk@14169 -
This commit is contained in:
sekelsenmat 2008-02-17 16:38:20 +00:00
parent 7a50172ef9
commit a4166c0986
1 changed files with 114 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -121,15 +121,15 @@ type
//menus //menus
const const
SPI_GETPLATFORMTYPE = 257;//roozbeh : should be moved to windows unit SPI_GETPLATFORMTYPE = 257;//roozbeh : should be moved to windows unit
function WStrCmp( W1, W2: PWideChar ): Integer; function WStrCmp( W1, W2: PWideChar ): Integer;
var var
counter: Integer; counter: Integer;
Begin begin
counter := 0; counter := 0;
While W1[counter] = W2[counter] do while W1[counter] = W2[counter] do
Begin begin
if (W2[counter] = #0) or (W1[counter] = #0) then if (W2[counter] = #0) or (W1[counter] = #0) then
break; break;
Inc(counter); Inc(counter);
@ -138,54 +138,57 @@ Begin
end; end;
function IsSmartPhone : Boolean; function IsSmartPhone: Boolean;
var var
buf:array[0..255] of WideChar; buf: array[0..255] of WideChar;
s:widestring; s: widestring;
begin begin
Result := false; Result := false;
if SystemParametersInfo(SPI_GETPLATFORMTYPE,sizeof(buf),@buf,0) then if SystemParametersInfo(SPI_GETPLATFORMTYPE,sizeof(buf),@buf,0) then
if WStrCmp(@buf,PWideChar('SmartPhone')) = 0 then begin
Result := true if WStrCmp(@buf,PWideChar('SmartPhone')) = 0 then
else Result := true
Result := false//roozbeh : either it is 'PocketPC' or something else :) else
else Result := false;//roozbeh : either it is 'PocketPC' or something else :)
if GetLastError=ERROR_ACCESS_DENIED then end
else if GetLastError=ERROR_ACCESS_DENIED then
Result := true; Result := true;
end; end;
//both menus are popup menus or submenus //both menus are popup menus or submenus
procedure CeMakeMenuesSame(SrcMenu,dstMenu : HMENU); procedure CeMakeMenuesSame(SrcMenu,dstMenu : HMENU);
var var
i: integer; i: integer;
mi: MENUITEMINFO; mi: MENUITEMINFO;
buf: array[0..255] of WideChar; buf: array[0..255] of WideChar;
fState:integer; fState:integer;
hPop : HMENU; hPop : HMENU;
uIDNewItem : integer; uIDNewItem : integer;
begin begin
while RemoveMenu(dstMenu,0,MF_BYPOSITION) do ; 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 i:=0;
buf[mi.cch]:=#0; mi.cbSize:=SizeOf(mi);
fState:=MF_STRING; mi.fMask:=MIIM_SUBMENU or MIIM_TYPE or MIIM_ID or MIIM_STATE;
if mi.fState and MFS_DISABLED <> 0 then mi.dwTypeData:=@buf;
fState:=fState or MF_GRAYED ;
if mi.fState and MFS_CHECKED <> 0 then while GetMenuItemInfo(srcMenu, i, True, mi) do
fState:=fState or MF_CHECKED; begin
uIDNewItem := mi.wID; buf[mi.cch]:=#0;
if mi.hSubMenu <> 0 then 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 begin
uIDNewItem := mi.hSubMenu; uIDNewItem := mi.hSubMenu;
fstate := fstate or MF_POPUP; fstate := fstate or MF_POPUP;
end; end;
AppendMenu(dstMenu,fState,uIDNewItem,@buf); AppendMenu(dstMenu,fState,uIDNewItem,@buf);
inc(i); inc(i);
end; end;
end; end;
procedure CeSetMenu(Wnd: HWND; Menu: HMENU); procedure CeSetMenu(Wnd: HWND; Menu: HMENU);
@ -235,24 +238,29 @@ begin
if (mbi.hwndMB = 0) or ( 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_L, 0) + 1)) xor (hasLMenu))) and
(not ((boolean(SendMessage (mbi.hwndMB, TB_COMMANDTOINDEX, MenuBarID_R, 0) + 1)) xor (hasRMenu)))) (not ((boolean(SendMessage (mbi.hwndMB, TB_COMMANDTOINDEX, MenuBarID_R, 0) + 1)) xor (hasRMenu))))
then begin then
begin
if not SHCreateMenuBar(@mbi) then if not SHCreateMenuBar(@mbi) then
begin begin
//MsgBox('not ok',0); //MsgBox('not ok',0);
exit; exit;
end; end;
end; end;
while SendMessage(mbi.hwndMB, TB_DELETEBUTTON, 0, 0) <> 0 do ; while SendMessage(mbi.hwndMB, TB_DELETEBUTTON, 0, 0) <> 0 do ;
with mi do begin with mi do
begin
cbSize:=SizeOf(mi); cbSize:=SizeOf(mi);
fMask:=MIIM_SUBMENU or MIIM_TYPE or MIIM_ID or MIIM_STATE; fMask:=MIIM_SUBMENU or MIIM_TYPE or MIIM_ID or MIIM_STATE;
dwTypeData:=@buf; dwTypeData:=@buf;
end; end;
if Menu <> 0 then begin if Menu <> 0 then
begin
i:=0; i:=0;
while True do begin while True do
begin
mi.cch:=SizeOf(buf); mi.cch:=SizeOf(buf);
if not GetMenuItemInfo(Menu, i, True, @mi) then if not GetMenuItemInfo(Menu, i, True, @mi) then
break; break;
@ -326,12 +334,13 @@ begin
end; end;
function FindMenuItemAccelerator(const ACharCode: char; const AMenuHandle: HMENU): integer; function FindMenuItemAccelerator(const ACharCode: char; const AMenuHandle: HMENU): integer;
var MenuItemIndex: integer; var
ItemInfo: MENUITEMINFO; MenuItemIndex: integer;
FirstMenuItem: TMenuItem; ItemInfo: MENUITEMINFO;
SiblingMenuItem: TmenuItem; FirstMenuItem: TMenuItem;
HotKeyIndex: integer; SiblingMenuItem: TmenuItem;
i: integer; HotKeyIndex: integer;
i: integer;
begin begin
Result := MakeLResult(0, 0); Result := MakeLResult(0, 0);
MenuItemIndex := -1; MenuItemIndex := -1;
@ -387,10 +396,11 @@ end;
(* Get the maximum length of the given string in pixels *) (* Get the maximum length of the given string in pixels *)
function StringSize(const aCaption: String; const aHDC: HDC; const aDecoration:TCaptionFlagsSet): TSize; function StringSize(const aCaption: String; const aHDC: HDC; const aDecoration:TCaptionFlagsSet): TSize;
var oldFont: HFONT; var
newFont: HFONT; oldFont: HFONT;
tmpRect: Windows.RECT; newFont: HFONT;
wCaption : WideString; tmpRect: Windows.RECT;
wCaption : WideString;
begin begin
tmpRect.right := 0; tmpRect.right := 0;
tmpRect.left := 0; tmpRect.left := 0;
@ -503,13 +513,14 @@ begin
end; end;
procedure DrawMenuItemCheckMark(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean); procedure DrawMenuItemCheckMark(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean);
var checkMarkWidth: integer; var
checkMarkHeight: integer; checkMarkWidth: integer;
hdcMem: HDC; checkMarkHeight: integer;
monoBitmap: HBITMAP; hdcMem: HDC;
oldBitmap: HBITMAP; monoBitmap: HBITMAP;
checkMarkShape: integer; oldBitmap: HBITMAP;
checkMarkRect: Windows.RECT; checkMarkShape: integer;
checkMarkRect: Windows.RECT;
begin begin
hdcMem := CreateCompatibleDC(aHDC); hdcMem := CreateCompatibleDC(aHDC);
checkMarkWidth := GetSystemMetrics(SM_CXMENUCHECK); checkMarkWidth := GetSystemMetrics(SM_CXMENUCHECK);
@ -530,23 +541,26 @@ begin
end; end;
procedure DrawMenuItemText(const aMenuItem: TMenuItem; const aHDC: HDC; aRect: Windows.RECT; const aSelected: boolean); procedure DrawMenuItemText(const aMenuItem: TMenuItem; const aHDC: HDC; aRect: Windows.RECT; const aSelected: boolean);
var crText: COLORREF; var
crBkgnd: COLORREF; crText: COLORREF;
TmpLength: integer; crBkgnd: COLORREF;
TmpHeight: integer; TmpLength: integer;
oldFont: HFONT; TmpHeight: integer;
newFont: HFONT; oldFont: HFONT;
decoration: TCaptionFlagsSet; newFont: HFONT;
shortCutText: string; decoration: TCaptionFlagsSet;
WorkRect: Windows.RECT; shortCutText: string;
wCaption : WideString; WorkRect: Windows.RECT;
wCaption : WideString;
begin begin
crText := TextColorMenu(aSelected, aMenuItem.Enabled); crText := TextColorMenu(aSelected, aMenuItem.Enabled);
crBkgnd := BackgroundColorMenu(aSelected, aMenuItem.IsInMenuBar); crBkgnd := BackgroundColorMenu(aSelected, aMenuItem.IsInMenuBar);
SetTextColor(aHDC, crText); SetTextColor(aHDC, crText);
SetBkColor(aHDC, crBkgnd); SetBkColor(aHDC, crBkgnd);
if aMenuItem.Default then decoration := [cfBold] if aMenuItem.Default then decoration := [cfBold]
else decoration := []; else decoration := [];
newFont := getMenuItemFont(decoration); newFont := getMenuItemFont(decoration);
oldFont := SelectObject(aHDC, newFont); oldFont := SelectObject(aHDC, newFont);
ExtTextOutW(aHDC, 0, 0, ETO_OPAQUE, @aRect, PWideChar(''), 0, nil); ExtTextOutW(aHDC, 0, 0, ETO_OPAQUE, @aRect, PWideChar(''), 0, nil);
@ -569,8 +583,9 @@ begin
end; end;
procedure DrawMenuItemIcon(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean); procedure DrawMenuItemIcon(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean);
var hdcMem: HDC; var
hbmpOld: HBITMAP; hdcMem: HDC;
hbmpOld: HBITMAP;
begin begin
hdcMem := aMenuItem.Bitmap.Canvas.Handle; hdcMem := aMenuItem.Bitmap.Canvas.Handle;
hbmpOld := SelectObject(hdcMem, aMenuItem.Bitmap.Handle); hbmpOld := SelectObject(hdcMem, aMenuItem.Bitmap.Handle);
@ -582,7 +597,8 @@ procedure DrawMenuItem(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect:
begin begin
if aMenuItem.IsLine then if aMenuItem.IsLine then
DrawSeparator(aHDC, aRect) DrawSeparator(aHDC, aRect)
else begin else
begin
DrawMenuItemText(aMenuItem, aHDC, aRect, aSelected); DrawMenuItemText(aMenuItem, aHDC, aRect, aSelected);
if aMenuItem.Checked then if aMenuItem.Checked then
DrawMenuItemCheckMark(aMenuItem, aHDC, aRect, aSelected); DrawMenuItemCheckMark(aMenuItem, aHDC, aRect, aSelected);
@ -673,8 +689,8 @@ var
MenuInfo: MENUITEMINFO; MenuInfo: MENUITEMINFO;
ParentMenuHandle: HMenu; ParentMenuHandle: HMenu;
ParentOfParent: HMenu; ParentOfParent: HMenu;
wCaption : WideString; wCaption: WideString;
fstate,cmd : integer; fstate, cmd: integer;
i : integer; i : integer;
begin begin
ParentMenuHandle := AMenuItem.Parent.Handle; ParentMenuHandle := AMenuItem.Parent.Handle;
@ -684,7 +700,8 @@ begin
if AMenuItem.Parent.Parent<>nil then if AMenuItem.Parent.Parent<>nil then
begin begin
ParentOfParent := AMenuItem.Parent.Parent.Handle; ParentOfParent := AMenuItem.Parent.Parent.Handle;
with MenuInfo do begin with MenuInfo do
begin
cbSize := menuiteminfosize; cbSize := menuiteminfosize;
fMask:=MIIM_SUBMENU; fMask:=MIIM_SUBMENU;
end; end;
@ -700,17 +717,17 @@ begin
end; end;
end; end;
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
begin 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 if not AMenuItem.IsLine then
begin begin
//fState:=fState or MF_OWNERDRAW;//roozbeh:couldnt make ownerdrawn menus work so far! //fState:=fState or MF_OWNERDRAW;//roozbeh:couldnt make ownerdrawn menus work so far!
@ -721,6 +738,7 @@ begin
//if AMenuItem.RadioItem then fType := fType or MFT_RADIOCHECK; //if AMenuItem.RadioItem then fType := fType or MFT_RADIOCHECK;
//if AMenuItem.RightJustify then fType := fType or MFT_RIGHTJUSTIFY; //if AMenuItem.RightJustify then fType := fType or MFT_RIGHTJUSTIFY;
end; end;
//roozbeh..i really doubt this works! //roozbeh..i really doubt this works!
wCaption := AmenuItem.Caption; wCaption := AmenuItem.Caption;
@ -832,8 +850,9 @@ end;
initialization initialization
menuiteminfosize:=sizeof(TMenuItemInfo); menuiteminfosize := sizeof(TMenuItemInfo);
MenuItemsList := TStringList.Create; MenuItemsList := TStringList.Create;
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
// I M P O R T A N T // I M P O R T A N T
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
@ -845,6 +864,9 @@ initialization
// RegisterWSComponent(TMainMenu, TWinCEWSMainMenu); // RegisterWSComponent(TMainMenu, TWinCEWSMainMenu);
RegisterWSComponent(TPopupMenu, TWinCEWSPopupMenu); RegisterWSComponent(TPopupMenu, TWinCEWSPopupMenu);
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
finalization finalization
MenuItemsList.Free; MenuItemsList.Free;
end. end.