jvcllaz: Add component editor for TJvOutlookBar (still some issues...)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6349 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-04-24 15:22:33 +00:00
parent 0f98655a07
commit 3106033431
6 changed files with 1133 additions and 51 deletions

View File

@ -549,7 +549,7 @@ resourcestring
//=== JvOutlookBarEditors.pas ================================================
resourcestring
RsOLEditor = 'OutlookBar Editor...';
RsOLBditor = 'OutlookBar Editor...';
//=== JvOutlookBarForm.pas ===================================================
resourcestring

View File

@ -35,19 +35,20 @@ begin
RegisterComponentEditor(TJvCustomTimeLine, TJvTimeLineEditor);
RegisterPropertyEditor(TypeInfo(TDate), TJvTimeLine, 'FirstVisibledate', TDatePropertyEditor);
// Outlookbar
(*
RegisterPropertyEditor(TypeInfo(TJvOutlookBarPages), TJvCustomOutlookBar,
'', TJvOutlookBarPagesProperty);
RegisterPropertyEditor(TypeInfo(TJvOutlookBarButtons), TJvOutlookBarPage,
'', TJvOutlookBarPagesProperty);
*)
// OutlookBar
{RegisterPropertyEditor(TypeInfo(TJvOutlookBarPages), TJvCustomOutlookBar,
'', TJvOutlookBarPagesProperty);}
RegisterPropertyEditor(TypeInfo(Integer), TJvCustomOutlookBar,
'ActivePageIndex', TJvOutlookBarActivePageProperty);
RegisterPropertyEditor(TypeInfo(TImageIndex), TJvOutlookBarButton,
'ImageIndex', TJvOutlookBarButtonImageIndexProperty);
RegisterPropertyEditor(TypeInfo(TImageIndex), TJvOutlookBarPage,
'ImageIndex', TJvOutlookBarPageImageIndexProperty);
RegisterPropertyEditor(TypeInfo(TCaption), TJvOutlookBarPage,
'Caption', TJvOutlookBarCaptionProperty);
RegisterPropertyEditor(TypeInfo(TCaption), TJvOutlookBarButton,
'Caption', TJvOutlookBarCaptionProperty);
RegisterComponentEditor(TJvCustomOutlookBar, TJvOutlookBarEditor);
// Thumbnails
RegisterPropertyToSkip(TJvThumbnail, 'ClientWidth', 'Redundant', '');

View File

@ -30,29 +30,31 @@ unit JvOutlookBarEditors;
interface
uses
SysUtils, Classes,
Controls, Forms, ToolWin,
Menus, ActnList, ComCtrls, ImgList,
// LazLogger,
SysUtils, Classes, Controls, Forms, ToolWin, Menus, ActnList, ComCtrls, ImgList,
PropEdits, GraphPropEdits, ComponentEditors,
// DesignEditors, DesignIntf, DesignMenus, DesignWindows,
//JvDsgnEditors,
JvOutlookBar;
type
TJvOutlookBarActivePageProperty = class(TIntegerProperty)
private
function GetOL: TJvCustomOutlookBar;
protected
property OL: TJvCustomOutlookBar read GetOL;
function GetOutlookBar: TJvCustomOutlookBar;
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
procedure GetValues(Proc: TGetStrProc); override;
end;
(*
TJvOutlookBarCaptionProperty = class(TStringProperty)
public
procedure SetValue(const Value: string); override;
end;
TJvOutlookBarEditor = class(TComponentEditor)
protected
function GetOutlookBar: TJvCustomOutlookBar;
procedure OpenEditor;
public
procedure ExecuteVerb(Index: Integer); override;
function GetVerb(Index: Integer): string; override;
@ -66,16 +68,18 @@ type
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
end; *)
end;
TJvOutlookBarButtonImageIndexProperty = class(TImageIndexPropertyEditor) //TJvDefaultImageIndexProperty)
protected
private
function GetPage: TJvOutlookBarPage;
function GetBar: TJvCustomOutlookBar;
protected
function GetImageList: TCustomImageList; override;
end;
TJvOutlookBarPageImageIndexProperty = class(TImageIndexPropertyEditor) //TJvDefaultImageIndexProperty)
protected
function GetImageList: TCustomImageList; override;
end;
@ -83,14 +87,27 @@ type
implementation
uses
//JvOutlookBarForm,
JvDsgnConsts;
JvDsgnConsts, JvOutlookBarForm;
type
THackOutlookBar = class(TJvCustomOutlookBar);
THackPages = class(TJvOutlookBarPages);
THackButtons = class(TJvOutlookBarButtons);
var
EditWindow: TFrmOLBEditor;
procedure ShowEditor(ADesigner: TComponentEditorDesigner;
AOutlookBar: TJvCustomOutlookBar);
begin
if AOutlookBar = nil then
exit;
if EditWindow = nil then
EditWindow := TFrmOLBEditor.Create(Application);
EditWindow.SetData(AOutlookBar, ADesigner);
EditWindow.Show;
end;
(*
procedure ShowEditor(Designer: TIDesigner; OutlookBar: TJvCustomOutlookBar);
var
@ -126,11 +143,13 @@ begin
end;
end;
*)
//=== { TJvOutlookBarPagesProperty } =========================================
(*
procedure TJvOutlookBarPagesProperty.Edit;
begin
ShowEditor(Designer, GetOutlookBar);
// !!!!!!!!!!!! HOW DO I GET THE DESIGNER HERE ???????????????
//ShowEditor(Designer, GetOutlookBar);
end;
function TJvOutlookBarPagesProperty.GetAttributes: TPropertyAttributes;
@ -154,46 +173,55 @@ begin
Result := Format('(%s)', [GetPropType^.Name]);
end;
//=== { TJvOutlookBarEditor } ================================================
procedure TJvOutlookBarEditor.ExecuteVerb(Index: Integer);
begin
case Index of
0:
ShowEditor(Designer, Component as TJvCustomOutlookBar);
else
inherited ExecuteVerb(Index);
0: OpenEditor;
else inherited ExecuteVerb(Index);
end;
end;
function TJvOutlookBarEditor.GetOutlookBar: TJvCustomOutlookBar;
var
lComponent: TComponent;
begin
lComponent := Self.GetComponent;
if (lComponent is TJvCustomOutlookBar) then
Result := TJvCustomOutlookBar(lComponent)
else
Result := nil;
end;
function TJvOutlookBarEditor.GetVerb(Index: Integer): string;
begin
case Index of
0:
Result := RsOLEditor;
else
Result := inherited GetVerb(Index);
0: Result := RsOLBditor;
else Result := inherited GetVerb(Index);
end;
end;
function TJvOutlookBarEditor.GetVerbCount: Integer;
begin
Result := 1;
end; *)
end;
procedure TJvOutlookBarEditor.OpenEditor;
begin
ShowEditor(Designer, GetOutlookBar);
end;
//=== { TJvOutlookBarActivePageProperty } ====================================
procedure TJvOutlookBarActivePageProperty.Edit;
begin
inherited Edit;
end;
function TJvOutlookBarActivePageProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paValueList, paSortList, paRevertable];
end;
function TJvOutlookBarActivePageProperty.GetOL: TJvCustomOutlookBar;
function TJvOutlookBarActivePageProperty.GetOutlookBar: TJvCustomOutlookBar;
begin
if GetComponent(0) is TJvCustomOutlookBar then
Result := TJvCustomOutlookBar(GetComponent(0))
@ -204,13 +232,15 @@ end;
function TJvOutlookBarActivePageProperty.GetValue: string;
var
I: Integer;
olb: THackOutlookBar;
begin
Result := '';
olb := THackOutlookBar(GetOutlookBar);
if olb = nil then
exit;
I := GetOrdValue;
if I < 0 then
Result := ''
else
if I < THackOutlookBar(OL).Pages.Count then
Result := THackOutlookBar(OL).Pages[I].Caption
if (I >= 0) and (I < olb.Pages.Count) then
Result := olb.Pages[I].Caption
else
Result := inherited GetValue;
end;
@ -218,20 +248,24 @@ end;
procedure TJvOutlookBarActivePageProperty.GetValues(Proc: TGetStrProc);
var
I: Integer;
olb: THackOutlookBar;
begin
for I := 0 to THackOutlookBar(OL).Pages.Count - 1 do
Proc(THackOutlookBar(OL).Pages[I].Caption);
olb := THackOutlookBar(GetOutlookBar);
for I := 0 to olb.Pages.Count - 1 do
Proc(olb.Pages[I].Caption);
end;
procedure TJvOutlookBarActivePageProperty.SetValue(const Value: string);
var
I: Integer;
olb: THackOutlookBar;
begin
I := StrToIntDef(Value, -1);
if I < 0 then
begin
for I := 0 to THackOutlookBar(OL).Pages.Count - 1 do
if AnsiSameText(THackOutlookBar(OL).Pages[I].Caption, Value) then
olb := THackOutlookBar(GetOutlookBar);
for I := 0 to olb.Pages.Count - 1 do
if AnsiSameText(olb.Pages[I].Caption, Value) then
begin
SetOrdValue(I);
Modified;
@ -243,7 +277,17 @@ begin
end;
//=== { TJvOutlookBarButtonImageIndexProperty } ==============================
//=== TJvOutlookBarCaptionEditor ===============================================
procedure TJvOutlookBarCaptionProperty.SetValue(const Value: string);
begin
inherited;
if EditWindow <> nil then
EditWindow.RefreshNames;
end;
//=== TJvOutlookBarButtonImageIndexProperty ====================================
function TJvOutlookBarButtonImageIndexProperty.GetBar: TJvCustomOutlookBar;
begin
@ -264,11 +308,20 @@ begin
end;
//=== { TJvOutlookBarPageImageIndexProperty } ================================
//=== TJvOutlookBarPageImageIndexProperty ======================================
function TJvOutlookBarPageImageIndexProperty.GetImageList: TCustomImageList;
var
page: TJvOutlookBarPage;
pages: TJvOutlookBarPages;
olb: TJvCustomOutlookBAr;
begin
Result := THackOutlookBar(THackPages(TJvOutlookBarPage(GetComponent(0)).Collection).Owner).PageImages;
page := TJvOutlookBarPage(GetComponent(0));
pages := THackPages(page.Collection);
olb := TJvCustomOutlookBar(pages.Owner);
Result := THackOutlookBar(olb).PageImages;
// Result := THackOutlookBar(THackPages(TJvOutlookBarPage(GetComponent(0)).Collection).Owner).PageImages;
// Result := THackOutlookBar(GetOutlookBar).PageImages;
end;
end.

View File

@ -0,0 +1,321 @@
object FrmOLBEditor: TFrmOLBEditor
Left = 311
Height = 462
Top = 151
Width = 226
BorderIcons = [biSystemMenu]
Caption = 'OutlookBar Editor'
ClientHeight = 462
ClientWidth = 226
Constraints.MinHeight = 200
Constraints.MinWidth = 150
OnActivate = FormActivate
OnDestroy = FormDestroy
OnShow = FormShow
PopupMenu = popForm
ShowHint = True
LCLVersion = '1.9.0.0'
object TbTop: TToolBar
Left = 0
Height = 26
Top = 0
Width = 226
AutoSize = True
Caption = 'TbTop'
EdgeBorders = [ebTop, ebBottom]
Images = ImgList16
ParentShowHint = False
PopupMenu = popToolbar
TabOrder = 0
object BtnNew: TToolButton
Left = 1
Top = 2
Action = AcNewPage
DropdownMenu = popNew
Style = tbsDropDown
end
object BtnDel: TToolButton
Left = 36
Top = 2
Action = AcDelete
end
object ToolButton1: TToolButton
Left = 59
Height = 22
Top = 2
Caption = 'ToolButton1'
Style = tbsDivider
end
object BtnUp: TToolButton
Left = 64
Top = 2
Action = AcMoveUp
end
object BtnDown: TToolButton
Left = 87
Top = 2
Action = AcMoveDown
end
end
object TvItems: TTreeView
Left = 0
Height = 413
Top = 26
Width = 226
Align = alClient
HideSelection = False
RightClickSelect = True
ShowButtons = False
TabOrder = 1
OnChange = TvItemsChange
OnCollapsing = TvItemsCollapsing
OnEdited = TvItemsEdited
OnKeyPress = TvItemsKeyPress
Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoRightClickSelect, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
end
object StatusBar1: TStatusBar
Left = 0
Height = 23
Top = 439
Width = 226
Panels = <
item
Width = 50
end>
SimplePanel = False
end
object ImgList16: TImageList
left = 64
top = 96
Bitmap = {
4C69040000001000000010000000000000000000000000000000848484FFFFFF
FFFF000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000FFFFFF0000000000000000848484FF00FF
FFFF0000000000000000848484FF000000000000000000000000000000000000
0000000000000000000000000000848484FF00FFFFFF00000000848484FFFFFF
FFFF00000000848484FF00FFFFFF000000000000000000000000000000000000
000000000000000000000000000000000000848484FF00FFFFFF848484FF00FF
FFFF848484FF00FFFFFF00000000000000000000000000000000000000000000
0000000000000000000000000000FFFFFFFF00FFFFFF848484FF00FFFFFFFFFF
FFFF848484FF848484FF848484FF848484FF000000FF000000FF000000FF0000
00FF000000FF000000FF00000000848484FF848484FF848484FFFFFFFFFF8484
84FFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FF
FFFFFFFFFFFF000000FF848484FF00000000848484FFFFFFFFFF848484FF00FF
FFFF848484FF00FFFFFFFFFFFFFF00FFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFF
FFFF00FFFFFF000000FF848484FF848484FF00FFFFFF00FFFFFF848484FFFFFF
FFFF00FFFFFF848484FF00FFFFFFFFFFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FF
FFFFFFFFFFFF000000FF848484FFFFFFFFFF000000FFFFFFFFFF848484FF00FF
FFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFF
FFFF00FFFFFF000000FF848484FF00000000000000FF00FFFFFFFFFFFFFF00FF
FFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF000000FF000000FF0000
00FF000000FF000000FF848484FF00000000000000FFFFFFFFFF00FFFFFFFFFF
FFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFF000000FF00FFFFFFC6C6
C6FF000000FF000000FF848484FF00000000000000FF00FFFFFFFFFFFFFF00FF
FFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF000000FFC6C6C6FF0000
00FFFFFFFFFF000000FF848484FF00000000000000FFFFFFFFFF00FFFFFFFFFF
FFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFF000000FF000000FFFFFF
FFFF00FFFFFF000000FF848484FF00000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF848484FF0000000000000000848484FF848484FF8484
84FF848484FF848484FF848484FF848484FF848484FF848484FF848484FF8484
84FF848484FF848484FF848484FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000084FF000084FF848484FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000084FF000084FF848484FF000000000000000000000000000000000000
0000000000000000000000000000000084FF000084FF848484FF000000000000
84FF000084FF848484FF00000000000000000000000000000000000000000000
0000000000000000000000000000848484FF000084FF000084FF000084FF0000
84FF848484FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF0000000000000000848484FF000084FF000084FF0000
84FFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FF
FFFFFFFFFFFF000000FF848484FF00000000848484FF000084FF000084FF0000
84FF000084FFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFF
FFFF00FFFFFF000000FF848484FF00000000000084FF000084FF848484FF00FF
FFFF000084FF000084FFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FF
FFFFFFFFFFFF000000FF848484FF848484FF000084FF848484FF00FFFFFFFFFF
FFFF848484FF000084FF848484FFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFF
FFFF00FFFFFF000000FF848484FF000084FF000084FF00FFFFFFFFFFFFFF00FF
FFFFFFFFFFFF848484FF000084FF00FFFFFFFFFFFFFF000000FF000000FF0000
00FF000000FF000000FF848484FF000084FF000000FFFFFFFFFF00FFFFFFFFFF
FFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFF000000FF00FFFFFFC6C6
C6FF000000FF000000FF848484FF848484FF000000FF00FFFFFFFFFFFFFF00FF
FFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF000000FFC6C6C6FF0000
00FFFFFFFFFF000000FF848484FF00000000000000FFFFFFFFFF00FFFFFFFFFF
FFFF00FFFFFFFFFFFFFF00FFFFFFFFFFFFFF00FFFFFF000000FF000000FFFFFF
FFFF00FFFFFF000000FF848484FF00000000000000FF000000FF000000FF0000
00FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
00FF000000FF000000FF848484FF0000000000000000848484FF848484FF8484
84FF848484FF848484FF848484FF848484FF848484FF848484FF848484FF8484
84FF848484FF848484FF848484FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF848400FF000000FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF848400FF848400FF848400FF000000FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00FF848400FF848400FF848400FF848400FF848400FF000000FF000000000000
0000000000000000000000000000000000000000000000000000000000FF8484
00FF848400FF848400FF848400FF848400FF848400FF848400FF000000FF0000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF848400FF848400FF848400FF000000FF000000FF000000FF0000
00FF000000000000000000000000000000000000000000000000000000000000
0000000000FF848400FF848400FF848400FF000000FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF848400FF848400FF848400FF000000FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF848400FF848400FF848400FF000000FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF000000FF000000FF000000FF000000FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF000000FF000000FF000000FF000000FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF848400FF848400FF848400FF000000FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF848400FF848400FF848400FF000000FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF848400FF848400FF848400FF000000FF00000000000000000000
00000000000000000000000000000000000000000000000000FF000000FF0000
00FF000000FF848400FF848400FF848400FF000000FF000000FF000000FF0000
00FF000000000000000000000000000000000000000000000000000000FF8484
00FF848400FF848400FF848400FF848400FF848400FF848400FF000000FF0000
0000000000000000000000000000000000000000000000000000000000000000
00FF848400FF848400FF848400FF848400FF848400FF000000FF000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000FF848400FF848400FF848400FF000000FF00000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000FF848400FF000000FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000
}
end
object AlActions: TActionList
Images = ImgList16
OnUpdate = AlActionsUpdate
left = 64
top = 40
object AcNewPage: TAction
Caption = 'New page'
Hint = 'Add new page'
ImageIndex = 0
OnExecute = AcNewPageExecute
end
object AcNewButton: TAction
Caption = 'New button'
Hint = 'Add new button'
ImageIndex = 0
OnExecute = AcNewButtonExecute
end
object AcDelete: TAction
Caption = 'Delete'
Hint = 'Delete selected item'
ImageIndex = 1
OnExecute = AcDeleteExecute
end
object AcMoveUp: TAction
Caption = 'Move up'
Hint = 'Move item up'
ImageIndex = 2
OnExecute = AcMoveUpExecute
end
object AcMoveDown: TAction
Caption = 'Move down'
Hint = 'Move item down'
ImageIndex = 3
OnExecute = AcMoveDownExecute
end
object AcUpdate: TAction
Caption = 'Update'
Hint = 'Update list'
OnExecute = AcUpdateExecute
end
object AcShowTextLabels: TAction
Caption = 'Text labels'
Hint = 'Show text labels'
OnExecute = AcShowTextLabelsExecute
end
object AcToolbar: TAction
Caption = 'Toolbar'
Checked = True
OnExecute = AcToolbarExecute
end
end
object popNew: TPopupMenu
Images = ImgList16
left = 64
top = 152
object MnuNewPage: TMenuItem
Action = AcNewPage
end
object MnuNewButton: TMenuItem
Action = AcNewButton
end
end
object popToolbar: TPopupMenu
Images = ImgList16
left = 64
top = 208
object MenuItem1: TMenuItem
Action = AcShowTextLabels
end
end
object popForm: TPopupMenu
Images = ImgList16
left = 64
top = 264
object MenuItem2: TMenuItem
Action = AcNewPage
end
object MenuItem3: TMenuItem
Action = AcNewButton
end
object MenuItem4: TMenuItem
Action = AcDelete
end
object MenuItem5: TMenuItem
Caption = '-'
end
object MenuItem6: TMenuItem
Action = AcMoveUp
end
object MenuItem7: TMenuItem
Action = AcMoveDown
end
object MenuItem8: TMenuItem
Caption = '-'
end
object MenuItem9: TMenuItem
Action = AcToolbar
end
end
end

View File

@ -0,0 +1,691 @@
unit JvOutlookBarForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ActnList, Menus,
PropEdits, ComponentEditors,
JvOutlookBar;
type
{ TFrmOLBEditor }
TFrmOLBEditor = class(TForm)
AcNewPage: TAction;
AcNewButton: TAction;
AcDelete: TAction;
AcMoveUp: TAction;
AcMoveDown: TAction;
AcToolbar: TAction;
AcUpdate: TAction;
AcShowTextLabels: TAction;
AlActions: TActionList;
ImgList16: TImageList;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
MnuNewPage: TMenuItem;
MnuNewButton: TMenuItem;
popNew: TPopupMenu;
popToolbar: TPopupMenu;
popForm: TPopupMenu;
StatusBar1: TStatusBar;
TbTop: TToolBar;
BtnNew: TToolButton;
BtnDel: TToolButton;
ToolButton1: TToolButton;
BtnUp: TToolButton;
BtnDown: TToolButton;
TvItems: TTreeView;
procedure AcDeleteExecute(Sender: TObject);
procedure AcMoveDownExecute(Sender: TObject);
procedure AcMoveUpExecute(Sender: TObject);
procedure AcNewButtonExecute(Sender: TObject);
procedure AcNewPageExecute(Sender: TObject);
procedure AcShowTextLabelsExecute(Sender: TObject);
procedure AcToolbarExecute(Sender: TObject);
procedure AcUpdateExecute(Sender: TObject);
procedure AlActionsUpdate(AAction: TBasicAction; var Handled: Boolean);
procedure FormActivate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TvItemsChange(Sender: TObject; Node: TTreeNode);
procedure TvItemsCollapsing(Sender: TObject; Node: TTreeNode;
var AllowCollapse: Boolean);
procedure TvItemsEdited(Sender: TObject; Node: TTreeNode; var S: string);
procedure TvItemsKeyPress(Sender: TObject; var Key: char);
private
procedure BuildTreeData;
procedure DeleteItem(Item: TPersistent);
procedure ExchangeItems(Node1, Node2: TTreeNode);
class function GetButtonName(OLBar: TJvCustomOutlookBar): string;
class function GetPageName(OLBar: TJvCustomOutlookBar): string;
procedure SelectButtonInObjectInspector(AButton: TJvOutlookBarButton; ForceUpdate: Boolean);
procedure SelectPageInObjectInspector(APage: TJvOutlookBarPage; ForceUpdate: Boolean);
function ValidateTreeData: boolean;
protected
FOutlookBar: TJvCustomOutlookBar;
FDesigner: TComponentEditorDesigner;
function CheckValidButtonNode(Node: TTreeNode): boolean;
function CheckValidPageNode(Node: TTreeNode): boolean;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
procedure RefreshNames;
procedure SetData(AOutlookBar: TJvCustomOutlookBar; ADesigner: TComponentEditorDesigner);
property Outlookbar: TJvCustomOutlookBar read FOutlookBar;
end;
var
FrmOLBEditor: TFrmOLBEditor;
implementation
{$R *.lfm}
uses
PropEditUtils,
JvConsts;
type
THackOutlookBar = class(TJvCustomOutlookBar);
const
SDamagedTreeStructure = 'Dameged tree structure.';
{ TFrmOLBEditor }
procedure TFrmOLBEditor.AcDeleteExecute(Sender: TObject);
var
P: TPersistent;
page: TJvOutlookBarPage;
node: TTreeNode;
begin
if (FOutlookBar = nil) or (FDesigner = nil) or (TvItems.Selected = nil) then
exit;
TvItems.Items.BeginUpdate;
try
node := TvItems.Selected;
P := TPersistent(node.Data);
if P is TJvOutlookBarPage then
THackOutlookBar(FOutlookBar).Pages.Delete(TJvOutlookBarPage(P).Index)
else
if P is TJvOutlookBarButton then
begin
page := TJvOutlookBarPage(node.Parent.Data);
page.Buttons.Delete(TJvOutlookBarButton(P).Index);
end;
DeleteItem(node);
finally
TvItems.Items.EndUpdate;
end;
end;
procedure TFrmOLBEditor.AcMoveDownExecute(Sender: TObject);
var
node: TTreeNode;
begin
if (FOutlookBar = nil) or (FDesigner = nil) or (TvItems.Selected = nil) then
exit;
ExchangeItems(TvItems.Selected, TvItems.Selected.GetNextSibling);
node := TvItems.Selected.GetNextSibling;
node.MoveTo(TvItems.Selected, naInsert);
node.Expand(True);
end;
procedure TFrmOLBEditor.AcMoveUpExecute(Sender: TObject);
var
node: TTreeNode;
begin
node := TvItems.Selected;
if (FOutlookBar = nil) or (FDesigner = nil) or (node = nil) then
exit;
ExchangeItems(TvItems.Selected, node.getPrevSibling);
node.MoveTo(node.GetPrevSibling, naInsert);
node.Expand(True);
TvItems.Selected := node;
end;
procedure TFrmOLBEditor.AcNewButtonExecute(Sender: TObject);
var
btn: TJvOutlookBarButton;
page: TJvOutlookBarPage;
N: TTreeNode;
begin
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
if FDesigner.PropertyEditorHook = nil then
exit;
N := TvItems.Selected;
if N.Parent <> nil then
N := N.Parent;
page := TJvOutlookBarPage(N.Data);
btn := page.Buttons.Add;
// btn.Caption := FDesigner.CreateUniqueComponentName(btn.ClassName);
btn.Caption := GetButtonName(OutlookBar);
TvItems.Selected := TvItems.Items.AddChildObject(N, btn.Caption, btn);
FDesigner.PropertyEditorHook.PersistentAdded(btn, True);
FDesigner.Modified;
end;
procedure TFrmOLBEditor.AcNewPageExecute(Sender: TObject);
var
page: TJvOutlookBarPage;
begin
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
if FDesigner.PropertyEditorHook = nil then
exit;
page := THackOutlookBar(FOutlookBar).Pages.Add;
// page.Caption := FDesigner.CreateUniqueComponentName(page.ClassName);
page.Caption := GetPageName(FOutlookBar);
TvItems.Selected := TvItems.Items.AddObject(nil, page.Caption, page);
FDesigner.PropertyEditorHook.PersistentAdded(page,True);
FDesigner.Modified;
end;
procedure TFrmOLBEditor.AcShowTextLabelsExecute(Sender: TObject);
begin
AcShowTextLabels.Checked := not AcShowTextLabels.Checked;
tbTop.ShowCaptions := AcShowTextLabels.Checked;
if AcShowTextLabels.Checked then begin
tbTop.ButtonHeight := 32;
tbTop.ButtonWidth := 32;
end else
begin
tbTop.ButtonHeight := 22;
tbTop.ButtonWidth := 22;
end;
end;
procedure TFrmOLBEditor.AcToolbarExecute(Sender: TObject);
begin
AcToolBar.Checked := not acToolBar.Checked;
TbTop.Visible := AcToolBar.Checked;
end;
procedure TFrmOLBEditor.AcUpdateExecute(Sender: TObject);
begin
BuildTreeData;
end;
procedure TFrmOLBEditor.AlActionsUpdate(AAction: TBasicAction; var Handled: Boolean);
var
Sel: Boolean;
begin
Sel := TvItems.Selected <> nil;
AcNewButton.Enabled := Sel;
AcDelete.Enabled := Sel;
AcMoveUp.Enabled := Sel and (TvItems.Selected.getPrevSibling <> nil);
AcMoveDown.Enabled := Sel and (TvItems.Selected.getNextSibling <> nil);
AcUpdate.Enabled := Screen.ActiveForm = Self;
end;
procedure TFrmOLBEditor.BuildTreeData;
var
i, j: Integer;
page: TJvOutlookBarPage;
pageNode: TTreeNode;
button: TJvOutlookBarButton;
olb: THackOutlookBar;
begin
TvItems.OnDeletion := nil;
TvItems.Items.Clear;
// TvItems.OnDeletion := TvItemsDeletion;
if FOutlookbar = nil then
exit;
{if FDesigner = nil) then
exit; }
TvItems.BeginUpdate;
try
olb := THackOutlookbar(FOutlookbar);
for i := 0 to olb.Pages.Count-1 do begin
page := olb.Pages[i];
pageNode := TvItems.Items.AddObject(nil, page.Caption, page);
for j := 0 to page.Buttons.Count-1 do begin
button := page.Buttons[j];
TvItems.Items.AddChildObject(pageNode, button.Caption, button);
end;
pageNode.Expand(false);
end;
finally
TvItems.EndUpdate;
end;
end;
function TFrmOLBEditor.CheckValidButtonNode(Node: TTreeNode): boolean;
begin
Result := false;
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
{$B-}
Result := (Node <> nil) and
(Node.Data <> nil) and
(TObject(Node.Data) is TJvOutlookBarButton);
end;
function TFrmOLBEditor.CheckValidPageNode(Node: TTreeNode): boolean;
begin
Result := false;
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
{$B-}
Result := (Node <> nil) and
(Node.Data <> nil) and
(TObject(Node.Data) is TJvOutlookBarPage);
end;
procedure TFrmOLBEditor.DeleteItem(Item: TPersistent);
var
N, N2: TTreeNode;
function FindNextNode(const Node: TTreeNode): TTreeNode;
begin
if Node = nil then
begin
Result := nil;
Exit;
end;
Result := Node.GetNextSibling;
if Result = nil then
Result := Node.GetPrevSibling;
if Result = nil then
Result := Node.Parent;
if Result = nil then
Result := TvItems.Items.GetFirstNode;
if Result = Node then
Result := nil;
end;
begin
N2 := TvItems.Selected;
N := TvItems.Items.GetFirstNode;
try
while Assigned(N) do
begin
if N = Item then
begin
N2 := FindNextNode(N);
N.Data := nil;
N.Delete;
Exit;
end;
N := N.GetNext;
N2 := N;
end;
finally
TvItems.Selected := N2;
end;
end;
procedure TFrmOLBEditor.ExchangeItems(Node1, Node2: TTreeNode);
var
I: Integer;
begin
if TObject(Node1.Data) is TJvOutlookBarButton then
begin
I := TJvOutlookBarButton(Node1.Data).Index;
TJvOutlookBarButton(Node1.Data).Index := TJvOutlookBarButton(Node2.Data).Index;
TJvOutlookBarButton(Node2.Data).Index := I;
end
else
if TObject(Node1.Data) is TJvOutlookBarPage then
begin
I := TJvOutlookBarPage(Node1.Data).Index;
TJvOutlookBarPage(Node1.Data).Index := TJvOutlookBarPage(Node2.Data).Index;
TJvOutlookBarPage(Node2.Data).Index := I;
end;
end;
procedure TFrmOLBEditor.FormActivate(Sender: TObject);
begin
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
if not ValidateTreeData then
BuildTreeData;
end;
procedure TFrmOLBEditor.FormDestroy(Sender: TObject);
begin
if FOutlookBar <> nil then
FOutlookBar.RemoveFreeNotification(self);
end;
procedure TFrmOLBEditor.FormShow(Sender: TObject);
begin
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
BuildTreeData;
end;
class function TFrmOLBEditor.GetButtonName(OLBar: TJvCustomOutlookBar): string;
const
cPrefix = 'JvOutlookBarButton';
cTemplate = cPrefix + '%d';
var
K: Integer;
Tmp: string;
function IsUnique(const S: string): Boolean;
var
I, J: Integer;
begin
Result := False;
for I := 0 to THackOutlookBar(OLBar).Pages.Count - 1 do
for J := 0 to THackOutlookBar(OLBar).Pages[I].Buttons.Count - 1 do
if AnsiSameText(THackOutlookBar(OLBar).Pages[I].Buttons[J].Caption, S) then
Exit;
Result := True;
end;
begin
Result := cPrefix;
if OLBar <> nil then
for K := 1 to MaxInt - 1 do
begin
Tmp := Format(cTemplate, [K]);
if IsUnique(Tmp) then
begin
Result := Tmp;
Exit;
end;
end;
end;
class function TFrmOLBEditor.GetPageName(OLBar: TJvCustomOutlookBar): string;
const
cPrefix = 'JvOutlookBarPage';
cTemplate = cPrefix + '%d';
var
K: Integer;
Tmp: string;
function IsUnique(const S: string): Boolean;
var
I: Integer;
begin
Result := False;
for I := 0 to THackOutlookBar(OLBar).Pages.Count - 1 do
if AnsiSameText(THackOutlookBar(OLBar).Pages[I].Caption, S) then
Exit;
Result := True;
end;
begin
Result := cPrefix;
if OLBar <> nil then
for K := 1 to MaxInt - 1 do
begin
Tmp := Format(cTemplate, [K]);
if IsUnique(Tmp) then
begin
Result := Tmp;
Exit;
end;
end;
end;
procedure TFrmOLBEditor.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (AComponent = FOutlookBar) and (Operation = opRemove) then
begin
// The toolbar is currently released, whose content is displayed in the
// editor window. Need to clean up the content - otherwise the window will
// have references to the already removed toolbars, which will end in AVs ...
SetData(nil, nil);
end;
end;
procedure TFrmOLBEditor.RefreshNames;
var
pageNode, buttonNode: TTreeNode;
obj: TObject;
s: string;
begin
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
pagenode := TvItems.Items.GetFirstNode;
while pagenode <> nil do
begin
if not CheckValidPageNode(pagenode) then
raise Exception.Create('TFrmOLBEditor.RefreshNames: '+ SDamagedTreeStructure);
pageNode.Text := TJvOutlookBarPage(pageNode.Data).Caption;
buttonNode := pageNode.GetFirstChild;
while buttonNode <> nil do
begin
if not CheckValidButtonNode(buttonNode) then
raise Exception.Create('TFrmOLBEditor.RefreshNames: '+ SDamagedTreeStructure);
buttonNode.Text := TJvOutlookBarButton(buttonNode.Data).Caption;
buttonNode := buttonNode.GetNextSibling;
end;
pageNode := pageNode.GetNextSibling;
end;
end;
procedure TFrmOLBEditor.SelectPageInObjectInspector(APage: TJvOutlookbarPage;
ForceUpdate: Boolean);
var
I: Integer;
NewSelection: TPersistentSelectionList;
begin
if (FOutlookBar = nil) or (GlobalDesignHook = nil) then
Exit;
// select in OI
NewSelection := TPersistentSelectionList.Create;
NewSelection.ForceUpdate := ForceUpdate;
try
NewSelection.Add(APage);
GlobalDesignHook.SetSelection(NewSelection);
GlobalDesignHook.LookupRoot := GetLookupRootForComponent(FOutlookBar);
finally
NewSelection.Free;
end;
end;
procedure TFrmOLBEditor.SelectButtonInObjectInspector(AButton: TJvOutlookBarButton;
ForceUpdate: Boolean);
var
I: Integer;
NewSelection: TPersistentSelectionList;
begin
if (FOutlookBar = nil) or (GlobalDesignHook = nil) then
Exit;
// select in OI
NewSelection := TPersistentSelectionList.Create;
NewSelection.ForceUpdate := ForceUpdate;
try
NewSelection.Add(AButton);
GlobalDesignHook.SetSelection(NewSelection);
GlobalDesignHook.LookupRoot := GetLookupRootForComponent(FOutlookBar);
finally
NewSelection.Free;
end;
end;
procedure TFrmOLBEditor.SetData(AOutlookBar: TJvCustomOutlookBar;
ADesigner: TComponentEditorDesigner);
begin
if FOutlookBar <> nil then
FOutlookBar.RemoveFreeNotification(self);
FOutlookBar := AOutlookBar;
FDesigner := ADesigner;
if FOutlookBar <> nil then
FOutlookBar.FreeNotification(self);
BuildTreeData;
end;
procedure TFrmOLBEditor.TvItemsChange(Sender: TObject; Node: TTreeNode);
var
Obj: TObject;
olb: THackOutlookBar;
page: TJvOutlookBarPage;
btn: TJvOutlookBarButton;
index: integer;
begin
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
olb := THackOutlookBar(FOutlookBar);
if Assigned(Node) then
begin
Obj := TObject(Node.Data);
if Obj = nil then
raise Exception.Create('TFrmOLBEditor.TvItemsChange: Incorrect data in the field.');
if Obj is TJvOutlookBarPage then
begin
if not(CheckValidPageNode(Node)) then
raise Exception.Create('TFrmOLBEditor.TvItemsChange: ' + SDamagedTreeStructure);
page := TJvOutlookBarPage(Obj);
SelectPageInObjectInspector(page, true);
(****************** FIX ME
FDesigner.SelectOnlyThisComponent(page); *)
index := olb.Pages.IndexOf(page);
if index = -1 then
raise Exception.Create('TFrmOLBEditor.TvItemsChange: ' + SDamagedTreeStructure);
olb.ActivePageIndex := index;
end else
if Obj is TJvOutlookBarButton then
begin
btn := TJvOutlookBarButton(Obj);
SelectButtonInObjectInspector(btn, true);
(******************* FIX ME
FDesigner.SelectOnlyThisComponent(btn);
**********)
if not(CheckValidButtonNode(Node)) then
raise Exception.Create('TFrmOLBEditor.TvItemsChange: ' + SDamagedTreeStructure);
page := TJvOutlookBarPage(Node.Parent.Data);
index := olb.Pages.IndexOf(page);
if index = -1 then
raise Exception.Create('TFrmOLBEditor.TvItemsChange: ' + SDamagedTreeStructure);
olb.ActivePageIndex := index;
end;
end else
FDesigner.SelectOnlyThisComponent(FOutlookBar);
// CheckActionsAvailability;
end;
procedure TFrmOLBEditor.TvItemsCollapsing(Sender: TObject; Node: TTreeNode;
var AllowCollapse: Boolean);
begin
//
end;
procedure TFrmOLBEditor.TvItemsEdited(Sender: TObject; Node: TTreeNode; var S: string);
var
page: TJvOutlookBarPage;
btn: TJvOutlookBarButton;
begin
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
if Node.Data = nil then
raise Exception.Create('TfrmOLBEditor.TvItemsEdited: ' + SDamagedTreeStructure);
if TObject(Node.Data) is TJvOutlookBarPage then
begin
page := TJvOutlookBarPage(Node.Data);
page.Caption := S;
FDesigner.Modified;
end else
if TObject(Node.Data) is TJvOutlookBarButton then
begin
btn := TJvOutlookBarButton(Node.Data);
btn.Caption := S;
FDesigner.Modified;
end else
raise Exception.Create('TFrmOLBEditor.TvItemsEdited: ' + SDamagedTreeStructure);
end;
procedure TFrmOLBEditor.TvItemsKeyPress(Sender: TObject; var Key: char);
begin
//
end;
function TFrmOLBEditor.ValidateTreeData: boolean;
var
i, j: Integer;
pagesValid: Boolean;
btnsValid: Boolean;
pageNode: TTreeNode;
btnNode: TTreeNode;
olb: THackOutlookBar;
begin
Result := false;
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
olb := THackOutlookBar(FOutlookBar);
i := 0;
pagesValid := true;
pageNode := TvItems.Items.GetFirstNode;
while (i < olb.Pages.Count) and pagesValid do
begin
pagesValid := pagesValid and (pageNode <> nil);
if pagesValid then
pagesValid := pagesValid and (TObject(pageNode.Data) = olb.Pages[i]);
if pagesValid then
begin
j := 0;
btnsValid := true;
btnNode := pageNode.GetFirstChild;
while (j < olb.Pages[i].Buttons.Count) and btnsValid do
begin
btnsValid := btnsValid and (btnNode <> nil);
if btnsValid then
btnsValid := btnsValid and (TObject(btnNode.Data) = olb.Pages[i].Buttons[j]);
if btnsValid then
begin
inc(j);
btnNode := btnNode.GetNextSibling;
end;
end;
// Important! You need to make sure that there are no extra items in the tree!
btnsValid := btnsValid and (btnNode = nil);
end;
if pagesValid then
begin
inc(i);
pageNode := pageNode.GetNextSibling;
end;
end;
// Important! You need to make sure that there are no extra items in the tree!
pagesValid := pagesValid and (pageNode = nil);
Result := pagesValid;
end;
end.

View File

@ -138,6 +138,7 @@ type
constructor Create(AOwner: TPersistent);
function Add: TJvOutlookBarButton;
procedure Assign(Source: TPersistent); override;
function IndexOf(AButton: TJvOutlookBarButton): Integer;
function Insert(Index: Integer): TJvOutlookBarButton;
property Items[Index: Integer]: TJvOutlookBarButton read GetItem write SetItem; default;
end;
@ -219,6 +220,7 @@ type
public
constructor Create(AOwner: TPersistent);
function Add: TJvOutlookBarPage;
function IndexOf(APage: TJvOutlookBarPage): Integer;
function Insert(Index: Integer): TJvOutlookBarPage;
procedure Assign(Source: TPersistent); override;
property Items[Index: Integer]: TJvOutlookBarPage read GetItem write SetItem; default;
@ -1053,6 +1055,13 @@ begin
Result := TJvOutlookBarButton(inherited Items[Index]);
end;
function TJvOutlookBarButtons.IndexOf(AButton: TJvOutlookBarButton): Integer;
begin
for Result := 0 to Count-1 do
if AButton = GetItem(Result) then exit;
Result := -1;
end;
function TJvOutlookBarButtons.Insert(Index: Integer): TJvOutlookBarButton;
begin
Result := TJvOutlookBarButton(inherited Insert(Index));
@ -1361,6 +1370,13 @@ begin
Result := TJvOutlookBarPage(inherited Items[Index]);
end;
function TJvOutlookBarPages.IndexOf(APage: TJvOutlookBarPage): Integer;
begin
for Result := 0 to Count-1 do
if APage = GetItem(Result) then exit;
Result := -1;
end;
function TJvOutlookBarPages.Insert(Index: Integer): TJvOutlookBarPage;
begin
Result := TJvOutlookBarPage(inherited Insert(Index));