paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-23 12:19:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

Menu designer: Cleanup. Move few nested functions to methods.

Browse Source 
git-svn-id: trunk@51552 -
This commit is contained in:
juha 2016-02-09 12:52:35 +00:00
parent ad856b47a0
commit c440bfd8e0
2 changed files with 114 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
designer/menueditorform.pas
View File

@ -33,7 +33,7 @@ uses
// LazUtils // LazUtils
LazUTF8, LazUTF8,
// IdeIntf // IdeIntf
LazIDEIntf, FormEditingIntf, PropEdits, FormEditingIntf, PropEdits,
// IDE // IDE
LazarusIDEStrConsts, MenuDesignerBase, MenuShortcuts; LazarusIDEStrConsts, MenuDesignerBase, MenuShortcuts;
@ -91,7 +91,7 @@ type
procedure ScanLookupRoot(aForm: TCustomForm); procedure ScanLookupRoot(aForm: TCustomForm);
procedure SetupPopupAssignmentsDisplay; procedure SetupPopupAssignmentsDisplay;
public public
constructor Create(aDesigner: TMenuDesignerBase); constructor Create(aDesigner: TMenuDesignerBase); reintroduce;
destructor Destroy; override; destructor Destroy; override;
procedure LoadVariableButtonGlyphs(isInMenubar: boolean); procedure LoadVariableButtonGlyphs(isInMenubar: boolean);
procedure SetMenu(aMenu: TMenu; aMenuItem: TMenuItem); procedure SetMenu(aMenu: TMenu; aMenuItem: TMenuItem);

226
designer/menushadows.pp
View File

@ -72,7 +72,9 @@ type
FShowingBottomFake: boolean; FShowingBottomFake: boolean;
FShowingRightFake: boolean; FShowingRightFake: boolean;
FState: TShadowItemDisplayState; FState: TShadowItemDisplayState;
function GetBitmapLeftTop: TPoint;
function GetBottomFake: TFake; function GetBottomFake: TFake;
function GetIconTopLeft: TPoint;
function GetIsInMenuBar: boolean; function GetIsInMenuBar: boolean;
function GetIsMainMenu: boolean; function GetIsMainMenu: boolean;
function GetLevel: integer; function GetLevel: integer;
@ -80,6 +82,7 @@ type
function GetShortcutWidth: integer; function GetShortcutWidth: integer;
function GetShowingBottomFake: boolean; function GetShowingBottomFake: boolean;
function GetShowingRightFake: boolean; function GetShowingRightFake: boolean;
function GetSubImagesIconTopLeft: TPoint;
procedure SetState(AValue: TShadowItemDisplayState); procedure SetState(AValue: TShadowItemDisplayState);
protected protected
function GetHeight: integer; function GetHeight: integer;
@ -2991,6 +2994,16 @@ begin
Result:=FRealItem.IsInMenuBar; Result:=FRealItem.IsInMenuBar;
end; end;
function TShadowItem.GetIsMainMenu: boolean;
begin
Result:=FShadowMenu.IsMainMenu;
end;
function TShadowItem.GetLevel: integer;
begin
Result:=FParentBox.Level;
end;
function TShadowItem.GetBottomFake: TFake; function TShadowItem.GetBottomFake: TFake;
begin begin
Result:=nil; Result:=nil;
@ -3003,33 +3016,16 @@ begin
end; end;
end; end;
function TShadowItem.GetIsMainMenu: boolean;
begin
Result:=FShadowMenu.IsMainMenu;
end;
function TShadowItem.GetLevel: integer;
begin
Result:=FParentBox.Level;
end;
{
function TShadowItem.GetMenu: TMenu;
begin
Result:=FShadowMenu.FMenu;
end;
}
function TShadowItem.GetRightFake: TFake; function TShadowItem.GetRightFake: TFake;
begin begin
if (FShadowMenu.SelectedShadowItem <> Self) then Result:=nil;
Result:=nil if (FShadowMenu.SelectedShadowItem = Self) then
else case FRealItem.IsInMenuBar of case FRealItem.IsInMenuBar of
False: if (FShadowMenu.AddSubMenuFake.Visible) then False: if (FShadowMenu.AddSubMenuFake.Visible) then
Result:=FRightFake Result:=FRightFake;
else Result:=nil; True: if FShadowMenu.AddItemFake.Visible then
True: if FShadowMenu.AddItemFake.Visible then Result:=FRightFake;
Result:=FRightFake end;
else Result:=nil;
end;
end; end;
function TShadowItem.GetShortcutWidth: integer; function TShadowItem.GetShortcutWidth: integer;
@ -3071,33 +3067,40 @@ begin
end; end;
end; end;
function TShadowItem.GetIconTopLeft: TPoint;
begin
Result:=Point(1, 1);
if (FShadowMenu.FMenu.Images.Height < ClientHeight) then
Result.y:=(ClientHeight - FShadowMenu.FMenu.Images.Height) div 2;
if (FShadowMenu.FMenu.Images.Width < Gutter_X) then
Result.x:=(Gutter_X - FShadowMenu.FMenu.Images.Width) div 2;
end;
function TShadowItem.GetBitmapLeftTop: TPoint;
begin
Result:=Point(1, 1);
if (FRealItem.Bitmap.Height < ClientHeight) then
Result.y:=(ClientHeight - FRealItem.Bitmap.Height) div 2;
if (FRealItem.Bitmap.Width < Gutter_X) then
Result.x:=(Gutter_X - FRealItem.Bitmap.Width) div 2;
end;
function TShadowItem.GetSubImagesIconTopLeft: TPoint;
begin
Result:=Point(1, 1);
if (FRealItem.Parent.SubMenuImages.Height < ClientHeight) then
Result.y:=(ClientHeight - FRealItem.Parent.SubMenuImages.Height) div 2;
if (FRealItem.Parent.SubMenuImages.Width < Gutter_X) then
Result.x:=(Gutter_X - FRealItem.Parent.SubMenuImages.Width) div 2;
end;
procedure TShadowItem.Paint; procedure TShadowItem.Paint;
var var
r, gutterR: TRect; r, gutterR: TRect;
dets: TThemedElementDetails;
textFlags: integer = DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_CENTER; textFlags: integer = DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_CENTER;
tStyle: TTextStyle; tStyle: TTextStyle;
alygn: TAlignment;
s: string; s: string;
function GetIconTopLeft: TPoint;
begin
Result:=Point(1, 1);
if (FShadowMenu.FMenu.Images.Height < ClientHeight) then
Result.y:=(ClientHeight - FShadowMenu.FMenu.Images.Height) div 2;
if (FShadowMenu.FMenu.Images.Width < Gutter_X) then
Result.x:=(Gutter_X - FShadowMenu.FMenu.Images.Width) div 2;
end;
function GetBitmapLeftTop: TPoint;
begin
Result:=Point(1, 1);
if (FRealItem.Bitmap.Height < ClientHeight) then
Result.y:=(ClientHeight - FRealItem.Bitmap.Height) div 2;
if (FRealItem.Bitmap.Width < Gutter_X) then
Result.x:=(Gutter_X - FRealItem.Bitmap.Width) div 2;
end;
procedure DrawMenuBarItem; procedure DrawMenuBarItem;
var var
oldFontStyle: TFontStyles; oldFontStyle: TFontStyles;
@ -3105,6 +3108,7 @@ var
x, y: integer; x, y: integer;
sz: TSize; sz: TSize;
pt: TPoint; pt: TPoint;
dets: TThemedElementDetails;
begin begin
if (FState = dsSelected) then begin if (FState = dsSelected) then begin
Canvas.Brush.Color:=clHighlight; Canvas.Brush.Color:=clHighlight;
@ -3168,7 +3172,8 @@ var
end; end;
if FRealItem.IsLine and (FState = dsSelected) then if FRealItem.IsLine and (FState = dsSelected) then
Canvas.FillRect(r.Left, r.Top+2, r.Right, r.Bottom+2) Canvas.FillRect(r.Left, r.Top+2, r.Right, r.Bottom+2)
else Canvas.FillRect(r); else
Canvas.FillRect(r);
gutterR:=Rect(Gutter_X, 0, Gutter_X+1, ClientHeight); gutterR:=Rect(Gutter_X, 0, Gutter_X+1, ClientHeight);
LCLIntf.DrawEdge(Canvas.Handle, gutterR, EDGE_ETCHED, BF_LEFT); LCLIntf.DrawEdge(Canvas.Handle, gutterR, EDGE_ETCHED, BF_LEFT);
end; end;
@ -3176,16 +3181,7 @@ var
procedure DrawCheckMarkIcon; procedure DrawCheckMarkIcon;
var var
pt: TPoint; pt: TPoint;
dets: TThemedElementDetails;
function GetSubImagesIconTopLeft: TPoint;
begin
Result:=Point(1, 1);
if (FRealItem.Parent.SubMenuImages.Height < ClientHeight) then
Result.y:=(ClientHeight - FRealItem.Parent.SubMenuImages.Height) div 2;
if (FRealItem.Parent.SubMenuImages.Width < Gutter_X) then
Result.x:=(Gutter_X - FRealItem.Parent.SubMenuImages.Width) div 2;
end;
begin begin
if FRealItem.Checked then begin if FRealItem.Checked then begin
gutterR:=r; gutterR:=r;
@ -3247,7 +3243,8 @@ var
Canvas.Brush.Style:=bsClear; Canvas.Brush.Style:=bsClear;
if FRealItem.RightJustify then if FRealItem.RightJustify then
textFlags:=textFlags or DT_RIGHT textFlags:=textFlags or DT_RIGHT
else textFlags:=textFlags or DT_LEFT; else
textFlags:=textFlags or DT_LEFT;
r.Left:=DropDown_Text_Offset; r.Left:=DropDown_Text_Offset;
oldFontStyle:=Canvas.Font.Style; oldFontStyle:=Canvas.Font.Style;
if FRealItem.Default then if FRealItem.Default then
@ -3278,29 +3275,30 @@ var
if sc2 then if sc2 then
s2:=ShortCutToText(FRealItem.ShortCutKey2); s2:=ShortCutToText(FRealItem.ShortCutKey2);
if sc1 or sc2 then //#todo allow for rightjustify? if sc1 or sc2 then //#todo allow for rightjustify?
begin begin
if sc1 and not sc2 then if sc1 and not sc2 then
s:=s1 s:=s1
else if sc2 and not sc1 then else if sc2 and not sc1 then
s:=s2 s:=s2
else s:=s1 + ', ' + s2; else
x:=r.Right - Canvas.TextWidth(s) - DropDown_Height; s:=s1 + ', ' + s2;
case FState of x:=r.Right - Canvas.TextWidth(s) - DropDown_Height;
dsNormal: Canvas.TextRect(r, x, y, s, tStyle); case FState of
dsSelected: begin dsNormal: Canvas.TextRect(r, x, y, s, tStyle);
OldFontColor:=Canvas.Font.Color; dsSelected: begin
Canvas.Font.Color:=clHighlightText; OldFontColor:=Canvas.Font.Color;
Canvas.TextRect(r, x, y, s, tStyle); Canvas.Font.Color:=clHighlightText;
Canvas.Font.Color:=oldFontColor; Canvas.TextRect(r, x, y, s, tStyle);
end; Canvas.Font.Color:=oldFontColor;
dsDisabled: begin end;
OldFontColor:=Canvas.Font.Color; dsDisabled: begin
Canvas.Font.Color:=clBtnShadow; OldFontColor:=Canvas.Font.Color;
Canvas.TextRect(r, x, y, s, tStyle); Canvas.Font.Color:=clBtnShadow;
Canvas.Font.Color:=OldFontColor; Canvas.TextRect(r, x, y, s, tStyle);
end; Canvas.Font.Color:=OldFontColor;
end; end;
end; end;
end;
Canvas.Font.Style:=oldFontStyle; Canvas.Font.Style:=oldFontStyle;
end; end;
@ -3336,41 +3334,43 @@ var
Canvas.Pen.Color:=oldPenColor; Canvas.Pen.Color:=oldPenColor;
end; end;
var
alygn: TAlignment;
begin begin
if not FParentBox.Updating then begin if FParentBox.Updating then Exit;
r:=ClientRect; r:=ClientRect;
if FRealItem.RightJustify then if FRealItem.RightJustify then
alygn:=taRightJustify alygn:=taRightJustify
else else
alygn:=taLeftJustify; alygn:=taLeftJustify;
if (FRealItem.Caption = '') then if (FRealItem.Caption = '') then
s:=FRealItem.Name s:=FRealItem.Name
else s:=FRealItem.Caption; else
FillChar(tStyle{%H-}, SizeOf(tStyle), 0); s:=FRealItem.Caption;
with tStyle do begin FillChar(tStyle{%H-}, SizeOf(tStyle), 0);
Alignment:=BidiFlipAlignment(alygn, UseRightToLeftAlignment); with tStyle do begin
Layout:=tlCenter; Alignment:=BidiFlipAlignment(alygn, UseRightToLeftAlignment);
SingleLine:=True; Layout:=tlCenter;
Clipping:=True; SingleLine:=True;
ShowPrefix:=True; Clipping:=True;
RightToLeft:=UseRightToLeftReading; ShowPrefix:=True;
ExpandTabs:=True; RightToLeft:=UseRightToLeftReading;
end; ExpandTabs:=True;
if FRealItem.IsInMenuBar then end;
DrawMenuBarItem if FRealItem.IsInMenuBar then
else begin DrawMenuBarItem
DrawBackgroundAndGutter; else begin
if FRealItem.IsLine then begin DrawBackgroundAndGutter;
gutterR:=Rect(Gutter_X, Separator_Centre, ClientWidth, Separator_Centre); if FRealItem.IsLine then begin
LCLIntf.DrawEdge(Canvas.Handle, gutterR, EDGE_ETCHED, BF_TOP); gutterR:=Rect(Gutter_X, Separator_Centre, ClientWidth, Separator_Centre);
Exit; LCLIntf.DrawEdge(Canvas.Handle, gutterR, EDGE_ETCHED, BF_TOP);
end; Exit;
if (FRealItem.Checked or FRealItem.HasIcon) then
DrawCheckMarkIcon;
DrawText;
if (FRealItem.Count > 0) then
DrawChevron;
end; end;
if (FRealItem.Checked or FRealItem.HasIcon) then
DrawCheckMarkIcon;
DrawText;
if (FRealItem.Count > 0) then
DrawChevron;
end; end;
end; end;
@ -3520,8 +3520,6 @@ begin
FGui.Free; FGui.Free;
if (GlobalDesignHook <> nil) then if (GlobalDesignHook <> nil) then
GlobalDesignHook.RemoveAllHandlersForObject(Self); GlobalDesignHook.RemoveAllHandlersForObject(Self);
if MenuDesignerSingleton = Self then
MenuDesignerSingleton := nil;
inherited Destroy; inherited Destroy;
end; end;