diff --git a/Packages/D7/X2CLMB.cfg b/Packages/D7/X2CLMB.cfg index 5b840e3..524454c 100644 --- a/Packages/D7/X2CLMB.cfg +++ b/Packages/D7/X2CLMB.cfg @@ -31,9 +31,9 @@ -M -$M16384,1048576 -K$00400000 --N"..\..\Lib\D7" --LE"..\..\Lib\D7" --LN"..\..\Lib\D7" +-N"P:\algemeen\lib" +-LE"P:\algemeen\bin" +-LN"P:\algemeen\lib" -Z -w-UNSAFE_TYPE -w-UNSAFE_CODE diff --git a/Packages/D7/X2CLMB.dof b/Packages/D7/X2CLMB.dof index b236d25..9290434 100644 --- a/Packages/D7/X2CLMB.dof +++ b/Packages/D7/X2CLMB.dof @@ -91,9 +91,9 @@ ImageBase=4194304 ExeDescription=X²CL MenuBar [Directories] OutputDir= -UnitOutputDir=..\..\Lib\D7 -PackageDLLOutputDir=..\..\Lib\D7 -PackageDCPOutputDir=..\..\Lib\D7 +UnitOutputDir=$(DELPHILIB) +PackageDLLOutputDir=$(DELPHIBIN) +PackageDCPOutputDir=$(DELPHILIB) SearchPath= Packages=vcl;rtl;vclx;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;CLXIB;ibxpress;VCLIB;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOfficeXP;Indy70;cxLibraryVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtDBItemsD7;dxBarExtItemsD7;dxDockingD7;dxsbD7;cxEditorsVCLD7;dxThemeD7;cxDataD7;cxExtEditorsVCLD7;cxPageControlVCLD7;cxGridVCLD7;cxSchedulerVCLD7;dxMasterViewD7;dxmdsD7;dxPSCoreD7;dxPSTeeChartD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSdxMVLnkD7;dxPSDBTeeChartD7;dxPScxCommonD7;dxPScxPCProdD7;dxPScxGridLnkD7;dxPScxExtCommonD7;dxPScxScheduler2LnkD7;wpViewPDF_D7;Rave50CLX;Rave50VCL;xtx_d7;IBSQLProperty;SamPackage;rbTCUI107;rbTC107;rbRCL107;rbIDE107;rbBDE107;rbUSERDesign107;rbUSER107;madBasic_;madDisAsm_;madExcept_;unageneral_d7 Conditionals= @@ -143,14 +143,17 @@ Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; Count=1 Item0=P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System [HistoryLists\hlUnitOutputDirectory] -Count=3 -Item0=..\..\Lib\D7 -Item1=..\Lib\D7 -Item2=Lib\D7 +Count=4 +Item0=$(DELPHILIB) +Item1=..\..\Lib\D7 +Item2=..\Lib\D7 +Item3=Lib\D7 [HistoryLists\hlBPLOutput] -Count=2 -Item0=..\..\Lib\D7 -Item1=Lib\D7 +Count=3 +Item0=$(DELPHIBIN) +Item1=..\..\Lib\D7 +Item2=Lib\D7 [HistoryLists\hlDCPOutput] -Count=1 -Item0=..\..\Lib\D7 +Count=2 +Item0=$(DELPHILIB) +Item1=..\..\Lib\D7 diff --git a/Packages/D7/X2CLMB.dpk b/Packages/D7/X2CLMB.dpk index 79a932b..7aa9a8b 100644 --- a/Packages/D7/X2CLMB.dpk +++ b/Packages/D7/X2CLMB.dpk @@ -38,7 +38,8 @@ contains X2CLGraphics in '..\..\Source\X2CLGraphics.pas', X2CLMenuBarAnimators in '..\..\Source\X2CLMenuBarAnimators.pas', X2CLMenuBar in '..\..\Source\X2CLMenuBar.pas', - X2CLmusikCubeMenuBarPainter in '..\..\Source\X2CLmusikCubeMenuBarPainter.pas'; + X2CLmusikCubeMenuBarPainter in '..\..\Source\X2CLmusikCubeMenuBarPainter.pas', + X2CLMenuBarActions in '..\..\Source\X2CLMenuBarActions.pas'; end. diff --git a/Packages/X2CLGraphicsEditor.dfm b/Packages/X2CLGraphicsEditor.dfm index a6488fe..d3d4fa8 100644 --- a/Packages/X2CLGraphicsEditor.dfm +++ b/Packages/X2CLGraphicsEditor.dfm @@ -119,10 +119,14 @@ object GraphicsEditorForm: TGraphicsEditorForm Top = 26 Width = 189 Height = 398 + Style = lbVirtual Align = alClient ItemHeight = 13 TabOrder = 1 OnClick = lstGraphicsClick + OnData = lstGraphicsData + OnDataFind = lstGraphicsDataFind + OnKeyPress = lstGraphicsKeyPress end object tbGraphics: TToolBar Left = 0 diff --git a/Packages/X2CLGraphicsEditor.pas b/Packages/X2CLGraphicsEditor.pas index 48817be..324ce26 100644 --- a/Packages/X2CLGraphicsEditor.pas +++ b/Packages/X2CLGraphicsEditor.pas @@ -67,6 +67,11 @@ type procedure actOpenExecute(Sender: TObject); procedure actSaveExecute(Sender: TObject); procedure actClearExecute(Sender: TObject); + procedure lstGraphicsData(Control: TWinControl; Index: Integer; + var Data: String); + function lstGraphicsDataFind(Control: TWinControl; + FindString: String): Integer; + procedure lstGraphicsKeyPress(Sender: TObject; var Key: Char); private FComponent: TX2GraphicContainer; FComponentDesigner: IDesigner; @@ -74,7 +79,7 @@ type procedure InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner); - procedure LoadGraphic(AIndex: Integer; AGraphic: TX2GraphicContainerItem; const AFileName: string); + procedure LoadGraphic(AGraphic: TX2GraphicContainerItem; const AFileName: string); procedure ItemChanged(AUpdatePreview: Boolean = True); procedure UpdateUI(); @@ -90,7 +95,8 @@ type implementation uses Graphics, - SysUtils; + SysUtils, + Windows; var @@ -110,9 +116,6 @@ begin end; procedure TGraphicsEditorForm.InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner); -var - graphicIndex: Integer; - begin FComponent := TX2GraphicContainer(AComponent); FComponent.FreeNotification(Self); @@ -120,22 +123,8 @@ begin FComponentDesigner := ADesigner; Caption := Format('%s Graphics', [FComponent.Name]); - // Fill graphics list - with lstGraphics.Items do - begin - BeginUpdate(); - try - Clear(); - - for graphicIndex := 0 to FComponent.GraphicCount - 1 do - AddObject(FComponent.Graphics[graphicIndex].PictureName, - FComponent.Graphics[graphicIndex]); - finally - EndUpdate(); - end; - - lstGraphics.ItemIndex := 0; - end; + lstGraphics.Count := FComponent.GraphicCount; + lstGraphics.ItemIndex := 0; UpdateUI(); UpdatePreview(); @@ -155,13 +144,13 @@ begin end; -procedure TGraphicsEditorForm.LoadGraphic(AIndex: Integer; AGraphic: TX2GraphicContainerItem; const AFileName: string); +procedure TGraphicsEditorForm.LoadGraphic(AGraphic: TX2GraphicContainerItem; const AFileName: string); begin AGraphic.Picture.LoadFromFile(AFileName); if Length(AGraphic.PictureName) = 0 then begin - AGraphic.PictureName := ChangeFileExt(ExtractFileName(AFileName), ''); - lstGraphics.Items[AIndex] := AGraphic.PictureName; + AGraphic.PictureName := ChangeFileExt(ExtractFileName(AFileName), ''); + lstGraphics.Invalidate; end; end; @@ -169,12 +158,12 @@ end; procedure TGraphicsEditorForm.ItemChanged(AUpdatePreview: Boolean); begin if Assigned(FComponentDesigner) then - FComponentDesigner.Modified(); + FComponentDesigner.Modified; UpdateUI(); if AUpdatePreview then - UpdatePreview(); + UpdatePreview; end; @@ -198,7 +187,7 @@ begin actClear.Enabled := enabled; actUp.Enabled := enabled and (index > 0); - actDown.Enabled := enabled and (index < Pred(lstGraphics.Items.Count)); + actDown.Enabled := enabled and (index < Pred(FComponent.GraphicCount)); end; @@ -213,8 +202,8 @@ begin if Active(index, graphic) then begin imgPreview.Picture.Assign(graphic.Picture); - txtName.Text := graphic.PictureName; - lstGraphics.Items[index] := graphic.PictureName; + txtName.Text := graphic.PictureName; + lstGraphics.Invalidate; end else begin imgPreview.Picture.Assign(nil); @@ -234,7 +223,7 @@ begin if AIndex = -1 then exit; - AGraphic := TX2GraphicContainerItem(lstGraphics.Items.Objects[AIndex]); + AGraphic := FComponent.Graphics[AIndex]; Result := Assigned(AGraphic); end; @@ -257,8 +246,8 @@ begin if Active(index, graphic) then begin - graphic.PictureName := txtName.Text; - lstGraphics.Items[index] := graphic.PictureName; + graphic.PictureName := txtName.Text; + lstGraphics.Invalidate; ItemChanged(False); end; @@ -267,7 +256,6 @@ end; procedure TGraphicsEditorForm.actAddExecute(Sender: TObject); var - index: Integer; graphic: TX2GraphicContainerItem; fileIndex: Integer; @@ -285,11 +273,10 @@ begin if Assigned(graphic) then begin - graphic.Container := FComponent; - index := lstGraphics.Items.AddObject('', graphic); - lstGraphics.ItemIndex := index; + graphic.Container := FComponent; + lstGraphics.Count := FComponent.GraphicCount; - LoadGraphic(index, graphic, dlgOpen.Files[fileIndex]); + LoadGraphic(graphic, dlgOpen.Files[fileIndex]); end else raise Exception.Create('Failed to create TX2GraphicContainerItem!'); end; @@ -313,10 +300,10 @@ begin if it's not allowed, for example due to it being introduced in an ancestor. } graphic.Free(); - lstGraphics.Items.Delete(index); + lstGraphics.Count := FComponent.GraphicCount; - if index > Pred(lstGraphics.Items.Count) then - index := Pred(lstGraphics.Items.Count); + if index > Pred(FComponent.GraphicCount) then + index := Pred(FComponent.GraphicCount); lstGraphics.ItemIndex := index; @@ -334,9 +321,9 @@ begin if Active(index, graphic) then if index > 0 then begin - lstGraphics.Items.Move(index, Pred(index)); graphic.Index := Pred(index); lstGraphics.ItemIndex := Pred(index); + lstGraphics.Invalidate; ItemChanged(False); end; @@ -350,11 +337,11 @@ var begin if Active(index, graphic) then - if index < Pred(lstGraphics.Items.Count) then + if index < Pred(FComponent.GraphicCount) then begin - lstGraphics.Items.Move(index, index + 1); graphic.Index := Succ(index); lstGraphics.ItemIndex := Succ(index); + lstGraphics.Invalidate; ItemChanged(False); end; @@ -374,7 +361,7 @@ begin if dlgOpen.Execute() then begin - LoadGraphic(index, graphic, dlgOpen.FileName); + LoadGraphic(graphic, dlgOpen.FileName); ItemChanged(); end; end; @@ -423,4 +410,34 @@ begin end; end; + +procedure TGraphicsEditorForm.lstGraphicsData(Control: TWinControl; Index: Integer; var Data: String); +begin + Data := Format('%d - %s', [Index, FComponent.Graphics[Index].PictureName]); +end; + + +function TGraphicsEditorForm.lstGraphicsDataFind(Control: TWinControl; FindString: String): Integer; +var + graphicIndex: Integer; + +begin + Result := -1; + + for graphicIndex := 0 to Pred(FComponent.GraphicCount) do + if SameText(Copy(FComponent.Graphics[graphicIndex].PictureName, 1, Length(FindString)), FindString) then + begin + Result := graphicIndex; + Break; + end; +end; + + +procedure TGraphicsEditorForm.lstGraphicsKeyPress(Sender: TObject; var Key: Char); +begin + { Because the listbox is virtual, Return causes the ItemIndex to reset to 0 } + if Ord(Key) = VK_RETURN then + Key := #0; +end; + end. diff --git a/Packages/X2CLMBEditors.pas b/Packages/X2CLMBEditors.pas index 39557a0..92a7078 100644 --- a/Packages/X2CLMBEditors.pas +++ b/Packages/X2CLMBEditors.pas @@ -10,6 +10,7 @@ unit X2CLMBEditors; interface uses DesignEditors; + type TX2MenuBarComponentEditor = class(TComponentEditor) @@ -20,12 +21,14 @@ type function GetVerbCount(): Integer; override; end; + implementation uses X2CLMenuBar, X2CLMenuBarEditor; + { TX2MenuBarComponentEditor } procedure TX2MenuBarComponentEditor.Edit(); begin @@ -33,16 +36,19 @@ begin TfrmMenuBarEditor.Execute(TX2CustomMenuBar(Component), Designer); end; + procedure TX2MenuBarComponentEditor.ExecuteVerb(Index: Integer); begin Edit(); end; + function TX2MenuBarComponentEditor.GetVerb(Index: Integer): string; begin Result := 'Edit...'; end; + function TX2MenuBarComponentEditor.GetVerbCount(): Integer; begin Result := 1; diff --git a/Packages/X2CLMenuBarEditor.dfm b/Packages/X2CLMenuBarEditor.dfm index cef4d80..4794541 100644 --- a/Packages/X2CLMenuBarEditor.dfm +++ b/Packages/X2CLMenuBarEditor.dfm @@ -1,10 +1,10 @@ object frmMenuBarEditor: TfrmMenuBarEditor - Left = 0 - Top = 0 + Left = 271 + Top = 101 + Width = 394 + Height = 469 BorderIcons = [biSystemMenu] Caption = 'Editing' - ClientHeight = 376 - ClientWidth = 276 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -22,20 +22,21 @@ object frmMenuBarEditor: TfrmMenuBarEditor TextHeight = 13 object tvMenu: TTreeView Left = 0 - Top = 26 - Width = 276 - Height = 331 + Top = 28 + Width = 386 + Height = 395 Align = alClient HideSelection = False Indent = 19 ReadOnly = True TabOrder = 0 OnChange = tvMenuChange + OnKeyPress = tvMenuKeyPress end object sbStatus: TStatusBar Left = 0 - Top = 357 - Width = 276 + Top = 423 + Width = 386 Height = 19 Panels = < item @@ -45,40 +46,307 @@ object frmMenuBarEditor: TfrmMenuBarEditor object tbMenu: TToolBar Left = 0 Top = 0 - Width = 276 - Height = 26 + Width = 386 + Height = 28 AutoSize = True - ButtonWidth = 84 EdgeBorders = [ebTop, ebBottom] Images = ilsActions - List = True - ShowCaptions = True TabOrder = 2 object tbAddGroup: TToolButton Left = 0 - Top = 0 + Top = 2 Action = actAddGroup - AutoSize = True end object tbAddItem: TToolButton - Left = 81 - Top = 0 + Left = 23 + Top = 2 Action = actAddItem - AutoSize = True end object tbDelete: TToolButton - Left = 154 - Top = 0 + Left = 46 + Top = 2 Action = actDelete - AutoSize = True + end + object tbSep1: TToolButton + Left = 69 + Top = 2 + Width = 8 + ImageIndex = 3 + Style = tbsSeparator + end + object tbMoveUp: TToolButton + Left = 77 + Top = 2 + Action = actMoveUp + end + object tbMoveDown: TToolButton + Left = 100 + Top = 2 + Action = actMoveDown end end object ilsActions: TImageList - Left = 8 - Top = 32 + Left = 24 + Top = 44 Bitmap = { - 494C010103000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 - 0000000000003600000028000000400000001000000001002000000000000010 + 494C010105000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000003000000001002000000000000030 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000069AC69005EAB5E0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000022AD350028B13E0071AF7100000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000020B7300069FFA30056D588001AA22700000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000001EAC240067FFA2005BF6900057F48D004CCB7E00169C1F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00001DA1210063FF9C005AF5900055EF890052ED860051EC860045C576001795 + 1C00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000000028A0 + 2B0068FFA20079FFA9006AF39A0051EB850050EA83004CE781004EEA860043C4 + 7500219426000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000228D23001093 + 1A001C97260049CA63008BF8B1004BE87F004DE7800049DD7D0028A946000D87 + 18000B8714001C831D0000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000199B270086F8B00047E57C0049E47D004ADF7F00128A1F000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000001A9B290083F6AE0044E2790046E17A0047DE7C00138A21000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000001A9929007FF3A90041DF760043DD770044DC7B00138921000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000001996260076F0A3003CDC71003FDA730041D97600118720000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000001997280097FCC2006BEC9B005BE98F004BE28400128923000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000077B0B0010881D000D8318001081180014851F0009750D000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -102,7 +370,7 @@ object frmMenuBarEditor: TfrmMenuBarEditor 770000750000BDA99D000000000000000000000000004E4EAB001844F600194D F8001031D2002427AE000000000000000000000000004E4EAB000928D700092E D7000313B3004E4EAB0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000A7B0E00128A1E000F8018000E791600117919000E7510000000 0000000000000000000000000000000000000000000000000000689BAF001989 B700007EB10090EFFF0030E0FF007AEEFF0000860000008600000086000048E1 7B00007500000075000000750000000000000000000000000000A27F6F00FFFF @@ -110,7 +378,7 @@ object frmMenuBarEditor: TfrmMenuBarEditor 7B0000750000007500000075000000000000000000002022B1002451F9001F51 FF00194DF8001744E8001017AF00000000004545AD00092ED7001142F9000D3D F5000D3DF500041ABC006F6FAA00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000025A93C0069F59E0044E47E0045E57F0045E17F00189230000000 00000000000000000000000000000000000000000000000000003B92B4003B9F C600007EB1009FF1FF0046E2FF0090EFFF00008D00005EF791005AF38D0053EC 860048E17B0045DE780000750000000000000000000000000000A3807000FFFF @@ -118,7 +386,7 @@ object frmMenuBarEditor: TfrmMenuBarEditor 860048E17B0045DE7800007500000000000000000000000000001832DB00285A FF002451F9002451F9001A4AF100060EAF000F30DD00164AFE001142F9001041 F6000D3DF5000D3DF5002C2CA200000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000022A7370077EFA40040DC750041DB740042DB7900188D2B000000 0000000000000000000000000000000000000000000074A0B1000E84B700B6F5 FB000081B400B6F5FB005EECFF00A3F3FF0000910000008D0000008D00005AF3 8D0000860000007D0000007D0000000000000000000000000000A9877800FFFF @@ -126,7 +394,7 @@ object frmMenuBarEditor: TfrmMenuBarEditor 8D0000860000007D0000007D000000000000000000007777B3001832DB004170 FF002D5DFF00285AFF00285AFF001F51FF00194DF800194DF8001142F9001142 F9000F3DF200161CAC0000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000025AC3A007DF3A90042DF770043DE770045DE7C0018902B000000 000000000000000000000000000000000000000000004596B40044A5C900DDFF FF000084B700C0FBFF0077F4FF00B6F5FB00ADF6FF00ADF6FF00008D00005EF7 910000860000C3F1F80061A8C700000000000000000000000000AB897A00FFFF @@ -134,7 +402,7 @@ object frmMenuBarEditor: TfrmMenuBarEditor 910000860000C8B7AE00000000000000000000000000000000006969B8001A25 C5003A6DFF003668FF00285AFF00285AFF002451F900194DF8001F51FF00123D ED002427AE000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000026AF3C0085F6AE0044E2790046E0790048E17E001B942E000000 000000000000000000000000000000000000000000002790B800ABDCEA00E6FE FE000084B700D2FFFF008EFDFF0089FAFF0082F6FF00B0F7FF00009100000091 0000008D0000C1FDFF000072A500000000000000000000000000AB897A00FFFF @@ -142,39 +410,39 @@ object frmMenuBarEditor: TfrmMenuBarEditor 0000008D0000BFABA10000000000000000000000000000000000000000000000 00002F2FB3002E4EE7003668FF00285AFF00285AFF002451F900123DED002C2C A200000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000028B03A008CF8B50048E57C0049E37D004AE2810019932B000000 000000000000000000000000000000000000000000000A8CBC00C9F6FA00F1FF FF000088BB00DDFFFF00A1FFFF00A1FFFF0094F8FF00C0FBFF00C0FBFF00B0F7 FF00C3EDF500DDFFFF000072A500000000000000000000000000B1908000FFFF FF00FFFFFF00FFFFFF00FFFFFF00FCF8F100FFFFFF00FCF8F100FFFFFF00FCF8 F100FCF6ED009B7C6B0000000000000000000000000000000000000000000000 000000000000253FDF003A6DFF003668FF002D5DFF00285AFF001B46EA002427 - AE00000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000018DC0000F92C1007EC4 + AE000000000000000000000000000000000000000000000000003397330015A7 + 23001BB02E0035C9550063F3960050EA83004DE780004BE27F00249A3D001293 + 210011981E002B8C2B00000000000000000000000000018DC0000F92C1007EC4 DD000088BB00C3EDF5007ADBEA0085E3EF0092F0F800A1FFFF0094F8FF0065D2 E700ADF6FF00DDFFFF000079AC00000000000000000000000000AF8F8000FFFF FF00DFCDCB00DFCDCB00DBC6C200DECAC600DDC1B400DDC1B400DEBEAD00DEBE AD00FCF6ED009B7C6B0000000000000000000000000000000000000000000000 00002B2CC0004B7CFF004170FF003A6DFF003A6DFF00285AFF00285AFF001031 - D2004A4AB2000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + D2004A4AB200000000000000000000000000000000000000000000000000279E + 2A009EFFC7007DFFAD0053F1890052EB850050E983004CE580004DE583004FEC + 8A00229628000000000000000000000000000000000000000000000000000000 0000018DC000F1FFFF00C3F1F800ABE7F10081D4E60065C6DF0065C6DF005FC2 DB00D2FFFF00E6FEFE000079AC00000000000000000000000000B1908000FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FCF8F100FCF8F100F9F4 EE00F0E8E0009C7D6D0000000000000000000000000000000000000000000000 0000253FDF00527CFA004170FF003668FF000C13C1003A6DFF00285AFF002451 F9000B1DC2000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 00001AA11F00A0FFC50062F7960053EF880051EB840050EA860051ED8A001A99 + 2000000000000000000000000000000000000000000000000000000000000000 00001A96C50031A5CD004AB0D30083CDE200D0EFF600E6FEFE00F1FFFF00E6FE FE00DDFFFF00F1FFFF000079AC00000000000000000000000000B1908000FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A3807000A782 7000A7827000A380700000000000000000000000000000000000000000004F4F BD00527CFA005080FF004B7CFF00181FC500000000001B22C4003A6DFF00285A FF001A4AF1001419B10000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000001AA82200A4FFC9005CF3900053EF890059F5930019A624000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000589FBA003298BE002390BC00158FBF00FFFF FF00FFFFFF00FFFFFF00007EB100000000000000000000000000B8988800FFFF @@ -182,7 +450,7 @@ object frmMenuBarEditor: TfrmMenuBarEditor D900B1908000AB9E98000000000000000000000000000000000000000000252D D6006A9CFF005788FF002E4EE7007070B90000000000000000001621C7002D5D FF002451F9001439DD004545AD00000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000021B42D00A4FFCC0072FEA9001DB32C00000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000000088BB00EDF6 FA00FFFFFF00FFFFFF00007EB100000000000000000000000000B8988800FFFF @@ -190,7 +458,7 @@ object frmMenuBarEditor: TfrmMenuBarEditor 7D00AB9E98000000000000000000000000000000000000000000000000004B4B C8003951E2005080FF002929C600000000000000000000000000000000001628 D300285AFF000F2EE3002123B500000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000035C84A0037CD500074AC7400000000000000 0000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000002F99C3000084 B7000084B7000081B4004388A900000000000000000000000000B8988800B898 @@ -198,7 +466,7 @@ object frmMenuBarEditor: TfrmMenuBarEditor 9800000000000000000000000000000000000000000000000000000000000000 0000000000003E3EB90000000000000000000000000000000000000000006B6B B6002E2EB5000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000006EAC6E0063AB630000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -208,18 +476,26 @@ object frmMenuBarEditor: TfrmMenuBarEditor 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000424D3E000000000000003E000000 - 2800000040000000100000000100010000000000800000000000000000000000 - 000000000000000000000000FFFFFF00FFFFFFFFFFFF0000E1C7C003C7CF0000 - E007C00383830000C001C00181010000C001C001C00100008001C00180030000 - 8001C003C00700008001C003F00F00008001C003F80F00008001C003F0070000 - F001C003F0070000F001C003E0830000FE01C003E0C10000FFC1C007E1E10000 - FFC1C00FFBE70000FFFFFFFFFFFF000000000000000000000000000000000000 + 2800000040000000300000000100010000000000800100000000000000000000 + 000000000000000000000000FFFFFF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FFFF000000000000FE7F000000000000 + FE3F000000000000FC3F000000000000F81F000000000000F00F000000000000 + E007000000000000C003000000000000F81F000000000000F81F000000000000 + F81F000000000000F81F000000000000F81F000000000000F81F000000000000 + FFFF000000000000FFFF000000000000FFFFFFFFFFFFFFFFE1C7C003C7CFFFFF + E007C0038383F81FC001C0018101F81FC001C001C001F81F8001C0018003F81F + 8001C003C007F81F8001C003F00FF81F8001C003F80FC0038001C003F007E007 + F001C003F007F00FF001C003E083F81FFE01C003E0C1FC3FFFC1C007E1E1FE3F + FFC1C00FFBE7FE7FFFFFFFFFFFFFFFFF00000000000000000000000000000000 000000000000} end object alMenu: TActionList Images = ilsActions - Left = 36 - Top = 32 + Left = 80 + Top = 44 object actAddGroup: TAction Caption = '&Add group' ImageIndex = 0 @@ -244,5 +520,17 @@ object frmMenuBarEditor: TfrmMenuBarEditor 'Ctrl+Del') OnExecute = actDeleteExecute end + object actMoveUp: TAction + Caption = 'Move &Up' + ImageIndex = 3 + ShortCut = 16422 + OnExecute = actMoveUpExecute + end + object actMoveDown: TAction + Caption = 'Move &Down' + ImageIndex = 4 + ShortCut = 16424 + OnExecute = actMoveDownExecute + end end end diff --git a/Packages/X2CLMenuBarEditor.pas b/Packages/X2CLMenuBarEditor.pas index caeddde..1f73514 100644 --- a/Packages/X2CLMenuBarEditor.pas +++ b/Packages/X2CLMenuBarEditor.pas @@ -7,17 +7,21 @@ uses ComCtrls, Controls, DesignIntf, + DesignWindows, Forms, ImgList, ToolWin, X2CLMenuBar; + type - TfrmMenuBarEditor = class(TForm, IX2MenuBarDesigner) + TfrmMenuBarEditor = class(TDesignWindow, IX2MenuBarDesigner) actAddGroup: TAction; actAddItem: TAction; actDelete: TAction; + actMoveDown: TAction; + actMoveUp: TAction; alMenu: TActionList; ilsActions: TImageList; sbStatus: TStatusBar; @@ -25,6 +29,9 @@ type tbAddItem: TToolButton; tbDelete: TToolButton; tbMenu: TToolBar; + tbMoveDown: TToolButton; + tbMoveUp: TToolButton; + tbSep1: TToolButton; tvMenu: TTreeView; procedure actDeleteExecute(Sender: TObject); @@ -36,10 +43,13 @@ type procedure FormDestroy(Sender: TObject); procedure tvMenuChange(Sender: TObject; Node: TTreeNode); procedure FormActivate(Sender: TObject); + procedure actMoveUpExecute(Sender: TObject); + procedure actMoveDownExecute(Sender: TObject); + procedure tvMenuKeyPress(Sender: TObject; var Key: Char); private - FDesigner: IDesigner; FMenuBar: TX2CustomMenuBar; FDesignerAttached: Boolean; + FMoving: Boolean; procedure SetMenuBar(const Value: TX2CustomMenuBar); @@ -48,6 +58,7 @@ type function GetSelectedItem(): TX2CustomMenuBarItem; function GetItemNode(AItem: TX2CustomMenuBarItem): TTreeNode; + procedure MoveSelectedItem(ADown: Boolean); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure ItemAdded(AItem: TX2CustomMenuBarItem); @@ -62,26 +73,29 @@ type procedure UpdateUI(); procedure Modified(); - property Designer: IDesigner read FDesigner write FDesigner; property MenuBar: TX2CustomMenuBar read FMenuBar write SetMenuBar; public class procedure Execute(AMenuBar: TX2CustomMenuBar; ADesigner: IDesigner); end; + implementation uses Contnrs, - SysUtils; + SysUtils, Dialogs; + var GEditors: TObjectBucketList; + type TProtectedX2CustomMenuBar = class(TX2CustomMenuBar); {$R *.dfm} + { TfrmMenuBarEditor } class procedure TfrmMenuBarEditor.Execute(AMenuBar: TX2CustomMenuBar; ADesigner: IDesigner); var @@ -106,6 +120,7 @@ begin editorForm.Show(); end; + procedure TfrmMenuBarEditor.FormCreate(Sender: TObject); begin {$IFDEF VER180} @@ -117,6 +132,7 @@ begin {$ENDIF} end; + procedure TfrmMenuBarEditor.FormActivate(Sender: TObject); var item: TX2CustomMenuBarItem; @@ -133,6 +149,7 @@ begin UpdateUI(); end; + procedure TfrmMenuBarEditor.FormClose(Sender: TObject; var Action: TCloseAction); begin if Assigned(Designer) and Assigned(MenuBar) then @@ -141,6 +158,7 @@ begin Action := caFree; end; + procedure TfrmMenuBarEditor.FormDestroy(Sender: TObject); begin if Assigned(MenuBar) then @@ -170,6 +188,12 @@ begin end; +procedure TfrmMenuBarEditor.tvMenuKeyPress(Sender: TObject; var Key: Char); +begin + ActivateInspector(Key); +end; + + procedure TfrmMenuBarEditor.RefreshMenu(); var groupIndex: Integer; @@ -195,11 +219,12 @@ begin Modified(); end; + procedure TfrmMenuBarEditor.actAddItemExecute(Sender: TObject); var menuItem: TX2CustomMenuBarItem; group: TX2MenuBarGroup; - + begin menuItem := GetSelectedItem(); if Assigned(menuItem) then @@ -222,6 +247,7 @@ begin end; end; + procedure TfrmMenuBarEditor.actDeleteExecute(Sender: TObject); var menuItem: TX2CustomMenuBarItem; @@ -236,6 +262,18 @@ begin end; +procedure TfrmMenuBarEditor.actMoveUpExecute(Sender: TObject); +begin + MoveSelectedItem(False); +end; + + +procedure TfrmMenuBarEditor.actMoveDownExecute(Sender: TObject); +begin + MoveSelectedItem(True); +end; + + function TfrmMenuBarEditor.AddGroup(AGroup: TX2MenuBarGroup): TTreeNode; var itemIndex: Integer; @@ -252,8 +290,8 @@ begin { Make sure the group is inserted in the correct position by searching for it's sibling group. Note: do NOT use Items[x] in a loop; TTreeView emulates this by using GetFirst/GetNext. } - if AGroup.Index > 0 then - siblingGroup := TX2MenuBarGroup(AGroup.Collection.Items[Pred(AGroup.Index)]); + if AGroup.Index < Pred(AGroup.Collection.Count) then + siblingGroup := TX2MenuBarGroup(AGroup.Collection.Items[Succ(AGroup.Index)]); if Assigned(siblingGroup) then begin @@ -268,9 +306,9 @@ begin end; if Assigned(siblingNode) then - groupNode := tvMenu.Items.Add(siblingNode, '') + groupNode := tvMenu.Items.AddNode(nil, siblingNode, '', nil, naInsert) else - groupNode := tvMenu.Items.AddFirst(nil, ''); + groupNode := tvMenu.Items.Add(nil, ''); groupNode.Data := AGroup; UpdateNode(groupNode); @@ -286,6 +324,7 @@ begin end; end; + function TfrmMenuBarEditor.AddItem(ANode: TTreeNode; AItem: TX2MenuBarItem): TTreeNode; var siblingItem: TX2MenuBarItem; @@ -299,8 +338,8 @@ begin siblingNode := nil; { See AddGroup } - if AItem.Index > 0 then - siblingItem := TX2MenuBarItem(AItem.Collection.Items[Pred(AItem.Index)]); + if AItem.Index < Pred(AItem.Collection.Count) then + siblingItem := TX2MenuBarItem(AItem.Collection.Items[Succ(AItem.Index)]); if Assigned(siblingItem) then begin @@ -315,9 +354,9 @@ begin end; if Assigned(siblingNode) then - itemNode := tvMenu.Items.Add(siblingNode, '') + itemNode := tvMenu.Items.AddNode(nil, siblingNode, '', nil, naInsert) else - itemNode := tvMenu.Items.AddChildFirst(ANode, ''); + itemNode := tvMenu.Items.AddChild(ANode, ''); itemNode.Data := AItem; UpdateNode(itemNode); @@ -328,6 +367,7 @@ begin end; end; + procedure TfrmMenuBarEditor.UpdateNode(ANode: TTreeNode); var menuItem: TX2CustomMenuBarItem; @@ -339,22 +379,56 @@ begin ANode.SelectedIndex := ANode.ImageIndex; end; + procedure TfrmMenuBarEditor.UpdateUI(); var + canMoveDown: Boolean; + canMoveUp: Boolean; itemSelected: Boolean; + menuItem: TX2CustomMenuBarItem; + group: TX2MenuBarGroup; begin itemSelected := Assigned(tvMenu.Selected); actAddGroup.Enabled := Assigned(MenuBar); actAddItem.Enabled := itemSelected; actDelete.Enabled := itemSelected; + + canMoveUp := False; + canMoveDown := False; + + if itemSelected then + begin + menuItem := GetSelectedItem(); + + if Assigned(menuItem.Collection) then + begin + canMoveUp := (menuItem.Index > 0); + canMoveDown := (menuItem.Index < Pred(menuItem.Collection.Count)); + + if menuItem is TX2MenuBarItem then + begin + group := TX2MenuBarItem(menuItem).Group; + + if Assigned(group) then + begin + canMoveUp := canMoveUp or (group.Index > 0); + canMoveDown := canMoveDown or (group.Index < Pred(MenuBar.Groups.Count)); + end; + end; + end; + end; + + actMoveUp.Enabled := canMoveUp; + actMoveDown.Enabled := canMoveDown; end; + procedure TfrmMenuBarEditor.Modified(); begin if Assigned(Designer) then Designer.Modified(); - + UpdateUI(); end; @@ -370,6 +444,7 @@ begin inherited; end; + procedure TfrmMenuBarEditor.ItemAdded(AItem: TX2CustomMenuBarItem); var group: TX2MenuBarGroup; @@ -377,6 +452,9 @@ var treeNode: TTreeNode; begin + if FMoving then + Exit; + treeNode := nil; if AItem is TX2MenuBarGroup then @@ -397,11 +475,15 @@ begin tvMenu.Selected := treeNode; end; + procedure TfrmMenuBarEditor.ItemModified(AItem: TX2CustomMenuBarItem); var treeNode: TTreeNode; begin + if FMoving then + Exit; + tvMenu.Items.BeginUpdate(); try treeNode := tvMenu.Items.GetFirstNode(); @@ -415,11 +497,15 @@ begin end; end; + procedure TfrmMenuBarEditor.ItemDeleting(AItem: TX2CustomMenuBarItem); var treeNode: TTreeNode; begin + if FMoving then + Exit; + treeNode := GetItemNode(AItem); if Assigned(treeNode) then tvMenu.Items.Delete(treeNode); @@ -435,6 +521,7 @@ begin FDesignerAttached := True; end; + procedure TfrmMenuBarEditor.DetachDesigner(); begin if not FDesignerAttached then @@ -446,6 +533,75 @@ begin end; + +procedure TfrmMenuBarEditor.MoveSelectedItem(ADown: Boolean); +var + selectedItem: TX2CustomMenuBarItem; + group: TX2MenuBarGroup; + refresh: Boolean; + +begin + if not Assigned(MenuBar) then + Exit; + + selectedItem := GetSelectedItem(); + if not Assigned(selectedItem) then + Exit; + + refresh := False; + group := nil; + + if selectedItem is TX2MenuBarItem then + group := TX2MenuBarItem(selectedItem).Group; + + FMoving := True; + try + if ADown then + begin + if selectedItem.Index < Pred(selectedItem.Collection.Count) then + begin + selectedItem.Index := Succ(selectedItem.Index); + refresh := True; + end else if Assigned(group) then + begin + { Move down to another group + The AddItem is triggered by moving between groups, no need + to add here. } + if group.Index < Pred(MenuBar.Groups.Count) then + begin + selectedItem.Collection := MenuBar.Groups[Succ(group.Index)].Items; + selectedItem.Index := 0; + refresh := True; + end; + end; + end else + begin + if selectedItem.Index > 0 then + begin + selectedItem.Index := Pred(selectedItem.Index); + refresh := True; + end else if Assigned(group) then + begin + { Move up to another group } + if group.Index > 0 then + begin + selectedItem.Collection := MenuBar.Groups[Pred(group.Index)].Items; + refresh := True; + end; + end; + end; + finally + FMoving := False; + + if refresh then + begin + ItemDeleting(selectedItem); + ItemAdded(selectedItem); + end; + end; +end; + + function TfrmMenuBarEditor.GetSelectedItem(): TX2CustomMenuBarItem; begin Result := nil; @@ -453,6 +609,7 @@ begin Result := TX2CustomMenuBarItem(tvMenu.Selected.Data); end; + function TfrmMenuBarEditor.GetItemNode(AItem: TX2CustomMenuBarItem): TTreeNode; var treeNode: TTreeNode; @@ -512,6 +669,7 @@ begin end; end; + initialization finalization if Assigned(GEditors) then diff --git a/Resources/Icons/MenuBar/Down.ico b/Resources/Icons/MenuBar/Down.ico new file mode 100644 index 0000000..c0b02a8 Binary files /dev/null and b/Resources/Icons/MenuBar/Down.ico differ diff --git a/Resources/Icons/MenuBar/Up.ico b/Resources/Icons/MenuBar/Up.ico new file mode 100644 index 0000000..d5c88d0 Binary files /dev/null and b/Resources/Icons/MenuBar/Up.ico differ diff --git a/Source/X2CLGraphics.pas b/Source/X2CLGraphics.pas index b79b9f7..f1a8e85 100644 --- a/Source/X2CLGraphics.pas +++ b/Source/X2CLGraphics.pas @@ -12,11 +12,22 @@ unit X2CLGraphics; interface uses - Graphics; + Classes, + Graphics, + Windows; type TX2Color32 = type TColor; + TDrawTextClipStyle = (csNone, csEllipsis, csPathEllipsis); + {$IFNDEF VER180} + TVerticalAlignment = (taTop, taBottom, taVerticalCenter); + {$ENDIF} + + PRGBAArray = ^TRGBAArray; + TRGBAArray = array[Word] of TRGBQuad; + + function Color32(AColor: TColor; AAlpha: Byte = 255): TX2Color32; function DelphiColor(AColor: TX2Color32): TColor; @@ -27,10 +38,72 @@ type function Blend(ABackground: TColor; AForeground: TX2Color32): TColor; -implementation -uses - Windows; + { + :$ Provides a wrapper for the DrawText API. + } + procedure DrawText(ACanvas: TCanvas; const AText: String; + const ABounds: TRect; + AHorzAlignment: TAlignment = taLeftJustify; + AVertAlignment: TVerticalAlignment = taVerticalCenter; + AMultiLine: Boolean = False; + AClipStyle: TDrawTextClipStyle = csNone); + + + { + :$ Returns a pointer to the first physical scanline. + + :: In bottom-up bitmaps, the most common kind, the Scanline property + :: compensates for this by returning the last physical row for Scanline[0]; + :: the first visual row. For most effects, the order in which the rows are + :: processed is not important; speed is. This function returns the first + :: physical scanline, which can be used as a single big array for the whole + :: bitmap. + + :! Note that every scanline is padded until it is a multiple of 4 bytes + :! (32 bits). For true lineair access, ensure the bitmap has a PixelFormat + :! of pf32bit. + } + function GetScanlinePointer(ABitmap: Graphics.TBitmap): Pointer; + + + { + :$ Wrapper for DrawFocusRect. + + :: Ensures the canvas is set up correctly for a standard focus rectangle. + } + procedure DrawFocusRect(ACanvas: TCanvas; const ABounds: TRect); + + + { + :$ Draws one bitmap over another with the specified Alpha transparency. + + :: Both bitmaps must be the same size. + } + procedure DrawBlended(ABackground, AForeground: Graphics.TBitmap; AAlpha: Byte); + + + { + :$ Draws a rectangle with a vertical gradient. + } + procedure GradientFillRect(ACanvas: TCanvas; ARect: TRect; AStartColor, AEndColor: TColor); + + + { + :$ Darkens a color with the specified value + } + function DarkenColor(const AColor: TColor; const AValue: Byte): TColor; + + + { + :$ Lightens a color with the specified value + } + function LightenColor(const AColor: TColor; const AValue: Byte): TColor; + + +implementation + + function Color32(AColor: TColor; AAlpha: Byte): TX2Color32; begin Result := (ColorToRGB(AColor) and $00FFFFFF) or (AAlpha shl 24); @@ -90,4 +163,204 @@ begin end; end; + +procedure DrawText(ACanvas: TCanvas; const AText: String; + const ABounds: TRect; AHorzAlignment: TAlignment; + AVertAlignment: TVerticalAlignment; + AMultiLine: Boolean; AClipStyle: TDrawTextClipStyle); +const + HorzAlignmentFlags: array[TAlignment] of Cardinal = + (DT_LEFT, DT_RIGHT, DT_CENTER); + VertAlignmentFlags: array[TVerticalAlignment] of Cardinal = + (DT_TOP, DT_BOTTOM, DT_VCENTER); + MultiLineFlags: array[Boolean] of Cardinal = + (DT_SINGLELINE, 0); + ClipStyleFlags: array[TDrawTextClipStyle] of Cardinal = + (0, DT_END_ELLIPSIS, DT_PATH_ELLIPSIS); + +var + flags: Cardinal; + bounds: TRect; + +begin + flags := HorzAlignmentFlags[AHorzAlignment] or + VertAlignmentFlags[AVertAlignment] or + MultiLineFlags[AMultiLine] or + ClipStyleFlags[AClipStyle]; + + if AMultiLine and (AClipStyle <> csNone) then + flags := flags or DT_EDITCONTROL; + + bounds := ABounds; + Windows.DrawText(ACanvas.Handle, PChar(AText), Length(AText), bounds, flags); +end; + + +function GetScanlinePointer(ABitmap: Graphics.TBitmap): Pointer; +var + firstScanline: Pointer; + lastScanline: Pointer; + +begin + firstScanline := ABitmap.ScanLine[0]; + lastScanline := ABitmap.ScanLine[Pred(ABitmap.Height)]; + + if Cardinal(firstScanline) > Cardinal(lastScanline) then + Result := lastScanline + else + Result := firstScanline; +end; + + +procedure DrawFocusRect(ACanvas: TCanvas; const ABounds: TRect); +begin + SetTextColor(ACanvas.Handle, ColorToRGB(clBlack)); + Windows.DrawFocusRect(ACanvas.Handle, ABounds); +end; + + +procedure DrawBlended(ABackground, AForeground: Graphics.TBitmap; AAlpha: Byte); +var + sourcePixels: PRGBAArray; + destPixels: PRGBAArray; + sourcePixel: PRGBQuad; + pixelCount: Integer; + pixelIndex: Integer; + backAlpha: Integer; + foreAlpha: Integer; + +begin + backAlpha := AAlpha; + foreAlpha := 256 - AAlpha; + pixelCount := AForeground.Width * AForeground.Height; + sourcePixels := GetScanlinePointer(AForeground); + destPixels := GetScanlinePointer(ABackground); + + for pixelIndex := Pred(pixelCount) downto 0 do + with destPixels^[pixelIndex] do + begin + sourcePixel := @sourcePixels^[pixelIndex]; + rgbRed := ((rgbRed * backAlpha) + + (sourcePixel^.rgbRed * foreAlpha)) shr 8; + rgbGreen := ((rgbGreen * backAlpha) + + (sourcePixel^.rgbGreen * foreAlpha)) shr 8; + rgbBlue := ((rgbBlue * backAlpha) + + (sourcePixel^.rgbBlue * foreAlpha)) shr 8; + end; +end; + + +procedure GradientFillRect(ACanvas: TCanvas; ARect: TRect; AStartColor, AEndColor: TColor); + + function FixValue(AValue: Single): Single; + begin + Result := AValue; + + if Result < 0 then + Result := 0; + + if Result > 255 then + Result := 255; + end; + + +var + startColor: Cardinal; + endColor: Cardinal; + stepCount: Integer; + redValue: Single; + greenValue: Single; + blueValue: Single; + redStep: Single; + greenStep: Single; + blueStep: Single; + line: Integer; + +begin + startColor := ColorToRGB(AStartColor); + endColor := ColorToRGB(AEndColor); + + if startColor = endColor then + begin + ACanvas.Brush.Style := bsSolid; + ACanvas.Brush.Color := startColor; + ACanvas.FillRect(ARect); + end else + begin + redValue := GetRValue(startColor); + greenValue := GetGValue(startColor); + blueValue := GetBValue(startColor); + + stepCount := ARect.Bottom - ARect.Top; + redStep := (GetRValue(endColor) - redValue) / stepCount; + greenStep := (GetGValue(endColor) - greenValue) / stepCount; + blueStep := (GetBValue(endColor) - blueValue) / stepCount; + + ACanvas.Pen.Style := psSolid; + + for line := ARect.Top to ARect.Bottom do + begin + ACanvas.Pen.Color := RGB(Trunc(redValue), Trunc(greenValue), Trunc(blueValue)); + ACanvas.MoveTo(ARect.Left, line); + ACanvas.LineTo(ARect.Right, line); + + redValue := FixValue(redValue + redStep); + greenValue := FixValue(greenValue + greenStep); + blueValue := FixValue(blueValue + blueStep); + end; + end; +end; + + +function DarkenColor(const AColor: TColor; const AValue: Byte): TColor; +var + cColor: Cardinal; + iRed: Integer; + iGreen: Integer; + iBlue: Integer; + +begin + cColor := ColorToRGB(AColor); + iRed := (cColor and $FF0000) shr 16;; + iGreen := (cColor and $00FF00) shr 8; + iBlue := cColor and $0000FF; + + Dec(iRed, AValue); + Dec(iGreen, AValue); + Dec(iBlue, AValue); + + if iRed < 0 then iRed := 0; + if iGreen < 0 then iGreen := 0; + if iBlue < 0 then iBlue := 0; + + Result := (iRed shl 16) + (iGreen shl 8) + iBlue; +end; + + +function LightenColor(const AColor: TColor; const AValue: Byte): TColor; +var + cColor: Cardinal; + iRed: Integer; + iGreen: Integer; + iBlue: Integer; + +begin + cColor := ColorToRGB(AColor); + iRed := (cColor and $FF0000) shr 16;; + iGreen := (cColor and $00FF00) shr 8; + iBlue := cColor and $0000FF; + + Inc(iRed, AValue); + Inc(iGreen, AValue); + Inc(iBlue, AValue); + + if iRed > 255 then iRed := 255; + if iGreen > 255 then iGreen := 255; + if iBlue > 255 then iBlue := 255; + + Result := (iRed shl 16) + (iGreen shl 8) + iBlue; +end; + end. + + diff --git a/Source/X2CLMenuBar.pas b/Source/X2CLMenuBar.pas index f74eac0..78427e4 100644 --- a/Source/X2CLMenuBar.pas +++ b/Source/X2CLMenuBar.pas @@ -21,26 +21,26 @@ uses Graphics, ImgList, Messages, + SysUtils, Types, Windows; + type + EInvalidItem = class(Exception); + TX2MenuBarAnimationStyle = (asNone, asSlide, asDissolve, asFade, - asSlideFade); + asSlideFade, asCustom); TX2MenuBarDirection = (mbdUp, mbdDown); + const DefaultAnimationStyle = asSlide; DefaultAnimationTime = 250; -type - {$IFNDEF VER180} - // #ToDo1 (MvR) 24-5-2006: check how D2006 defines these - TVerticalAlignment = (taTop, taBottom, taVerticalCenter); - {$ENDIF} - // #ToDo1 (MvR) 25-3-2006: various Select methods for key support +type // #ToDo1 (MvR) 1-4-2006: scroll wheel support TX2CustomMenuBarAnimatorClass = class of TX2CustomMenuBarAnimator; TX2CustomMenuBarAnimator = class; @@ -51,6 +51,7 @@ type TX2MenuBarGroup = class; TX2CustomMenuBar = class; + IX2MenuBarDesigner = interface ['{F648CFD2-771D-4531-84D0-621FD7597E48}'] procedure ItemAdded(AItem: TX2CustomMenuBarItem); @@ -58,11 +59,13 @@ type procedure ItemDeleting(AItem: TX2CustomMenuBarItem); end; + TX2MenuBarHitTest = record HitTestCode: Integer; Item: TX2CustomMenuBarItem; end; + TX2MenuBarDrawState = (mdsHot, mdsSelected, mdsGroupHot, mdsGroupSelected); TX2MenuBarDrawStates = set of TX2MenuBarDrawState; @@ -70,13 +73,12 @@ type seBeforeFirstItem, seAfterLastItem, seBeforeItem, seAfterItem); - TX2MenuBarSelectAction = (saBefore, saAfter, saBoth); - TX2ComponentNotificationEvent = procedure(Sender: TObject; AComponent: TComponent; Operation: TOperation) of object; TX2MenuBarExpandingEvent = procedure(Sender: TObject; Group: TX2MenuBarGroup; var Allowed: Boolean) of object; TX2MenuBarExpandedEvent = procedure(Sender: TObject; Group: TX2MenuBarGroup) of object; TX2MenuBarSelectedChangingEvent = procedure(Sender: TObject; Item, NewItem: TX2CustomMenUBarItem; var Allowed: Boolean) of object; TX2MenuBarSelectedChangedEvent = procedure(Sender: TObject; Item: TX2CustomMenUBarItem) of object; + TX2MenuBarGetAnimatorClassEvent = procedure(Sender: TObject; var AnimatorClass: TX2CustomMenuBarAnimatorClass) of object; TX2MenuBarItemBoundsProc = procedure(Sender: TObject; Item: TX2CustomMenuBarItem; @@ -93,11 +95,13 @@ type TCollectionNotifyEvent = procedure(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification) of object; TCollectionUpdateEvent = procedure(Sender: TObject; Item: TCollectionItem) of object; + IX2MenuBarPainterObserver = interface ['{22DE60C9-49A1-4E7D-B547-901BEDCC0FB7}'] procedure PainterUpdate(Sender: TX2CustomMenuBarPainter); end; + { :$ Abstract animation class @@ -107,7 +111,6 @@ type private FAnimationTime: Cardinal; FExpanding: Boolean; - FGroup: TX2MenuBarGroup; FStartTime: Cardinal; FItemsBuffer: Graphics.TBitmap; FTerminated: Boolean; @@ -124,16 +127,19 @@ type constructor Create(AItemsBuffer: Graphics.TBitmap); virtual; destructor Destroy(); override; + procedure ResetStartTime(); + procedure Update(); virtual; procedure Draw(ACanvas: TCanvas; const ABounds: TRect); virtual; abstract; property AnimationTime: Cardinal read FAnimationTime write FAnimationTime; property Expanding: Boolean read FExpanding write SetExpanding; - property Group: TX2MenuBarGroup read FGroup write FGroup; - property Terminated: Boolean read FTerminated; property Height: Integer read GetHeight; + property StartTime: Cardinal read FStartTime write FStartTime; + property Terminated: Boolean read FTerminated; end; + { :$ Abstract painter class. @@ -174,6 +180,45 @@ type procedure DetachObserver(AObserver: IX2MenuBarPainterObserver); end; + + { + :$ Abstract action class. + + :: Provides a base for menu bar actions which need to be performed + :: asynchronous and/or in sequence. + } + TX2CustomMenuBarAction = class(TObject) + private + FMenuBar: TX2CustomMenuBar; + FStarted: Boolean; + FTerminated: Boolean; + protected + function GetTerminated(): Boolean; virtual; + procedure Terminate(); virtual; + + property MenuBar: TX2CustomMenuBar read FMenuBar; + public + constructor Create(AMenuBar: TX2CustomMenuBar); + + function AllowUpdateScrollbar(): Boolean; virtual; + function AllowInteraction(): Boolean; virtual; + + procedure Start(); virtual; + procedure Stop(); virtual; + + procedure BeforePaint(); virtual; + procedure GetItemHeight(AItem: TX2CustomMenuBarItem; var AHeight: Integer; var AHandled: Boolean); virtual; + procedure DrawMenuItem(ACanvas: TCanvas; APainter: TX2CustomMenuBarPainter; + AItem: TX2CustomMenuBarItem; const AMenuBounds, + AItemBounds: TRect; AState: TX2MenuBarDrawStates; + var AHandled: Boolean); virtual; + procedure AfterPaint(); virtual; + + property Started: Boolean read FStarted; + property Terminated: Boolean read GetTerminated; + end; + + { :$ Action link for menu items and groups. } @@ -195,6 +240,7 @@ type property Client: TX2CustomMenuBarItem read FClient; end; + { :$ Provides component notifications for collection items. } @@ -208,6 +254,7 @@ type property OnNotification: TX2ComponentNotificationEvent read FOnNotification write FOnNotification; end; + { :$ Base class for menu items and groups. } @@ -256,6 +303,7 @@ type property Visible: Boolean read FVisible write SetVisible default True; end; + { :$ Base class for menu collections. } @@ -271,6 +319,7 @@ type property OnUpdate: TCollectionUpdateEvent read FOnUpdate write FOnUpdate; end; + { :$ Contains a single menu item. } @@ -285,6 +334,7 @@ type property Group: TX2MenuBarGroup read GetGroup; end; + { :$ Manages a collection of menu items. } @@ -300,6 +350,7 @@ type property Items[Index: Integer]: TX2MenuBarItem read GetItem write SetItem; default; end; + { :$ Contains a single menu group. } @@ -319,18 +370,19 @@ type procedure InternalSetExpanded(const Value: Boolean); procedure ItemsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification); procedure ItemsUpdate(Sender: TObject; Item: TCollectionItem); + + property SelectedItem: Integer read GetSelectedItem write FSelectedItem; public constructor Create(Collection: TCollection); override; destructor Destroy(); override; procedure Assign(Source: TPersistent); override; - - property SelectedItem: Integer read GetSelectedItem write FSelectedItem; published property Expanded: Boolean read FExpanded write SetExpanded; property Items: TX2MenuBarItems read FItems write SetItems; end; + { :$ Manages a collection of menu groups. } @@ -346,6 +398,7 @@ type property Items[Index: Integer]: TX2MenuBarGroup read GetItem write SetItem; default; end; + { :$ Implements the menu bar. @@ -358,33 +411,35 @@ type FAllowCollapseAll: Boolean; FAnimationStyle: TX2MenuBarAnimationStyle; FAnimationTime: Cardinal; - FAnimator: TX2CustomMenuBarAnimator; FAutoCollapse: Boolean; FAutoSelectItem: Boolean; FBorderStyle: TBorderStyle; - FBuffer: Graphics.TBitmap; FCursorGroup: TCursor; FCursorItem: TCursor; - FDesigner: IX2MenuBarDesigner; - FExpandingGroups: TStringList; - FGroups: TX2MenuBarGroups; FHideScrollbar: Boolean; - FHotItem: TX2CustomMenuBarItem; + FGroups: TX2MenuBarGroups; FImages: TCustomImageList; - FLastMousePos: TPoint; + FImagesChangeLink: TChangeLink; FOnCollapsed: TX2MenuBarExpandedEvent; FOnCollapsing: TX2MenuBarExpandingEvent; FOnExpanded: TX2MenuBarExpandedEvent; FOnExpanding: TX2MenuBarExpandingEvent; + FOnGetAnimatorClass: TX2MenuBarGetAnimatorClassEvent; FOnSelectedChanged: TX2MenuBarSelectedChangedEvent; FOnSelectedChanging: TX2MenuBarSelectedChangingEvent; FPainter: TX2CustomMenuBarPainter; FScrollbar: Boolean; - FScrollOffset: Integer; + + FHotItem: TX2CustomMenuBarItem; FSelectedItem: TX2CustomMenuBarItem; + FActionQueue: TObjectList; + FBuffer: Graphics.TBitmap; + FDesigner: IX2MenuBarDesigner; + FLastMousePos: TPoint; + FScrollOffset: Integer; + procedure SetAllowCollapseAll(const Value: Boolean); - procedure SetAnimator(const Value: TX2CustomMenuBarAnimator); procedure SetAutoCollapse(const Value: Boolean); procedure SetAutoSelectItem(const Value: Boolean); procedure SetBorderStyle(const Value: TBorderStyle); @@ -401,13 +456,15 @@ type procedure GroupsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification); procedure GroupsUpdate(Sender: TObject; Item: TCollectionItem); procedure UpdateScrollbar(); + procedure ImagesChange(Sender: TObject); procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; -// procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE; procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL; +// procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL; +// procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL; procedure TestMousePos(); virtual; function GetMenuHeight(): Integer; virtual; @@ -416,9 +473,12 @@ type protected procedure SetPainter(const Value: TX2CustomMenuBarPainter); virtual; + + { Painting } procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; procedure Paint(); override; + function GetDrawState(AItem: TX2CustomMenuBarItem): TX2MenuBarDrawStates; procedure DrawMenu(ACanvas: TCanvas); virtual; procedure DrawMenuItem(Sender: TObject; Item: TX2CustomMenuBarItem; const MenuBounds, ItemBounds: TRect; Data: Pointer; var Abort: Boolean); virtual; @@ -426,33 +486,60 @@ type procedure DrawNoPainter(ACanvas: TCanvas; const ABounds: TRect); virtual; function GetAnimatorClass(): TX2CustomMenuBarAnimatorClass; virtual; + function GetAnimateAction(AGroup: TX2MenuBarGroup; AExpanding: Boolean): TX2CustomMenuBarAction; virtual; function IterateItemBounds(ACallback: TX2MenuBarItemBoundsProc; AData: Pointer = nil): TX2CustomMenuBarItem; function AllowInteraction(): Boolean; virtual; function ItemEnabled(AItem: TX2CustomMenuBarItem): Boolean; virtual; function ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; virtual; + + { Action queue } + function GetCurrentAction(): TX2CustomMenuBarAction; + procedure PushAction(AAction: TX2CustomMenuBarAction); + procedure PopCurrentAction(); + + + property ActionQueue: TObjectList read FActionQueue; + property HotItem: TX2CustomMenuBarItem read FHotItem write FHotItem; + property AllowCollapseAll: Boolean read FAllowCollapseAll write SetAllowCollapseAll default True; property AnimationStyle: TX2MenuBarAnimationStyle read FAnimationStyle write FAnimationStyle default DefaultAnimationStyle; property AnimationTime: Cardinal read FAnimationTime write FAnimationTime default DefaultAnimationTime; - property Animator: TX2CustomMenuBarAnimator read FAnimator write SetAnimator; property AutoCollapse: Boolean read FAutoCollapse write SetAutoCollapse default False; property AutoSelectItem: Boolean read FAutoSelectItem write SetAutoSelectItem default False; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone; property CursorGroup: TCursor read FCursorGroup write FCursorGroup default crDefault; property CursorItem: TCursor read FCursorItem write FCursorItem default crDefault; property HideScrollbar: Boolean read FHideScrollbar write SetHideScrollbar default True; + property Scrollbar: Boolean read FScrollbar write SetScrollbar default True; + property OnCollapsed: TX2MenuBarExpandedEvent read FOnCollapsed write FOnCollapsed; property OnCollapsing: TX2MenuBarExpandingEvent read FOnCollapsing write FOnCollapsing; property OnExpanded: TX2MenuBarExpandedEvent read FOnExpanded write FOnExpanded; property OnExpanding: TX2MenuBarExpandingEvent read FOnExpanding write FOnExpanding; + property OnGetAnimatorClass: TX2MenuBarGetAnimatorClassEvent read FOnGetAnimatorClass write FOnGetAnimatorClass; property OnSelectedChanged: TX2MenuBarSelectedChangedEvent read FOnSelectedChanged write FOnSelectedChanged; property OnSelectedChanging: TX2MenuBarSelectedChangingEvent read FOnSelectedChanging write FOnSelectedChanging; - property Scrollbar: Boolean read FScrollbar write SetScrollbar default True; protected - procedure DoAutoCollapse(AGroup: TX2MenuBarGroup); virtual; - function DoAutoSelectItem(AGroup: TX2MenuBarGroup; AAction: TX2MenuBarSelectAction): Boolean; virtual; - procedure DoExpand(AGroup: TX2MenuBarGroup; AExpanding: Boolean); virtual; + procedure InternalSetExpanded(AGroup: TX2MenuBarGroup; AExpanded: Boolean); virtual; + procedure InternalSetSelected(AItem: TX2CustomMenuBarItem); virtual; + + function DoAutoCollapse(AGroup: TX2MenuBarGroup): Boolean; virtual; + function DoAutoSelectItem(AGroup: TX2MenuBarGroup): Boolean; virtual; + function DoExpand(AGroup: TX2MenuBarGroup; AExpanding: Boolean): Boolean; virtual; + function DoSelectItem(AItem: TX2CustomMenuBarItem): Boolean; virtual; + + function PerformAutoCollapse(AGroup: TX2MenuBarGroup): Boolean; virtual; + function PerformAutoSelectItem(AGroup: TX2MenuBarGroup): Boolean; virtual; + function PerformExpand(AGroup: TX2MenuBarGroup; AExpanding: Boolean): Boolean; virtual; + function PerformSelectItem(AItem: TX2CustomMenuBarItem): Boolean; virtual; + + procedure DoCollapsed(AGroup: TX2MenuBarGroup); virtual; + procedure DoCollapsing(AGroup: TX2MenuBarGroup; var AAllowed: Boolean); virtual; + procedure DoExpanded(AGroup: TX2MenuBarGroup); virtual; + procedure DoExpanding(AGroup: TX2MenuBarGroup; var AAllowed: Boolean); virtual; + procedure DoExpandedChanging(AGroup: TX2MenuBarGroup; AExpanding: Boolean); virtual; procedure DoExpandedChanged(AGroup: TX2MenuBarGroup); virtual; procedure DoSelectedChanging(ANewItem: TX2CustomMenuBarItem; var AAllowed: Boolean); virtual; @@ -489,6 +576,7 @@ type property SelectedItem: TX2CustomMenuBarItem read FSelectedItem write SetSelectedItem; end; + { :$ Exposes the menu bar's published properties. } @@ -513,6 +601,8 @@ type property HideScrollbar; property Images; property ParentFont; + property TabOrder; + property TabStop default True; property OnClick; property OnCollapsed; property OnCollapsing; @@ -536,47 +626,6 @@ type property Scrollbar; end; - { - :$ Provides a wrapper for the DrawText API. - } - TDrawTextClipStyle = (csNone, csEllipsis, csPathEllipsis); - - procedure DrawText(ACanvas: TCanvas; const AText: String; - const ABounds: TRect; - AHorzAlignment: TAlignment = taLeftJustify; - AVertAlignment: TVerticalAlignment = taVerticalCenter; - AMultiLine: Boolean = False; - AClipStyle: TDrawTextClipStyle = csNone); - - { - :$ Returns a pointer to the first physical scanline. - - :: In bottom-up bitmaps, the most common kind, the Scanline property - :: compensates for this by returning the last physical row for Scanline[0]; - :: the first visual row. For most effects, the order in which the rows are - :: processed is not important; speed is. This function returns the first - :: physical scanline, which can be used as a single big array for the whole - :: bitmap. - - :! Note that every scanline is padded until it is a multiple of 4 bytes - :! (32 bits). For true lineair access, ensure the bitmap has a PixelFormat - :! of pf32bit. - } - function GetScanlinePointer(ABitmap: Graphics.TBitmap): Pointer; - - { - :$ Wrapper for DrawFocusRect. - - :: Ensures the canvas is set up correctly for a standard focus rectangle. - } - procedure DrawFocusRect(ACanvas: TCanvas; const ABounds: TRect); - - { - :$ Draws one bitmap over another with the specified Alpha transparency. - - :: Both bitmaps must be the same size. - } - procedure DrawBlended(ABackground, AForeground: Graphics.TBitmap; AAlpha: Byte); const { HitTest Codes } @@ -586,110 +635,26 @@ const htItem = 3; htScroller = 4; -type - PRGBAArray = ^TRGBAArray; - TRGBAArray = array[Word] of TRGBQuad; - implementation uses - SysUtils, - + X2CLGraphics, + X2CLMenuBarActions, X2CLMenuBarAnimators; + const SDefaultItemCaption = 'Menu Item'; SDefaultGroupCaption = 'Group'; SNoPainter = 'Painter property not set'; + SInvalidItem = 'Item does not belong to this MenuBar'; + type TProtectedCollection = class(TCollection); -{ Convenience functions } -procedure DrawText(ACanvas: TCanvas; const AText: String; - const ABounds: TRect; AHorzAlignment: TAlignment; - AVertAlignment: TVerticalAlignment; - AMultiLine: Boolean; AClipStyle: TDrawTextClipStyle); -const - HorzAlignmentFlags: array[TAlignment] of Cardinal = - (DT_LEFT, DT_RIGHT, DT_CENTER); - VertAlignmentFlags: array[TVerticalAlignment] of Cardinal = - (DT_TOP, DT_BOTTOM, DT_VCENTER); - MultiLineFlags: array[Boolean] of Cardinal = - (DT_SINGLELINE, 0); - ClipStyleFlags: array[TDrawTextClipStyle] of Cardinal = - (0, DT_END_ELLIPSIS, DT_PATH_ELLIPSIS); - -var - flags: Cardinal; - bounds: TRect; - -begin - flags := HorzAlignmentFlags[AHorzAlignment] or - VertAlignmentFlags[AVertAlignment] or - MultiLineFlags[AMultiLine] or - ClipStyleFlags[AClipStyle]; - - if AMultiLine and (AClipStyle <> csNone) then - flags := flags or DT_EDITCONTROL; - - bounds := ABounds; - Windows.DrawText(ACanvas.Handle, PChar(AText), Length(AText), bounds, flags); -end; - -function GetScanlinePointer(ABitmap: Graphics.TBitmap): Pointer; -var - firstScanline: Pointer; - lastScanline: Pointer; - -begin - firstScanline := ABitmap.ScanLine[0]; - lastScanline := ABitmap.ScanLine[Pred(ABitmap.Height)]; - - if Cardinal(firstScanline) > Cardinal(lastScanline) then - Result := lastScanline - else - Result := firstScanline; -end; - -procedure DrawFocusRect(ACanvas: TCanvas; const ABounds: TRect); -begin - SetTextColor(ACanvas.Handle, ColorToRGB(clBlack)); - Windows.DrawFocusRect(ACanvas.Handle, ABounds); -end; - -procedure DrawBlended(ABackground, AForeground: Graphics.TBitmap; AAlpha: Byte); -var - sourcePixels: PRGBAArray; - destPixels: PRGBAArray; - sourcePixel: PRGBQuad; - pixelCount: Integer; - pixelIndex: Integer; - backAlpha: Integer; - foreAlpha: Integer; - -begin - backAlpha := AAlpha; - foreAlpha := 256 - AAlpha; - pixelCount := AForeground.Width * AForeground.Height; - sourcePixels := GetScanlinePointer(AForeground); - destPixels := GetScanlinePointer(ABackground); - - for pixelIndex := Pred(pixelCount) downto 0 do - with destPixels^[pixelIndex] do - begin - sourcePixel := @sourcePixels^[pixelIndex]; - rgbRed := ((rgbRed * backAlpha) + - (sourcePixel^.rgbRed * foreAlpha)) shr 8; - rgbGreen := ((rgbGreen * backAlpha) + - (sourcePixel^.rgbGreen * foreAlpha)) shr 8; - rgbBlue := ((rgbBlue * backAlpha) + - (sourcePixel^.rgbBlue * foreAlpha)) shr 8; - end; -end; - - + { TX2CustomMenuBarPainter } constructor TX2CustomMenuBarPainter.Create(AOwner: TComponent); begin @@ -699,6 +664,7 @@ begin FMenuBar := TX2CustomMenuBar(AOwner); end; + destructor TX2CustomMenuBarPainter.Destroy(); begin FreeAndNil(FObservers); @@ -728,12 +694,14 @@ begin FMenuBar := AMenuBar; end; + procedure TX2CustomMenuBarPainter.EndPaint(); begin Assert(Assigned(FMenuBar), 'EndPaint without BeginPaint'); FMenuBar := nil; end; + procedure TX2CustomMenuBarPainter.NotifyObservers(); var observerIndex: Integer; @@ -750,6 +718,7 @@ begin Result := ABounds; end; + function TX2CustomMenuBarPainter.GetGroupHeight(AGroup: TX2MenuBarGroup): Integer; var itemIndex: Integer; @@ -775,6 +744,7 @@ begin Abort := PtInRect(ItemBounds, hitPoint^); end; + function TX2CustomMenuBarPainter.HitTest(const APoint: TPoint): TX2MenuBarHitTest; var hitPoint: TPoint; @@ -791,6 +761,7 @@ begin Result.HitTestCode := htItem; end; + function TX2CustomMenuBarPainter.HitTest(AX, AY: Integer): TX2MenuBarHitTest; begin Result := HitTest(Point(AX, AY)); @@ -803,6 +774,7 @@ begin Result := FMenuBar; end; + function TX2CustomMenuBarPainter.GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; begin Result := 0; @@ -814,7 +786,7 @@ constructor TX2CustomMenuBarAnimator.Create(AItemsBuffer: Graphics.TBitmap); begin inherited Create(); - FStartTime := GetTickCount(); + ResetStartTime(); FItemsBuffer := Graphics.TBitmap.Create(); FItemsBuffer.Assign(AItemsBuffer); end; @@ -827,11 +799,18 @@ begin end; +procedure TX2CustomMenuBarAnimator.ResetStartTime(); +begin + FStartTime := GetTickCount(); +end; + + function TX2CustomMenuBarAnimator.GetHeight(): Integer; begin Result := ItemsBuffer.Height; end; + function TX2CustomMenuBarAnimator.GetTimeElapsed(): Cardinal; var currentTime: Cardinal; @@ -844,6 +823,7 @@ begin Inc(Result, High(Cardinal)); end; + procedure TX2CustomMenuBarAnimator.SetExpanding(const Value: Boolean); begin FExpanding := Value; @@ -861,54 +841,131 @@ begin end; + +{ TX2CustomMenuBarAction } +constructor TX2CustomMenuBarAction.Create(AMenuBar: TX2CustomMenuBar); +begin + inherited Create; + + FMenuBar := AMenuBar; +end; + + +procedure TX2CustomMenuBarAction.Terminate(); +begin + FTerminated := True; +end; + + +function TX2CustomMenuBarAction.AllowInteraction(): Boolean; +begin + Result := False; +end; + + +function TX2CustomMenuBarAction.AllowUpdateScrollbar(): Boolean; +begin + Result := False; +end; + + +procedure TX2CustomMenuBarAction.Start(); +begin + FStarted := True; +end; + + +procedure TX2CustomMenuBarAction.Stop(); +begin + FStarted := False; +end; + + +procedure TX2CustomMenuBarAction.BeforePaint(); +begin +end; + + +procedure TX2CustomMenuBarAction.GetItemHeight(AItem: TX2CustomMenuBarItem; var AHeight: Integer; var AHandled: Boolean); +begin +end; + + +procedure TX2CustomMenuBarAction.DrawMenuItem(ACanvas: TCanvas; APainter: TX2CustomMenuBarPainter; + AItem: TX2CustomMenuBarItem; const AMenuBounds, + AItemBounds: TRect; AState: TX2MenuBarDrawStates; + var AHandled: Boolean); +begin +end; + + +procedure TX2CustomMenuBarAction.AfterPaint(); +begin +end; + + +function TX2CustomMenuBarAction.GetTerminated(): Boolean; +begin + Result := FTerminated; +end; + + { TX2MenuBarActionLink } procedure TX2MenuBarActionLink.AssignClient(AClient: TObject); begin FClient := (AClient as TX2CustomMenuBarItem); end; + function TX2MenuBarActionLink.IsCaptionLinked(): Boolean; begin Result := inherited IsCaptionLinked() and (Client.Caption = (Action as TCustomAction).Caption); end; + function TX2MenuBarActionLink.IsEnabledLinked(): Boolean; begin Result := inherited IsCaptionLinked() and (Client.Enabled = (Action as TCustomAction).Enabled); end; + function TX2MenuBarActionLink.IsImageIndexLinked(): Boolean; begin Result := inherited IsCaptionLinked() and (Client.ImageIndex = (Action as TCustomAction).ImageIndex); end; + function TX2MenuBarActionLink.IsVisibleLinked(): Boolean; begin Result := inherited IsCaptionLinked() and (Client.Visible = (Action as TCustomAction).Visible); end; + procedure TX2MenuBarActionLink.SetCaption(const Value: string); begin if IsCaptionLinked() then Client.Caption := Value; end; + procedure TX2MenuBarActionLink.SetEnabled(Value: Boolean); begin if IsEnabledLinked() then Client.Enabled := Value; end; + procedure TX2MenuBarActionLink.SetImageIndex(Value: Integer); begin if IsImageIndexLinked() then Client.ImageIndex := Value; end; + procedure TX2MenuBarActionLink.SetVisible(Value: Boolean); begin if IsVisibleLinked() then @@ -968,6 +1025,7 @@ begin ActionChange(Sender, False); end; + procedure TX2CustomMenuBarItem.ActionChange(Sender: TObject; CheckDefaults: Boolean); begin @@ -994,6 +1052,7 @@ begin Result := (Length(Caption) > 0); end; + function TX2CustomMenuBarItem.GetMenuBar(): TX2CustomMenuBar; var parentCollection: TCollection; @@ -1021,6 +1080,7 @@ begin end; end; + procedure TX2CustomMenuBarItem.SetAction(const Value: TBasicAction); begin if Value <> FAction then @@ -1053,6 +1113,7 @@ begin end; end; + procedure TX2CustomMenuBarItem.SetCaption(const Value: String); begin if Value <> FCaption then @@ -1062,6 +1123,7 @@ begin end; end; + procedure TX2CustomMenuBarItem.SetData(const Value: TObject); begin if Value <> FData then @@ -1073,6 +1135,7 @@ begin end; end; + procedure TX2CustomMenuBarItem.SetEnabled(const Value: Boolean); begin if Value <> FEnabled then @@ -1082,6 +1145,7 @@ begin end; end; + procedure TX2CustomMenuBarItem.SetImageIndex(const Value: TImageIndex); begin if Value <> FImageIndex then @@ -1091,6 +1155,7 @@ begin end; end; + procedure TX2CustomMenuBarItem.SetVisible(const Value: Boolean); begin if Value <> FVisible then @@ -1110,6 +1175,7 @@ begin inherited; end; + procedure TX2CustomMenuBarItems.Update(Item: TCollectionItem); begin inherited; @@ -1165,6 +1231,7 @@ begin Result := TX2MenuBarItem(inherited GetItem(Index)); end; + procedure TX2MenuBarItems.SetItem(Index: Integer; const Value: TX2MenuBarItem); begin inherited SetItem(Index, Value); @@ -1184,6 +1251,7 @@ begin inherited; end; + destructor TX2MenuBarGroup.Destroy(); begin FreeAndNil(FItems); @@ -1218,28 +1286,24 @@ begin end; end; -procedure TX2MenuBarGroup.InternalSetExpanded(const Value: Boolean); -var - menu: TX2CustomMenuBar; +procedure TX2MenuBarGroup.InternalSetExpanded(const Value: Boolean); begin if Value <> FExpanded then begin FExpanded := Value; Changed(False); - - menu := MenuBar; - if Assigned(menu) then - menu.DoExpandedChanged(Self); end; end; + procedure TX2MenuBarGroup.ItemsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification); begin if Assigned(Self.Collection) then TProtectedCollection(Self.Collection).Notify(Item, Action); end; + procedure TX2MenuBarGroup.ItemsUpdate(Sender: TObject; Item: TCollectionItem); var groupCollection: TProtectedCollection; @@ -1251,11 +1315,13 @@ begin groupCollection.Update(Item); end; + function TX2MenuBarGroup.IsCaptionStored(): Boolean; begin Result := (Caption <> SDefaultGroupCaption); end; + procedure TX2MenuBarGroup.SetEnabled(const Value: Boolean); begin inherited; @@ -1264,6 +1330,7 @@ begin Expanded := False; end; + procedure TX2MenuBarGroup.SetExpanded(const Value: Boolean); var menu: TX2CustomMenuBar; @@ -1280,6 +1347,7 @@ begin end; end; + procedure TX2MenuBarGroup.SetItems(const Value: TX2MenuBarItems); begin if Value <> FItems then @@ -1311,6 +1379,7 @@ begin Result := TX2MenuBarGroup(inherited GetItem(Index)); end; + procedure TX2MenuBarGroups.SetItem(Index: Integer; const Value: TX2MenuBarGroup); begin inherited SetItem(Index, Value); @@ -1322,20 +1391,25 @@ constructor TX2CustomMenuBar.Create(AOwner: TComponent); begin inherited; + FActionQueue := TObjectList.Create(True); FAllowCollapseAll := True; FAnimationStyle := DefaultAnimationStyle; FAnimationTime := DefaultAnimationTime; FBorderStyle := bsNone; FCursorGroup := crDefault; FCursorItem := crDefault; - FExpandingGroups := TStringList.Create(); FGroups := TX2MenuBarGroups.Create(Self); FGroups.OnNotify := GroupsNotify; FGroups.OnUpdate := GroupsUpdate; FHideScrollbar := True; + FImagesChangeLink := TChangeLink.Create(); FScrollbar := True; + TabStop := True; + + FImagesChangeLink.OnChange := ImagesChange; end; + procedure TX2CustomMenuBar.CreateParams(var Params: TCreateParams); const BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER); @@ -1357,6 +1431,7 @@ begin end; end; + procedure TX2CustomMenuBar.Loaded(); begin inherited; @@ -1367,30 +1442,33 @@ end; destructor TX2CustomMenuBar.Destroy(); begin - Animator := nil; + Images := nil; Painter := nil; - FreeAndNil(FExpandingGroups); FreeAndNil(FGroups); FreeAndNil(FBuffer); + FreeAndNil(FActionQueue); + FreeAndNil(FImagesChangeLink); inherited; end; + procedure TX2CustomMenuBar.WMEraseBkgnd(var Msg: TWMEraseBkgnd); begin Msg.Result := 0; end; + procedure TX2CustomMenuBar.Paint(); var bufferRect: TRect; - expand: Boolean; - group: TX2MenuBarGroup; + currentAction: TX2CustomMenuBarAction; begin if Assigned(Painter) then begin + { Prepare buffer } if not Assigned(FBuffer) then begin FBuffer := Graphics.TBitmap.Create(); @@ -1407,10 +1485,22 @@ begin bufferRect := Rect(0, 0, FBuffer.Width, FBuffer.Height); FBuffer.Canvas.Font.Assign(Self.Font); - if Assigned(Animator) then - Animator.Update(); + + { Update action } + currentAction := GetCurrentAction(); + if Assigned(currentAction) then + begin + if not currentAction.Started then + currentAction.Start(); + + currentAction.BeforePaint(); + end; + UpdateScrollbar(); + + + { Draw menu } Painter.BeginPaint(Self); try Painter.DrawBackground(FBuffer.Canvas, bufferRect); @@ -1421,30 +1511,38 @@ begin Self.Canvas.Draw(0, 0, FBuffer); - if Assigned(Animator) then + + { Action queue } + if Assigned(currentAction) then begin - if Animator.Terminated then - begin - Animator.Group.InternalSetExpanded(Animator.Expanding); - Animator := nil; - end - else - { Prevent 100% CPU usage } - Sleep(5); - - TestMousePos(); + { Make sure Paint is called again while there's an action queue } Invalidate(); - end - else - { Process animation queue } - if FExpandingGroups.Count > 0 then - begin - expand := (FExpandingGroups[0] = #1); - group := TX2MenuBarGroup(FExpandingGroups.Objects[0]); - FExpandingGroups.Delete(0); - DoExpand(group, expand); + currentAction.AfterPaint(); + + if currentAction.Terminated then + begin + currentAction.Stop(); + PopCurrentAction(); + + { Start the next action in the queue, continue until we find an + action which doesn't terminate immediately. See PushAction. } + currentAction := GetCurrentAction(); + while Assigned(currentAction) do + begin + currentAction.Start(); + + if currentAction.Terminated then + begin + currentAction.Stop(); + PopCurrentAction(); + + currentAction := GetCurrentAction(); + end else + Break; + end; end; + end; end else DrawNoPainter(Self.Canvas, Self.ClientRect); @@ -1475,15 +1573,16 @@ begin Include(Result, mdsGroupSelected); end; + procedure TX2CustomMenuBar.DrawMenuItem(Sender: TObject; Item: TX2CustomMenuBarItem; const MenuBounds, ItemBounds: TRect; Data: Pointer; var Abort: Boolean); var - canvas: TCanvas; - drawState: TX2MenuBarDrawStates; - group: TX2MenuBarGroup; - groupBounds: TRect; + canvas: TCanvas; + currentAction: TX2CustomMenuBarAction; + drawState: TX2MenuBarDrawStates; + handled: Boolean; begin if ItemBounds.Top > MenuBounds.Bottom then @@ -1492,28 +1591,25 @@ begin exit; end; - canvas := TCanvas(Data); - drawState := GetDrawState(Item); + canvas := TCanvas(Data); + drawState := GetDrawState(Item); + currentAction := GetCurrentAction(); + handled := False; - if Item is TX2MenuBarGroup then + if Assigned(currentAction) then + currentAction.DrawMenuItem(canvas, Painter, Item, MenuBounds, ItemBounds, + drawState, handled); + + if not handled then begin - group := TX2MenuBarGroup(Item); - Painter.DrawGroupHeader(canvas, group, ItemBounds, - drawState); - - if Assigned(Animator) and (Animator.Group = group) then - begin - groupBounds := MenuBounds; - groupBounds.Top := ItemBounds.Bottom + - Painter.GetSpacing(seAfterGroupHeader) + - Painter.GetSpacing(seBeforeFirstItem); - groupBounds.Bottom := groupBounds.Top + Animator.Height; - Animator.Draw(canvas, groupBounds); - end; - end else if Item is TX2MenuBarItem then - Painter.DrawItem(canvas, TX2MenuBarItem(Item), ItemBounds, drawState); + if Item is TX2MenuBarGroup then + Painter.DrawGroupHeader(canvas, TX2MenuBarGroup(Item), ItemBounds, drawState) + else if Item is TX2MenuBarItem then + Painter.DrawItem(canvas, TX2MenuBarItem(Item), ItemBounds, drawState); + end; end; + procedure TX2CustomMenuBar.DrawMenuItems(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect); var itemBounds: TRect; @@ -1542,11 +1638,13 @@ begin end; end; + procedure TX2CustomMenuBar.DrawMenu(ACanvas: TCanvas); begin IterateItemBounds(DrawMenuItem, Pointer(ACanvas)); end; + procedure TX2CustomMenuBar.DrawNoPainter(ACanvas: TCanvas; const ABounds: TRect); const XorColor = $00FFD8CE; // RGB(206, 216, 255) @@ -1563,7 +1661,7 @@ begin Brush.Style := bsClear; Rectangle(ABounds); - DrawText(ACanvas, SNoPainter, ABounds, taCenter); + X2CLGraphics.DrawText(ACanvas, SNoPainter, ABounds, taCenter); end; end; @@ -1581,20 +1679,72 @@ begin end; +function TX2CustomMenuBar.GetAnimateAction(AGroup: TX2MenuBarGroup; AExpanding: Boolean): TX2CustomMenuBarAction; +var + animatorClass: TX2CustomMenuBarAnimatorClass; + animator: TX2CustomMenuBarAnimator; + itemsBuffer: Graphics.TBitmap; + itemsBounds: TRect; + +begin + Result := nil; + if not Assigned(Painter) then + Exit; + + animatorClass := GetAnimatorClass(); + if Assigned(animatorClass) and not (csDesigning in ComponentState) then + begin + Painter.BeginPaint(Self); + try + itemsBuffer := Graphics.TBitmap.Create(); + try + itemsBounds := Painter.ApplyMargins(Self.ClientRect); + itemsBuffer.PixelFormat := pf32bit; + itemsBuffer.Width := itemsBounds.Right - itemsBounds.Left; + itemsBuffer.Height := Painter.GetGroupHeight(AGroup); + itemsBounds := Rect(0, 0, itemsBuffer.Width, itemsBuffer.Height); + itemsBuffer.Canvas.Font.Assign(Self.Font); + + // #ToDo3 (MvR) 23-3-2006: this will probably cause problems if we ever + // want a bitmapped/customdrawn background. + // Maybe we can trick around a bit with the + // canvas offset? think about it later. + Painter.DrawBackground(itemsBuffer.Canvas, itemsBounds); + DrawMenuItems(itemsBuffer.Canvas, AGroup, itemsBounds); + + animator := animatorClass.Create(itemsBuffer); + animator.AnimationTime := AnimationTime; + animator.Expanding := AExpanding; + + Result := TX2MenuBarAnimateAction.Create(Self, AGroup, animator); + finally + FreeAndNil(itemsBuffer); + end; + finally + Painter.EndPaint(); + Invalidate(); + end; + end; +end; + + function TX2CustomMenuBar.IterateItemBounds(ACallback: TX2MenuBarItemBoundsProc; AData: Pointer): TX2CustomMenuBarItem; var - groupIndex: Integer; - group: TX2MenuBarGroup; - menuBounds: TRect; - itemBounds: TRect; - itemIndex: Integer; - item: TX2MenuBarItem; abort: Boolean; + currentAction: TX2CustomMenuBarAction; + group: TX2MenuBarGroup; + groupIndex: Integer; + handled: Boolean; + item: TX2MenuBarItem; + itemBounds: TRect; + itemHeight: Integer; + itemIndex: Integer; + menuBounds: TRect; begin Assert(Assigned(Painter), 'No Painter assigned'); - + Result := nil; menuBounds := Painter.ApplyMargins(Self.ClientRect); itemBounds := menuBounds; @@ -1619,14 +1769,22 @@ begin break; end; + itemBounds.Top := itemBounds.Bottom + Painter.GetSpacing(seAfterGroupHeader); + currentAction := GetCurrentAction(); + handled := False; - if Assigned(Animator) and (Animator.Group = group) then + if Assigned(currentAction) then begin - { Animated group } - Inc(itemBounds.Top, Animator.Height); - end else if group.Expanded and (group.Items.Count > 0) then + itemHeight := 0; + + currentAction.GetItemHeight(group, itemHeight, handled); + if handled then + Inc(itemBounds.Top, itemHeight); + end; + + if (not handled) and group.Expanded and (group.Items.Count > 0) then begin Inc(itemBounds.Top, Painter.GetSpacing(seBeforeFirstItem)); @@ -1699,9 +1857,10 @@ begin { Pretend to auto select item - required for proper functioning of the OnSelectedChanging event } - if AutoSelectItem then - if not DoAutoSelectItem(AGroup, saBefore) then - exit; + // #ToDo1 (MvR) 20-4-2007: check OnSelectedChanging behaviour +// if AutoSelectItem then +// if not DoAutoSelectItem(AGroup, saBefore) then +// exit; { Allow collapse all } if not (AExpanding or AllowCollapseAll) then @@ -1714,28 +1873,30 @@ begin end; end; - { Auto collapse } - if AutoCollapse then - if AExpanding then - DoAutoCollapse(AGroup); - if AGroup.Items.Count > 0 then - DoExpand(AGroup, AExpanding) - else + begin + { Auto collapse first } + if AutoCollapse and AExpanding then + DoAutoCollapse(AGroup); + + PerformExpand(AGroup, AExpanding); + end else begin AGroup.InternalSetExpanded(AExpanding); - SelectedItem := AGroup + SelectedItem := AGroup; + + { Auto collapse after - if selecting the group takes some time this ensures + that the animation starts afterwards. } + if AutoCollapse and AExpanding then + DoAutoCollapse(AGroup); end; end; + procedure TX2CustomMenuBar.DoExpandedChanged(AGroup: TX2MenuBarGroup); begin if AGroup.Expanded then begin - { Auto select item } - if AutoSelectItem then - DoAutoSelectItem(AGroup, saAfter); - if Assigned(FOnExpanded) then FOnExpanded(Self, AGroup); end else @@ -1743,6 +1904,7 @@ begin FOnCollapsed(Self, AGroup); end; + procedure TX2CustomMenuBar.DoSelectedChanging(ANewItem: TX2CustomMenuBarItem; var AAllowed: Boolean); begin @@ -1750,6 +1912,7 @@ begin FOnSelectedChanging(Self, SelectedItem, ANewItem, AAllowed); end; + procedure TX2CustomMenuBar.DoSelectedChanged(); begin if Assigned(FOnSelectedChanged) then @@ -1757,118 +1920,251 @@ begin end; -function TX2CustomMenuBar.AllowInteraction(): Boolean; +procedure TX2CustomMenuBar.DoCollapsed(AGroup: TX2MenuBarGroup); begin - Result := not Assigned(Animator); + if Assigned(FOnCollapsed) then + FOnCollapsed(Self, AGroup); end; + +procedure TX2CustomMenuBar.DoCollapsing(AGroup: TX2MenuBarGroup; var AAllowed: Boolean); +begin + if Assigned(FOnCollapsing) then + FOnCollapsing(Self, AGroup, AAllowed); +end; + + +procedure TX2CustomMenuBar.DoExpanded(AGroup: TX2MenuBarGroup); +begin + if Assigned(FOnExpanded) then + FOnExpanded(Self, AGroup); +end; + + +procedure TX2CustomMenuBar.DoExpanding(AGroup: TX2MenuBarGroup; var AAllowed: Boolean); +begin + if Assigned(FOnExpanding) then + FOnExpanding(Self, AGroup, AAllowed); +end; + + + +function TX2CustomMenuBar.AllowInteraction(): Boolean; +var + currentAction: TX2CustomMenuBarAction; + +begin + Result := True; + + currentAction := GetCurrentAction(); + if Assigned(currentAction) then + Result := currentAction.AllowInteraction(); +end; + + function TX2CustomMenuBar.ItemEnabled(AItem: TX2CustomMenuBarItem): Boolean; begin Result := AItem.Enabled and AItem.Visible; end; + function TX2CustomMenuBar.ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; begin Result := AItem.Visible or (csDesigning in ComponentState); end; -procedure TX2CustomMenuBar.DoExpand(AGroup: TX2MenuBarGroup; - AExpanding: Boolean); + +function TX2CustomMenuBar.GetCurrentAction(): TX2CustomMenuBarAction; +begin + Result := nil; + if ActionQueue.Count > 0 then + Result := TX2CustomMenuBarAction(ActionQueue[0]); +end; + + +procedure TX2CustomMenuBar.PushAction(AAction: TX2CustomMenuBarAction); var - animatorClass: TX2CustomMenuBarAnimatorClass; - itemsBuffer: Graphics.TBitmap; - itemsBounds: TRect; + action: TX2CustomMenuBarAction; begin - if not Assigned(Painter) then - exit; + action := AAction; - if AGroup.Items.Count = 0 then + if ActionQueue.Count = 0 then begin - AGroup.InternalSetExpanded(AExpanding); - Exit; + { Start the action; if it's terminated immediately don't add it to the + queue. This enables actions like selecting an item without requiring + animation to fire straight away. } + action.Start(); + + if action.Terminated then + begin + action.Stop(); + FreeAndNil(action); + end; end; - if Assigned(Animator) then + if Assigned(action) then + ActionQueue.Add(action); + + Invalidate(); +end; + + +procedure TX2CustomMenuBar.PopCurrentAction(); +begin + if ActionQueue.Count > 0 then + ActionQueue.Delete(0); +end; + + +procedure TX2CustomMenuBar.InternalSetExpanded(AGroup: TX2MenuBarGroup; + AExpanded: Boolean); +begin + AGroup.InternalSetExpanded(AExpanded); + DoExpandedChanged(AGroup); + + Invalidate(); +end; + + +procedure TX2CustomMenuBar.InternalSetSelected(AItem: TX2CustomMenuBarItem); +var + group: TX2MenuBarGroup; + +begin + FSelectedItem := AItem; + DoSelectedChanged(); + + if Assigned(AItem) then begin - FExpandingGroups.AddObject(Chr(Ord(AExpanding)), AGroup); - end else - begin - animatorClass := GetAnimatorClass(); - if Assigned(animatorClass) and not (csDesigning in ComponentState) then + if (AItem is TX2MenuBarItem) then begin - Painter.BeginPaint(Self); - try - itemsBuffer := Graphics.TBitmap.Create(); - try - itemsBounds := Painter.ApplyMargins(Self.ClientRect); - itemsBuffer.PixelFormat := pf32bit; - itemsBuffer.Width := itemsBounds.Right - itemsBounds.Left; - itemsBuffer.Height := Painter.GetGroupHeight(AGroup); - itemsBounds := Rect(0, 0, itemsBuffer.Width, itemsBuffer.Height); - itemsBuffer.Canvas.Font.Assign(Self.Font); + group := TX2MenuBarItem(AItem).Group; + if Assigned(group) then + group.SelectedItem := AItem.Index; + end; - // #ToDo3 (MvR) 23-3-2006: this will probably cause problems if we ever - // want a bitmapped/customdrawn background. - // Maybe we can trick around a bit with the - // canvas offset? think about it later. - Painter.DrawBackground(itemsBuffer.Canvas, itemsBounds); - DrawMenuItems(itemsBuffer.Canvas, AGroup, itemsBounds); - - Animator := animatorClass.Create(itemsBuffer); - Animator.AnimationTime := AnimationTime; - Animator.Expanding := AExpanding; - Animator.Group := AGroup; - finally - FreeAndNil(itemsBuffer); - end; - finally - Painter.EndPaint(); - Invalidate(); - end; - end else - AGroup.InternalSetExpanded(AExpanding); + if Assigned(AItem) and Assigned(AItem.Action) then + AItem.ActionLink.Execute(Self); end; end; -procedure TX2CustomMenuBar.DoAutoCollapse(AGroup: TX2MenuBarGroup); + +function TX2CustomMenuBar.DoAutoCollapse(AGroup: TX2MenuBarGroup): Boolean; var + possibleGroup: TX2MenuBarGroup; expandedGroup: TX2MenuBarGroup; groupIndex: Integer; group: TX2MenuBarGroup; + collapseGroups: TList; + collapseActions: TX2MenuBarAnimateMultipleAction; + collapseAction: TX2MenuBarAnimateAction; begin + Result := True; expandedGroup := AGroup; + + { If no group is specified, use the first appropriate group } if not Assigned(expandedGroup) then begin + possibleGroup := nil; + for groupIndex := 0 to Pred(Groups.Count) do - if Groups[groupIndex].Expanded then + begin + if ItemVisible(Groups[groupIndex]) then begin - expandedGroup := Groups[groupIndex]; - break; + if Groups[groupIndex].Expanded then + begin + expandedGroup := Groups[groupIndex]; + break; + end else + if not Assigned(possibleGroup) then + possibleGroup := nil; end; + end; if not Assigned(expandedGroup) then - if Groups.Count > 0 then + begin + expandedGroup := possibleGroup; + + if Assigned(expandedGroup) then begin - expandedGroup := Groups[0]; - expandedGroup.Expanded := True; - end else - exit; + { Expand the first visible group. This will trigger DoAutoCollapse + again. } + Result := PerformExpand(expandedGroup, True); + Exit; + end; + end; end; - for groupIndex := 0 to Pred(Groups.Count) do - begin - group := Groups[groupIndex]; + collapseGroups := TList.Create(); + try + { Determine which groups to collapse } + for groupIndex := 0 to Pred(Groups.Count) do + begin + group := Groups[groupIndex]; - if (group <> expandedGroup) and (group.Expanded) then - DoExpand(group, False); + if (group <> expandedGroup) and (group.Expanded) then + collapseGroups.Add(group); + end; + + if collapseGroups.Count > 0 then + begin + { If more than one, collapse simultaniously } + if collapseGroups.Count > 1 then + begin + { Check if all the groups are allowed to collapse first } + for groupIndex := 0 to Pred(collapseGroups.Count) do + begin + group := TX2MenuBarGroup(collapseGroups[groupIndex]); + DoCollapsing(group, Result); + + if not Result then + Break; + end; + + + if Result then + begin + { Animate visible groups } + collapseActions := TX2MenuBarAnimateMultipleAction.Create(Self); + + for groupIndex := 0 to Pred(collapseGroups.Count) do + begin + group := TX2MenuBarGroup(collapseGroups[groupIndex]); + + if ItemVisible(group) then + begin + collapseAction := TX2MenuBarAnimateAction(GetAnimateAction(group, False)); + + if Assigned(collapseAction) then + collapseActions.Add(collapseAction); + end; + end; + + if collapseActions.Count > 0 then + PushAction(collapseActions) + else + FreeAndNil(collapseActions); + + + { Add the collapse actions after the animation so OnCollapsed events + raise afterwards. } + for groupIndex := 0 to Pred(collapseGroups.Count) do + PushAction(TX2MenuBarExpandAction.Create(Self, TX2MenuBarGroup(collapseGroups[groupIndex]), + False)); + end; + end else + Result := PerformExpand(TX2MenuBarGroup(collapseGroups[0]), False); + end; + finally + FreeAndNil(collapseGroups); end; end; -function TX2CustomMenuBar.DoAutoSelectItem(AGroup: TX2MenuBarGroup; - AAction: TX2MenuBarSelectAction): Boolean; + +function TX2CustomMenuBar.DoAutoSelectItem(AGroup: TX2MenuBarGroup): Boolean; var group: TX2MenuBarGroup; groupIndex: Integer; @@ -1878,6 +2174,7 @@ var begin Result := True; group := AGroup; + if not Assigned(group) then begin for groupIndex := 0 to Pred(Groups.Count) do @@ -1913,17 +2210,92 @@ begin end; if Assigned(newItem) and (newItem <> SelectedItem) then - begin - if AAction in [saBefore, saBoth] then - DoSelectedChanging(newItem, Result); - - if Result and (AAction in [saAfter, saBoth]) then - SelectedItem := newItem; - end; + PerformSelectItem(newItem); end; end; +function TX2CustomMenuBar.DoExpand(AGroup: TX2MenuBarGroup; AExpanding: Boolean): Boolean; +var + allowed: Boolean; + expandAction: TX2MenuBarAnimateAction; + +begin + Result := False; + allowed := True; + + if AExpanding then + DoExpanding(AGroup, allowed) + else + DoCollapsing(AGroup, allowed); + + if not allowed then + Exit; + + if AExpanding then + if not PerformAutoCollapse(AGroup) then + Exit; + + // if not AExpanding then +// begin +// // #ToDo1 (MvR) 22-3-2007: ? anything ? +// end else +// begin +// if not (PerformAutoCollapse(AGroup) and +// PerformAutoSelectItem(AGroup)) then +// Result := False; +// end; + + Result := True; + expandAction := TX2MenuBarAnimateAction(GetAnimateAction(AGroup, AExpanding)); + if Assigned(expandAction) then + PushAction(expandAction); + + PushAction(TX2MenuBarExpandAction.Create(Self, AGroup, AExpanding)); +end; + + +function TX2CustomMenuBar.DoSelectItem(AItem: TX2CustomMenuBarItem): Boolean; +begin + PushAction(TX2MenuBarSelectAction.Create(Self, AItem)); + Result := True; +end; + + +function TX2CustomMenuBar.PerformAutoCollapse(AGroup: TX2MenuBarGroup): Boolean; +begin + Result := True; + + if AutoCollapse then + Result := DoAutoCollapse(AGroup); +end; + + +function TX2CustomMenuBar.PerformAutoSelectItem(AGroup: TX2MenuBarGroup): Boolean; +begin + Result := True; + + if AutoSelectItem then + Result := DoAutoSelectItem(AGroup); +end; + + +function TX2CustomMenuBar.PerformExpand(AGroup: TX2MenuBarGroup; + AExpanding: Boolean): Boolean; +begin + Result := True; + + if AExpanding <> AGroup.Expanded then + Result := DoExpand(AGroup, AExpanding); +end; + + +function TX2CustomMenuBar.PerformSelectItem(AItem: TX2CustomMenuBarItem): Boolean; +begin + Result := DoSelectItem(AItem); +end; + + procedure TX2CustomMenuBar.ResetGroupsSelectedItem; var groupIndex: Integer; @@ -1954,6 +2326,7 @@ begin end; end; + function TX2CustomMenuBar.HitTest(AX, AY: Integer): TX2MenuBarHitTest; begin Result := HitTest(Point(AX, AY)); @@ -2064,6 +2437,7 @@ begin end; end; + function TX2CustomMenuBar.SelectLast(): TX2CustomMenuBarItem; begin Result := nil; @@ -2076,25 +2450,27 @@ begin end; end; + function TX2CustomMenuBar.SelectNext(): TX2CustomMenuBarItem; begin Result := nil; if AllowInteraction then begin - Result := Iterate(FindEnabledItem, mbdDown, nil, FSelectedItem); + Result := Iterate(FindEnabledItem, mbdDown, nil, SelectedItem); if Assigned(Result) then SelectedItem := Result; end; end; + function TX2CustomMenuBar.SelectPrior(): TX2CustomMenuBarItem; begin Result := nil; if AllowInteraction then begin - Result := Iterate(FindEnabledItem, mbdUp, nil, FSelectedItem); + Result := Iterate(FindEnabledItem, mbdUp, nil, SelectedItem); if Assigned(Result) then SelectedItem := Result; end; @@ -2115,6 +2491,7 @@ begin end; end; + function TX2CustomMenuBar.SelectItem(AIndex: Integer; AGroup: TX2MenuBarGroup): TX2CustomMenuBarItem; var @@ -2152,6 +2529,7 @@ begin end; end; + function TX2CustomMenuBar.SelectItem(AIndex, AGroup: Integer): TX2CustomMenuBarItem; var group: TX2MenuBarGroup; @@ -2187,11 +2565,13 @@ begin inherited; end; + procedure TX2CustomMenuBar.PainterUpdate(Sender: TX2CustomMenuBarPainter); begin Invalidate(); end; + procedure TX2CustomMenuBar.GroupsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification); begin if Action = cnDeleting then @@ -2210,6 +2590,7 @@ begin Invalidate(); end; + procedure TX2CustomMenuBar.GroupsUpdate(Sender: TObject; Item: TCollectionItem); begin if Assigned(SelectedItem) and (not ItemEnabled(SelectedItem)) then @@ -2226,32 +2607,22 @@ procedure TX2CustomMenuBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var hitTest: TX2MenuBarHitTest; - group: TX2MenuBarGroup; begin if Button = mbLeft then + begin if AllowInteraction then begin hitTest := Self.HitTest(X, Y); - - if hitTest.HitTestCode = htGroup then - begin - group := TX2MenuBarGroup(hitTest.Item); - if ItemEnabled(group) then - begin - group.Expanded := not group.Expanded; - hitTest.Item := SelectedItem; - Invalidate(); - end; - end; - if Assigned(hitTest.Item) then SelectedItem := hitTest.Item; end; + end; inherited; end; + procedure TX2CustomMenuBar.MouseMove(Shift: TShiftState; X, Y: Integer); var cursor: TCursor; @@ -2261,13 +2632,15 @@ begin TestMousePos(); cursor := crDefault; - if Assigned(FHotItem) then - if FHotItem is TX2MenuBarGroup then + if Assigned(HotItem) then + begin + if HotItem is TX2MenuBarGroup then cursor := CursorGroup - else if FHotItem is TX2MenuBarItem then + else if HotItem is TX2MenuBarItem then cursor := CursorItem; + end; - if (cursor <> crDefault) and ItemEnabled(FHotItem) then + if (cursor <> crDefault) and ItemEnabled(HotItem) then begin Windows.SetCursor(Screen.Cursors[cursor]); exit; @@ -2276,11 +2649,6 @@ begin inherited; end; -//procedure TX2CustomMenuBar.MouseUp(Button: TMouseButton; Shift: TShiftState; -// X, Y: Integer); -//begin -// inherited; -//end; procedure TX2CustomMenuBar.CMMouseLeave(var Msg: TMessage); begin @@ -2362,6 +2730,7 @@ begin end; end; + procedure TX2CustomMenuBar.TestMousePos(); var hitTest: TX2MenuBarHitTest; @@ -2370,18 +2739,22 @@ begin hitTest := Self.HitTest(FLastMousePos.X, FLastMousePos.Y); if hitTest.Item <> FHotItem then begin - FHotItem := hitTest.Item; + HotItem := hitTest.Item; Invalidate(); end; end; + function TX2CustomMenuBar.GetMenuHeight(): Integer; var - groupIndex: Integer; + currentAction: TX2CustomMenuBarAction; group: TX2MenuBarGroup; - menuBounds: TRect; - itemIndex: Integer; + groupIndex: Integer; + handled: Boolean; item: TX2MenuBarItem; + itemHeight: Integer; + itemIndex: Integer; + menuBounds: TRect; begin if not Assigned(Painter) then @@ -2404,11 +2777,17 @@ begin Painter.GetGroupHeaderHeight(group) + Painter.GetSpacing(seAfterGroupHeader)); - if Assigned(Animator) and (Animator.Group = group) then + handled := False; + currentAction := GetCurrentAction(); + if Assigned(currentAction) then begin - { Animated group } - Inc(Result, Animator.Height); - end else if group.Expanded then + currentAction.GetItemHeight(group, itemHeight, handled); + + if handled then + Inc(Result, itemHeight); + end; + + if (not handled) and group.Expanded then begin Inc(Result, Painter.GetSpacing(seBeforeFirstItem)); @@ -2429,14 +2808,17 @@ begin end; end; + procedure TX2CustomMenuBar.UpdateScrollbar(); var + currentAction: TX2CustomMenuBarAction; scrollInfo: TScrollInfo; begin { Don't update the scrollbar while animating, prevents issues with the items buffer width if the scrollbar happens to show/hide during animation. } - if Assigned(Animator) then + currentAction := GetCurrentAction(); + if Assigned(currentAction) and (not currentAction.AllowUpdateScrollbar()) then exit; FillChar(scrollInfo, SizeOf(TScrollInfo), #0); @@ -2470,6 +2852,12 @@ begin end; +procedure TX2CustomMenuBar.ImagesChange(Sender: TObject); +begin + Invalidate(); +end; + + procedure TX2CustomMenuBar.SetAllowCollapseAll(const Value: Boolean); begin if Value <> FAllowCollapseAll then @@ -2479,14 +2867,6 @@ begin end; end; -procedure TX2CustomMenuBar.SetAnimator(const Value: TX2CustomMenuBarAnimator); -begin - if Value <> FAnimator then - begin - FreeAndNil(FAnimator); - FAnimator := Value; - end; -end; procedure TX2CustomMenuBar.SetAutoCollapse(const Value: Boolean); begin @@ -2499,6 +2879,7 @@ begin end; end; + procedure TX2CustomMenuBar.SetAutoSelectItem(const Value: Boolean); begin if Value <> FAutoSelectItem then @@ -2506,10 +2887,11 @@ begin FAutoSelectItem := Value; if Value and (not Assigned(SelectedItem)) then - DoAutoSelectItem(nil, saBoth); + DoAutoSelectItem(nil); end; end; + procedure TX2CustomMenuBar.SetBorderStyle(const Value: TBorderStyle); begin if Value <> FBorderStyle then @@ -2519,12 +2901,14 @@ begin end; end; + procedure TX2CustomMenuBar.SetGroups(const Value: TX2MenuBarGroups); begin if Value <> FGroups then FGroups.Assign(Value); end; + procedure TX2CustomMenuBar.SetHideScrollbar(const Value: Boolean); begin if Value <> FHideScrollbar then @@ -2534,22 +2918,30 @@ begin end; end; + procedure TX2CustomMenuBar.SetImages(const Value: TCustomImageList); begin if Value <> FImages then begin if Assigned(FImages) then + begin + FImages.UnRegisterChanges(FImagesChangeLink); FImages.RemoveFreeNotification(Self); + end; FImages := Value; if Assigned(FImages) then + begin FImages.FreeNotification(Self); + FImages.RegisterChanges(FImagesChangeLink); + end; Invalidate(); end; end; + procedure TX2CustomMenuBar.SetPainter(const Value: TX2CustomMenuBarPainter); begin if FPainter <> Value then @@ -2560,7 +2952,7 @@ begin FPainter.RemoveFreeNotification(Self); end; - Animator := nil; + // #ToDo1 (MvR) 13-3-2007: check queue ? FPainter := Value; if Assigned(FPainter) then @@ -2573,6 +2965,7 @@ begin end; end; + procedure TX2CustomMenuBar.SetScrollbar(const Value: Boolean); begin if Value <> FScrollbar then @@ -2582,61 +2975,77 @@ begin end; end; + procedure TX2CustomMenuBar.SetSelectedItem(const Value: TX2CustomMenuBarItem); var allowed: Boolean; group: TX2MenuBarGroup; + selectItem: TX2CustomMenuBarItem; begin if Value <> FSelectedItem then begin - if Assigned(Value) then + if Assigned(Value) and (Value.MenuBar <> Self) then + raise EInvalidItem.Create(SInvalidItem); + + + allowed := (not Assigned(Value)) or ItemEnabled(Value); + if allowed then + DoSelectedChanging(Value, allowed); + + + if allowed then begin - allowed := ItemEnabled(Value); - if allowed then + selectItem := Value; + + if Assigned(selectItem) then begin - DoSelectedChanging(Value, allowed); - - if allowed then + if selectItem is TX2MenuBarGroup then begin - if Value is TX2MenuBarGroup then - begin - group := TX2MenuBarGroup(Value); + group := TX2MenuBarGroup(selectItem); + { Check if the group should be collapsed } + if group.Expanded and (not AutoCollapse) then + begin + PerformExpand(group, False); + end else + begin if group.Items.Count > 0 then begin - // Item is a group, expand it (triggers autoselect too if appropriate) - group.Expanded := True; - Exit; + PerformExpand(group, True); + PerformAutoSelectItem(group); end else - DoAutoCollapse(group); - end; - - FSelectedItem := Value; - - if Value is TX2MenuBarItem then - begin - group := TX2MenuBarItem(Value).Group; - if Assigned(group) then begin - group.SelectedItem := Value.Index; - - if not group.Expanded then - group.Expanded := True; + if PerformAutoCollapse(group) then + PerformSelectItem(group); end; end; + end else + begin + if (selectItem is TX2MenuBarItem) then + begin + group := TX2MenuBarItem(selectItem).Group; + if Assigned(group) and (not group.Expanded) then + PerformExpand(group, True); + end; - if Assigned(FSelectedItem) and Assigned(FSelectedItem.Action) then - FSelectedItem.ActionLink.Execute(Self); + PerformSelectItem(selectItem); end; - end; - end else - FSelectedItem := Value; - - DoSelectedChanged(); - Invalidate(); + end else + PerformSelectItem(selectItem); + end; end; end; +//procedure TX2CustomMenuBar.WMMouseWheel(var Message: TWMMouseWheel); +//begin +//// MessageBox(0, 'I gots a mousewheel', '', 0); +//end; +// +//procedure TX2CustomMenuBar.CMMouseWheel(var Message: TCMMouseWheel); +//begin +//// MessageBox(0, 'I gots a mousewheel', '', 0); +//end; + end. diff --git a/Source/X2CLMenuBarActions.pas b/Source/X2CLMenuBarActions.pas new file mode 100644 index 0000000..5e73f1b --- /dev/null +++ b/Source/X2CLMenuBarActions.pas @@ -0,0 +1,375 @@ +unit X2CLMenuBarActions; + +interface +uses + Contnrs, + Graphics, + Windows, + + X2CLMenuBar; + + +type + { + :$ Animate group expand/collapse. + + :: Handles the animating of a single group. + } + TX2MenuBarAnimateAction = class(TX2CustomMenuBarAction) + private + FAnimator: TX2CustomMenuBarAnimator; + FGroup: TX2MenuBarGroup; + protected + property Animator: TX2CustomMenuBarAnimator read FAnimator; + property Group: TX2MenuBarGroup read FGroup; + public + constructor Create(AMenuBar: TX2CustomMenuBar; AGroup: TX2MenuBarGroup; + AAnimator: TX2CustomMenuBarAnimator); + destructor Destroy(); override; + + procedure Start(); override; + + procedure BeforePaint(); override; + procedure GetItemHeight(AItem: TX2CustomMenuBarItem; var AHeight: Integer; + var AHandled: Boolean); override; + procedure DrawMenuItem(ACanvas: TCanvas; APainter: TX2CustomMenuBarPainter; + AItem: TX2CustomMenuBarItem; const AMenuBounds: TRect; + const AItemBounds: TRect; AState: TX2MenuBarDrawStates; + var AHandled: Boolean); override; + procedure AfterPaint(); override; + end; + + + { + :$ Animate multiple groups expanding/collapsing. + + :: Manages multiple TX2MenuBarAnimateAction instances in one action. + } + TX2MenuBarAnimateMultipleAction = class(TX2CustomMenuBarAction) + private + FAnimateActions: TObjectList; + + function GetCount(): Integer; + protected + function GetAnimateAction(AIndex: Integer): TX2MenuBarAnimateAction; + function GetTerminated(): Boolean; override; + + property AnimateActions: TObjectList read FAnimateActions; + public + constructor Create(AMenuBar: TX2CustomMenuBar); + destructor Destroy(); override; + + procedure Add(AAction: TX2MenuBarAnimateAction); + + procedure BeforePaint(); override; + procedure GetItemHeight(AItem: TX2CustomMenuBarItem; var AHeight: Integer; + var AHandled: Boolean); override; + procedure DrawMenuItem(ACanvas: TCanvas; APainter: TX2CustomMenuBarPainter; + AItem: TX2CustomMenuBarItem; const AMenuBounds: TRect; + const AItemBounds: TRect; AState: TX2MenuBarDrawStates; + var AHandled: Boolean); override; + procedure AfterPaint(); override; + + property Count: Integer read GetCount; + end; + + + { + :$ Sets the Expanded property of a group. + + :: Provides a way to set the Expanded property of a group after it has + :: been animated. + } + TX2MenuBarExpandAction = class(TX2CustomMenuBarAction) + private + FExpanding: Boolean; + FGroup: TX2MenuBarGroup; + public + constructor Create(AMenuBar: TX2CustomMenuBar; AGroup: TX2MenuBarGroup; + AExpanding: Boolean); + + procedure Start(); override; + end; + + + { + :$ Sets the Selected property. + + :: Provides a way to set the Selected property of an item after + :: animating. + } + TX2MenuBarSelectAction = class(TX2CustomMenuBarAction) + private + FItem: TX2CustomMenuBarItem; + public + constructor Create(AMenuBar: TX2CustomMenuBar; AItem: TX2CustomMenuBarItem); + + procedure Start(); override; + end; + + +implementation +uses + SysUtils; + + +type + TProtectedX2CustomMenuBarPainter = class(TX2CustomMenuBarPainter); + TProtectedX2CustomMenuBar = class(TX2CustomMenuBar); + TProtectedX2MenuBarGroup = class(TX2MenuBarGroup); + + + +{ TX2MenuBarAnimateAction } +constructor TX2MenuBarAnimateAction.Create(AMenuBar: TX2CustomMenuBar; AGroup: TX2MenuBarGroup; + AAnimator: TX2CustomMenuBarAnimator); +begin + inherited Create(AMenuBar); + + FAnimator := AAnimator; + FGroup := AGroup; +end; + + +destructor TX2MenuBarAnimateAction.Destroy(); +begin + FreeAndNil(FAnimator); + + inherited; +end; + + +procedure TX2MenuBarAnimateAction.Start(); +begin + inherited; + + Animator.ResetStartTime(); +end; + + +procedure TX2MenuBarAnimateAction.BeforePaint(); +begin + inherited; + + Animator.Update(); + if Animator.Terminated then + Terminate(); +end; + + +procedure TX2MenuBarAnimateAction.GetItemHeight(AItem: TX2CustomMenuBarItem; + var AHeight: Integer; + var AHandled: Boolean); +begin + inherited; + + if AItem = Group then + begin + AHeight := Animator.Height; + AHandled := True; + end; +end; + + +procedure TX2MenuBarAnimateAction.DrawMenuItem(ACanvas: TCanvas; APainter: TX2CustomMenuBarPainter; + AItem: TX2CustomMenuBarItem; const AMenuBounds, + AItemBounds: TRect; AState: TX2MenuBarDrawStates; + var AHandled: Boolean); +var + groupBounds: TRect; + painter: TProtectedX2CustomMenuBarPainter; + +begin + inherited; + + if Group = AItem then + begin + painter := TProtectedX2CustomMenuBarPainter(APainter); + groupBounds := AMenuBounds; + groupBounds.Top := AItemBounds.Bottom + + painter.GetSpacing(seAfterGroupHeader) + + painter.GetSpacing(seBeforeFirstItem); + groupBounds.Bottom := groupBounds.Top + Animator.Height; + Animator.Draw(ACanvas, groupBounds); +// AHandled := True; + end; +end; + + +procedure TX2MenuBarAnimateAction.AfterPaint(); +begin + inherited; + + if not Terminated then + begin + { Prevent 100% CPU usage } + Sleep(5); + + TProtectedX2CustomMenuBar(MenuBar).TestMousePos(); + MenuBar.Invalidate(); + end; +end; + + +{ TX2MenuBarAnimateMultipleAction } +constructor TX2MenuBarAnimateMultipleAction.Create(AMenuBar: TX2CustomMenuBar); +begin + inherited; + + FAnimateActions := TObjectList.Create(True); +end; + + +destructor TX2MenuBarAnimateMultipleAction.Destroy(); +begin + FreeAndNil(FAnimateActions); + + inherited; +end; + + +procedure TX2MenuBarAnimateMultipleAction.Add(AAction: TX2MenuBarAnimateAction); +begin + AnimateActions.Add(AAction); +end; + + +procedure TX2MenuBarAnimateMultipleAction.BeforePaint(); +var + actionIndex: Integer; + +begin + inherited; + + for actionIndex := 0 to Pred(AnimateActions.Count) do + GetAnimateAction(actionIndex).BeforePaint(); +end; + + +procedure TX2MenuBarAnimateMultipleAction.GetItemHeight(AItem: TX2CustomMenuBarItem; + var AHeight: Integer; + var AHandled: Boolean); +var + actionIndex: Integer; + +begin + inherited; + + for actionIndex := 0 to Pred(AnimateActions.Count) do + begin + GetAnimateAction(actionIndex).GetItemHeight(AItem, AHeight, AHandled); + + if AHandled then + Break; + end; +end; + + +procedure TX2MenuBarAnimateMultipleAction.DrawMenuItem(ACanvas: TCanvas; + APainter: TX2CustomMenuBarPainter; + AItem: TX2CustomMenuBarItem; + const AMenuBounds, AItemBounds: TRect; + AState: TX2MenuBarDrawStates; + var AHandled: Boolean); +var + actionIndex: Integer; + +begin + inherited; + + for actionIndex := 0 to Pred(AnimateActions.Count) do + begin + GetAnimateAction(actionIndex).DrawMenuItem(ACanvas, APainter, AItem, + AMenuBounds, AItemBounds, AState, + AHandled); + + if AHandled then + Break; + end; +end; + + +procedure TX2MenuBarAnimateMultipleAction.AfterPaint(); +var + actionIndex: Integer; + +begin + inherited; + + for actionIndex := 0 to Pred(AnimateActions.Count) do + GetAnimateAction(actionIndex).AfterPaint(); +end; + + +function TX2MenuBarAnimateMultipleAction.GetAnimateAction(AIndex: Integer): TX2MenuBarAnimateAction; +begin + Result := TX2MenuBarAnimateAction(AnimateActions[AIndex]); +end; + + +function TX2MenuBarAnimateMultipleAction.GetCount(): Integer; +begin + Result := FAnimateActions.Count; +end; + + +function TX2MenuBarAnimateMultipleAction.GetTerminated(): Boolean; +var + actionIndex: Integer; + +begin + Result := inherited GetTerminated(); + + if not Result then + begin + for actionIndex := 0 to Pred(AnimateActions.Count) do + if GetAnimateAction(actionIndex).Terminated then + begin + Result := True; + Break; + end; + end; +end; + + +{ TX2MenuBarExpandAction } +constructor TX2MenuBarExpandAction.Create(AMenuBar: TX2CustomMenuBar; + AGroup: TX2MenuBarGroup; + AExpanding: Boolean); +begin + inherited Create(AMenuBar); + + FExpanding := AExpanding; + FGroup := AGroup; +end; + + +procedure TX2MenuBarExpandAction.Start(); +begin + inherited; + + TProtectedX2CustomMenuBar(MenuBar).InternalSetExpanded(FGroup, FExpanding); + Terminate(); +end; + + +{ TX2MenuBarSelectAction } +constructor TX2MenuBarSelectAction.Create(AMenuBar: TX2CustomMenuBar; + AItem: TX2CustomMenuBarItem); +begin + inherited Create(AMenuBar); + + FItem := AItem; +end; + + +procedure TX2MenuBarSelectAction.Start(); +begin + inherited; + + TProtectedX2CustomMenuBar(MenuBar).InternalSetSelected(FItem); + Terminate(); +end; + +end. + diff --git a/Source/X2CLMenuBarAnimators.pas b/Source/X2CLMenuBarAnimators.pas index 43dac53..68b2e2d 100644 --- a/Source/X2CLMenuBarAnimators.pas +++ b/Source/X2CLMenuBarAnimators.pas @@ -81,7 +81,9 @@ type implementation uses - SysUtils; + SysUtils, + + X2CLGraphics; { TX2MenuBarSlideAnimator } @@ -346,7 +348,7 @@ begin destRect := Rect(0, 0, backBuffer.Width, backBuffer.Height); backBuffer.Canvas.CopyRect(destRect, ACanvas, ABounds); - X2CLMenuBar.DrawBlended(backBuffer, ItemsBuffer, FAlpha); + X2CLGraphics.DrawBlended(backBuffer, ItemsBuffer, FAlpha); sourceRect := Rect(0, 0, ItemsBuffer.Width, Self.Height); destRect := ABounds; diff --git a/Source/X2CLmusikCubeMenuBarPainter.pas b/Source/X2CLmusikCubeMenuBarPainter.pas index 054851a..11b29be 100644 --- a/Source/X2CLmusikCubeMenuBarPainter.pas +++ b/Source/X2CLmusikCubeMenuBarPainter.pas @@ -216,7 +216,7 @@ begin iconBuffer.Assign(backBuffer); AImageList.Draw(iconBuffer.Canvas, 0, 0, AImageIndex); - X2CLMenuBar.DrawBlended(backBuffer, iconBuffer, AAlpha); + X2CLGraphics.DrawBlended(backBuffer, iconBuffer, AAlpha); finally FreeAndNil(iconBuffer); end; diff --git a/Source/X2CLunaMenuBarPainter.pas b/Source/X2CLunaMenuBarPainter.pas index bfdea66..26e8592 100644 --- a/Source/X2CLunaMenuBarPainter.pas +++ b/Source/X2CLunaMenuBarPainter.pas @@ -14,6 +14,7 @@ interface uses Classes, Graphics, + ImgList, Windows, X2CLMenuBar; @@ -28,6 +29,7 @@ type property OnChange: TNotifyEvent read FOnChange write FOnChange; end; + TX2MenuBarunaColor = class(TX2MenuBarunaProperty) private FDefaultDisabled: TColor; @@ -63,6 +65,7 @@ type property Selected: TColor read FSelected write SetSelected stored IsSelectedStored; end; + TX2MenuBarunaGroupColors = class(TX2MenuBarunaProperty) private FFill: TX2MenuBarunaColor; @@ -85,6 +88,7 @@ type property Text: TX2MenuBarunaColor read FText write SetText; end; + TX2MenuBarunaMetrics = class(TX2MenuBarunaProperty) private FAfterGroupHeader: Integer; @@ -96,6 +100,8 @@ type FGroupHeight: Integer; FItemHeight: Integer; FMargin: Integer; + FImageOffsetY: Integer; + FImageOffsetX: Integer; procedure SetAfterGroupHeader(const Value: Integer); procedure SetAfterItem(const Value: Integer); @@ -106,6 +112,8 @@ type procedure SetGroupHeight(const Value: Integer); procedure SetItemHeight(const Value: Integer); procedure SetMargin(const Value: Integer); + procedure SetImageOffsetX(const Value: Integer); + procedure SetImageOffsetY(const Value: Integer); public constructor Create(); @@ -120,8 +128,11 @@ type property GroupHeight: Integer read FGroupHeight write SetGroupHeight default 22; property ItemHeight: Integer read FItemHeight write SetItemHeight default 21; property Margin: Integer read FMargin write SetMargin default 10; + property ImageOffsetX: Integer read FImageOffsetX write SetImageOffsetX default 0; + property ImageOffsetY: Integer read FImageOffsetY write SetImageOffsetY default 0; end; + TX2MenuBarunaPainter = class(TX2CustomMenuBarPainter) private FArrowColor: TColor; @@ -132,6 +143,9 @@ type FMetrics: TX2MenuBarunaMetrics; FShadowColor: TColor; FShadowOffset: Integer; + FGroupGradient: Integer; + FArrowImages: TCustomImageList; + FArrowImageIndex: TImageIndex; procedure SetBlurShadow(const Value: Boolean); procedure SetGroupColors(const Value: TX2MenuBarunaGroupColors); @@ -139,7 +153,14 @@ type procedure SetMetrics(const Value: TX2MenuBarunaMetrics); procedure SetShadowColor(const Value: TColor); procedure SetShadowOffset(const Value: Integer); + procedure SetGroupGradient(const Value: Integer); + procedure SetArrowImageIndex(const Value: TImageIndex); + procedure SetArrowImages(const Value: TCustomImageList); protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + + function HasArrowImage(): Boolean; + function ApplyMargins(const ABounds: TRect): TRect; override; function GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; override; function GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; override; @@ -148,6 +169,7 @@ type procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); override; procedure DrawGroupHeader(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect; AState: TX2MenuBarDrawStates); override; procedure DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem; const ABounds: TRect; AState: TX2MenuBarDrawStates); override; + procedure DrawArrow(ACanvas: TCanvas; ABounds: TRect); procedure ColorChange(Sender: TObject); public @@ -156,24 +178,30 @@ type procedure ResetColors(); published - property ArrowColor: TColor read FArrowColor write FArrowColor default clBlue; - property BlurShadow: Boolean read FBlurShadow write SetBlurShadow default True; - property Color: TColor read FColor write FColor default clWindow; - property GroupColors: TX2MenuBarunaGroupColors read FGroupColors write SetGroupColors; - property ItemColors: TX2MenuBarunaColor read FItemColors write SetItemColors; - property Metrics: TX2MenuBarunaMetrics read FMetrics write SetMetrics; - property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow; - property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 2; + property ArrowImageIndex: TImageIndex read FArrowImageIndex write SetArrowImageIndex default -1; + property ArrowImages: TCustomImageList read FArrowImages write SetArrowImages; + property ArrowColor: TColor read FArrowColor write FArrowColor default clBlue; + property BlurShadow: Boolean read FBlurShadow write SetBlurShadow default True; + property Color: TColor read FColor write FColor default clWindow; + property GroupColors: TX2MenuBarunaGroupColors read FGroupColors write SetGroupColors; + property ItemColors: TX2MenuBarunaColor read FItemColors write SetItemColors; + property Metrics: TX2MenuBarunaMetrics read FMetrics write SetMetrics; + property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow; + property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 2; + property GroupGradient: Integer read FGroupGradient write SetGroupGradient default 0; end; implementation uses - ImgList, SysUtils, X2CLGraphics; +const + ArrowMargin = 2; + ArrowWidth = 8; + procedure Blur(ASource: Graphics.TBitmap); var @@ -387,16 +415,37 @@ begin end; +procedure TX2MenuBarunaMetrics.SetImageOffsetX(const Value: Integer); +begin + if Value <> FImageOffsetX then + begin + FImageOffsetX := Value; + Changed(); + end; +end; + + +procedure TX2MenuBarunaMetrics.SetImageOffsetY(const Value: Integer); +begin + if Value <> FImageOffsetY then + begin + FImageOffsetY := Value; + Changed(); + end; +end; + + { TX2MenuBarunaPainter } constructor TX2MenuBarunaPainter.Create(AOwner: TComponent); begin inherited; - FBlurShadow := True; - FGroupColors := TX2MenuBarunaGroupColors.Create(); - FItemColors := TX2MenuBarunaColor.Create(); - FMetrics := TX2MenuBarunaMetrics.Create(); - FShadowOffset := 2; + FArrowImageIndex := -1; + FBlurShadow := True; + FGroupColors := TX2MenuBarunaGroupColors.Create(); + FItemColors := TX2MenuBarunaColor.Create(); + FMetrics := TX2MenuBarunaMetrics.Create(); + FShadowOffset := 2; FGroupColors.OnChange := ColorChange; FItemColors.OnChange := ColorChange; @@ -407,6 +456,7 @@ end; destructor TX2MenuBarunaPainter.Destroy(); begin + SetArrowImages(nil); FreeAndNil(FMetrics); FreeAndNil(FItemColors); FreeAndNil(FGroupColors); @@ -526,6 +576,9 @@ var shadowBitmap: Graphics.TBitmap; shadowBounds: TRect; textRect: TRect; + clipRegion: HRGN; + startColor: TColor; + endColor: TColor; begin if not ((mdsSelected in AState) or (mdsGroupSelected in AState)) then @@ -558,12 +611,32 @@ begin end; { Rounded rectangle } - ACanvas.Brush.Color := GetColor(GroupColors.Fill); + startColor := GetColor(GroupColors.Fill); + endColor := startColor; + + if GroupGradient > 0 then + endColor := LightenColor(startColor, GroupGradient) + + else if GroupGradient < 0 then + endColor := DarkenColor(startColor, -GroupGradient); + + + clipRegion := CreateRoundRectRgn(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5); + SelectClipRgn(ACanvas.Handle, clipRegion); + + GradientFillRect(ACanvas, ABounds, startColor, endColor); + + SelectClipRgn(ACanvas.Handle, 0); + DeleteObject(clipRegion); + + ACanvas.Brush.Style := bsClear; ACanvas.Pen.Color := GetColor(GroupColors.Border); + ACanvas.Pen.Style := psSolid; + ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5); + + ACanvas.Brush.Style := bsSolid; ACanvas.Font.Color := GetColor(GroupColors.Text); - ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5); - textRect := ABounds; Inc(textRect.Left, 4); Dec(textRect.Right, 4); @@ -576,6 +649,10 @@ begin begin imagePos.X := textRect.Left; imagePos.Y := ABounds.Top + ((ABounds.Bottom - ABounds.Top - imageList.Height) div 2); + + Inc(imagePos.X, Metrics.ImageOffsetX); + Inc(imagePos.Y, Metrics.ImageOffsetY); + imageList.Draw(ACanvas, imagePos.X, imagePos.Y, AGroup.ImageIndex); end; @@ -584,6 +661,7 @@ begin { Text } ACanvas.Font.Style := [fsBold]; + SetBkMode(ACanvas.Handle, TRANSPARENT); DrawText(ACanvas, AGroup.Caption, textRect, taLeftJustify, taVerticalCenter, False, csEllipsis); end; @@ -604,21 +682,58 @@ procedure TX2MenuBarunaPainter.DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem; Result := AColor.Disabled; end; + var focusBounds: TRect; textBounds: TRect; - arrowPoints: array[0..2] of TPoint; begin focusBounds := ABounds; - Dec(focusBounds.Right, Metrics.Margin); + + if HasArrowImage() then + Dec(focusBounds.Right, ArrowImages.Width + ArrowMargin) + else + Dec(focusBounds.Right, ArrowWidth + ArrowMargin); if (mdsSelected in AState) then begin - { Focus rectangle } + { Focus rectangle and arrow } DrawFocusRect(ACanvas, focusBounds); + DrawArrow(ACanvas, ABounds); + end; - { Arrow } + { Text } + ACanvas.Font.Color := GetColor(ItemColors); + textBounds := focusBounds; + Inc(textBounds.Left, 4); + Dec(textBounds.Right, 4); + + if not AItem.Visible then + { Design-time } + ACanvas.Font.Style := [fsItalic] + else + ACanvas.Font.Style := []; + + SetBkMode(ACanvas.Handle, TRANSPARENT); + DrawText(ACanvas, AItem.Caption, textBounds, taRightJustify, taVerticalCenter, + False, csEllipsis); +end; + + +procedure TX2MenuBarunaPainter.DrawArrow(ACanvas: TCanvas; ABounds: TRect); +var + arrowX: Integer; + arrowY: Integer; + arrowPoints: array[0..2] of TPoint; + +begin + if HasArrowImage() then + begin + arrowX := ABounds.Right - ArrowImages.Width; + arrowY := ABounds.Top + ((ABounds.Bottom - ABounds.Top - ArrowImages.Height) div 2); + ArrowImages.Draw(ACanvas, arrowX, arrowY, ArrowImageIndex); + end else + begin ACanvas.Brush.Color := ArrowColor; ACanvas.Pen.Color := ArrowColor; @@ -630,23 +745,6 @@ begin arrowPoints[2].Y := arrowPoints[0].Y + 7; ACanvas.Polygon(arrowPoints); end; - - { Text } - ACanvas.Font.Color := GetColor(ItemColors); - textBounds := focusBounds; - Inc(textBounds.Left, 4); - Dec(textBounds.Right, 4); - - SetBkMode(ACanvas.Handle, TRANSPARENT); - - if not AItem.Visible then - { Design-time } - ACanvas.Font.Style := [fsItalic] - else - ACanvas.Font.Style := []; - - DrawText(ACanvas, AItem.Caption, textBounds, taRightJustify, taVerticalCenter, - False, csEllipsis); end; @@ -656,6 +754,21 @@ begin end; +function TX2MenuBarunaPainter.HasArrowImage(): Boolean; +begin + Result := Assigned(ArrowImages) and (ArrowImageIndex > -1); +end; + + +procedure TX2MenuBarunaPainter.Notification(AComponent: TComponent; Operation: TOperation); +begin + if (Operation = opRemove) and (AComponent = FArrowImages) then + SetArrowImages(nil); + + inherited; +end; + + procedure TX2MenuBarunaPainter.SetGroupColors(const Value: TX2MenuBarunaGroupColors); begin if Value <> FGroupColors then @@ -702,6 +815,43 @@ begin end; +procedure TX2MenuBarunaPainter.SetGroupGradient(const Value: Integer); +begin + if Value <> FGroupGradient then + begin + FGroupGradient := Value; + NotifyObservers(); + end; +end; + + +procedure TX2MenuBarunaPainter.SetArrowImageIndex(const Value: TImageIndex); +begin + if Value <> FArrowImageIndex then + begin + FArrowImageIndex := Value; + NotifyObservers(); + end; +end; + + +procedure TX2MenuBarunaPainter.SetArrowImages(const Value: TCustomImageList); +begin + if Value <> FArrowImages then + begin + if Assigned(FArrowImages) then + FArrowImages.RemoveFreeNotification(Self); + + FArrowImages := Value; + + if Assigned(FArrowImages) then + FArrowImages.FreeNotification(Self); + + NotifyObservers(); + end; +end; + + { TX2MenuBarunaProperty } procedure TX2MenuBarunaProperty.Changed(); begin diff --git a/Test/MenuBar/MainForm.dfm b/Test/MenuBar/MainForm.dfm index 9f96e36..921a5cc 100644 --- a/Test/MenuBar/MainForm.dfm +++ b/Test/MenuBar/MainForm.dfm @@ -1,9 +1,9 @@ object frmMain: TfrmMain Left = 300 Top = 219 + Width = 613 + Height = 406 Caption = 'X2MenuBar Test' - ClientHeight = 379 - ClientWidth = 589 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -23,8 +23,6 @@ object frmMain: TfrmMain Height = 379 Align = alLeft Shape = bsLeftLine - ExplicitLeft = 148 - ExplicitTop = -4 end object lblAnimationTime: TLabel Left = 424 @@ -33,24 +31,13 @@ object frmMain: TfrmMain Height = 13 Caption = 'Animation time (ms):' end - object seAnimationTime: TJvSpinEdit - Left = 424 - Top = 36 - Width = 81 - Height = 21 - CheckMinValue = True - ButtonKind = bkStandard - Value = 250.000000000000000000 - TabOrder = 0 - OnChange = seAnimationTimeChange - end object Panel1: TPanel Left = 280 Top = 68 Width = 133 Height = 77 BevelOuter = bvNone - TabOrder = 1 + TabOrder = 0 object rbmusikCube: TRadioButton Left = 0 Top = 0 @@ -87,7 +74,7 @@ object frmMain: TfrmMain Width = 153 Height = 101 BevelOuter = bvNone - TabOrder = 2 + TabOrder = 1 object rbSliding: TRadioButton Left = 0 Top = 20 @@ -142,7 +129,7 @@ object frmMain: TfrmMain Width = 89 Height = 17 Caption = 'Auto collapse' - TabOrder = 3 + TabOrder = 2 OnClick = chkAutoCollapseClick end object chkAllowCollapseAll: TCheckBox @@ -151,7 +138,7 @@ object frmMain: TfrmMain Width = 101 Height = 17 Caption = 'Allow collapse all' - TabOrder = 5 + TabOrder = 4 OnClick = chkAllowCollapseAllClick end object chkAutoSelectItem: TCheckBox @@ -160,7 +147,7 @@ object frmMain: TfrmMain Width = 101 Height = 17 Caption = 'Auto select item' - TabOrder = 4 + TabOrder = 3 OnClick = chkAutoSelectItemClick end object chkScrollbar: TCheckBox @@ -171,7 +158,7 @@ object frmMain: TfrmMain Caption = 'Scrollbar' Checked = True State = cbChecked - TabOrder = 6 + TabOrder = 5 OnClick = chkScrollbarClick end object chkHideScrollbar: TCheckBox @@ -182,7 +169,7 @@ object frmMain: TfrmMain Caption = 'Hide Scrollbar' Checked = True State = cbChecked - TabOrder = 7 + TabOrder = 6 OnClick = chkHideScrollbarClick end object lbEvents: TListBox @@ -191,7 +178,7 @@ object frmMain: TfrmMain Width = 421 Height = 93 ItemHeight = 13 - TabOrder = 8 + TabOrder = 7 end object Button1: TButton Left = 152 @@ -200,7 +187,7 @@ object frmMain: TfrmMain Height = 25 Caption = 'SelectFirst' Enabled = False - TabOrder = 9 + TabOrder = 8 end object Button2: TButton Left = 152 @@ -209,7 +196,7 @@ object frmMain: TfrmMain Height = 25 Caption = 'SelectPrior' Enabled = False - TabOrder = 10 + TabOrder = 9 end object Button3: TButton Left = 152 @@ -218,7 +205,7 @@ object frmMain: TfrmMain Height = 25 Caption = 'SelectNext' Enabled = False - TabOrder = 11 + TabOrder = 10 end object Button4: TButton Left = 152 @@ -227,7 +214,7 @@ object frmMain: TfrmMain Height = 25 Caption = 'SelectLast' Enabled = False - TabOrder = 12 + TabOrder = 11 end object Button5: TButton Left = 152 @@ -236,7 +223,7 @@ object frmMain: TfrmMain Height = 25 Caption = 'SelectGroupByIndex' Enabled = False - TabOrder = 13 + TabOrder = 12 end object Button6: TButton Left = 152 @@ -245,7 +232,7 @@ object frmMain: TfrmMain Height = 25 Caption = 'SelectItemByIndex' Enabled = False - TabOrder = 14 + TabOrder = 13 end object chkHotHand: TCheckBox Left = 424 @@ -305,8 +292,9 @@ object frmMain: TfrmMain end> end item + Action = actTest2 Caption = 'Group without items' - ImageIndex = 2 + ImageIndex = 3 Expanded = False Items = <> end @@ -378,115 +366,113 @@ object frmMain: TfrmMain OnSelectedChanged = mbTestSelectedChanged OnSelectedChanging = mbTestSelectedChanging Painter = mcPainter - ExplicitLeft = -6 end object gcMenu: TX2GraphicContainer - Graphics = < - item - Name = 'ShareFile' - Picture.Data = { - 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000 - 00001008060000001FF3FF61000001844944415478DAA5D2CD4B02411400F0B7 - DB2DA27FAB4EE22102A1A0C0FCA0837A4989683734C7A072A12C45502902FB00 - E95487FEA20E1D24337777E635B33BBB389B5E6A60F6ED1EDE6FDE9BB71AFC73 - 69C14BADF98A223A8EEB7DDB41B4FD38B11D1112D661A23F1728A657E69E5428 - F761796911869F5F0A32174044102551E6BF17C90364B76270F7F4A6202140AE - 5FB09459554E1589942B8CF9C0F4E280A600A6F58C462E3613A01C70F9B61DCA - 4F1F83D51CA0656EEB2A501FA0918FAB2D88646FA3D74A108D6A0F2E2A496D26 - 20127D80972E93998208A00B97951D1530CE076816E2E052FFF238E125B228C4 - 1F06E941230AEC9F3CE2F1DE1A7CBB2CAC00652B4CB6C2E49D1C912E07522A50 - 22F7484AEB30B2250018224C2607509974A0719C5681BC798B75630386131AA9 - 80274B2C68A5C22BB8AA46809C71C347B3091F631ACC414564152E8FD55A079A - 24A302A9621B5BB524BC8F9CA951AA80F72FF07D76DA8516C9AAC0EE411B755D - 0790339045841719DC8BA86241D37F4FE1AFEB07F8392D2050E7313500000000 - 49454E44AE426082} - end - item - Name = 'ShareFolder' - Picture.Data = { - 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000 - 00001008060000001FF3FF610000025B4944415478DAAD936D48535118C7FF77 - 775BEAD8ACA123CB2834EC9B2DB2B0328CCC284B461192146A48040505D36A05 - 154826A64D53A490303F6510C528421B6B2CC4C0E5170317ABA859099ACEBBF7 - B6BBFBD2F172433F680875E0CF797BFE3FCE79CE7928FC63A3961B38D201BB3F - 82524100E6140AA0A7D28ADA65039C2D88159DF3A7AA52F5D2FCF90D0AA60650 - 4B02BCBDD8C504512288284CB23088EA0C63F18569FACFFE92007727BCB47E4B - 9E5A9385F4753B9091530EB5D6009AD690DD28519C2813B66B5A1CB9B908C075 - 0762B139042EEE412CF01D51BF0789F04F4064C1712C36EEAE275119787A350B - C79A64C0609B2209958E5E633C4FF9DE36A0B07610D1D97EA8523448D56AB122 - 2D8D642E8EC98FA3D0E79442AD31E289250F15CD32C0D942058ACE0EA7ABD236 - C1D19C8E7D973F93D521804B4A4649624292CFF3151B0AEAF1F8E26654B6CA00 - C76DA53BFF68DFB6CCDC9DB037ADC5FE2BA3C4F41AE009804BCC03F8047E787D - C8DE5E8547751538619501F62674AF5A5F525350D9AD1A68CCC5018B8BE4AA5F - 324060E57EEE041CC4A40026A6C3CBAE07A8BA2B03061A5141F1F4BDBD752FF4 - AF5ACB70E8928D24FC1931B20B00736312ACA010F42760EB79839ACE05AF3070 - 2BC5A6CBDA6A9AF10DA1DCFC1008F649999704228508669605331E86776C06D3 - 939189EA0E6453F31F0367D49AD55DF1F0246D32B713402F3125C04C45C8BD43 - 98188F89D15032405E72F8781B0E2E5A0BCEAE7C8E99784F97551FC627B70BDF - BEFCE2E3117E4AE031625809CB9EEBF8F0D7627A77BFE0D4D8D88855A9440022 - 1C27DB71FABF55E352ED373075032024CD24170000000049454E44AE426082} - end - item - Name = 'ShareWebcam' - Picture.Data = { - 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000 - 00001008060000001FF3FF61000002C14944415478DABD935D48935118C7FF9B - DB9CD38913155CB586D008C30F9A95A8217927A14157DE441FE88521A4828108 - 0A8992621745A80C477AB3A048D44A08A18589BA959AE0D4A09CBAE936F7E55E - 759B7BDFB91EDF20E82E283A70381CCE797EFFE739E7FF08F09743F04F00D5D5 - BA94C4C4E47A954AA171BB0F6452292B92CB25C24824088E63A32C1BE658F630 - B2BFBF175E5B5B5B0F0643AF8DC6E79F7F011A1B87DE3435555C0D8582181F37 - 637BFB3BEAEA6ED28918BBBB3EC4C589F8AB1C071C1C846136CFC52626DE0D8D - 8E0EDEE6011D1D2F772A2B0BD2392E0A936915878711C46231088502582C6FB1 - B4B44CC0079899998048C48132A1A8D42D9DAEEB240F686919F017179F4D6118 - 8ED4BD9048E22016FF9C16CB14525353A056E7C26AB5109C4166A692A0566F6F - EFC3341ED0DDFDC25759A9552C2CAC8061F6715C7B2C968868D405AD36076EB7 - 874A0990BA020A453A8145181B1BF1F7F575A7F280F6F621574D4D4586DDEE81 - D7CBC066B3D2EA446E6E16BABA9E906A0C39392AE4E79F874A758E32946078F8 - 95BBBFBF278307B4B50D6CD6D65E3FB5B9E982CFC7606BCB4EEA3EACAE2E2110 - 5042A3C9C6E4A40EA5A525042A444282140683C1A6D33D56F180E6E6A75F1B1A - 6E683636B649790F3B3B0E04832EACAF7F83D13887B4B44CC8E52C0A0B8B9097 - 7701F1F1F1D0EBF52B7A7D6F360FA8AFEFFAD4DA7AB7C06ADD86C7B34BC10C1C - 0E3BA4D2E35F311F7B014AE50994945C21F544242727D1BB3D9A32189E5DE601 - 55558D239D9DF7AE310C4BEA7EAA5100A7D3857098A1E010EDC5C8CA3A43CA32 - BACD61717131363030747F76F6430F0F282FBF73A9ACACE47D51915666B3B9C8 - 386421B11432593C418294CD163DAC2DE2743AE697972DC66834326A327D34FD - D60BE5E5B72EAAD5A7079392E41AB2AE9BCC6275B91CCB3E5FE08B40C0CE1F1D - F917A6A767427FD24C429A47FFAD1B7F00ED1B51200D4AE2740000000049454E - 44AE426082} - end - item - Name = 'ShareWebcamVideo' - Picture.Data = { - 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000 - 00001008060000001FF3FF61000002EA4944415478DAA5935D48935118C7FFF3 - DDAB6BCEF9FDED44DC4CA15E8761412A1296A121285ED595DD7521298C125341 - E9622B584CE6BCF122454891AE9424432B3FC8A4FC203F32D1E9FCAA95D36DCD - B5BDAF7BB78E2B040BA2E8DC9CAFE7FC9EE7FCCFF90BF09F4DF0EB82CFE713E8 - F5FA149AA6198FC7C3884422262C2C8C118BC5A91CC7EDBBDDAE75ABD5BAC4B2 - 9C4EA5524D1E03747777574B2492A688888830D2432A952238580C9AA6C82E8F - 830316DBDB7632077A7B7B5FD7D737E41C017A7A7A8A939393FB188611DA6C36 - 2426268265DDB05A2D9899716373D30BA39187CD7608FA86ADCD06D7E0D0A0D8 - 0F50ABD585342D7CEA703828A55289E8E818242424203C5C82AE2E0789909183 - FB70BB59389D2E02F66274F4BA6361615CEA075455DD1C11894EE43FEC7C8C2B - C59791794A8EA2A26212ECC4F47436380EE430878D8D31D8ED6FC93A199BDEAC - 4FCD0CA4F801776A6B9D731F56C553CB1C3EED72A82C4FC2A5C2622814C99898 - 9061656519F3F3F7B1B7B785A8A818040444212DEDCCAC56AB52FA013535B7ED - E65D56FA688405EF0DC5D59CAF60329290937B0E7373720C0CA840511C76763E - FB01F1F1371014343B6B3034FE005456560E9D4C935FACD6AF03541CCAB35791 - 9A1082D34C3A9697F33035A5267A444128CC464848162C163BD1A97FB2B5557D - F667053525F0F17D2C1527E81B36212B6E1D79F917E0724988FAB9100804F078 - 78A2C5A1802EA2831B1919CFFB753A6DC9D133D6D5D5DD22719AF434B9D0E9E2 - 488981E4B942313C1C47EECCC3EBF591B9070E871B4AA58FC09E7536371B2A8E - 7DA4F6F6F677A5A5A59966B39964B1C164B2A0A34388C04090CC3C2223BD2828 - A0C978D16B327D2CD56A1F3C3906D0E974E3656565E7799EF7976DB57E415BDB - 26C46211C94A932A8CBEA5A5B5171415D8A8D1685EFDE605F2A1AE51146590C9 - 64110A8582F8C2EBBFF7E2E27B9FD1B8F6322040D8A4D1DC1BFBA39988418288 - 894A481515B1B1B185168BE51531D8DD969696D1BF72E3BFB6EF2C065120000A - A5C30000000049454E44AE426082} - end> Left = 180 Top = 8 + object gcMenuShareFile: TX2GraphicContainerItem + Picture.Data = { + 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000 + 00001008060000001FF3FF61000001844944415478DAA5D2CD4B02411400F0B7 + DB2DA27FAB4EE22102A1A0C0FCA0837A4989683734C7A072A12C45502902FB00 + E95487FEA20E1D24337777E635B33BBB389B5E6A60F6ED1EDE6FDE9BB71AFC73 + 69C14BADF98A223A8EEB7DDB41B4FD38B11D1112D661A23F1728A657E69E5428 + F761796911869F5F0A32174044102551E6BF17C90364B76270F7F4A6202140AE + 5FB09459554E1589942B8CF9C0F4E280A600A6F58C462E3613A01C70F9B61DCA + 4F1F83D51CA0656EEB2A501FA0918FAB2D88646FA3D74A108D6A0F2E2A496D26 + 20127D80972E93998208A00B97951D1530CE076816E2E052FFF238E125B228C4 + 1F06E941230AEC9F3CE2F1DE1A7CBB2CAC00652B4CB6C2E49D1C912E07522A50 + 22F7484AEB30B2250018224C2607509974A0719C5681BC798B75630386131AA9 + 80274B2C68A5C22BB8AA46809C71C347B3091F631ACC414564152E8FD55A079A + 24A302A9621B5BB524BC8F9CA951AA80F72FF07D76DA8516C9AAC0EE411B755D + 0790339045841719DC8BA86241D37F4FE1AFEB07F8392D2050E7313500000000 + 49454E44AE426082} + PictureName = 'ShareFile' + end + object gcMenuShareFolder: TX2GraphicContainerItem + Picture.Data = { + 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000 + 00001008060000001FF3FF610000025B4944415478DAAD936D48535118C7FF77 + 775BEAD8ACA123CB2834EC9B2DB2B0328CCC284B461192146A48040505D36A05 + 154826A64D53A490303F6510C528421B6B2CC4C0E5170317ABA859099ACEBBF7 + B6BBFBD2F172433F680875E0CF797BFE3FCE79CE7928FC63A3961B38D201BB3F + 82524100E6140AA0A7D28ADA65039C2D88159DF3A7AA52F5D2FCF90D0AA60650 + 4B02BCBDD8C504512288284CB23088EA0C63F18569FACFFE92007727BCB47E4B + 9E5A9385F4753B9091530EB5D6009AD690DD28519C2813B66B5A1CB9B908C075 + 0762B139042EEE412CF01D51BF0789F04F4064C1712C36EEAE275119787A350B + C79A64C0609B2209958E5E633C4FF9DE36A0B07610D1D97EA8523448D56AB122 + 2D8D642E8EC98FA3D0E79442AD31E289250F15CD32C0D942058ACE0EA7ABD236 + C1D19C8E7D973F93D521804B4A4649624292CFF3151B0AEAF1F8E26654B6CA00 + C76DA53BFF68DFB6CCDC9DB037ADC5FE2BA3C4F41AE009804BCC03F8047E787D + C8DE5E8547751538619501F62674AF5A5F525350D9AD1A68CCC5018B8BE4AA5F + 324060E57EEE041CC4A40026A6C3CBAE07A8BA2B03061A5141F1F4BDBD752FF4 + AF5ACB70E8928D24FC1931B20B00736312ACA010F42760EB79839ACE05AF3070 + 2BC5A6CBDA6A9AF10DA1DCFC1008F649999704228508669605331E86776C06D3 + 939189EA0E6453F31F0367D49AD55DF1F0246D32B713402F3125C04C45C8BD43 + 98188F89D15032405E72F8781B0E2E5A0BCEAE7C8E99784F97551FC627B70BDF + BEFCE2E3117E4AE031625809CB9EEBF8F0D7627A77BFE0D4D8D88855A9440022 + 1C27DB71FABF55E352ED373075032024CD24170000000049454E44AE426082} + PictureName = 'ShareFolder' + end + object gcMenuShareWebcam: TX2GraphicContainerItem + Picture.Data = { + 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000 + 00001008060000001FF3FF61000002C14944415478DABD935D48935118C7FF9B + DB9CD38913155CB586D008C30F9A95A8217927A14157DE441FE88521A4828108 + 0A8992621745A80C477AB3A048D44A08A18589BA959AE0D4A09CBAE936F7E55E + 759B7BDFB91EDF20E82E283A70381CCE797EFFE739E7FF08F09743F04F00D5D5 + BA94C4C4E47A954AA171BB0F6452292B92CB25C24824088E63A32C1BE658F630 + B2BFBF175E5B5B5B0F0643AF8DC6E79F7F011A1B87DE3435555C0D8582181F37 + 637BFB3BEAEA6ED28918BBBB3EC4C589F8AB1C071C1C846136CFC52626DE0D8D + 8E0EDEE6011D1D2F772A2B0BD2392E0A936915878711C46231088502582C6FB1 + B4B44CC0079899998048C48132A1A8D42D9DAEEB240F686919F017179F4D6118 + 8ED4BD9048E22016FF9C16CB14525353A056E7C26AB5109C4166A692A0566F6F + EFC3341ED0DDFDC25759A9552C2CAC8061F6715C7B2C968868D405AD36076EB7 + 874A0990BA020A453A8145181B1BF1F7F575A7F280F6F621574D4D4586DDEE81 + D7CBC066B3D2EA446E6E16BABA9E906A0C39392AE4E79F874A758E32946078F8 + 95BBBFBF278307B4B50D6CD6D65E3FB5B9E982CFC7606BCB4EEA3EACAE2E2110 + 5042A3C9C6E4A40EA5A525042A444282140683C1A6D33D56F180E6E6A75F1B1A + 6E683636B649790F3B3B0E04832EACAF7F83D13887B4B44CC8E52C0A0B8B9097 + 7701F1F1F1D0EBF52B7A7D6F360FA8AFEFFAD4DA7AB7C06ADD86C7B34BC10C1C + 0E3BA4D2E35F311F7B014AE50994945C21F544242727D1BB3D9A32189E5DE601 + 55558D239D9DF7AE310C4BEA7EAA5100A7D3857098A1E010EDC5C8CA3A43CA32 + BACD61717131363030747F76F6430F0F282FBF73A9ACACE47D51915666B3B9C8 + 386421B11432593C418294CD163DAC2DE2743AE697972DC66834326A327D34FD + D60BE5E5B72EAAD5A7079392E41AB2AE9BCC6275B91CCB3E5FE08B40C0CE1F1D + F917A6A767427FD24C429A47FFAD1B7F00ED1B51200D4AE2740000000049454E + 44AE426082} + PictureName = 'ShareWebcam' + end + object gcMenuShareWebcamVideo: TX2GraphicContainerItem + Picture.Data = { + 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001000 + 00001008060000001FF3FF61000002EA4944415478DAA5935D48935118C7FFF3 + DDAB6BCEF9FDED44DC4CA15E8761412A1296A121285ED595DD7521298C125341 + E9622B584CE6BCF122454891AE9424432B3FC8A4FC203F32D1E9FCAA95D36DCD + B5BDAF7BB78E2B040BA2E8DC9CAFE7FC9EE7FCCFF90BF09F4DF0EB82CFE713E8 + F5FA149AA6198FC7C3884422262C2C8C118BC5A91CC7EDBBDDAE75ABD5BAC4B2 + 9C4EA5524D1E03747777574B2492A688888830D2432A952238580C9AA6C82E8F + 830316DBDB7632077A7B7B5FD7D737E41C017A7A7A8A939393FB188611DA6C36 + 2426268265DDB05A2D9899716373D30BA39187CD7608FA86ADCD06D7E0D0A0D8 + 0F50ABD585342D7CEA703828A55289E8E818242424203C5C82AE2E0789909183 + FB70BB59389D2E02F66274F4BA6361615CEA075455DD1C11894EE43FEC7C8C2B + C59791794A8EA2A26212ECC4F47436380EE430878D8D31D8ED6FC93A199BDEAC + 4FCD0CA4F801776A6B9D731F56C553CB1C3EED72A82C4FC2A5C2622814C99898 + 9061656519F3F3F7B1B7B785A8A818040444212DEDCCAC56AB52FA013535B7ED + E65D56FA688405EF0DC5D59CAF60329290937B0E7373720C0CA840511C76763E + FB01F1F1371014343B6B3034FE005456560E9D4C935FACD6AF03541CCAB35791 + 9A1082D34C3A9697F33035A5267A444128CC464848162C163BD1A97FB2B5557D + F667053525F0F17D2C1527E81B36212B6E1D79F917E0724988FAB9100804F078 + 78A2C5A1802EA2831B1919CFFB753A6DC9D133D6D5D5DD22719AF434B9D0E9E2 + 488981E4B942313C1C47EECCC3EBF591B9070E871B4AA58FC09E7536371B2A8E + 7DA4F6F6F677A5A5A59966B39964B1C164B2A0A34388C04090CC3C2223BD2828 + A0C978D16B327D2CD56A1F3C3906D0E974E3656565E7799EF7976DB57E415BDB + 26C46211C94A932A8CBEA5A5B5171415D8A8D1685EFDE605F2A1AE51146590C9 + 64110A8582F8C2EBBFF7E2E27B9FD1B8F6322040D8A4D1DC1BFBA39988418288 + 894A481515B1B1B185168BE51531D8DD969696D1BF72E3BFB6EF2C065120000A + A5C30000000049454E44AE426082} + PictureName = 'ShareWebcamVideo' + end end object glMenu: TX2GraphicList Container = gcMenu @@ -511,5 +497,10 @@ object frmMain: TfrmMain ImageIndex = 1 OnExecute = actTestExecute end + object actTest2: TAction + Caption = 'Group without items' + ImageIndex = 3 + OnExecute = actTest2Execute + end end end diff --git a/Test/MenuBar/MainForm.pas b/Test/MenuBar/MainForm.pas index eb36cb2..9cc7127 100644 --- a/Test/MenuBar/MainForm.pas +++ b/Test/MenuBar/MainForm.pas @@ -11,8 +11,8 @@ uses StdCtrls, XPMan, - JvExMask, - JvSpin, +// JvExMask, +// JvSpin, PNGImage, X2CLGraphicList, X2CLMenuBar, @@ -28,7 +28,6 @@ type rbmusikCube: TRadioButton; rbSliding: TRadioButton; lblAnimationTime: TLabel; - seAnimationTime: TJvSpinEdit; Panel1: TPanel; Panel2: TPanel; rbNoAnimation: TRadioButton; @@ -53,6 +52,7 @@ type mbTest: TX2MenuBar; alMenu: TActionList; actTest: TAction; + actTest2: TAction; procedure mbTestSelectedChanging(Sender: TObject; Item, NewItem: TX2CustomMenuBarItem; var Allowed: Boolean); procedure mbTestSelectedChanged(Sender: TObject; @@ -73,6 +73,7 @@ type procedure AnimationClick(Sender: TObject); procedure seAnimationTimeChange(Sender: TObject); procedure actTestExecute(Sender: TObject); + procedure actTest2Execute(Sender: TObject); procedure FormClick(Sender: TObject); private procedure Event(const AMsg: String); @@ -82,7 +83,7 @@ implementation uses Dialogs, - X2UtHandCursor; + Windows; {$R *.dfm} @@ -165,6 +166,8 @@ begin chkAllowCollapseAll.Checked := mbTest.AllowCollapseAll; chkScrollbar.Checked := mbTest.Scrollbar; chkHideScrollbar.Checked := mbTest.HideScrollbar; + + rbUnameIT.Checked := True; end; procedure TfrmMain.mbTestCollapsed(Sender: TObject; Group: TX2MenuBarGroup); @@ -229,7 +232,12 @@ end; procedure TfrmMain.seAnimationTimeChange(Sender: TObject); begin - mbTest.AnimationTime := seAnimationTime.AsInteger; +// mbTest.AnimationTime := seAnimationTime.AsInteger; +end; + +procedure TfrmMain.actTest2Execute(Sender: TObject); +begin + Sleep(200); end; procedure TfrmMain.FormClick(Sender: TObject); diff --git a/Test/MenuBar/MenuBarTest.cfg b/Test/MenuBar/MenuBarTest.cfg index 30e5130..f627b81 100644 --- a/Test/MenuBar/MenuBarTest.cfg +++ b/Test/MenuBar/MenuBarTest.cfg @@ -31,12 +31,12 @@ -M -$M16384,1048576 -K$00400000 --LE"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl" --LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl" --U"..\..\Source" --O"..\..\Source" --I"..\..\Source" --R"..\..\Source" +-LE"c:\program files\borland\delphi7\Projects\Bpl" +-LN"c:\program files\borland\delphi7\Projects\Bpl" +-U"P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System" +-O"P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System" +-I"P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System" +-R"P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System" -w-UNSAFE_TYPE -w-UNSAFE_CODE -w-UNSAFE_CAST diff --git a/Test/MenuBar/MenuBarTest.dpr b/Test/MenuBar/MenuBarTest.dpr index 51051f7..ed40526 100644 --- a/Test/MenuBar/MenuBarTest.dpr +++ b/Test/MenuBar/MenuBarTest.dpr @@ -4,7 +4,11 @@ uses Forms, MainForm in 'MainForm.pas' {frmMain}, X2CLMenuBarAnimators in '..\..\Source\X2CLMenuBarAnimators.pas', - X2CLGraphics in '..\..\Source\X2CLGraphics.pas'; + X2CLGraphics in '..\..\Source\X2CLGraphics.pas', + X2CLunaMenuBarPainter in '..\..\Source\X2CLunaMenuBarPainter.pas', + X2CLMenuBar in '..\..\Source\X2CLMenuBar.pas', + X2CLmusikCubeMenuBarPainter in '..\..\Source\X2CLmusikCubeMenuBarPainter.pas', + X2CLMenuBarActions in '..\..\Source\X2CLMenuBarActions.pas'; {$R *.res}