{ Copyright (C) 2005 ***************************************************************************** * * * See the file COPYING.modifiedLGPL, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** part of the ActionList Editor author: Pawel Piwowar, alfapawel@tlen.pl version: 0.1 - 10.03.2005 - added to ActionList Editor 0.2 - 14.03.2005 - headline, hint and shortcut descriptions ToDo: - multiselect for actions - standard icon } unit actionseditorstd; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, Buttons, ActnList, StdActns, DBActns, LCLType, Contnrs, LCLProc; type TActStdPropItem = class; TActStdProp = class; TResultActProc = procedure (const Category: string; ActionClass: TBasicActionClass; ActionProperty: TActStdPropItem; LastItem: Boolean) of object; { TFormActStandard } TFormActStandard = class(TForm) btnCancel: TBitBtn; btnOK: TBitBtn; LabelHeadLine: TLabel; tvActStdList: TTreeView; procedure FormActStandardClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormActStandardKeyPress(Sender: TObject; var Key: char); procedure btnOKClick(Sender: TObject); procedure tvActStdListDblClick(Sender: TObject); private { private declarations } FResultActionProc: TResultActProc; fActStdProperty: TActStdProp; procedure EnumAct; procedure ResultActionProc; procedure AddStdActProperties; public { public declarations } constructor Create(AOwner: TComponent); override; constructor CreateEx(AOwner: TComponent; ResultActProc: TResultActProc); destructor Destroy; override; end; TRecActStdProp = packed record Caption: String; ShortCut: TShortCut; Hint: String; end; { TActStdPropItem } TActStdPropItem = class private FActProperties: TRecActStdProp; FClassName: String; procedure SetActClassName(const AValue: String); procedure SetActProperties(const AValue: TRecActStdProp); public property ActClassName: String read FClassName write SetActClassName; property ActionProperty: TRecActStdProp read FActProperties write FActProperties; end; { TActStdProp } TActStdProp = class private fPropList: TObjectList; procedure Add(ActClassType: TClass; HeadLine, ShortCut, Hint: String); public constructor Create; destructor Destroy; override; function IndexOfClass(ActClassName: String): TActStdPropItem; end; implementation uses actionseditor, ObjInspStrConsts; { TFormActStandard } procedure TFormActStandard.FormActStandardClose(Sender: TObject; var CloseAction: TCloseAction); begin CloseAction := caFree; end; procedure TFormActStandard.FormActStandardKeyPress(Sender: TObject; var Key: char); begin if Ord(Key) = VK_ESCAPE then Self.Close; end; procedure TFormActStandard.btnOKClick(Sender: TObject); begin if Assigned(FResultActionProc) and not tvActStdList.Selected.HasChildren then ResultActionProc; end; procedure TFormActStandard.tvActStdListDblClick(Sender: TObject); var node: TTreeNode; MyHitTest : THitTests; mousePoint: TPoint; begin mousePoint := TTreeView(Sender).ScreenToClient(Mouse.CursorPos); node := TTreeView(Sender).Selected; if Assigned(node) then begin MyHitTest := TTreeView(Sender).GetHitTestInfoAt(mousePoint.X, mousePoint.Y ); if (htOnItem in MyHitTest) or (htOnLabel in MyHitTest) then begin if (not node.HasChildren) and (node.Parent is TTreeNode) then btnOK.Click { else begin if node.Expanded then node.Collapse(False) else node.Expand(False); end; } end; end; end; procedure TFormActStandard.EnumAct; var outer, inner: Integer; NodeCategory: TTreeNode; begin tvActStdList.BeginUpdate; for outer := 0 to RegisteredActions.Count-1 do begin with tvActStdList.Items do begin NodeCategory := Add(nil, RegisteredActions.Items[outer].Name); for inner := 0 to RegisteredActions.Items[outer].Count-1 do AddChild(NodeCategory, RegisteredActions.Items[outer].Items[inner].ActionClass.ClassName); end; // with end; // for outer tvActStdList.EndUpdate; tvActStdList.Selected := tvActStdList.Items[0].Items[0]; end; procedure TFormActStandard.ResultActionProc; var Category: String; lastItem: Boolean; // for multiselect, but now the multiselect property is not implemented in the TTreeView fClass: TBasicActionClass; begin Category := tvActStdList.Selected.Parent.Text; lastItem := True; fClass := RegisteredActions.Items[RegisteredActions.IndexOfCategory(Category)].Items[tvActStdList.Selected.Index].ActionClass; FResultActionProc(Category, fClass, fActStdProperty.IndexOfClass(fClass.ClassName), lastItem); end; procedure TFormActStandard.AddStdActProperties; begin //ActStdResource.Add(TEditCutResource); fActStdProperty.Add(TEditCut, oiStdActEditCutHeadLine, oiStdActEditCutShortCut, oiStdActEditCutShortHint); fActStdProperty.Add(TEditCopy, oiStdActEditCopyHeadLine, oiStdActEditCopyShortCut, oiStdActEditCopyShortHint); fActStdProperty.Add(TEditPaste, oiStdActEditPasteHeadLine, oiStdActEditPasteShortCut, oiStdActEditPasteShortHint); fActStdProperty.Add(TEditSelectAll, oiStdActEditSelectAllHeadLine, oiStdActEditSelectAllShortCut, oiStdActEditSelectAllShortHint); fActStdProperty.Add(TEditUndo, oiStdActEditUndoHeadLine, oiStdActEditUndoShortCut, oiStdActEditUndoShortHint); fActStdProperty.Add(TEditDelete, oiStdActEditDeleteHeadLine, oiStdActEditDeleteShortCut, oiStdActEditDeleteShortHint); fActStdProperty.Add(THelpContents, oiStdActHelpContentsHeadLine, '', oiStdActHelpContentsHint); fActStdProperty.Add(THelpTopicSearch, oiStdActHelpTopicSearchHeadLine, '', oiStdActHelpTopicSearchHint); fActStdProperty.Add(THelpOnHelp, oiStdActHelpHelpHelpHeadLine, '', oiStdActHelpHelpHelpHint); fActStdProperty.Add(TFileOpen, oiStdActFileOpenHeadLine, oiStdActFileOpenShortCut, oiStdActFileOpenHint); fActStdProperty.Add(TFileSaveAs, oiStdActFileSaveAsHeadLine, '', oiStdActFileSaveAsHint); fActStdProperty.Add(TFileExit, oiStdActFileExitHeadLine, '', oiStdActFileExitHint); fActStdProperty.Add(TColorSelect, oiStdActColorSelect1HeadLine, '', oiStdActColorSelectHint); fActStdProperty.Add(TFontEdit, oiStdActFontEditHeadLine, '', oiStdActFontEditHint); fActStdProperty.Add(TDataSetFirst, oiStdActDataSetFirstHeadLine, '', oiStdActDataSetFirstHint); fActStdProperty.Add(TDataSetPrior, oiStdActDataSetPriorHeadLine, '', oiStdActDataSetPriorHint); fActStdProperty.Add(TDataSetNext, oiStdActDataSetNextHeadLine, '', oiStdActDataSetNextHint); fActStdProperty.Add(TDataSetLast, oiStdActDataSetLastHeadLine, '', oiStdActDataSetLastHint); fActStdProperty.Add(TDataSetInsert, oiStdActDataSetInsertHeadLine, '', oiStdActDataSetInsertHint); fActStdProperty.Add(TDataSetDelete, oiStdActDataSetDeleteHeadLine, '', oiStdActDataSetDeleteHint); fActStdProperty.Add(TDataSetEdit, oiStdActDataSetEditHeadLine, '', oiStdActDataSetEditHint); fActStdProperty.Add(TDataSetPost, oiStdActDataSetPostHeadLine, '', oiStdActDataSetPostHint); fActStdProperty.Add(TDataSetCancel, oiStdActDataSetCancelHeadLine, '', oiStdActDataSetCancel1Hint); fActStdProperty.Add(TDataSetRefresh, oiStdActDataSetRefreshHeadLine, '', oiStdActDataSetRefreshHint); end; constructor TFormActStandard.Create(AOwner: TComponent); begin CreateEx(AOwner, nil); end; constructor TFormActStandard.CreateEx(AOwner: TComponent; ResultActProc: TResultActProc); begin inherited Create(AOwner); FResultActionProc := ResultActProc; Caption := OisStdActionListEditor; LabelHeadLine.Caption := oisStdActionListEditorClass; EnumAct; fActStdProperty := TActStdProp.Create; AddStdActProperties; end; destructor TFormActStandard.Destroy; begin fActStdProperty.Free; inherited Destroy; end; { TActStdProp } procedure TActStdProp.Add(ActClassType: TClass; HeadLine, ShortCut, Hint: String); var ActItem: TActStdPropItem; ActionProperty: TRecActStdProp; begin if Assigned(IndexOfClass(ActClassType.ClassName)) then Exit; ActItem := TActStdPropItem.Create; ActItem.ActClassName := ActClassType.ClassName; ActionProperty.Caption := HeadLine; ActionProperty.ShortCut := TextToShortCut(ShortCut); ActionProperty.Hint := Hint; ActItem.ActionProperty := ActionProperty; fPropList.Add(ActItem); end; constructor TActStdProp.Create; begin fPropList := TObjectList.Create; end; destructor TActStdProp.Destroy; begin fPropList.Free; inherited Destroy; end; function TActStdProp.IndexOfClass(ActClassName: String): TActStdPropItem; var i: Integer; begin Result := nil; for i:= 0 to fPropList.Count-1 do begin if TActStdPropItem(fPropList[i]).ActClassName = ActClassName then begin Result := TActStdPropItem(fPropList[i]); Break; end; end; end; { TActStdPropItem } procedure TActStdPropItem.SetActClassName(const AValue: String); begin if FClassName = AValue then Exit; FClassName := AValue; end; procedure TActStdPropItem.SetActProperties(const AValue: TRecActStdProp); begin FActProperties := AValue; end; initialization {$I actionseditorstd.lrs} end.