mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-18 01:39:25 +02:00
added menueditor from Martin Patik, not yet working
git-svn-id: trunk@2471 -
This commit is contained in:
mattias
parent
48cf736bf6
commit
0bcd6a6058
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -101,10 +101,12 @@ designer/componenteditors.pas svneol=native#text/pascal
|
||||
designer/controlselection.pp svneol=native#text/pascal
|
||||
designer/customeditor.pp svneol=native#text/pascal
|
||||
designer/designer.pp svneol=native#text/pascal
|
||||
designer/designermenu.pp svneol=native#text/pascal
|
||||
designer/designerprocs.pas svneol=native#text/pascal
|
||||
designer/designerstr.pas svneol=native#text/pascal
|
||||
designer/filesystem.pp svneol=native#text/pascal
|
||||
designer/jitforms.pp svneol=native#text/pascal
|
||||
designer/menueditorform.pas svneol=native#text/pascal
|
||||
designer/objectinspector.pp svneol=native#text/pascal
|
||||
designer/objinspstrconsts.pas svneol=native#text/pascal
|
||||
designer/propedits.pp svneol=native#text/pascal
|
||||
|
||||
277
designer/designermenu.pp
Normal file
277
designer/designermenu.pp
Normal file
@ -0,0 +1,277 @@
|
||||
unit DesignerMenu;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Menus, Graphics, GraphType, Buttons;
|
||||
|
||||
type
|
||||
PDesignerMenuItem = ^TDesignerMenuItem;
|
||||
TDesignerMenuItem = record
|
||||
ParentMenu: PDesignerMenuItem;
|
||||
SubMenu: PDesignerMenuItem;
|
||||
PrevItem: PDesignerMenuItem;
|
||||
NextItem: PDesignerMenuItem;
|
||||
Caption: string;
|
||||
coord: TRect;
|
||||
Level: Integer;
|
||||
Selected: Boolean;
|
||||
Active: Boolean;
|
||||
end;
|
||||
|
||||
TDesignerMainMenu = class(TCustomControl)
|
||||
private
|
||||
FRoot: PDesignerMenuItem;
|
||||
FAppMenu: TMainMenu;
|
||||
public
|
||||
constructor CreateWithMenu(TheOwner: TComponent; AMenu: TMainMenu);
|
||||
destructor Destroy; override;
|
||||
property Root: PDesignerMenuItem read FRoot write FRoot;
|
||||
property AppMenu: TMainMenu read FAppMenu write FAppMenu;
|
||||
procedure LoadMainMenu;
|
||||
function SaveMainMenu: TMainMenu;
|
||||
procedure MouseDownClick(MenuItem: PDesignerMenuItem; x,y: Integer);
|
||||
procedure Init(MenuItem: PDesignerMenuItem);
|
||||
procedure InitHook(MenuItem: PDesignerMenuItem);
|
||||
procedure Link(MenuItem: TMenuItem; ParentM: PDesignerMenuItem);
|
||||
procedure Erase(MenuItem: PDesignerMenuItem; C: TCanvas);
|
||||
procedure Draw(MenuItem: PDesignerMenuItem; C: TCanvas);
|
||||
procedure SetCoordinates(Coord_Left,Coord_Top: Integer;
|
||||
MenuItem: PDesignerMenuItem);
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
var
|
||||
temp_level: Integer;
|
||||
|
||||
constructor TDesignerMainMenu.CreateWithMenu(TheOwner: TComponent;
|
||||
AMenu: TMainMenu);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
new(Root);
|
||||
Root:=nil;
|
||||
AppMenu:=AMenu;
|
||||
temp_level:=1;
|
||||
end;
|
||||
|
||||
destructor TDesignerMainMenu.Destroy;
|
||||
begin
|
||||
Dispose(Root);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDesignerMainMenu.Init(MenuItem: PDesignerMenuItem);
|
||||
begin
|
||||
MenuItem^.coord.Left:=0;
|
||||
MenuItem^.coord.Top:=0;
|
||||
MenuItem^.coord.Right:=0;
|
||||
MenuItem^.coord.Bottom:=0;
|
||||
end;
|
||||
|
||||
procedure TDesignerMainMenu.InitHook(MenuItem: PDesignerMenuItem);
|
||||
begin
|
||||
MenuItem^.Selected:=false;
|
||||
Menuitem^.Active:=false;
|
||||
if (MenuItem^.SubMenu <> nil) then InitHook(MenuItem^.SubMenu);
|
||||
if (MenuItem^.NextItem <> nil) then InitHook(MenuItem^.NextItem);
|
||||
end;
|
||||
|
||||
procedure TDesignerMainMenu.LoadMainMenu;
|
||||
var
|
||||
prevtemp,temp: PDesignerMenuItem;
|
||||
i: Integer;
|
||||
begin
|
||||
prevtemp:=nil;
|
||||
for i:= 0 to AppMenu.Items.Count-1 do
|
||||
begin
|
||||
new(temp);
|
||||
temp^.Caption:=AppMenu.Items[i].Caption;
|
||||
temp^.Level:=temp_level;
|
||||
temp^.NextItem:=nil;
|
||||
temp^.SubMenu:=nil;
|
||||
temp^.ParentMenu:=nil;
|
||||
if (i=0) then
|
||||
begin
|
||||
temp^.PrevItem:=nil;
|
||||
Root:=temp;
|
||||
end else
|
||||
begin
|
||||
temp^.PrevItem:=prevtemp;
|
||||
prevtemp^.NextItem:=temp;
|
||||
end;
|
||||
Init(temp);
|
||||
prevtemp:=temp;
|
||||
Link(AppMenu.Items[i],temp);
|
||||
end;
|
||||
InitHook(Root);
|
||||
Root^.Selected:=true;
|
||||
end;
|
||||
|
||||
procedure TDesignerMainMenu.Link(MenuItem: TMenuItem; ParentM: PDesignerMenuItem);
|
||||
var
|
||||
prevtemp,temp: PDesignerMenuItem;
|
||||
i: Integer;
|
||||
begin
|
||||
inc(temp_level);
|
||||
if (MenuItem.Count > 0) then
|
||||
begin
|
||||
prevtemp:=nil;
|
||||
for i:= 0 to MenuItem.Count-1 do
|
||||
begin
|
||||
new(temp);
|
||||
temp^.Caption:=MenuItem.Items[i].Caption;
|
||||
temp^.Level:=temp_level;
|
||||
temp^.NextItem:=nil;
|
||||
temp^.SubMenu:=nil;
|
||||
if (i=0) then
|
||||
begin
|
||||
temp^.ParentMenu:=ParentM;
|
||||
temp^.PrevItem:=nil;
|
||||
ParentM^.SubMenu:=temp;
|
||||
end else
|
||||
begin
|
||||
temp^.PrevItem:=prevtemp;
|
||||
prevtemp^.NextItem:=temp;
|
||||
temp^.ParentMenu:=nil;
|
||||
end;
|
||||
Init(temp);
|
||||
prevtemp:=temp;
|
||||
Link(MenuItem.Items[i],temp);
|
||||
end;
|
||||
end;
|
||||
dec(temp_level);
|
||||
end;
|
||||
|
||||
procedure TDesignerMainMenu.Erase(MenuItem: PDesignerMenuItem; C: TCanvas);
|
||||
begin
|
||||
with C do
|
||||
begin
|
||||
Brush.Color:=clBackground;
|
||||
FillRect(Rect(MenuItem^.coord.Left,MenuItem^.coord.Top,MenuItem^.coord.Right,MenuItem^.coord.Bottom));
|
||||
end;
|
||||
if (MenuItem^.SubMenu <> nil) then Erase(MenuItem^.SubMenu,C);
|
||||
if (MenuItem^.NextItem <> nil) then Erase(MenuItem^.NextItem,C);
|
||||
end;
|
||||
|
||||
procedure TDesignerMainMenu.Draw(MenuItem: PDesignerMenuItem; C: TCanvas);
|
||||
begin
|
||||
with C do
|
||||
begin
|
||||
if (MenuItem^.Selected) then
|
||||
begin
|
||||
Brush.Color:=clNavy;
|
||||
FillRect(Rect(MenuItem^.coord.Left,MenuItem^.coord.Top,MenuItem^.coord.Right,MenuItem^.coord.Bottom));
|
||||
Font.color:=clYellow;
|
||||
end else
|
||||
if (MenuItem^.Active) then
|
||||
begin
|
||||
Brush.Color:=clGray;
|
||||
FillRect(Rect(MenuItem^.coord.Left,MenuItem^.coord.Top,MenuItem^.coord.Right,MenuItem^.coord.Bottom));
|
||||
Font.Color:=clBlack;
|
||||
end else
|
||||
begin
|
||||
Brush.Color:=clSilver;
|
||||
FillRect(Rect(MenuItem^.coord.Left,MenuItem^.coord.Top,MenuItem^.coord.Right,MenuItem^.coord.Bottom));
|
||||
Font.Color:=clBlack;
|
||||
end;
|
||||
TextOut(MenuItem^.coord.Left + 5,MenuItem^.coord.Top + 3,MenuItem^.Caption);
|
||||
end;
|
||||
if ((MenuItem^.SubMenu <> nil) and ((MenuItem^.Selected) or (MenuItem^.Active))) then Draw(MenuItem^.SubMenu,C);
|
||||
if (MenuItem^.NextItem <> nil) then Draw(MenuItem^.NextItem,C);
|
||||
end;
|
||||
|
||||
function TDesignerMainMenu.SaveMainMenu: TMainMenu;
|
||||
var
|
||||
temp: PDesignerMenuItem;
|
||||
begin
|
||||
Result:=nil;
|
||||
temp:=Root;
|
||||
while (temp^.NextItem <> nil) do
|
||||
begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDesignerMainMenu.SetCoordinates(Coord_Left,Coord_Top: Integer; MenuItem: PDesignerMenuItem);
|
||||
var
|
||||
temp_menuitem: PDesignerMenuItem;
|
||||
LongestWidth: Integer;
|
||||
begin
|
||||
if (MenuItem^.Level = 1) then
|
||||
begin
|
||||
writeln(MenuItem^.Caption,' - ',MenuItem^.Level);
|
||||
MenuItem^.coord.Left:=Coord_Left;
|
||||
MenuItem^.coord.Top:=Coord_Top;
|
||||
MenuItem^.coord.Right:=MenuItem^.coord.Left + Canvas.TextWidth(MenuItem^.Caption) + 10;
|
||||
MenuItem^.coord.Bottom:=MenuItem^.coord.Top + Canvas.TextHeight('aaa') + 10;
|
||||
end else
|
||||
begin
|
||||
temp_menuitem:=MenuItem;
|
||||
LongestWidth:=Canvas.TextWidth(temp_menuitem^.Caption);
|
||||
while (temp_menuitem^.PrevItem <> nil) do temp_menuitem:=temp_menuitem^.PrevItem;
|
||||
while (temp_menuitem <> nil) do
|
||||
begin
|
||||
if (Canvas.TextWidth(temp_menuitem^.Caption) > LongestWidth) then
|
||||
LongestWidth:=Canvas.TextWidth(temp_menuitem^.Caption);
|
||||
temp_menuitem:=temp_menuitem^.NextItem;
|
||||
end;
|
||||
MenuItem^.coord.Left:=Coord_Left;
|
||||
MenuItem^.coord.Top:=Coord_Top;
|
||||
MenuItem^.coord.Right:=MenuItem^.coord.Left + LongestWidth + 10;
|
||||
MenuItem^.coord.Bottom:=MenuItem^.coord.Top + Canvas.TextHeight('aaa') + 10;
|
||||
end;
|
||||
if (MenuItem^.SubMenu <> nil) then
|
||||
begin
|
||||
if (MenuItem^.Level = 1) then
|
||||
SetCoordinates(MenuItem^.coord.Left,MenuItem^.coord.Bottom + 1,MenuItem^.SubMenu)
|
||||
else
|
||||
SetCoordinates(MenuItem^.coord.Right + 1,MenuItem^.coord.Top,MenuItem^.SubMenu);
|
||||
end;
|
||||
if (MenuItem^.NextItem <> nil) then
|
||||
begin
|
||||
if (MenuItem^.Level = 1) then
|
||||
SetCoordinates(MenuItem^.coord.Right + 1,MenuItem^.coord.Top,MenuItem^.NextItem)
|
||||
else
|
||||
SetCoordinates(MenuItem^.coord.Left,MenuItem^.coord.Bottom + 1,MenuItem^.NextItem);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TDesignerMainMenu.MouseDownClick(MenuItem: PDesignerMenuItem;
|
||||
x,y: Integer);
|
||||
var
|
||||
temp_menuitem: PDesignerMenuItem;
|
||||
clickArea: Boolean;
|
||||
begin
|
||||
clickArea:=false;
|
||||
if (MenuItem <> nil) then
|
||||
begin
|
||||
writeln(MenuItem^.Caption,',',MenuItem^.Selected,',',MenuItem^.Active);
|
||||
if ((MenuItem^.Selected) or (MenuItem^.Active)) then clickArea:=true;
|
||||
if ((MenuItem^.coord.Left <= x) and (MenuItem^.coord.Right >= x) and
|
||||
(MenuItem^.coord.Top <= y) and (MenuItem^.coord.Bottom >= y)) then
|
||||
begin
|
||||
InitHook(Root);
|
||||
MenuItem^.Selected:=true;
|
||||
temp_menuitem:=MenuItem;
|
||||
while ((temp_menuitem^.ParentMenu <> nil) or (temp_menuitem^.PrevItem <> nil)) do
|
||||
begin
|
||||
if (temp_menuitem^.ParentMenu <> nil) then
|
||||
begin
|
||||
temp_menuitem^.ParentMenu^.Active:=true;
|
||||
temp_menuitem:=temp_menuitem^.ParentMenu;
|
||||
end else
|
||||
if (temp_menuitem^.PrevItem <> nil) then temp_menuitem:=temp_menuitem^.PrevItem;
|
||||
end;
|
||||
end;
|
||||
if (clickArea) then MouseDownClick(MenuItem^.SubMenu,x,y);
|
||||
MouseDownClick(MenuItem^.NextItem,x,y);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
138
designer/menueditorform.pas
Normal file
138
designer/menueditorform.pas
Normal file
@ -0,0 +1,138 @@
|
||||
unit MenuEditorForm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, StdCtrls,
|
||||
Buttons, ExtCtrls, LMessages, DesignerMenu, Menus, GraphType,
|
||||
ComponentEditors;
|
||||
|
||||
type
|
||||
|
||||
TMainMenuEditorForm = class(TForm)
|
||||
private
|
||||
FDesignerMainMenu: TDesignerMainMenu;
|
||||
FCanvas: TCanvas;
|
||||
public
|
||||
constructor CreateWithMenu(TheOwner: TComponent; AMenu: TMainMenu);
|
||||
destructor Destroy; override;
|
||||
procedure Paint; override;
|
||||
procedure MouseDownClick(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X,Y: Integer);
|
||||
property DesignerMainMenu: TDesignerMainMenu read FDesignerMainMenu
|
||||
write FDesignerMainMenu;
|
||||
property Canvas: TCanvas read FCanvas write FCanvas;
|
||||
end;
|
||||
|
||||
{ TMenuComponentEditor
|
||||
The default component editor for TMenu. }
|
||||
TMainMenuComponentEditor = class(TDefaultComponentEditor)
|
||||
private
|
||||
FMenu: TMainMenu;
|
||||
protected
|
||||
public
|
||||
constructor Create(AComponent: TComponent;
|
||||
ADesigner: TComponentEditorDesigner); override;
|
||||
procedure Edit; override;
|
||||
property Menu: TMainMenu read FMenu write FMenu;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TMainMenuEditorForm }
|
||||
|
||||
constructor TMainMenuEditorForm.CreateWithMenu(TheOwner: TComponent;
|
||||
AMenu: TMainMenu);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
Canvas:=inherited Canvas;
|
||||
self.width:=800;
|
||||
self.height:=600;
|
||||
self.position:=poDesktopCenter;
|
||||
self.OnMouseDown:=@MouseDownClick;
|
||||
|
||||
DesignerMainMenu:=TDesignerMainMenu.CreateWithMenu(Self,AMenu);
|
||||
with DesignerMainMenu do
|
||||
begin
|
||||
LoadMainMenu;
|
||||
SetCoordinates(1,1,DesignerMainMenu.Root);
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMainMenuEditorForm.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMainMenuEditorForm.Paint;
|
||||
begin
|
||||
inherited Paint;
|
||||
DesignerMainMenu.Erase(DesignerMainmenu.Root,Canvas);
|
||||
DesignerMainMenu.Draw(DesignerMainMenu.Root,Canvas);
|
||||
end;
|
||||
|
||||
procedure TMainMenuEditorForm.MouseDownClick(Sender: TObject;
|
||||
Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
|
||||
begin
|
||||
DesignerMainMenu.MouseDownClick(DesignerMainMenu.Root,X,Y);
|
||||
Paint;
|
||||
end;
|
||||
|
||||
{ TMainMenuComponentEditor}
|
||||
|
||||
constructor TMainMenuComponentEditor.Create(AComponent: TComponent;
|
||||
ADesigner: TComponentEditorDesigner);
|
||||
var
|
||||
m1: TMenuItem;
|
||||
m2: TMenuItem;
|
||||
m3: TMenuItem;
|
||||
m4: TMenuItem;
|
||||
m5: TMenuItem;
|
||||
m6: TMenuItem;
|
||||
m7: TMenuItem;
|
||||
m8: TMenuItem;
|
||||
begin
|
||||
inherited Create(AComponent,ADesigner);
|
||||
Menu:=TMainMenu.Create(AComponent);
|
||||
m1:=TMenuItem.Create(AComponent);
|
||||
m1.Caption:='File';
|
||||
Menu.Items.Add(m1);
|
||||
m2:=TMenuItem.Create(AComponent);
|
||||
m2.Caption:='Power';
|
||||
Menu.Items.Add(m2);
|
||||
m3:=TMenuItem.Create(AComponent);
|
||||
m3.Caption:='Settings';
|
||||
Menu.Items.Add(m3);
|
||||
m4:=TMenuItem.Create(AComponent);
|
||||
m4.Caption:='New';
|
||||
m1.Add(m4);
|
||||
m5:=TMenuItem.Create(AComponent);
|
||||
m5.Caption:='Wizard';
|
||||
m1.Add(m5);
|
||||
m6:=TMenuItem.Create(AComponent);
|
||||
m6.Caption:='Project';
|
||||
m5.Add(m6);
|
||||
m7:=TMenuItem.Create(AComponent);
|
||||
m7.Caption:='Power On';
|
||||
m2.Add(m7);
|
||||
m8:=TMenuItem.Create(AComponent);
|
||||
m8.Caption:='Another Caption';
|
||||
m6.Add(m8);
|
||||
end;
|
||||
|
||||
procedure TMainMenuComponentEditor.Edit;
|
||||
var
|
||||
MainMenuEditorForm: TMainMenuEditorForm;
|
||||
begin
|
||||
MainMenuEditorForm:=TMainMenuEditorForm.CreateWithMenu(Application,Menu);
|
||||
MainMenuEditorForm.ShowModal;
|
||||
MainMenuEditorForm.Free;
|
||||
end;
|
||||
{ //TMainMenuComponentEditor}
|
||||
|
||||
initialization
|
||||
RegisterComponentEditor(TMainMenu,TMainMenuComponentEditor);
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user