paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-30 11:10:23 +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

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

@ -126,10 +126,10 @@ SPI_GETPLATFORMTYPE = 257;//roozbeh : should be moved to windows unit
function WStrCmp( W1, W2: PWideChar ): Integer;
var
counter: Integer;
Begin
begin
counter := 0;
While W1[counter] = W2[counter] do
Begin
while W1[counter] = W2[counter] do
begin
if (W2[counter] = #0) or (W1[counter] = #0) then
break;
Inc(counter);
@ -145,12 +145,13 @@ s:widestring;
begin
Result := false;
if SystemParametersInfo(SPI_GETPLATFORMTYPE,sizeof(buf),@buf,0) then
begin
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 := false;//roozbeh : either it is 'PocketPC' or something else :)
end
else if GetLastError=ERROR_ACCESS_DENIED then
Result := true;
end;
@ -165,12 +166,14 @@ 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
while GetMenuItemInfo(srcMenu, i, True, mi) do
begin
buf[mi.cch]:=#0;
fState:=MF_STRING;
if mi.fState and MFS_DISABLED <> 0 then
@ -235,24 +238,29 @@ begin
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
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
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 Menu <> 0 then
begin
i:=0;
while True do begin
while True do
begin
mi.cch:=SizeOf(buf);
if not GetMenuItemInfo(Menu, i, True, @mi) then
break;
@ -326,7 +334,8 @@ begin
end;
function FindMenuItemAccelerator(const ACharCode: char; const AMenuHandle: HMENU): integer;
var MenuItemIndex: integer;
var
MenuItemIndex: integer;
ItemInfo: MENUITEMINFO;
FirstMenuItem: TMenuItem;
SiblingMenuItem: TmenuItem;
@ -387,7 +396,8 @@ 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;
var
oldFont: HFONT;
newFont: HFONT;
tmpRect: Windows.RECT;
wCaption : WideString;
@ -503,7 +513,8 @@ begin
end;
procedure DrawMenuItemCheckMark(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean);
var checkMarkWidth: integer;
var
checkMarkWidth: integer;
checkMarkHeight: integer;
hdcMem: HDC;
monoBitmap: HBITMAP;
@ -530,7 +541,8 @@ begin
end;
procedure DrawMenuItemText(const aMenuItem: TMenuItem; const aHDC: HDC; aRect: Windows.RECT; const aSelected: boolean);
var crText: COLORREF;
var
crText: COLORREF;
crBkgnd: COLORREF;
TmpLength: integer;
TmpHeight: integer;
@ -545,8 +557,10 @@ begin
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);
ExtTextOutW(aHDC, 0, 0, ETO_OPAQUE, @aRect, PWideChar(''), 0, nil);
@ -569,7 +583,8 @@ begin
end;
procedure DrawMenuItemIcon(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean);
var hdcMem: HDC;
var
hdcMem: HDC;
hbmpOld: HBITMAP;
begin
hdcMem := aMenuItem.Bitmap.Canvas.Handle;
@ -582,7 +597,8 @@ procedure DrawMenuItem(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect:
begin
if aMenuItem.IsLine then
DrawSeparator(aHDC, aRect)
else begin
else
begin
DrawMenuItemText(aMenuItem, aHDC, aRect, aSelected);
if aMenuItem.Checked then
DrawMenuItemCheckMark(aMenuItem, aHDC, aRect, aSelected);
@ -684,7 +700,8 @@ begin
if AMenuItem.Parent.Parent<>nil then
begin
ParentOfParent := AMenuItem.Parent.Parent.Handle;
with MenuInfo do begin
with MenuInfo do
begin
cbSize := menuiteminfosize;
fMask:=MIIM_SUBMENU;
end;
@ -700,7 +717,6 @@ begin
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;
@ -709,8 +725,9 @@ begin
begin
cmd := AMenuItem.Handle;
fState := fState or MF_POPUP;
end else
end
else
begin
if not AMenuItem.IsLine then
begin
//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.RightJustify then fType := fType or MFT_RIGHTJUSTIFY;
end;
//roozbeh..i really doubt this works!
wCaption := AmenuItem.Caption;
@ -834,6 +852,7 @@ initialization
menuiteminfosize := sizeof(TMenuItemInfo);
MenuItemsList := TStringList.Create;
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
@ -845,6 +864,9 @@ initialization
// RegisterWSComponent(TMainMenu, TWinCEWSMainMenu);
RegisterWSComponent(TPopupMenu, TWinCEWSPopupMenu);
////////////////////////////////////////////////////
finalization
MenuItemsList.Free;
end.