paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 01:48:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

sparta: paint fake mainmenu

Browse Source 
git-svn-id: trunk@51141 -
This commit is contained in:
ondrej 2016-01-03 10:24:20 +00:00
parent 90b92def4e
commit 3a6b0c9da3
5 changed files with 127 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
components/sparta/dockedformeditor/source/sparta_fakecustom.pas
View File

@ -897,46 +897,8 @@ begin
end;
function TDesignedFormImpl.PositionDelta: TPoint;
procedure FormBorderDelta;
var
LTestCtrl: TWinControl;
LTestRec, LFormRect: TRect;
LForm: TCustomForm;
begin
LForm := GetForm;
LTestCtrl := TWinControl.Create(Self);
try
LTestCtrl.Parent := LForm;
LTestCtrl.Left := 0;
LTestCtrl.Top := 0;
GetWindowRect(LForm.Handle, LFormRect);
GetWindowRect(LTestCtrl.Handle, LTestRec);
Result.x := Result.x + Max(LTestRec.Left - LFormRect.Left, 0);
Result.y := Result.y + Max(LTestRec.Top - LFormRect.Top, 0);
finally
LTestCtrl.free;
end;
end;
procedure MainMenuDelta;
var
LForm: TCustomForm;
begin
LForm := GetForm;
if LForm.Menu <> nil then
if LForm.Menu.Items.Count>0 then
Result.y := Result.y - LCLIntf.GetSystemMetrics(SM_CYMENU);
end;
begin
Result := Point(0, 0);
{$IFDEF WINDOWS}
FormBorderDelta;
MainMenuDelta;
{$ENDIF}
end;
procedure TDesignedFormImpl.SetOnChangeHackedBounds(const AValue: TNotifyEvent);
@ -1016,23 +978,8 @@ begin
end;
function TDesignedFormImpl.GetLogicalClientRect(ALogicalClientRect: TRect): TRect;
var
i: Integer;
begin
Result:=ALogicalClientRect;
Result.Right := Width;
if (FOwner.Menu <> nil) and (FOwner.Menu.Items.Count <> 0) then
begin
for i := 0 to FOwner.Menu.Items.Count - 1 do
if FOwner.Menu.Items[i].Visible then
begin
Result.Bottom:= Height - LCLIntf.GetSystemMetrics(SM_CYMENU);
Exit;
end;
end;
Result.Bottom:= Height;
end;
constructor TDesignedFormImpl.Create(AOwner: TForm);

22
components/sparta/dockedformeditor/source/sparta_mainide.pas
View File

@ -191,6 +191,7 @@ type
class procedure OnShowMethod(const Name: String);
class procedure OnDesignRefreshPropertyValues;
class procedure OnMenuChanged;
end;
var
@ -506,6 +507,9 @@ begin
RepaintFormImages;
end;
if (TheMessage.msg = CM_MENUCHANGED) and (Form.Form is TFakeForm) then
TSpartaMainIDE.OnMenuChanged;
// during docking, form position was in wrong place... we need to delay changing position :)
if TheMessage.msg = WM_BoundToDesignTabSheet then
if Form.LastActiveSourceWindow <> nil then
@ -1521,6 +1525,24 @@ begin
LWindowData.OnChangeBounds(Sender);
end;
class procedure TSpartaMainIDE.OnMenuChanged;
var
LForm: TCustomForm;
LFormData: TDesignFormData;
LSourceWindow: TSourceEditorWindowInterface;
LPageCtrl: TModulePageControl;
begin
if (GlobalDesignHook.LookupRoot is TCustomForm) then
begin
LForm := TCustomForm(GlobalDesignHook.LookupRoot);
LFormData := FindDesignFormData(LForm);
LSourceWindow := (LFormData as IDesignedForm).LastActiveSourceWindow;
LPageCtrl := FindModulePageControl(LSourceWindow);
if LPageCtrl.Resizer<>nil then
LPageCtrl.Resizer.FResizerFrame.OnMenuChanged;
end;
end;
{$IFDEF USE_POPUP_PARENT_DESIGNER}
class procedure TSpartaMainIDE.OnBeforeClose(Sender: TObject);
begin

1
components/sparta/dockedformeditor/source/sparta_resizer.pas
View File

@ -118,6 +118,7 @@ begin
FDesignedForm.RealPopupParent := FindFirstFormParent;
{$ELSE}
FDesignedForm.Form.Parent := FResizerFrame.pClient;
FDesignedForm.Form.BorderStyle := bsNone;
{$ENDIF}
// for big forms (bigger than screen resolution) we need to refresh Real* values
DesignedForm.RealWidth := DesignedForm.Width;

3
components/sparta/dockedformeditor/source/sparta_resizerframe.lfm
View File

@ -8,6 +8,8 @@ object ResizerFrame: TResizerFrame
Color = clDefault
ParentColor = False
TabOrder = 0
DesignLeft = 356
DesignTop = 23
object pR: TPanel
AnchorSideTop.Control = Owner
Cursor = crSizeWE
@ -167,6 +169,7 @@ object ResizerFrame: TResizerFrame
Color = clNone
ParentColor = False
TabOrder = 4
OnPaint = pBGPaint
end
object pClient: TPanel
AnchorSideLeft.Control = pL

126
components/sparta/dockedformeditor/source/sparta_resizerframe.pas
View File

@ -18,7 +18,7 @@ interface
uses
Classes, contnrs, SysUtils, FileUtil, Forms, Controls, ExtCtrls, StdCtrls, Graphics, LCLType,
lclintf, sparta_DesignedForm, Math, FormEditingIntf, PropEdits;
lclintf, Menus, sparta_DesignedForm, Math, Types, FormEditingIntf, PropEdits;
type
@ -39,6 +39,7 @@ type
pMarginT: TPanel;
pR: TPanel;
pT: TPanel;
procedure pBGPaint(Sender: TObject);
procedure sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
procedure sbHorizontalScroll(Sender: TObject; ScrollCode: TScrollCode;
@ -66,6 +67,11 @@ type
FMaxWidth, FMaxHeight: Integer;
FActivePropertyGridItemIndex: Integer;
FLastClientWidth, FLastClientHeight: Integer;
FOldHasMainMenu: Boolean;
FMenuChanged: Boolean;
function HasMainMenu: Boolean;
procedure AppOnIdle(Sender: TObject; var Done: Boolean);
procedure PanelPaint(Sender: TObject);
procedure BGChangeBounds(Sender: TObject);
@ -122,6 +128,8 @@ type
procedure ShowSizeRects;
procedure ShowSizeControls;
procedure OnMenuChanged;
property VerticalScrollPos: Integer read FVerticalScrollPos write FVerticalScrollPos;
property HorizontalScrollPos: Integer read FHorizontalScrollPos write FHorizontalScrollPos;
end;
@ -222,6 +230,37 @@ begin
TileImage(iResizerLineImg, pT.Canvas, 0, 0, Width, SIZER_LINE_WIDTH);
end;
procedure TResizerFrame.pBGPaint(Sender: TObject);
var
MenuRect: Types.TRect;
Menu: TMainMenu;
X, Y, I: Integer;
LCanvas: TCanvas;
begin
//fake paint menu
if not HasMainMenu then
Exit;
Menu := FDesignedForm.Form.Menu;
LCanvas := (Sender as TPanel).Canvas;
LCanvas.Brush.Color := clMenuBar;
MenuRect := (Sender as TPanel).ClientRect;
MenuRect.Bottom := MenuRect.Top + LCLIntf.GetSystemMetrics(SM_CYMENU);
LCanvas.FillRect(MenuRect);
LCanvas.Font.Color := clMenuText;
X := 5;
Y := (MenuRect.Top+MenuRect.Bottom-LCanvas.TextHeight('Hg')) div 2;
for I := 0 to Menu.Items.Count-1 do
if Menu.Items[I].Visible then
begin
LCanvas.TextOut(X, Y, Menu.Items[I].Caption);
Inc(X, LCanvas.TextWidth(Menu.Items[I].Caption) + 10);
end;
LCanvas.Brush.Color := clNone;
end;
procedure TResizerFrame.ClientChangeBounds(Sender: TObject);
{$IFDEF USE_POPUP_PARENT_DESIGNER}
var
@ -583,6 +622,11 @@ begin
end;
end;
procedure TResizerFrame.OnMenuChanged;
begin
FMenuChanged := True;
end;
function TResizerFrame.GetRightMargin: Integer;
begin
if not FNodePositioning then
@ -590,6 +634,19 @@ begin
Result := FLastRightMarign;
end;
function TResizerFrame.HasMainMenu: Boolean;
var
I: Integer;
begin
Result := False;
if (FDesignedForm<>nil) and (FDesignedForm.Form.Menu<>nil)
and (FDesignedForm.Form.Menu.Items.Count>0)
then
for I := 0 to FDesignedForm.Form.Menu.Items.Count-1 do
if FDesignedForm.Form.Menu.Items[I].Visible then
Exit(True);
end;
function TResizerFrame.GetBottomMargin: Integer;
begin
if not FNodePositioning then
@ -661,6 +718,9 @@ begin
Result := 0
else
Result := FBackground.GetMargin(AIndex);
if (AIndex = 1) and HasMainMenu then
Result := Result + LCLIntf.GetSystemMetrics(SM_CYMENU);
end;
procedure TResizerFrame.TryBoundDesignedForm;
@ -718,10 +778,24 @@ begin
pClient.OnChangeBounds := ClientChangeBounds;
pBG.OnChangeBounds := BGChangeBounds;
PositionNodes(Self);
Application.AddOnIdleHandler(AppOnIdle);
end;
procedure TResizerFrame.AppOnIdle(Sender: TObject; var Done: Boolean);
begin
if not FMenuChanged then
Exit;
if FOldHasMainMenu <> HasMainMenu then
PositionNodes(Self)
else if FOldHasMainMenu then
pBG.Invalidate;
end;
destructor TResizerFrame.Destroy;
begin
Application.RemoveOnIdleHandler(AppOnIdle);
FNodes.Free;
inherited Destroy;
end;
@ -737,35 +811,37 @@ begin
// positions of bars
if not FNodePositioning then
begin
pL.Left := -FHorizontalScrollPos;
pR.Left := FDesignedForm.Width - FHorizontalScrollPos + pL.Width + BgRightMargin + BgLeftMargin;
pT.Top := -FVerticalScrollPos;
pB.Top := FDesignedForm.Height - FVerticalScrollPos + pT.Height + BgBottomMargin + BgTopMargin;
pL.Left := -FHorizontalScrollPos;
pR.Left := FDesignedForm.Width - FHorizontalScrollPos + pL.Width + BgRightMargin + BgLeftMargin;
pT.Top := -FVerticalScrollPos;
pB.Top := FDesignedForm.Height - FVerticalScrollPos + pT.Height + BgBottomMargin + BgTopMargin;
// width and height
pL.Top:=0;
pL.Height := FDesignedForm.Height + 2*SIZER_RECT_SIZE + BgTopMargin + BgBottomMargin;
pR.Top:=0;
pR.Height := FDesignedForm.Height + 2*SIZER_RECT_SIZE + BgTopMargin + BgBottomMargin;
pT.Left:=0;
pT.Width := FDesignedForm.Width + 2*SIZER_RECT_SIZE + BgLeftMargin + BgRightMargin;
pB.Left:=0;
pB.Width := FDesignedForm.Width + 2*SIZER_RECT_SIZE + BgLeftMargin + BgRightMargin;
// width and height
pL.Top:=0;
pL.Height := FDesignedForm.Height + 2*SIZER_RECT_SIZE + BgTopMargin + BgBottomMargin;
pR.Top:=0;
pR.Height := FDesignedForm.Height + 2*SIZER_RECT_SIZE + BgTopMargin + BgBottomMargin;
pT.Left:=0;
pT.Width := FDesignedForm.Width + 2*SIZER_RECT_SIZE + BgLeftMargin + BgRightMargin;
pB.Left:=0;
pB.Width := FDesignedForm.Width + 2*SIZER_RECT_SIZE + BgLeftMargin + BgRightMargin;
// client
if pBG.Left + BgLeftMargin <= 0 then
pClient.Left := -(pBG.Left) - (FHorizontalScrollPos - SIZER_RECT_SIZE)
else
pClient.Left := pBG.Left + BgLeftMargin;
if pBG.Top + BgTopMargin <= 0 then
pClient.Top := -(pBG.Top) - (FVerticalScrollPos - SIZER_RECT_SIZE)
else
pClient.Top := pBG.Top + BgTopMargin;
// client
if pBG.Left + BgLeftMargin <= 0 then
pClient.Left := -(pBG.Left) - (FHorizontalScrollPos - SIZER_RECT_SIZE)
else
pClient.Left := pBG.Left + BgLeftMargin;
if pBG.Top + BgTopMargin <= 0 then
pClient.Top := -(pBG.Top) - (FVerticalScrollPos - SIZER_RECT_SIZE)
else
pClient.Top := pBG.Top + BgTopMargin;
pClient.Height := Height - pClient.Top - Max(Height - (pB.Top - BgBottomMargin), 0);
pClient.Width := Width - pClient.Left - Max(Width - (pR.Left - BgRightMargin), 0);
pClient.Height := Height - pClient.Top - Max(Height - (pB.Top - BgBottomMargin), 0);
pClient.Width := Width - pClient.Left - Max(Width - (pR.Left - BgRightMargin), 0);
end;
FOldHasMainMenu := HasMainMenu;
for Node := 0 to 7 do
begin
with AroundControl do