unit pcGUI; interface uses Windows,graphics,classes,GUIStrings,PCTypesUtils,pcMsBar, U_Common_Classes, Buttons,Forms,stdctrls,stylecombos,SysUtils,Controls,Messages, {$ifndef Designer} Powercad,PCLayerDlg,PCMacroDlg,PCBlockDlg,PcPluginDlg,PCFillDlg, {$endif} extctrls,registry,menus,dialogs; type TCommandInstance = class; TCadInterface = class; TCommandmenuItem = class; TOptionsPopUp = class; TGroupList = class (Tlist) EventId: integer; EventHandle: Pointer; Name: String; CadControl: Pointer; Constructor Create(aName:String; Owner: Pointer); Destructor Destroy;Override; Procedure Syncronize(dCom:TObject); End; TPCadCommand = class(TMyObject) Name : String; ID : Integer; CatID : Integer; Bitmap: Graphics.TBitmap; ShortCut:TShortCut; Instances:TList; CadControl:Pointer; GInterface: TCadInterface; GroupOwner:TGroupList; IsCustom:Boolean; EventId: Integer; EventHandle: Pointer; EventEnabled : Boolean; CanMenu: Boolean; Tag: Integer; Enabled: Boolean; Constructor Create;virtual; Destructor Destroy;override; Procedure SyncronizeInstances;virtual; Procedure Clicked(Sender:TObject);virtual; Procedure Enter(Sender:TObject);virtual; Procedure Leave(Sender:TObject);virtual; Function CreateInstance: TCommandInstance;virtual; Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;virtual; Function CreateMenuItem(Menu:TMenu; Instance: TCommandInstance):TCommandMenuItem;virtual; Procedure WriteToStream(Stream: TStream);virtual; Procedure LoadFromStream(Stream:TStream;GUI:TCadInterface);virtual; Class Function CreateCommandFromStream(ComClass: String; Stream:TStream;GUI: TCadInterface):TPcadCommand; end; TToolCommand = class (TPcadCommand) Selected: Boolean; ToolIndex: Byte; ToolName:String; Procedure Clicked(Sender:TObject);override; Constructor Create;override; Procedure SyncronizeInstances;override; function CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl;override; Procedure WriteToStream(Stream: TStream);override; Procedure LoadFromStream(Stream:TStream;GUI:TCadInterface);override; end; TPCColorCommand = class(TPCadCommand) PopUp : TColorPopUp; Color: TColor; Constructor Create;override; Destructor Destroy;override; Procedure SyncronizeInstances;override; Procedure Clicked(Sender:TObject);override; Procedure ColorChanged(Sender:Tobject;xColor:TColor); Procedure CreateDialog; Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; Function CreateMenuItem(Menu:TMenu; Instance: TCommandInstance):TCommandMenuItem;override; end; TPCToggleCommand = class(TPCadCommand) Flag: Boolean; Procedure SyncronizeInstances;override; Procedure Clicked(Sender:TObject);override; Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; Function CreateMenuItem(Menu:TMenu; Instance: TCommandInstance):TCommandMenuItem;override; end; TPCFileNameCommand = class(TPCadCommand) FileName: String; Procedure Clicked(Sender:TObject);override; end; TPCOptionsCommand = class(TPCadCommand) Bitmaps: TList; Options: TStringlist; Value: Byte; Index: Byte; PopUp: ToptionsPopUp; BmpWidth : Integer; UseText: Boolean; Procedure SetValue(FValue:Byte); Procedure AddOption(xBitmap:TBitmap; oName: String;OValue:Byte=255;Break:Boolean=False); Constructor Create;override; Destructor Destroy;override; Procedure SyncronizeInstances;override; Procedure Clicked(Sender:TObject);override; Procedure OptionChanged(Sender:Tobject; xValue:Byte; xIndex:Byte); Procedure CreateDialog; Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; Function CreateMenuItem(Menu:TMenu; Instance: TCommandInstance):TCommandMenuItem;override; Procedure LoadFromStream(Stream:TStream;GUI:TCadInterface);override; Procedure WriteToStream(Stream: TStream);override; end; TInfoCommand = class(TPCadCommand) Info: String; Procedure Clicked(Sender:TObject); Procedure SyncronizeInstances;override; Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; end; TEditCommand = class(TPCadCommand) History: TstringList; HId: Integer; Text: String; Constructor Create;override; Destructor Destroy;override; Procedure KeyClicked(Sender: TObject; var Key: Word; Shift: TShiftState); Procedure SyncronizeInstances;override; Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; end; TStyleCommand = class(TPCadCommand) style:Byte; Procedure SyncronizeInstances;override; end; TTempRecord = class ComName: String; Caption: String; BeginGroup: Boolean; BmpWritten: Boolean; BmpChanged: Boolean; Bitmap: TBitmap; Destructor Destroy;override; Constructor Create; end; TCommandList = class(TPcadCommand) ComList: TList; InstList: TList; TempList: TList; PopUp: TPopUpMenu; Procedure CreateContentFromTempList(GUI:TCadInterface); Function AddCommand(xCommand:TPCadCommand; BeginGroup:Boolean): TCommandInstance; Procedure RemoveCommand(xCommand:TPCadCommand); Procedure CreateInstances; Constructor Create;override; Procedure SyncronizeInstances;override; Procedure Clicked(Sender:TObject);override; Function CreateInstance: TCommandInstance;override; Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; Function CreateMenuItem(Menu:TMenu; Instance: TCommandInstance):TCommandMenuItem;override; Procedure LoadFromStream(Stream:TStream;GUI:TCadInterface);override; Procedure WriteToStream(Stream: TStream);override; Destructor Destroy;override; end; TPCBrushStyleCommand = class(TStyleCommand) Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; end; TPCPenStyleCommand = class(TStyleCommand) Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; end; TPCRowStyleCommand = class(TStyleCommand) Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; end; TPCPenWidthCommand = class(TStyleCommand) Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; end; TPCFontNameCommand = class(TPCadCommand) FontName:String; Constructor Create;override; Procedure SyncronizeInstances;override; Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; end; TPCTextSizeCommand = class(TPCadCommand) Value:Double; Procedure SyncronizeInstances;override; Function CreateControl(aOwner:TComponent; Instance: TCommandInstance):TControl;override; Constructor Create;override; end; TCommandClass = class of TPCadCommand; TCommandInstance = class(TMyObject) Command: TPCadCommand; Bitmap : Graphics.TBitmap; Caption: String; BeginGroup: Boolean; Button: TComponent; Bevel: TComponent; MenuItem: TMenuItem; BitmapChanged:Boolean; Constructor Create(aCommand: TPcadCommand; aCaption:String; aBitmap:Graphics.TBitmap); Destructor Destroy;override; end; TToolbarDef = class (TObject) Caption: String; Commands: TList; Visible : Boolean; IsMenu : Boolean; Toolbar : TComponent; DefaultDock: TPCDock; DockRow: Integer; DockPos: Integer; Constructor Create(aName: String); Destructor Destroy;override; end; TMDIOpenFileEvent = Procedure (Sender:TObject;FileName:String) of Object; TCadInterface = class (TComponent) Private FFileName:String; CommandGroups: Tlist; CommandBitmap: TBitmap; OptionsBitmap: TBitmap; GradsBitmap: TBitmap; TextureBitmap:TBitmap; FEnabled: Boolean; {$ifndef Designer} fCadControl: TPowercad; FBlockDlg: TPCBlockDlg; FLayerDlg: TPCLayerDlg; FMacroDlg: TPCMacroDialog; FPluginDlg: TPCPluginDlg; FFillDlg: TPCFillDlg; {$endif} FMDI: Boolean; FMDIOpenFile: TMDIOpenFileEvent; FMDINewFile: TNotifyEvent; FMDIexit: TNotifyEvent; FOnCustomized: TNotifyEvent; Procedure SaveToReg; Procedure LoadFromReg; Function NewSubCommand(aName: String; comID:integer;catId: Integer; xBitmap: TBitmap; comClass: TCommandClass):TPCadCommand; Function GetBitmap(col,row: integer): TBitmap; Function GetOptBitmap(col,row: integer): TBitmap; Function GetGradBitmap(idx: integer): TBitmap; Function GetTxtBitmap(idx: integer): TBitmap; Procedure AddToGroup(Group: TGrouplist; Command: TPCadCommand); Procedure AddCommand(pCom: TPCadCommand); procedure SetEnabled(const Value: Boolean); {$ifndef Designer} procedure SetControl(const Value: TPowercad); procedure SetBlockDlg(const Value: TPCBlockDlg); procedure SetLayerDlg(const Value: TPClayerDlg); procedure SetMacroDlg(const Value: TPCMacroDialog); procedure SetPluginDlg(const Value: TPCPluginDlg); procedure SetFillDlg(const Value: TPCFillDlg); procedure Notification(AComponent: TComponent; Operation: TOperation); override; {$endif} Procedure BotResize(Sender:TObject); function ToolbarRemoveNotification(aComponent: TComponent): Boolean; procedure SetMDI(const Value: Boolean); public ToolBars: TList; CatList : TStringList; CommandList: TList; DockTop,DockLeft,DockRight,DockBottom: TPCDock; //BottomPanel: TPanel; Window: TForm; CanCustomize: Boolean; {$ifndef Designer} Procedure SetToolIndex; {$endif} Function NewGroup(Name: String;Owner:Pointer): TGroupList; Function FindGroup(Name: String): TGroupList; Procedure ClearGroups; Constructor Create(aOwner:TComponent);override; Destructor Destroy;override; Procedure Customize; Function NewToolBar(TName: String):TToolBarDef; Procedure RemoveToolBar(TB:TToolBarDef); Function NewCommand(aName: String; comID:integer;catId: Integer; xBitmap: TBitmap):TPCadCommand; Function AddTBCommand(tbIndex:Integer;Command:TPCadCommand; BeginGroup:Boolean): TCommandInstance; Procedure RemoveTBCommand(tbIndex:Integer;Command:TCommandInstance); Procedure CreateControls; Function CreateMenuControls(TbDef:TToolBarDef;Index:Integer):TComponent; Function CreateToolBarControls(TbDef:TToolBarDef;Index:Integer):TComponent; Function FindCommand(ComName:String):TPCadCommand; Procedure RemoveCommand(pCom: TPCadCommand); Function NewMenu(aName:String;catId,ComId:Integer;Bitmap:TBitmap):TCommandList; Procedure CreateCategories; Procedure CreateStandartCommands; {$ifndef Designer} Procedure CreateMacroCommands; Procedure CreateBlockCommands; Procedure CreatePluginCommands; {$endif} Procedure BuildStandartInterface; Procedure RefreshAllInterface; Procedure CollectCommands(cList: Tlist;comId: Integer); // Procedure LoadFromFile(fName:String); Procedure SaveToFile(fName:String); Procedure RemoveCategory(catID: integer); Procedure ClearToolbars; Procedure ClearMenus; Procedure ClearCommands; Procedure ClearCommandsById(ComId: Integer); Procedure ClearContent; Procedure SaveToRegistry(KeyName: String); Procedure LoadFromRegistry(KeyName: String); Procedure SaveToStream(Stream:TStream); Procedure LoadFromStream(Stream:TStream); Published {$ifndef Designer} Property CadControl:TPowercad read fCadControl write SetControl; Property MacroDialog: TPCMacroDialog read FMacroDlg write SetMacroDlg; Property BlockDialog: TPCBlockDlg read FBlockDlg write SetBlockDlg; Property LayerDialog: TPCLayerDlg read FLayerDlg write SetLayerDlg; Property PluginDialog: TPCPluginDlg read FPluginDlg write SetPluginDlg; Property FillDialog:TPCFillDlg read FFillDlg write SetFillDlg; {$endif} Property Enabled: Boolean read FEnabled write SetEnabled; Property FileName:String read FFileName; Property MDIApp:Boolean read FMDI write SetMDI; Property OnMDINewFile:TNotifyEvent read FMDINewFile write FMDINewFile; Property OnMDIExit:TNotifyEvent read FMDIexit write FMDIexit; Property OnMDIOpenFile:TMDIOpenFileEvent read FMDIOpenFile write FMDIOpenFile; Property OnCusotmized:TNotifyEvent read FOnCustomized write FOnCustomized; end; //TGUIProperty = class (TClassProperty) //public // function GetAttributes: TPropertyAttributes; override; // procedure Edit; override; //end; TCommandButton = class (TSpeedButton) private FMouseLeave: TNotifyEvent; FMouseEnter: TNotifyEvent; procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; public ComBitmap: TBitmap; ComCaption: String; CapS: Integer; ComInst: TCommandInstance; Constructor Create(aOwner: TComponent; aCom: TCommandInstance);virtual; Destructor Destroy;override; Procedure Paint;override; Property OnMouseLeave:TNotifyEvent read FMouseLeave write FMouseLeave; Property OnMouseEnter:TNotifyEvent read FMouseEnter write FMouseEnter; end; TCommandPanel = class(TPanel) ComInst: TCommandInstance; Constructor Create(aOwner: TComponent; aCom: TCommandInstance);virtual; Destructor Destroy;override; end; TCommandEdit = class(TEdit) ComInst: TCommandInstance; Constructor Create(aOwner: TComponent; aCom: TCommandInstance);virtual; Destructor Destroy;override; end; TColorCommandButton = class (TCommandButton) Private FColor:Tcolor; Procedure SetColor(Value: TColor); Protected Procedure Paint;override; public property Color: TColor read FColor write SetColor; end; TOptionsCommandButton = class (TCommandButton) Private FValue:Byte; FIndex: Byte; Procedure SetValue(aValue: Byte); procedure SetIndex(const Value: Byte); Protected Procedure Paint;override; public property Value:Byte read FValue write SetValue; Property SelIndex:Byte read FIndex write SetIndex; end; TListCommandButton = class (TCommandButton) Protected Procedure Paint;override; end; TComboClass = class of TStyleCombo; TBSCommandCombo = class (TBrushStyleCombo) Private Style: Byte; Public ComInst: TCommandInstance; Constructor Create(aOwner: TComponent; aCom: TCommandInstance); Destructor Destroy;override; Procedure Clicked(Sender:TObject);virtual; end; TPSCommandCombo = class (TPenStyleCombo) Private Style: Byte; Public ComInst: TCommandInstance; Constructor Create(aOwner: TComponent; aCom: TCommandInstance); Destructor Destroy;override; Procedure Clicked(Sender:TObject);virtual; end; TRSCommandCombo = class (TRowCombo) Private Style: Byte; Public ComInst: TCommandInstance; Constructor Create(aOwner: TComponent; aCom: TCommandInstance); Destructor Destroy;override; Procedure Clicked(Sender:TObject);virtual; end; TPWCommandCombo = class (TPenWidthCombo) Private Style: Byte; Public ComInst: TCommandInstance; Constructor Create(aOwner: TComponent; aCom: TCommandInstance); Destructor Destroy;override; Procedure Clicked(Sender:TObject);virtual; end; TFontCommandCombo = class (TFontComboBox) Private FontName: String; Public ComInst: TCommandInstance; Constructor Create(aOwner: TComponent; aCom: TCommandInstance); Destructor Destroy;override; Procedure Clicked(Sender:TObject);virtual; end; TTextSizeCommandCombo = class (TComboBox) Private Value: Integer; Public ComInst: TCommandInstance; Constructor Create(aOwner: TComponent; aCom: TCommandInstance); Destructor Destroy;override; Procedure Clicked(Sender:TObject);virtual; end; TCommandMenuItem = class(TMenuItem) Private Bitmap: Graphics.TBitmap; FOwnerDraw: Boolean; procedure SetOwnerDraw(const Value: Boolean); public ComInst: TCommandInstance; Constructor Create(aOwner:TComponent;aCom:TCommandInstance); Destructor Destroy;override; procedure SelfMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);virtual; procedure SelfAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);virtual; Procedure SetBitmap(aBitmap: Graphics.TBitmap); Property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw; end; TColorMnItem = Class(TCommandMenuItem) Private FColor:TColor; SelectedItem: TMenuItem; Procedure SetColor(Value: TColor); public Constructor Create(aOwner:TComponent;aCom:TCommandInstance); procedure SelfMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);override; procedure SelfAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);override; procedure ChildMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); procedure ChildAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); Procedure ColorSelected(Sender:TObject); Property Color:TColor read FColor write setColor; end; TOptionsMenuItem = class(TCommandMenuItem) Private FValue:Byte; FIndex: Integer; SelectedItem: TMenuItem; Bitmaps: Tlist; Options: TStringList; BMpWidth: Integer; BMpHeight: Integer; Usetext: Boolean; procedure setValue(const xValue: Byte); public Constructor Create(aOwner:TComponent;aCom:TCommandInstance;aUseText: Boolean); procedure SelfMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);override; procedure SelfAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);override; procedure ChildMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); procedure ChildAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); Procedure OptionSelected(Sender:TObject); Property Value:Byte read FValue write setValue; end; TOptionChangeEvent = Procedure (Sender: Tobject; Option: Byte;Index:Byte) of Object; TOptionsPopUp = class (TPopUpMenu) Private FValue:Byte; FIndex:Byte; SelectedItem: TMenuItem; Bitmaps: Tlist; Options: TStringList; BMpWidth: Integer; BMpHeight: Integer; Usetext: Boolean; FOptionChange: TOptionChangeEvent; procedure setValue(const xValue: Byte); public Constructor Create(aOwner:TComponent;aBitmaps: Tlist; aOptions: TStringList;aUsetext:Boolean); Procedure OptionSelected(Sender:TObject); procedure ChildMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); procedure ChildAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); Property Value:Byte read FValue write setValue; Property SelIndex:Byte read FIndex; Property OnOptionChange: TOptionChangeEvent read FOptionChange write FOptionChange; end; Procedure GroupButtonsUp(Command:TPCadCommand); procedure GUIEventCallback(Client:TObject; EventId: Integer; NumVal:Integer; Strval:String; DblVal:Double;Enabled:Boolean);stdcall; implementation {$R *.RES} {$R *.DCR} uses pcCustomForm, U_Common, U_BaseCommon; var CommandClasses: Tlist; { TCadInterface } function TCadInterface.AddTBCommand(tbIndex: Integer; Command: TPCadCommand;BeginGroup:Boolean): TCommandInstance; var tbDef: TToolBarDef; cList: TCommandlist; i: integer; sInst: TCommandInstance; begin Result := nil; if tbIndex > toolbars.Count - 1 then exit; tbDef := TToolbarDef(Toolbars[tbIndex]); Result := Command.CreateInstance; Result.BeginGroup := BeginGroup; tbDef.Commands.Add(result); end; procedure TCadInterface.BuildStandartInterface; var tbDef: TToolBarDef; tbMenu,tbStbar,tbDraw,tbFile,tbEdit,tbFormat, tbTransform,tbArrange,tbOptions,tbZoom,tbComBar: Integer; begin ToolBars.Clear; tbDef := NewToolBar(csMainMenu); tbDef.IsMenu := True; tbDef := NewToolBar(csDraw); tbDef.DefaultDock := DockLeft; tbDef.DockRow := 0;tbDef.DockPos := 0; tbDef := NewToolBar(csFile);tbDef.DefaultDock := DockTop;tbDef.DockRow := 0;tbDef.DockPos := 0; tbDef := NewToolBar(csEdit);tbDef.DefaultDock := DockTop;tbDef.DockRow := 0;tbDef.DockPos := 40; tbDef := NewToolBar(csFormat);tbDef.DefaultDock := DockTop;tbDef.DockRow := 1;tbDef.DockPos := 0; tbDef := NewToolBar(csTransform);tbDef.DefaultDock := DockLeft;tbDef.DockRow := 0;tbDef.DockPos := 100; tbDef := NewToolBar(csArrange);tbDef.DefaultDock := DockTop;tbDef.DockRow := 0;tbDef.DockPos := 0; tbDef := NewToolBar(csCommandBar);tbDef.DefaultDock := DockBottom;tbDef.DockRow := 0;tbDef.DockPos := 0; tbDef := NewToolBar(csStatusBar);tbDef.DefaultDock := DockBottom;tbDef.DockRow := 1;tbDef.DockPos := 0; tbMenu := 0; tbDraw := 1; tbFile := 2; tbEdit := 3; tbFormat := 4; tbTransform := 5; tbArrange := 6; tbComBar := 7; tbStbar := 8; // Build Main Menu AddTbCommand(tbMenu,FindCommand(csFile),False); AddTbCommand(tbMenu,FindCommand(csEdit),False); AddTbCommand(tbMenu,FindCommand(csArrange),False); AddTbCommand(tbMenu,FindCommand(csFormat),False); AddTbCommand(tbMenu,FindCommand(csView),False); AddTbCommand(tbMenu,FindCommand(csInsert),False); AddTbCommand(tbMenu,FindCommand(csOptions),False); AddTbCommand(tbMenu,FindCommand(csTools),False); // Build Draw ToolBar AddTbCommand(tbDraw,FindCommand(csSelect),False); AddTbCommand(tbDraw,FindCommand(csLine),True); AddTbCommand(tbDraw,FindCommand(csRect),False); AddTbCommand(tbDraw,FindCommand(csEllipse),False); AddTbCommand(tbDraw,FindCommand(csCircle),False); AddTbCommand(tbDraw,FindCommand(csArc),False); AddTbCommand(tbDraw,FindCommand(csElpArc),False); AddTbCommand(tbDraw,FindCommand(csPLine),False); AddTbCommand(tbDraw,FindCommand(csFreeHand),False); AddTbCommand(tbDraw,FindCommand(csVertex),False); AddTbCommand(tbDraw,FindCommand(csText),False); AddTbCommand(tbDraw,FindCommand(csTextPanel),False); AddTbCommand(tbDraw,FindCommand(csKnife),False); AddTbCommand(tbDraw,FindCommand(csHorzDim),True); AddTbCommand(tbDraw,FindCommand(csVertDim),False); AddTbCommand(tbDraw,FindCommand(csAlignedDim),False); AddTbCommand(tbDraw,FindCommand(csRadiusDim),False); AddTbCommand(tbDraw,FindCommand(csAngleDim),False); //Build File ToolBar AddTbCommand(tbFile,FindCommand(csNew),False); AddTbCommand(tbFile,FindCommand(csOpen),False); AddTbCommand(tbFile,FindCommand(csSave),False); AddTbCommand(tbFile,FindCommand(csPrint),True); AddTbCommand(tbFile,FindCommand(csPPView),False); //Build Edit ToolBar AddTbCommand(tbEdit,FindCommand(csUndo),False); AddTbCommand(tbEdit,FindCommand(csCopy),True); AddTbCommand(tbEdit,FindCommand(csCut),False); AddTbCommand(tbEdit,FindCommand(csPaste),False); AddTbCommand(tbEdit,FindCommand(csDelete),False); //Build Modify ToolBar AddTbCommand(tbFormat,FindCommand(csPenColor),False); AddTbCommand(tbFormat,FindCommand(csPenStyle),True); AddTbCommand(tbFormat,FindCommand(csPenWidth),True); AddTbCommand(tbFormat,FindCommand(csRowStyle),True); AddTbCommand(tbFormat,FindCommand(csBrushColor),True); AddTbCommand(tbFormat,FindCommand(csBrushStyle),True); AddTbCommand(tbFormat,FindCommand(csTextColor),True); AddTbCommand(tbFormat,FindCommand(csFontName),False); AddTbCommand(tbFormat,FindCommand(csTextSize),False); AddTbCommand(tbFormat,FindCommand(csBold),True); AddTbCommand(tbFormat,FindCommand(csItalic),False); AddTbCommand(tbFormat,FindCommand(csUnderline),False); //Build Transform ToolBar AddTbCommand(tbTransform,FindCommand(csMove),False); AddTbCommand(tbTransform,FindCommand(csDuplicate),False); AddTbCommand(tbTransform,FindCommand(csDuplicateAsBezier),False); AddTbCommand(tbTransform,FindCommand(csRotate),False); AddTbCommand(tbTransform,FindCommand(csMirror),False); AddTbCommand(tbTransform,FindCommand(csArrayR),False); AddTbCommand(tbTransform,FindCommand(csArrayP),False); //Build Arrange ToolBar AddTbCommand(tbarrange,FindCommand(csGroup),False); AddTbCommand(tbarrange,FindCommand(csUnGroup),False); AddTbCommand(tbarrange,FindCommand(csConvertToBezier),False); AddTbCommand(tbarrange,FindCommand(csOffset),False); AddTbCommand(tbarrange,FindCommand(csInterbreak),False); AddTbCommand(tbarrange,FindCommand(csOrder),True); AddTbCommand(tbarrange,FindCommand(csInvertArc),True); AddTbCommand(tbarrange,FindCommand(csArcStyle),False); AddTbCommand(tbarrange,FindCommand(csFlipHorz),True); AddTbCommand(tbarrange,FindCommand(csFlipVert),False); AddTbCommand(tbarrange,FindCommand(csTransparentImage),False); //AddTbCommand(tbarrange,FindCommand(csClipImage),False); AddTbCommand(tbarrange,FindCommand(csWeldIntoPolyLine),True); AddTbCommand(tbarrange,FindCommand(csConvertBeziertoPolyLine),False); AddTbCommand(tbarrange,FindCommand(csConvertPolyLinetoBezier),False); AddTbCommand(tbarrange,FindCommand(csPolyLineClosed),False); AddTbCommand(tbStBar,FindCommand(csRulers),False); AddTbCommand(tbStBar,FindCommand(csGrids),False); AddTbCommand(tbStBar,FindCommand(csGuides),False); AddTbCommand(tbStBar,FindCommand(csSnapGrid),False); AddTbCommand(tbStBar,FindCommand(csSnapGuides),False); AddTbCommand(tbStBar,FindCommand(csSnapObject),False); AddTbCommand(tbStBar,FindCommand(csInfoXY),False); AddTbCommand(tbStBar,FindCommand(csInfoDim),False); AddTbCommand(tbStBar,FindCommand(csInfoMes),False); AddTbCommand(tbStBar,FindCommand(csZoomIn),False); AddTbCommand(tbStBar,FindCommand(csZoomOut),False); AddTbCommand(tbStBar,FindCommand(csZoomArea),False); AddTbCommand(tbStBar,FindCommand(csActualSize),False); AddTbCommand(tbStBar,FindCommand(csFitToPage),False); AddTbCommand(tbComBar,FindCommand(csCommandEdit),False); end; constructor TCadInterface.Create(aOwner:TComponent); begin inherited Create(aOwner); {$ifndef Designer} FCadControl := nil; {$endif} if (aOwner is TCustomForm) and not (csDesigning in ComponentState) then begin DockTop := TPCDock.Create(aOwner); DockTop.Parent := TCustomForm(aOwner); Docktop.Position := dpTop; DockTop.Name := 'pcDockTop'; DockLeft := TPCDock.Create(aOwner); DockLeft.Parent := TCustomForm(aOwner); DockLeft.Position := dpLeft; DockLeft.Name := 'pcDockLeft'; DockRight := TPCDock.Create(aOwner); DockRight.Parent := TCustomForm(aOwner); DockRight.Position := dpRight; DockRight.Name := 'pcDockRight'; DockBottom := TPCDock.Create(aOwner); DockBottom.Parent := TCustomForm(aOwner); DockBottom.Position := dpBottom; DockBottom.Name := 'pcDockBottom'; DockBottom.AllowDrag := True; DockBottom.OnResize := botResize; Window := TForm(aOwner); end; CommandGroups := TList.Create; FEnabled := True; CanCustomize := True; Toolbars := TList.Create; CatList := TStringList.Create; CommandList := TList.Create; CommandBitmap := Tbitmap.Create; CommandBitmap.LoadFromResourceName(hInstance, 'COMMANDS'); OptionsBitmap := Tbitmap.Create; OptionsBitmap.LoadFromResourceName(hInstance, 'OPTIONS'); GradsBitmap := Tbitmap.Create; GradsBitmap.LoadFromResourceName(hInstance, 'grad'); TextureBitmap := Tbitmap.Create; TextureBitmap.LoadFromResourceName(hInstance, 'txtmenu'); end; {$ifndef Designer} procedure TCadInterface.CreateBlockCommands; var xList: TStringList; i: Integer; ToolCommand: TToolCommand; grp: TgroupList; begin // Blocks if not assigned(FBlockDlg) then exit; xList := TStringList.Create; FBlockDlg.GetBlockFileNames(xList); for i := 0 to xList.Count -1 do begin toolCommand := TToolCommand(findCommand(ExtractFileName(xList[i]))); if toolCommand = nil then toolCommand := TToolCommand(NewSubCommand(ExtractFileName(xList[i]),cDrawTool,ciBlocks,GetBitmap(6,7),TToolCommand)); toolCommand.ToolIndex := ord(toInsertCurrentBlock); toolCommand.ToolName := xList[i]; end; xList.Free; end; {$endif} procedure TCadInterface.CreateCategories; begin CatList.Add(Cat1); CatList.Add(Cat2); CatList.Add(Cat3); CatList.Add(Cat4); CatList.Add(Cat5); CatList.Add(Cat6); CatList.Add(Cat7); CatList.Add(Cat8); CatList.Add(Cat14); CatList.Add(Cat9); CatList.Add(Cat10); CatList.Add(Cat11); CatList.Add(Cat12); CatList.Add(Cat13); end; procedure TCadInterface.CreateControls; var i,k: integer; tbDef: TToolBarDef; tb : TPCOfficeBar; mn: TMainMenu; pCom: TCommandInstance; but: TControl; orderIndex : integer; mnItem: TmenuItem; begin Window.Visible := False; for i := 0 to ToolBars.Count - 1 do begin tb := nil; tbDef := TToolBarDef(Toolbars[i]); if tbDef.IsMenu then CreateMenuControls(tbDef,i) else CreateToolBarControls(tbDef,i); end; Window.Visible := True; end; {$ifndef Designer} procedure TCadInterface.CreateMacroCommands; var xList: TStringList; i: Integer; fCommand: TPCFileNameCommand; begin // Macros if not assigned(FMacroDlg) then exit; xList := TstringList.Create; FMacroDlg.GetMacroFileNames(xList); for i := 0 to xList.Count -1 do begin fCommand := TPCFileNameCommand(FindCommand(ExtractFileName(xList[i]))); if fCommand = nil then fCommand := TPCFileNameCommand(NewSubCommand(ExtractFileName(xList[i]),cRunMacro,ciMacros, GetBitmap(10,8),TPCFileNameCommand)); fCommand.FileName := xList[i]; end; xList.Free; end; {$endif} Procedure TCadInterface.CollectCommands(cList: Tlist;comId: Integer); var i:integer; xCom: TPCadCommand; begin For i := 0 to CommandList.Count-1 do begin xCom := TPCadCommand(CommandList[i]); if xCom.ID = ComId then begin cList.Add(xCom); end; end; end; {$ifndef Designer} procedure TCadInterface.CreatePluginCommands; var vList,xList: TStringList; i,k,x,cnt: Integer; //fCommand: TPCFileNameCommand; fCommand: TCommandList; vCom: TPCadCommand; pName,vName: String; cList: Tlist; comList: TCommandList; begin // Plugins if not assigned(FPluginDlg) then exit; xList := TstringList.Create; vList := TStringlist.Create; cList := TList.Create; CollectCommands(cList,cPluginVerbs); FPluginDlg.GetPlugins(xList); for i := 0 to CList.Count-1 do begin ComList := TCommandList(cList[i]); pName := ComList.Name; if xList.IndexOf(pName) = -1 then begin cnt := ComList.ComList.Count; for k := cnt -1 downto 0 do begin vCom := TPCadCommand(ComList.ComList[k]); RemoveCommand(vCom); end; RemoveCommand(ComList); end; end; x := 0; for i := 0 to xList.Count -1 do begin pName := xList[i]; fCommand := TCommandList(FindCommand(pName)); vList.Text := FPluginDlg.GetPluginVerbs(i); if fCommand = nil then fCommand := TCommandList(NewSubCommand(pName,cPluginVerbs,ciPlugins, nil,TCommandList)) else begin // Check Verbs cnt := fCommand.ComList.Count; for k := cnt-1 downto 0 do begin vCom := TPCadCommand(fCommand.ComList[k]); vName := vCom.Name; if Vlist.IndexOf(vName) = -1 then begin RemoveCommand(vCom); end; end; end; fCommand.Tag := 0; for k := 0 to vList.Count-1 do begin x := (i+1)*1000+(k+1); vCom := FindCommand(vList[k]); if vCom = nil then begin vCom := NewCommand(vList[k],cRunPlugin,ciPlugins,GetBitmap(10,8)); fCommand.AddCommand(vCom,false); end; vCom.Tag := x; end; end; xList.Free; vList.Free; end; {$endif} Function TCadInterface.NewCommand(aName: String; comID:integer;catId: Integer; xBitmap: TBitmap):TPCadCommand; begin Result := TPCadCommand.Create; CommandList.Add(Result); Result.Name := aName; Result.ID := comId; Result.CatId := catId; Result.Bitmap := xBitmap; {$ifndef Designer} Result.CadControl := CadControl; {$endif} Result.GInterface := Self; end; Function TCadInterface.NewSubCommand(aName: String; comID:integer;catId: Integer; xBitmap: TBitmap; comClass: TCommandClass):TPCadCommand; begin Result := ComClass.Create; CommandList.Add(Result); Result.Name := aName; Result.ID := comId; Result.CatId := catId; Result.Bitmap := xBitmap; {$ifndef Designer} Result.CadControl := CadControl; {$endif} Result.GInterface := Self; end; Function TCadInterface.GetBitmap(col,row: integer): TBitmap; var sRect: Trect; begin result := TBitmap.Create; result.Width := 16; result.Height := 16; Srect := Rect ((col-1)*16,(row-1)*16,col*16,row*16); result.Canvas.CopyRect(Rect(0,0,16,16),CommandBitmap.Canvas,sRect); end; Function TCadInterface.GetOptBitmap(col,row: integer): TBitmap; var sRect: Trect; begin result := TBitmap.Create; result.Width := 32; result.Height := 16; Srect := Rect ((col-1)*32,(row-1)*16,col*32,row*16); result.Canvas.CopyRect(Rect(0,0,32,16),OptionsBitmap.Canvas,sRect); end; Procedure TCadInterface.AddToGroup(Group: TGrouplist; Command: TPCadCommand); begin Group.Add(Command); Command.GroupOwner := Group; end; procedure TCadInterface.CreateStandartCommands; var oCommand : TPCOptionsCommand; cCommand : TPCColorCommand; pCom: TPCadCommand; toCommand: TPCToggleCommand; iCommand: TInfoCommand; i: Integer; cListFile,cListEdit,cListArrange,cListOrder,cListAlign, cListFormat,cListView,CListFontS,cListInsert, cListZoom,cListTools,cListOptions :TCommandlist; {$ifndef Designer} {$endif} ToolsGroup: TGroupList; toolCommand : TToolCommand; eCommand:TEditCommand; GOwner:Pointer; begin GOwner := nil; {$ifndef Designer} GOwner := CadControl; {$endif} ToolsGroup := NewGroup('Tools',GOwner); // File Commands cListFile := TCommandList(NewSubCommand(csFile,cFile,ciMenus,nil,TCommandList)); cListFile.AddCommand(NewCommand(csNew,cNew,ciFile,GetBitmap(1,1)),False); cListFile.AddCommand(NewCommand(csOpen,cOpen,ciFile,GetBitmap(2,1)),False); cListFile.AddCommand(NewCommand(csSave,cSave,ciFile,GetBitmap(3,1)),False); cListFile.AddCommand(NewCommand(csSaveAs,cSaveAs,ciFile,nil),False); cListFile.AddCommand(NewCommand(csPrint,cPrint,ciFile,GetBitmap(4,1)),True); cListFile.AddCommand(NewCommand(csPSetUp,cPrinterSetup,ciFile,GetBitmap(5,1)),False); cListFile.AddCommand(NewCommand(csPPView,cPrintPreview,ciFile,GetBitmap(6,1)),False); cListFile.AddCommand(NewCommand(csImport,cImportDrawing,ciFile,nil),True); cListFile.AddCommand(NewCommand(csExport,cExportDrawing,ciFile,nil),False); cListFile.AddCommand(NewCommand(csExit,cExit,ciFile,nil),True); // Drawing Commands toolCommand := TToolCommand(NewSubCommand(csSelect,cDrawTool,ciDraw,GetBitmap(8,1),TToolCommand)); toolCommand.ToolIndex := ord(toSelect); toolCommand.ToolName := ''; toolCommand := TToolCommand(NewSubCommand(csLine,cDrawTool,ciDraw,GetBitmap(9,1),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TLine'; toolCommand := TToolCommand(NewSubCommand(csRect,cDrawTool,ciDraw,GetBitmap(10,1),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TRectangle'; toolCommand := TToolCommand(NewSubCommand(csEllipse,cDrawTool,ciDraw,GetBitmap(1,2),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TEllipse'; toolCommand := TToolCommand(NewSubCommand(csCircle,cDrawTool,ciDraw,GetBitmap(2,2),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TCircle'; toolCommand := TToolCommand(NewSubCommand(csArc,cDrawTool,ciDraw,GetBitmap(3,2),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TArc'; toolCommand := TToolCommand(NewSubCommand(csElpArc,cDrawTool,ciDraw,GetBitmap(6,13),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TElpArc'; toolCommand := TToolCommand(NewSubCommand(csPLine,cDrawTool,ciDraw,GetBitmap(4,2),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TPolyline'; toolCommand := TToolCommand(NewSubCommand(csFreehand,cDrawTool,ciDraw,GetBitmap(8,12),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TFreehand'; toolCommand := TToolCommand(NewSubCommand(csVertex,cDrawTool,ciDraw,GetBitmap(5,2),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TVertex'; toolCommand := TToolCommand(NewSubCommand(csText,cDrawTool,ciDraw,GetBitmap(6,2),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TText'; toolCommand := TToolCommand(NewSubCommand(csTextPanel,cDrawTool,ciDraw,GetBitmap(7,2),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TTextPanel'; toolCommand := TToolCommand(NewSubCommand(csKnife,cDrawTool,ciDraw,GetBitmap(8,13),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TKnife'; toolCommand := TToolCommand(NewSubCommand(csHorzDim,cDrawTool,ciDraw,GetBitmap(2,9),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'THDimline'; toolCommand := TToolCommand(NewSubCommand(csVertDim,cDrawTool,ciDraw,GetBitmap(1,9),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TVDimline'; toolCommand := TToolCommand(NewSubCommand(csAlignedDim,cDrawTool,ciDraw,GetBitmap(3,9),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TADimline'; toolCommand := TToolCommand(NewSubCommand(csRadiusDim,cDrawTool,ciDraw,GetBitmap(4,13),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TCDimline'; toolCommand := TToolCommand(NewSubCommand(csAngleDim,cDrawTool,ciDraw,GetBitmap(5,13),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TArcDimline'; {$ifndef Designer} if assigned(CadControl) then begin ToolsGroup.EventHandle := CadControl.RegisterEvent(cDrawTool,Self,GUIEventCallback); ToolsGroup.EventId := cDrawTool; end; {$endif} // Edit Commands cListEdit := TCommandList(NewSubCommand(csEdit,cEdit,ciMenus,nil,TCommandList)); cListEdit.AddCommand(NewCommand(csUndo,cUndo,ciEdit,GetBitmap(9,2)),False); cListEdit.AddCommand(NewCommand(csRedo,cRedo,ciEdit,GetBitmap(10,2)),False); cListEdit.AddCommand(NewCommand(csCut,cCut,ciEdit,GetBitmap(1,3)),True); cListEdit.AddCommand(NewCommand(csCopy,cCopy,ciEdit,GetBitmap(2,3)),False); cListEdit.AddCommand(NewCommand(csPaste,cPaste,ciEdit,GetBitmap(3,3)),False); cListEdit.AddCommand(NewCommand(csDelete,cDelete,ciEdit,GetBitmap(4,3)),True); cListEdit.AddCommand(NewCommand(csClear,cClear,ciEdit,nil),False); cListEdit.AddCommand(NewCommand(csSelectAll,cSelectAll,ciEdit,nil),True); cListEdit.AddCommand(NewCommand(csDeSelectAll,cDeselectAll,ciEdit,nil),False); cListEdit.AddCommand(NewCommand(csInvertSelection,cInvertSelection,ciEdit,nil),False); // Arrrange Commands cListArrange := TCommandList(NewSubCommand(csArrange,cArrange,ciMenus,nil,TCommandList)); pCom := NewCommand(csGroup,cGroup,ciArrange,GetBitmap(5,3)); pCom.EventId := cAnySel; {$ifndef Designer} if assigned(CadControl) then pCom.Eventhandle := CadControl.RegisterEvent(cAnySel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); pCom := NewCommand(csUnGroup,cUngroup,ciArrange,GetBitmap(6,3)); pCom.EventId := cGroupSel; {$ifndef Designer} if assigned(CadControl) then pCom.Eventhandle := CadControl.RegisterEvent(cGroupSel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); pCom := NewCommand(csConvertToBezier,cConvertToBezier,ciArrange,GetBitmap(10,13)); pCom.EventId := cAnySel; {$ifndef Designer} if assigned(CadControl) then pCom.Eventhandle := CadControl.RegisterEvent(cAnySel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); pCom := NewCommand(csInterBreak,cInterbreak,ciArrange,GetBitmap(9,13)); pCom.EventId := cAnySel; {$ifndef Designer} if assigned(CadControl) then pCom.Eventhandle := CadControl.RegisterEvent(cAnySel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); pCom := NewCommand(csOffset,cOffset,ciArrange,GetBitmap(7,13)); pCom.EventId := cAnySel; {$ifndef Designer} if assigned(CadControl) then pCom.Eventhandle := CadControl.RegisterEvent(cAnySel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); // Order Commands cListOrder := TCommandList(NewSubCommand(csOrder,cOrder,ciMenus,GetBitmap(7,3),TCommandList)); cListOrder.AddCommand(NewCommand(csBtf,cBringToFront,ciArrange,GetBitmap(7,3)),False); cListOrder.AddCommand(NewCommand(csStb,cSendToBack,ciArrange,GetBitmap(8,3)),False); cListOrder.AddCommand(NewCommand(csbfw,cBringForward,ciArrange,GetBitmap(9,3)),False); cListOrder.AddCommand(NewCommand(csSbw,cSendBackward,ciArrange,GetBitmap(10,3)),False); cListArrange.AddCommand(cListOrder,True); // Align Commands cListAlign := TCommandList(NewSubCommand(csAlign,cAlign,ciMenus,GetBitmap(1,6),TCommandList)); cListAlign.AddCommand(NewCommand(csAlTop,cAlignTops,ciArrange,GetBitmap(1,6)),False); cListAlign.AddCommand(NewCommand(csAlBottom,cAlignBottoms,ciArrange,GetBitmap(2,6)),False); cListAlign.AddCommand(NewCommand(csAlXCenter,cAlignXCenters,ciArrange,GetBitmap(3,6)),False); cListAlign.AddCommand(NewCommand(csDistXCenter,cDistrubuteHorizontal,ciArrange,GetBitmap(4,6)),False); cListAlign.AddCommand(NewCommand(csAlLeft,cAlignLefts,ciArrange,GetBitmap(5,6)),True); cListAlign.AddCommand(NewCommand(csAlRight,cAlignRights,ciArrange,GetBitmap(6,6)),False); cListAlign.AddCommand(NewCommand(csAlYCenter,cAlignYCenters,ciArrange,GetBitmap(7,6)),False); cListAlign.AddCommand(NewCommand(csDistYCenter,cDistrubuteVertical,ciArrange,GetBitmap(8,6)),False); cListArrange.AddCommand(cListAlign,False); pCom := NewCommand(csInvertArc,cInvertArc,ciArrange,GetBitmap(1,4)); pCom.EventId := cArcSel; {$ifndef Designer} if assigned(CadControl) then pcom.EventHandle := CadControl.RegisterEvent(cArcSel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,True); oCommand := TPCOptionsCommand(NewSubCommand(csArcStyle,cArcStyle,ciArrange,nil,TPCOptionsCommand)); oCommand.AddOption(GetBitmap(2,4),csASOpen); oCommand.AddOption(GetBitmap(3,4),csASPie); oCommand.AddOption(GetBitmap(4,4),csASChord); oCommand.EventId := cArcStyle; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cArcStyle,oCommand,GUIEventCallback); {$endif} cListArrange.AddCommand(oCommand,False); NewCommand(csASOpen,cArcStyleOPen,ciArrange,GetBitmap(2,4)); NewCommand(csASPie,cArcStylePie,ciArrange,GetBitmap(3,4)); NewCommand(csASChord,cArcStyleChord,ciArrange,GetBitmap(4,4)); toCommand := TPCToggleCommand(NewSubCommand(csTransparentImage,cTransparentImage,ciArrange,GetBitmap(3,8),TPCToggleCommand)); toCommand.EventId := cTransparentImage; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cTransparentImage,oCommand,GUIEventCallback); {$endif} cListArrange.AddCommand(toCommand,True); //toCommand := TPCToggleCommand(NewSubCommand(csClipImage,cClipImage,ciArrange,GetBitmap(4,8),TPCToggleCommand)); //toCommand.EventId := cClipImage; {$ifndef Designer} //if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cClipImage,oCommand,GUIEventCallback); {$endif} //cListArrange.AddCommand(toCommand,False); pCom := NewCommand(csFlipHorz,cFlipImageHorizontal,ciArrange,GetBitmap(5,4)); pCom.EventId := cBmpSel; {$ifndef Designer} if assigned(CadControl) then pcom.EventHandle := CadControl.RegisterEvent(cBmpSel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); pCom := NewCommand(csFlipVert,cFlipImageVertical,ciArrange,GetBitmap(6,4)); pCom.EventId := cBmpSel; {$ifndef Designer} if assigned(CadControl) then pcom.EventHandle := CadControl.RegisterEvent(cBmpSel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); toCommand := TPCToggleCommand(NewSubCommand(csBoundLine,cBoundLine,ciArrange,GetBitmap(5,8),TPCToggleCommand)); toCommand.EventId := cBoundLine; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cBoundLine,oCommand,GUIEventCallback); {$endif} cListArrange.AddCommand(toCommand,True); pCom := NewCommand(csWeldIntoPolyLine,cWeldIntoPolyLine,ciArrange,GetBitmap(6,8)); pCom.EventId := cAnySel; {$ifndef Designer} if assigned(CadControl) then pcom.EventHandle := CadControl.RegisterEvent(cLineSel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); pCom := NewCommand(csConvertBeziertoPolyLine,cConvertBeziertoPolyLine,ciArrange,GetBitmap(7,8)); pCom.EventId := cPLineSel; {$ifndef Designer} if assigned(CadControl) then pcom.EventHandle := CadControl.RegisterEvent(cPLineSel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); pCom := NewCommand(csConvertPolyLinetoBezier,cConvertPolyLinetoBezier,ciArrange,GetBitmap(8,8)); pCom.EventId := cPLineSel; {$ifndef Designer} if assigned(CadControl) then pcom.EventHandle := CadControl.RegisterEvent(cPLineSel,pCom,GUIEventCallback); {$endif} cListArrange.AddCommand(pCom,False); toCommand := TPCToggleCommand(NewSubCommand(csPolyLineClosed,cPolyLineClosed,ciArrange,GetBitmap(9,8),TPCToggleCommand)); toCommand.EventId := cPolyLineClosed; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cPolyLineClosed,oCommand,GUIEventCallback); {$endif} cListArrange.AddCommand(toCommand,False); // Modify Commands cListFormat := TCommandList(NewSubCommand(csFormat,cFormat,ciMenus,nil,TCommandList)); oCommand := TPCOptionsCommand(NewSubCommand(csPenStyle,cPenStyle,ciModify,nil,TPCOptionsCommand)); oCommand.AddOption(GetOptBitmap(1,1),csSolid); oCommand.AddOption(GetOptBitmap(1,2),csDash); oCommand.AddOption(GetOptBitmap(1,3),csDot); oCommand.AddOption(GetOptBitmap(1,4),csDashDot); oCommand.AddOption(GetOptBitmap(1,5),csDashDotDot); oCommand.AddOption(GetOptBitmap(1,6),csClearPen); oCommand.EventId := cPenStyle; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cPenStyle,oCommand,GUIEventCallback); {$endif} cListFormat.AddCommand(oCommand,False); cCommand := TPCColorCommand(NewSubCommand(csPenColor,cPenColor,ciModify,GetBitmap(7,4),TPCColorCommand)); cCommand.EventId := cPenColor; {$ifndef Designer} if assigned(CadControl) then cCommand.EventHandle := CadControl.RegisterEvent(cPenColor,cCommand,GUIEventCallback); {$endif} cListFormat.AddCommand(cCommand,False); oCommand := TPCOptionsCommand(NewSubCommand(csPenWidth,cPenWidth,ciModify,nil,TPCOptionsCommand)); oCommand.AddOption(GetOptBitmap(4,1),csPw1); oCommand.AddOption(GetOptBitmap(4,2),csPw2); oCommand.AddOption(GetOptBitmap(4,3),csPw3); oCommand.AddOption(GetOptBitmap(4,4),csPw4); oCommand.AddOption(GetOptBitmap(4,5),csPw5); oCommand.AddOption(GetOptBitmap(4,6),csPw6); oCommand.AddOption(GetOptBitmap(4,7),csPw7); oCommand.AddOption(GetOptBitmap(4,8),csPw8); oCommand.EventId := cPenWidth; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cPenWidth,oCommand,GUIEventCallback); {$endif} cListFormat.AddCommand(oCommand,False); oCommand := TPCOptionsCommand(NewSubCommand(csRowStyle,cRowStyle,ciModify,nil,TPCOptionsCommand)); oCommand.AddOption(GetOptBitmap(2,1),csNoRow); oCommand.AddOption(GetOptBitmap(2,2),csRightSolid); oCommand.AddOption(GetOptBitmap(2,3),csLeftSolid); oCommand.AddOption(GetOptBitmap(2,4),csBothSolid); oCommand.AddOption(GetOptBitmap(2,5),csRightLight); oCommand.AddOption(GetOptBitmap(2,6),csLeftLight); oCommand.AddOption(GetOptBitmap(2,7),csBothLight); oCommand.EventId := cRowStyle; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cRowStyle,oCommand,GUIEventCallback); {$endif} cListFormat.AddCommand(oCommand,False); cCommand := TPCColorCommand(NewSubCommand(csBrushColor,cBrushColor,ciModify,GetBitmap(8,4),TPCColorCommand)); cCommand.EventId := cBrushColor; {$ifndef Designer} if assigned(CadControl) then cCommand.EventHandle := CadControl.RegisterEvent(cBrushColor,cCommand,GUIEventCallback); {$endif} cListFormat.AddCommand(cCommand,True); oCommand := TPCOptionsCommand(NewSubCommand(csBrushStyle,cBrushStyle,ciModify,nil,TPCOptionsCommand)); oCommand.AddOption(GetOptBitmap(3,1),csSolidBrs,0); oCommand.AddOption(GetOptBitmap(3,2),csClearBrs,1); oCommand.AddOption(GetOptBitmap(3,9),csBrsDialog,8); oCommand.AddOption(GetOptBitmap(3,3),cbsHorizontalBrs,2,True); oCommand.AddOption(GetOptBitmap(3,4),csVerticalBrs,3); oCommand.AddOption(GetOptBitmap(3,5),csFDiagonalBrs,4); oCommand.AddOption(GetOptBitmap(3,6),csBDiagonalBrs,5); oCommand.AddOption(GetOptBitmap(3,7),csCrossBrs,6); oCommand.AddOption(GetOptBitmap(3,8),csDiagCrossBrs,7); oCommand.AddOption(GetGradBitmap(1),csHorzGrad,9,True); oCommand.AddOption(GetGradBitmap(2),csVertGrad,10); oCommand.AddOption(GetGradBitmap(3),csRadGrad,11); oCommand.AddOption(GetGradBitmap(4),csDiagFGrad,12); oCommand.AddOption(GetGradBitmap(5),csDiagBGrad,13); oCommand.AddOption(GetGradBitmap(6),csMirrorGrad,14); oCommand.AddOption(GetTxtBitmap(1),cstxtNewsPrint,15,True); oCommand.AddOption(GetTxtBitmap(2),cstxtStationery,16); oCommand.AddOption(GetTxtBitmap(3),cstxtWhiteMarble,17); oCommand.AddOption(GetTxtBitmap(4),cstxtWovenMat,18); oCommand.AddOption(GetTxtBitmap(5),cstxtPaperBag,19); oCommand.AddOption(GetTxtBitmap(6),cstxtMediumWood,20); oCommand.EventId := cBrushStyle; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cBrushStyle,oCommand,GUIEventCallback); {$endif} cListFormat.AddCommand(oCommand,False); cCommand := TPCColorCommand(NewSubCommand(csTextColor,cTextColor,ciModify,GetBitmap(3,5),TPCColorCommand)); cCommand.EventId := cTextColor; {$ifndef Designer} if assigned(CadControl) then cCommand.EventHandle := CadControl.RegisterEvent(cTextColor,cCommand,GUIEventCallback); {$endif} cListFormat.AddCommand(cCommand,True); pCom := NewSubCommand(csFontName,cFontName,ciModify,nil,TPCFontNameCommand); pCom.EventId := cFontName; {$ifndef Designer} if assigned(CadControl) then pCom.EventHandle := CadControl.RegisterEvent(cFontName,pCom,GUIEventCallback); {$endif} //cListFormat.AddCommand(pCom,False); pCom := NewSubCommand(csTextSize,cTextSize,ciModify,nil,TPCTextSizeCommand); pCom.EventId := cTextSize; {$ifndef Designer} if assigned(CadControl) then pCom.EventHandle := CadControl.RegisterEvent(cTextSize,pCom,GUIEventCallback); {$endif} oCommand := TPCOptionsCommand(NewSubCommand(csTextCharset,cTextCharset,ciModify,nil,TPCOptionsCommand)); oCommand.UseText := True; for i := 0 to 17 do oCommand.AddOption(GetBitmap(5,12),csCharSet[i]); oCommand.EventId := cTextCharset; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cTextCharset,oCommand,GUIEventCallback); {$endif} cListFormat.AddCommand(oCommand,False); cListFontS := TCommandList(NewSubCommand(csFontStyle,cFontStyle,ciMenus,nil,TCommandList)); toCommand := TPCToggleCommand(NewSubCommand(csBold,cBold,ciModify,GetBitmap(9,4),TPCToggleCommand)); toCommand.EventId := cBold; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cBold,toCommand,GUIEventCallback); {$endif} cListFontS.AddCommand(toCommand,False); toCommand := TPCToggleCommand(NewSubCommand(csItalic,cItalic,ciModify,GetBitmap(10,4),TPCToggleCommand)); toCommand.EventId := cItalic; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cItalic,toCommand,GUIEventCallback); {$endif} cListFontS.AddCommand(toCommand,False); toCommand := TPCToggleCommand(NewSubCommand(csUnderLine,cUnderline,ciModify,GetBitmap(1,5),TPCToggleCommand)); toCommand.EventId := cUnderline; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cUnderline,toCommand,GUIEventCallback); {$endif} cListFontS.AddCommand(toCommand,False); toCommand := TPCToggleCommand(NewSubCommand(csStrike,cStrike,ciModify,GetBitmap(2,5),TPCToggleCommand)); toCommand.EventId := cStrike; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cStrike,toCommand,GUIEventCallback); {$endif} cListFontS.AddCommand(toCommand,False); cListFormat.AddCommand(cListFontS,False); // Transform Commands toolCommand := TToolCommand(NewSubCommand(csMove,cDrawTool,ciTransform,GetBitmap(5,5),TToolCommand)); toolCommand.ToolIndex := ord(toOperation); toolCommand.ToolName := 'TMove'; toolCommand := TToolCommand(NewSubCommand(csDuplicate,cDrawTool,ciTransform,GetBitmap(6,5),TToolCommand)); toolCommand.ToolIndex := ord(toOperation); toolCommand.ToolName := 'TDuplicate'; toolCommand := TToolCommand(NewSubCommand(csDuplicateAsBezier,cDrawTool,ciTransform,GetBitmap(10,13),TToolCommand)); toolCommand.ToolIndex := ord(toOperation); toolCommand.ToolName := 'TDuplicateAsBezier'; toolCommand := TToolCommand(NewSubCommand(csRotate,cDrawTool,ciTransform,GetBitmap(7,5),TToolCommand)); toolCommand.ToolIndex := ord(toOperation); toolCommand.ToolName := 'TRotate'; toolCommand := TToolCommand(NewSubCommand(csMirror,cDrawTool,ciTransform,GetBitmap(8,5),TToolCommand)); toolCommand.ToolIndex := ord(toOperation); toolCommand.ToolName := 'TMirror'; toolCommand := TToolCommand(NewSubCommand(csArrayR,cDrawTool,ciTransform,GetBitmap(9,5),TToolCommand)); toolCommand.ToolIndex := ord(toOperation); toolCommand.ToolName := 'TArrayRect'; toolCommand := TToolCommand(NewSubCommand(csArrayP,cDrawTool,ciTransform,GetBitmap(10,5),TToolCommand)); toolCommand.ToolIndex := ord(toOperation); toolCommand.ToolName := 'TArrayPol'; NewCommand(csTransformDlg,cTransformDlg,5,GetBitmap(7,5)); //Insert cListInsert := TCommandList(NewSubCommand(csInsert,cInsert,ciMenus,nil,TCommandList)); toolCommand := TToolCommand(NewSubCommand(csInsertPicture,cDrawTool,ciInsert,GetBitmap(10,6),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TBmpObject'; cListInsert.AddCommand(toolCommand,False); toolCommand := TToolCommand(NewSubCommand(csInsertBlock,cDrawTool,ciInsert,GetBitmap(1,7),TToolCommand)); toolCommand.ToolIndex := ord(toInsertBlock); toolCommand.ToolName := ''; cListInsert.AddCommand(toolCommand,False); toolCommand := TToolCommand(NewSubCommand(csRText,cDrawTool,ciInsert,GetBitmap(7,2),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TRichText'; cListInsert.AddCommand(toolCommand,False); toolCommand := TToolCommand(NewSubCommand(csOle,cDrawTool,ciInsert,GetBitmap(8,2),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TOleObject'; cListInsert.AddCommand(toolCommand,False); toolCommand := TToolCommand(NewSubCommand(csMathGraph,cDrawTool,ciInsert,GetBitmap(9,6),TToolCommand)); toolCommand.ToolIndex := ord(toFigure); toolCommand.ToolName := 'TMathGraph'; cListInsert.AddCommand(toolCommand,False); //View cListView := TCommandList(NewSubCommand(csView,cView,ciMenus,nil,TCommandList)); //cListView.AddCommand(NewCommand(csShowProp,cShowProperties,ciView,GetBitmap(3,7)),false); cListView.AddCommand(NewCommand(csLayersDial,cLayersDialog,ciView,GetBitmap(4,7)),false); cListView.AddCommand(NewCommand(csActualSize,cActualSize,ciView,GetBitmap(8,7)),false); cListView.AddCommand(NewCommand(csFitToPage,cFitToPage,ciView,GetBitmap(9,7)),false); cListView.AddCommand(NewCommand(csZoomIn,cZoomIn,ciView,GetBitmap(10,7)),false); cListView.AddCommand(NewCommand(csZoomOut,cZoomOut,ciView,GetBitmap(1,8)),false); toolCommand := TToolCommand(NewSubCommand(csZoomArea,cDrawTool,ciView,GetBitmap(2,8),TToolCommand)); toolCommand.ToolIndex := ord(toZoom); toolCommand.ToolName := ''; cListView.AddCommand(toolCommand,false); cListZoom := TCommandList(NewSubCommand(csZoom,cZoom,ciView,nil,TCommandList)); cListZoom.AddCommand(NewCommand(csZoom50,cZoom50,ciView,nil),False); cListZoom.AddCommand(NewCommand(csZoom75,cZoom75,ciView,nil),False); cListZoom.AddCommand(NewCommand(csZoom25,cZoom25,ciView,nil),False); cListZoom.AddCommand(NewCommand(csZoom150,cZoom150,ciView,nil),False); cListZoom.AddCommand(NewCommand(csZoom200,cZoom200,ciView,nil),False); cListZoom.AddCommand(NewCommand(csZoom125,cZoom125,ciView,nil),False); cListZoom.AddCommand(NewCommand(csZoom175,cZoom175,ciView,nil),False); cListView.AddCommand(cListZoom,false); // Tools cListTools := TCommandList(NewSubCommand(csTools,cTools,ciMenus,nil,TCommandList)); cListTools.AddCommand(NewCommand(csBlockManager,cBlocksManager,ciTools,GetBitmap(6,7)),False); cListTools.AddCommand(NewCommand(csMacroManager,cMacroManager,ciTools,GetBitmap(7,7)),False); cListTools.AddCommand(NewCommand(csPluginManager,cPluginManager,ciTools,GetBitmap(6,12)),False); //cListTools.AddCommand(NewCommand(csEnvironmentOptions,cEnvironmentOptions,ciTools,GetBitmap(5,7)),False); cListTools.AddCommand(NewCommand(csCustomize,cCustomize,ciTools,nil),False); cListTools.AddCommand(NewCommand(csMakeBlock,cMakeBlock,ciTools,GetBitmap(8,10)),False); // Option Commands cListOptions := TCommandList(NewSubCommand(csOptions,cOptions,ciMenus,nil,TCommandList)); toCommand := TPCToggleCommand(NewSubCommand(csRulers,cRulers,ciOptions,GetBitmap(4,9),TPCToggleCommand)); toCommand.EventId := cRulers; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cRulers,toCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(toCommand,False); toCommand := TPCToggleCommand(NewSubCommand(csGrids,cGrids,ciOptions,GetBitmap(5,9),TPCToggleCommand)); toCommand.EventId := cGrids; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cGrids,toCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(toCommand,False); oCommand := TPCOptionsCommand(NewSubCommand(csGridType,cGridType,ciOptions,nil,TPCOptionsCommand)); oCommand.UseText := True; oCommand.AddOption(GetBitmap(9,12),csLineGrid); oCommand.AddOption(GetBitmap(10,12),csPointGrid); oCommand.AddOption(GetBitmap(3,13),csCrossGrid); oCommand.EventId := cGridType; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cGridType,oCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(oCommand,False); toCommand := TPCToggleCommand(NewSubCommand(csCenterGuides,cCenterGuides,ciOptions,GetBitmap(7,12),TPCToggleCommand)); toCommand.EventId := cCenterGuides; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cCenterGuides,toCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(toCommand,False); toCommand := TPCToggleCommand(NewSubCommand(csGuides,cGuides,ciOptions,GetBitmap(6,9),TPCToggleCommand)); toCommand.EventId := cGuides; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cGuides,toCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(toCommand,False); toCommand := TPCToggleCommand(NewSubCommand(csSnapGrid,cSnapGrid,ciOptions,GetBitmap(7,9),TPCToggleCommand)); toCommand.EventId := cSnapGrid; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cSnapGrid,toCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(toCommand,False); toCommand := TPCToggleCommand(NewSubCommand(csSnapGuides,cSnapGuides,ciOptions,GetBitmap(8,9),TPCToggleCommand)); toCommand.EventId := cSnapGuides; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cSnapGuides,toCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(toCommand,False); toCommand := TPCToggleCommand(NewSubCommand(csSnapObject,cSnapObject,ciOptions,GetBitmap(9,9),TPCToggleCommand)); toCommand.EventId := cSnapObject; {$ifndef Designer} if assigned(CadControl) then toCommand.EventHandle := CadControl.RegisterEvent(cSnapObject,toCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(toCommand,False); cCommand := TPCColorCommand(NewSubCommand(csGridColor,cGridColor,ciOptions,GetBitmap(5,9),TPCColorCommand)); cCommand.EventId := cGridColor; {$ifndef Designer} if assigned(CadControl) then cCommand.EventHandle := CadControl.RegisterEvent(cGridColor,cCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(cCommand,False); cCommand := TPCColorCommand(NewSubCommand(csGuideColor,cGuideColor,ciOptions,GetBitmap(6,9),TPCColorCommand)); cCommand.EventId := cGuideColor; {$ifndef Designer} if assigned(CadControl) then cCommand.EventHandle := CadControl.RegisterEvent(cGuideColor,cCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(cCommand,False); cCommand := TPCColorCommand(NewSubCommand(csBackColor,cBackColor,ciOptions,GetBitmap(10,10),TPCColorCommand)); cCommand.EventId := cBackColor; {$ifndef Designer} if assigned(CadControl) then cCommand.EventHandle := CadControl.RegisterEvent(cBackColor,cCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(cCommand,False); cCommand := TPCColorCommand(NewSubCommand(csPageColor,cPageColor,ciOptions,GetBitmap(9,10),TPCColorCommand)); cCommand.EventId := cPageColor; {$ifndef Designer} if assigned(CadControl) then cCommand.EventHandle := CadControl.RegisterEvent(cPageColor,cCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(cCommand,False); oCommand := TPCOptionsCommand(NewSubCommand(csAngularGuides,cAngularGuides,ciOptions,nil,TPCOptionsCommand)); oCommand.UseText := True; oCommand.AddOption(GetBitmap(4,10),csAGNone); oCommand.AddOption(GetBitmap(10,9),csAG90); oCommand.AddOption(GetBitmap(2,10),csAG30); oCommand.AddOption(GetBitmap(1,10),csAG45); oCommand.AddOption(GetBitmap(3,10),csAG60); oCommand.EventId := cAngularGuides; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cAngularGuides,oCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(oCommand,False); oCommand := TPCOptionsCommand(NewSubCommand(csRulerSystem,cRulerSystem,ciOptions,nil,TPCOptionsCommand)); oCommand.UseText := True; oCommand.AddOption(GetBitmap(6,10),csMetric); oCommand.AddOption(GetBitmap(7,10),csInch); oCommand.EventId := cRulerSystem; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cRulerSystem,oCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(oCommand,False); oCommand := TPCOptionsCommand(NewSubCommand(csRulerMode,cRulerMode,ciOptions,nil,TPCOptionsCommand)); oCommand.UseText := True; oCommand.AddOption(GetBitmap(2,13),csPage); oCommand.AddOption(GetBitmap(1,13),csWorld); oCommand.EventId := cRulerMode; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cRulerMode,oCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(oCommand,False); oCommand := TPCOptionsCommand(NewSubCommand(csPageLo,cPageLo,ciOptions,nil,TPCOptionsCommand)); oCommand.UseText := False; oCommand.AddOption(GetBitmap(6,11),csA0); oCommand.AddOption(GetBitmap(7,11),csA1); oCommand.AddOption(GetBitmap(8,11),csA2); oCommand.AddOption(GetBitmap(9,11),csA3); oCommand.AddOption(GetBitmap(5,11),csA4); oCommand.AddOption(GetBitmap(4,11),csA5); oCommand.AddOption(GetBitmap(3,11),csA6); oCommand.AddOption(GetBitmap(10,11),csB4); oCommand.AddOption(GetBitmap(1,12),csB5); oCommand.AddOption(GetBitmap(2,12),csTabloid); oCommand.AddOption(GetBitmap(3,12),csLetter); oCommand.AddOption(GetBitmap(4,12),csCustom); oCommand.EventId := cPageLo; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cPageLo,oCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(oCommand,False); oCommand := TPCOptionsCommand(NewSubCommand(csPageOr,cPageOr,ciOptions,nil,TPCOptionsCommand)); oCommand.UseText := True; oCommand.AddOption(GetBitmap(2,11),csLandscape); oCommand.AddOption(GetBitmap(1,11),csPortrait); oCommand.EventId := cPageOr; {$ifndef Designer} if assigned(CadControl) then oCommand.EventHandle := CadControl.RegisterEvent(cPageOr,oCommand,GUIEventCallback); {$endif} cListOptions.AddCommand(oCommand,False); cListOptions.AddCommand(NewCommand(csSetGridStep,cGridStep,ciOptions,nil),True); cListOptions.AddCommand(NewCommand(csSetMapScale,cMapScale,ciOptions,nil),False); cListOptions.AddCommand(NewCommand(csPageWidth,cPageWidth,ciOptions,nil),False); cListOptions.AddCommand(NewCommand(csPageHeight,cPageHeight,ciOptions,nil),False); iCommand := TInfoCommand(NewSubCommand(csInfoXY,cInfoXY,ciOptions,nil,TInfoCommand)); iCommand.EventId := cInfoXY; {$ifndef Designer} if assigned(CadControl) then iCommand.Eventhandle := CadControl.RegisterEvent(cInfoXY,iCommand,GUIEventCallback); {$endif} iCommand := TInfoCommand(NewSubCommand(csInfoDim,cInfoDim,ciOptions,nil,TInfoCommand)); iCommand.EventId := cInfoDim; {$ifndef Designer} if assigned(CadControl) then iCommand.Eventhandle := CadControl.RegisterEvent(cInfoDim,iCommand,GUIEventCallback); {$endif} iCommand := TInfoCommand(NewSubCommand(csInfoMes,cInfoMes,ciOptions,nil,TInfoCommand)); iCommand.EventId := cInfoMes; {$ifndef Designer} if assigned(CadControl) then iCommand.Eventhandle := CadControl.RegisterEvent(cInfoMes,iCommand,GUIEventCallback); {$endif} eCommand := TEditCommand(NewSubCommand(csCommandEdit,cCommEdit,ciOptions,nil,TEditCommand)); end; procedure TCadInterface.Customize; var frm: TFrmCustom; begin frm := TFrmCustom.Create(application); frm.GUI := self; frm.DesignMode := False; frm.ShowModal; SaveToFile(FFileName); CreateControls; frm.Free; if assigned(FOnCustomized) then FOnCustomized(Self); end; function TCadInterface.FindCommand(ComName:String): TPcadCommand; var i:integer; xCom: TPCadCommand; begin Result := nil; For i := 0 to CommandList.Count-1 do begin xCom := TPCadCommand(CommandList[i]); if xCom.Name = ComName then begin result := xCom; exit; end; end; end; procedure TCadInterface.LoadFromReg; begin end; function TCadInterface.NewMenu(aName: String; catID,comId: Integer; Bitmap: TBitmap): TCommandList; begin Result := TCommandList.Create; CommandList.Add(Result); Result.Name := aName; Result.ID := comId; Result.CatId := catId; if assigned(Bitmap) then begin Result.Bitmap := Tbitmap.Create; Result.Bitmap.Width := 16; Result.Bitmap.Height := 16; Bitmap.Transparent := false; Result.Bitmap.Canvas.Draw(0,0,Bitmap); end; Result.IsCustom := True; {$ifndef Designer} Result.CadControl := CadControl; {$endif} end; Function TCadInterface.NewToolBar(TName: String):TToolbarDef; begin Result := TToolBarDef.Create(tName); ToolBars.Add(Result); end; procedure TCadInterface.SaveToReg; begin end; { TTolbarDef } constructor TToolbarDef.Create(aName:String); begin Commands := TList.Create; Caption := aName; Visible := True; IsMenu := False; end; Procedure TCadInterface.LoadFromFile(fName: String); var Stream: TFileStream; app: String; begin FFileName := fName; if FileExists(FFileName) then begin Stream := TFileStream.Create(FileName,fmOpenRead); LoadFromStream(Stream); Stream.Free; app := ExtractFileName(Application.ExeName); {$ifndef Designer} LoadFromRegistry('\Software\Tekhnelogos\Powercad\'+app+'\GUI'); {$endif} end; end; Function TCadInterface.ToolbarRemoveNotification(aComponent: TComponent):Boolean; var tb: TToolBarDef; i: integer; begin result := false; for i := 0 to ToolBars.Count -1 do begin tb := TToolBarDef(Toolbars[i]); if tb.Toolbar = aComponent then begin tb.Toolbar := nil; result := true; exit; end; end; end; procedure TCadInterface.ClearToolbars; var tb: TToolBarDef; i: integer; begin try for i := 0 to ToolBars.Count -1 do begin tb := TToolBarDef(Toolbars[i]); tb.Free; end; Toolbars.Clear; except // on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TCadInterface.ClearToolbars (pcGUI)' + E.Message); end; end; procedure TCadInterface.RemoveTBCommand(tbIndex: Integer; Command: TCommandInstance); var tbDef: TToolBarDef; i: integer; sInst: TCommandInstance; begin if tbIndex > toolbars.Count - 1 then exit; tbDef := TToolbarDef(Toolbars[tbIndex]); tbdef.Commands.Remove(Command); Command.Free; end; procedure TCadInterface.RemoveToolBar(TB: TToolBarDef); begin ToolBars.Remove(tb); tb.free; end; procedure TCadInterface.RemoveCommand(pCom: TPCadCommand); var lCom: TCommandList; iCom: TCommandInstance; i,k: integer; tb : TToolBarDef; cnt: Integer; begin CommandList.Remove(pCom); For i := 0 to Commandlist.Count-1 do begin if TPcadCommand(Commandlist[i]) is TCommandList then begin lCom := TCommandList(Commandlist[i]); if lCom.ComList.IndexOf(pCom) <> -1 then lCom.RemoveCommand(pCom); end; end; For i := 0 to ToolBars.Count -1 do begin tb := TToolbarDef(Toolbars[i]); cnt := tb.Commands.Count; for k := cnt-1 downto 0 do begin iCom := TCommandInstance(tb.Commands[k]); if iCom.Command = pCom then RemoveTbCommand(i,iCom); end; end; pCom.Free; end; procedure TCadInterface.AddCommand(pCom: TPCadCommand); begin CommandList.Add(pCom); {$ifndef Designer} pCom.CadControl := CadControl; {$endif} pCom.GInterface := Self; end; procedure TCadInterface.ClearMenus; var i: integer; pCom: TCommandList; cnt : integer; begin cnt := CommandList.Count; for i := cnt-1 downto 0 do begin if TPcadCommand(CommandList[i]) is TCommandList then begin pCom := TCommandList(CommandList[i]); CommandList.Delete(i); RemoveCommand(pCom); end; end; end; procedure TCadInterface.RemoveCategory(catID: integer); var pCom: TPCadCommand; i: integer; begin if (catID <> -1) and (catID < CatList.Count-1) then begin CatList.Delete(catID); end; for i := 0 to CommandList.Count -1 do begin pCom := TPcadCommand(CommandList[i]); if pCom.CatID = catId then begin pCom.CatId := -1; end else if pCom.CatId > CatId then begin pCom.CatId := pCom.CatId -1; end; end; end; procedure TCadInterface.ClearCommands; var i: integer; pCom: TPCadCommand; cnt : integer; begin ClearGroups; cnt := CommandList.Count; for i := cnt-1 downto 0 do begin pCom := TPCadCommand(CommandList[i]); RemoveCommand(pCom); end; CommandList.Clear; end; Procedure TCadInterface.ClearCommandsById(ComId: Integer); var i: integer; pCom: TPCadCommand; cnt : integer; begin cnt := CommandList.Count; for i := cnt-1 downto 0 do begin pCom := TPCadCommand(CommandList[i]); if pCom.Id = ComId then begin CommandList.Delete(i); RemoveCommand(pCom); end; end; end; function TCadInterface.NewGroup(Name: String;Owner:Pointer): TGroupList; begin Result := TGroupList.Create(Name,Owner); CommandGroups.Add(Result); end; function TCadInterface.FindGroup(Name: String): TGroupList; var i : Integer; grp: TGroupList; begin result := nil; for i := 0 to CommandGroups.Count -1 do begin grp := TGroupList(CommandGroups[i]); if grp.Name = Name then begin result := grp; exit; end; end; end; procedure TCadInterface.ClearGroups; var i: Integer; grp: TGroupList; begin try for i := 0 to CommandGroups.Count - 1 do begin grp := TGroupList(CommandGroups[i]); grp.free; end; CommandGroups.Clear; except // on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TCadInterface.ClearGroups (pcGUI)' + E.Message); end; end; procedure TCadInterface.LoadFromRegistry(KeyName: String); begin RegLoadToolbarPositions(Window,KeyName); end; procedure TCadInterface.SaveToRegistry(KeyName: String); begin RegSaveToolbarPositions(Window,KeyName); end; procedure TCadInterface.SaveToStream(Stream: TStream); var MenuList: TList; cnt,i,k,comId: Integer; xCom: TpcadCommand; pCom: TCommandInstance; tb: TToolbarDef; bool: Byte; grp: TgroupList; xCode:Byte; evId: Integer; begin // Write properties if FEnabled then xCode := 1 else xCode := 0; Stream.Write(xCode,1); if CanCustomize then xCode := 1 else xCode := 0; Stream.Write(xCode,1); // Write the categories WriteString(Stream,CatList.Text); // Write CommandGroups Stream.Write(Commandgroups.Count,4); for i := 0 to Commandgroups.Count-1 do begin grp := TgroupList(Commandgroups[i]); WriteString(Stream,grp.Name); Stream.Write(grp.EventId,4); end; // Write Commands cnt := CommandList.Count; Stream.Write(Cnt,2); for i := 0 to CommandList.Count -1 do begin xCom := TPCadCommand(CommandList[i]); WriteString(Stream,Xcom.ClassName); xCom.WriteToStream(stream); end; // Write Toolbars cnt := ToolBars.Count; Stream.Write(cnt,1); for i := 0 to Toolbars.Count -1 do begin tb := TToolBarDef(ToolBars[i]); WriteString(Stream,tb.Caption); if tb.Visible then bool := 1 else bool := 0; Stream.Write(bool,1); if tb.isMenu then bool := 1 else bool := 0; Stream.Write(bool,1); bool := 0; //if tb.PanelL then bool := 1 else bool := 0; Stream.Write(bool,1); //if tb.PanelR then bool := 1 else bool := 0; Stream.Write(bool,1); Cnt := tb.Commands.Count; Stream.Write(cnt,1); for k := 0 to cnt-1 do begin pCom := TCommandInstance(tb.Commands[k]); comId := pcom.Command.Id; Stream.Write(comId,4); WriteString(Stream,pcom.Command.Name); WriteString(Stream,pcom.Caption); if pCom.BeginGroup then bool := 1 else bool := 0; Stream.Write(bool,1); if (pCom.bitmapchanged) then bool := 1 else bool := 0; Stream.Write(bool,1); if assigned(pCom.Bitmap) and (pCom.bitmapchanged) then begin bool := 1;Stream.Write(bool,1); pCom.Bitmap.SaveToStream(Stream); end else begin bool := 0;Stream.Write(bool,1); end; end; end; end; procedure TCadInterface.LoadFromStream(Stream: TStream); var MenuList: TList; i,k,comId: Integer; cnt,gcnt: word; comCnt: Byte; xCom: TpcadCommand; pCom: TCommandInstance; tb: TToolbarDef; bool: Byte; cap,comClass,comName: String; bmpChanged,bmpWritten: Byte; cats,gName:string; grp: TGroupList; evId: Integer; xcode: Byte; xBmp: TBitmap; gOwner: Pointer; begin gOwner := nil; {$ifndef Designer} gOwner := CadControl; {$endif} // Clear Current Stuff ClearContent; // Read properties Stream.Read(xCode,1); Enabled := (xCode = 1); if not enabled then exit; Stream.Read(xCode,1); CanCustomize := (xCode = 1); // Read Categories Cats := ReadStringFromstream(Stream); CatList.text := cats; // Read CommandGroups gcnt := 0; Stream.Read(gcnt,4); for i := 1 to gcnt do begin gname := ReadStringFromstream(Stream); grp := NewGroup(gName,gOwner); Stream.Read(evId,4); if gName = 'Tools' then evId := cDrawTool; if evId <> 0 then begin grp.EventId := evId; {$ifndef Designer} if assigned(CadControl) then grp.EventHandle := CadControl.RegisterEvent(evId,Self,GUIEventCallBack); {$endif} end; end; // read Commands cnt := 0; Stream.Read(Cnt,2); MenuList := TList.Create; for i := 0 to Cnt -1 do begin comClass := ReadStringFromStream(Stream); xCom := TPCadCommand.CreateCommandFromStream(ComClass,Stream,Self); if assigned(xCom) then xCom.IsCustom := True; if assigned(xCom) then AddCommand(xCom); if xCom is TCommandList then MenuList.Add(xCom); end; // Create menu Content for i := 0 to Menulist.Count -1 do begin TCommandList(MenuList[i]).CreateContentFromtempList(Self); end; MenuList.Free; // Read Toolbars cnt := 0; Stream.Read(cnt,1); for i := 0 to cnt-1 do begin cap := ReadStringFromStream(Stream); tb := Newtoolbar(cap); tb.DefaultDock := nil; if cap = csDraw then begin tb.DefaultDock := DockLeft; tb.DockRow := 0; tb.DockPos := 0; end else if cap = csFile then begin tb.DefaultDock := DockTop; tb.DockRow := 0; tb.DockPos := 0; end else if cap = csEdit then begin tb.DefaultDock := DockTop; tb.DockRow := 0; tb.DockPos := 100; end else if cap = csFormat then begin tb.DefaultDock := DockTop; tb.DockRow := 1; tb.DockPos := 0; end else if cap = csTransform then begin tb.DefaultDock := DockLeft; tb.DockRow := 0; tb.DockPos := 100; end else if cap = csArrange then begin tb.DefaultDock := DockTop; tb.DockRow := 0; tb.DockPos := 200; end else if cap = csCommandBar then begin tb.DefaultDock := DockBottom; tb.DockRow := 0; tb.DockPos := 0; end else if cap = csStatusBar then begin tb.DefaultDock := DockBottom; tb.DockRow := 1; tb.DockPos := 0; end; Stream.Read(bool,1); if bool = 1 then tb.Visible := true else tb.Visible := false; Stream.Read(bool,1); if bool = 1 then tb.IsMenu := true else tb.IsMenu := false; Stream.Read(bool,1); //if bool = 1 then tb.PanelL := true else tb.PanelL := false; Stream.Read(bool,1); //if bool = 1 then tb.PanelR := true else tb.PanelR := false; //if (tb.PanelR or tb.PanelL) then tb.Toolbar := BottomPanel; ComCnt := 0; Stream.Read(ComCnt,1); for k := 0 to ComCnt-1 do begin Stream.Read(comId,4); comName := ReadStringFromStream(Stream); cap := ReadStringFromStream(Stream); Stream.Read(bool,1); xcom := nil; xCom := FindCommand(comName); pCom := nil; if assigned(xCom) then begin pCom := AddTbCommand(i,xCom,(bool = 1)); pCom.Caption := cap; end; Stream.Read(bmpChanged,1); // bitmap changed Stream.Read(bmpWritten,1); // bitmap written if assigned(pCom) then pCom.BitmapChanged := (bmpChanged = 1); if assigned(pCom) and (bmpWritten = 1) then begin if assigned(pCom.Bitmap) then pCom.Bitmap.free; xBmp := TBitmap.Create; xBmp.LoadFromStream(Stream); //xBmp.Transparent := False; pCom.Bitmap := TBitmap.Create; pCom.Bitmap.Width := xBmp.Width; pCom.Bitmap.Height := xBmp.Height; pCom.Bitmap.Canvas.Draw(0,0,xBmp); pCom.Bitmap.Transparent := xBmp.Transparent; xBmp.Free; end; if assigned(pCom) and (bmpWritten = 0) and (bmpChanged = 1) then begin if assigned(pCom.Bitmap) then pCom.Bitmap.free; pCom.Bitmap := nil; end; end; end; {$ifndef Designer} CreateMacroCommands; CreateBlockCommands; CreatePluginCommands; if not (csDesigning in ComponentState) then CreateControls; {$endif} end; {$ifndef Designer} procedure TCadInterface.SetToolIndex; var i: Integer; xCom: TPcadCommand; tCom: TToolCommand; begin For i := 0 to CommandList.Count-1 do begin xCom := TPCadCommand(CommandList[i]); if xCom is TToolCommand then begin tCom := TToolCommand(xCom); if (tCom.ToolIndex = ord(CadControl.ToolIdx)) and (tCom.ToolName = CadControl.ToolInfo) then begin tCom.Selected := True; tCom.SyncronizeInstances; end else begin tCom.Selected := False; tCom.SyncronizeInstances; end; end; end; end; {$endif} procedure TCadInterface.ClearContent; begin CatList.Clear; ClearToolbars; ClearCommands; end; procedure TCadInterface.SetEnabled(const Value: Boolean); begin FEnabled := Value; if not Value then begin ClearToolbars; ClearCommands; CatList.Clear; CanCustomize := False; end; end; function TCadInterface.CreateMenuControls(TbDef: TToolBarDef; Index: Integer): TComponent; var mn: TMainmenu; k,OrderIndex: Integer; But: TControl; pCom: TcommandInstance; mnItem: TCommandmenuItem; begin if assigned(tbDef.Toolbar) then begin mn := TMainMenu(tbDef.Toolbar); end else begin mn := TMainMenu.create(Window); mn.OwnerDraw := True; end; mn.Items.Clear; mn.Name := ValidateString(tbDef.Caption); Window.Menu := mn; mn.Tag := Index; tbDef.ToolBar := mn; OrderIndex := 0; for k := 0 to tbDef.Commands.Count - 1 do begin pCom := TCommandInstance(tbDef.Commands[k]); mnItem := nil; mnItem := pCom.Command.CreateMenuItem(mn,pCom); if assigned(mnItem) then begin mnItem.OwnerDraw := False; mnItem.OnClick := nil; mn.Items.Add(mnItem); pCom.MenuItem := mnItem; end; inc(orderIndex); end; end; function TCadInterface.CreateToolBarControls(TbDef: TToolBarDef; Index: Integer): TComponent; var tb: TPCOfficeBar; k,x,OrderIndex: Integer; Bevel: TPCSep; But: TControl; pCom: TcommandInstance; //pan: TPanel; isPanel:Boolean; Pos: Integer; begin //isPanel := (tbDef.PanelL or tbDef.PanelR); if assigned(tbDef.Toolbar) then begin tb := TPCOfficeBar(tbDef.Toolbar); if tbDef.Caption = csStatusBar then begin tb.DockRow := 1; tb.DockPos := 0; end; end else begin tb := TPCOfficeBar.create(Window); if not assigned(tbDef.DefaultDock) then tbDef.DefaultDock := DockTop; tb.Parent := tbDef.DefaultDock; tb.DockedTo := tbDef.DefaultDock; tb.DockRow := tbDef.DockRow; tb.DockPos := tbDef.DockPos; if tbDef.Caption = csStatusBar then begin tb.CanDockLeftRight := false; end; end; tb.Visible := tbDef.Visible; tb.Caption := tbDef.Caption; tb.Name := ValidateString(tbDef.Caption); tb.Tag := Index; tbDef.ToolBar := tb; OrderIndex := 0; for k := 0 to tbDef.Commands.Count - 1 do begin pCom := TCommandInstance(tbDef.Commands[k]); if pCom.BeginGroup then begin if not assigned(pCom.Bevel) then begin bevel := TPCSep.Create(tb); bevel.parent := tb; bevel.Visible := true; bevel.SizeHorz := 10; bevel.SizeVert := 10; tb.OrderIndex[TControl(bevel)] := OrderIndex ; pCom.bevel := bevel; end; Inc(OrderIndex); end else begin if assigned(pCom.Bevel) then begin if Pcom.Bevel is TPCSep then TPCSep(pCom.Bevel).Free; pCom.bevel := nil; end; end; but := nil; but := pCom.Command.CreateControl(tb,pCom); if assigned(but) then tb.OrderIndex[But] := OrderIndex; inc(orderIndex); end; end; procedure TCadInterface.SaveToFile(fName: String); var Stream: TFileStream; app: String; begin FFileName := fName; Stream := TFileStream.Create(FileName,fmCreate); SavetoStream(Stream); Stream.Free; app := ExtractFileName(Application.ExeName); {$ifndef Designer} SaveToRegistry('\Software\Tekhnelogos\Powercad\'+app+'\GUI'); {$endif} end; {$ifndef Designer} procedure TCadInterface.SetControl(const Value: TPowercad); var i: Integer; com: TPCadCommand; oldC: TPowercad; begin oldC := fCadControl; fCadControl := Value; if not (csDesigning in ComponentState) then begin for i :=0 to Commandlist.Count-1 do begin com := TPcadCommand(CommandList[i]); com.CadControl := Value; if assigned(com.EventHandle) and assigned(oldC) then OldC.UnRegisterEvent(com.EventId,com.EventHandle); Com.EventHandle := nil; if (Com.EventId <> 0) and (assigned(Value)) then Com.EventHandle := Value.RegisterEvent(com.EventId,com,GUIEventCallback); if (not (Com.ID in [cNew,cOpen,cCustomize,cFile,cEdit,cArrange,cFormat,cView,cInsert,cOptions,cTools,cExit])) then Com.Enabled := assigned(value); Com.SyncronizeInstances; end; if assigned(fCadControl) then SetToolIndex; end; end; procedure TCadInterface.SetBlockDlg(const Value: TPCBlockDlg); begin FBlockDlg := Value; CreateBlockCommands; end; procedure TCadInterface.SetLayerDlg(const Value: TPCLayerDlg); begin FLayerDlg := Value; end; procedure TCadInterface.SetMacroDlg(const Value: TPCMacroDialog); begin FMacroDlg := Value; CreateMacroCommands; end; procedure TCadInterface.SetPluginDlg(const Value: TPCPluginDlg); begin FPluginDlg := Value; end; procedure TCadInterface.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) then begin if (AComponent = FCadControl) then begin FCadControl := nil; CadControl := nil; end else if (AComponent = Docktop) then begin DockTop := nil; end else if (AComponent = DockLeft) then begin DockLeft := nil; end else if (AComponent = DockRight) then begin DockRight := nil; end else if (AComponent = DockBottom) then begin DockBottom := nil; end else if (AComponent = FMacroDlg) then begin MacroDialog := nil; end else if (AComponent = FBlockDlg) then begin BlockDialog := nil; end else if (AComponent = FlayerDlg) then begin LayerDialog := nil; end else if (AComponent = FPluginDlg) then begin PluginDialog := nil; end else if (AComponent = FFillDlg) then begin FillDialog := nil; end else if ToolBarRemoveNotification(aComponent) then begin end; end; end; {$endif} procedure TCadInterface.BotResize(Sender: TObject); var i: Integer; begin For i := 0 to DockBottom.ToolbarCount -1 do DockBottom.Toolbars[i].ReAlignControls(DockBottom.Width); end; destructor TCadInterface.Destroy; begin {$ifndef Designer} CadControl := nil; {$endif} if assigned(DockTop) then DockTop.Free; if assigned(DockLeft) then DockLeft.Free; if assigned(DockRight) then DockRight.Free; if assigned(DockBottom) then DockBottom.Free; ClearContent; CatList.Free; CommandBitmap.Free; OptionsBitmap.Free; GradsBitmap.Free; TextureBitmap.Free; CommandGroups.Free; Toolbars.Free; CommandList.Free; inherited destroy; end; procedure TCadInterface.SetMDI(const Value: Boolean); begin FMDI := Value; end; procedure TCadInterface.RefreshAllInterface; begin ClearToolbars; ClearCommands; CatList.Clear; CreateCategories; CreateStandartCommands; BuildStandartInterface; end; function TCadInterface.GetGradBitmap(idx: integer): TBitmap; var sRect: Trect; begin result := TBitmap.Create; result.Width := 32; result.Height := 16; Srect := Rect (0,(idx-1)*16,32,(idx)*16); result.Canvas.CopyRect(Rect(0,0,32,16),GradsBitmap.Canvas,sRect); result.canvas.Pen.Color := clBlack; result.canvas.Brush.style := bsClear; result.canvas.Rectangle(1,0,32,16); result.canvas.Pen.Color := clTeal; result.canvas.MoveTo(0,0); result.canvas.LineTo(0,16); end; function TCadInterface.GetTxtBitmap(idx: integer): TBitmap; var sRect: Trect; begin result := TBitmap.Create; result.Width := 32; result.Height := 16; Srect := Rect (0,(idx-1)*16,32,(idx)*16); result.Canvas.CopyRect(Rect(0,0,32,16),TextureBitmap.Canvas,sRect); result.canvas.Pen.Color := clBlack; result.canvas.Brush.style := bsClear; result.canvas.Rectangle(1,0,32,16); result.canvas.Pen.Color := clTeal; result.canvas.MoveTo(0,0); result.canvas.LineTo(0,16) end; procedure TCadInterface.SetFillDlg(const Value: TPCFillDlg); begin FFillDlg := Value; end; { TPCadCommand } procedure TPCadCommand.Clicked(Sender: TObject); {$ifndef Designer} var pControl: TControl; plIdx,vIdx: Integer; FName: String; {$endif} begin {$ifndef Designer} if Id in [cBlocksManager,cMacroManager,cPluginManager,cLayersDialog,cCustomize,cRunPlugin] then begin Case Id of cBlocksManager: if assigned(GInterface.BlockDialog) then GInterface.BlockDialog.Show; cMacroManager: if assigned(GInterface.MacroDialog) then GInterface.MacroDialog.Show; cPluginManager: if assigned(GInterface.PluginDialog) then GInterface.PluginDialog.Show; cLayersDialog: if assigned(GInterface.LayerDialog) then GInterface.LayerDialog.Show; cCustomize:GInterface.Customize; cRunPlugin: begin plIdx := (Tag div 1000)-1; vIdx := Tag-((plIdx+1)*1000)-1; if assigned(GInterface.PluginDialog) then GInterface.PluginDialog.DoPluginVerb(plIdx,vIdx); end; end; end else if GInterface.MDIApp and (Id in [cNew,cOpen,cExit]) then begin Case Id of cNew : if assigned(GInterface.FMDINewFile) then GInterface.FMDINewFile(GInterface); cOpen: if assigned(GInterface.FMDIOpenFile) then GInterface.FMDIOpenFile(GInterface,FName); cExit: if assigned(GInterface.FMDIExit) then GInterface.FMDIExit(GInterface); end; end else begin if assigned(CadControl) then begin TPowerCad(CadControl).CurrentValue := Tag; if Id = -1 then TPowerCad(CadControl).ExecuteCustomCommand(Name) else TPowerCad(CadControl).ExecuteTBCommand(ID); end; if assigned(GroupOwner) then begin GroupOwner.Syncronize(Self); end; end; {$endif} end; constructor TPCadCommand.Create; begin inherited; instances := Tlist.create; GroupOwner := nil; IsCustom := false; EventId := 0; EventHandle := nil; EventEnabled := True; CanMenu := True; Tag := 0; Enabled := true; end; class function TPCadCommand.CreateCommandFromStream(ComClass: String; Stream: TStream;GUI:TcadInterface): TPcadCommand; type TCClass = class of TPCadCommand; var cClass: TCClass; i: integer; begin result := nil; for i := 0 to CommandClasses.Count -1 do begin cClass := TCCLass(CommandClasses[i]); if cClass.ClassName = ComClass then begin result := cClass.Create; result.LoadFromStream(Stream,GUI); end; end; end; function TPCadCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cButton : TCommandButton; w: integer; begin w := 0; if assigned(Instance.Button) then begin cButton := TCommandButton(Instance.Button); end else begin cButton := TCommandButton.Create(aOwner,Instance); end; CButton.Caps := 0; if Assigned(GroupOwner) then begin cButton.GroupIndex := integer(Instance); cButton.AllowAllUp := True; end; cButton.Parent := TWinControl(aOwner); cButton.Visible := true; cButton.Flat := True; cButton.Font.Name := 'Tahoma'; cButton.Font.Size := 8; CButton.ComCaption := ''; if assigned(Instance.Bitmap) then begin if CButton.ComBitmap.Width = 0 then begin cButton.ComBitmap.Height := 16; cButton.ComBitmap.Width := 16; end; Instance.Bitmap.Transparent := False; cButton.ComBitmap.Canvas.Draw(0,0,Instance.Bitmap); w := 22; end; if not assigned(Instance.Bitmap) then begin if assigned(cButton.ComBitmap) then begin cButton.ComBitmap.Free; cButton.ComBitmap := nil; cButton.ComBitmap := Tbitmap.Create; end; end; if (not assigned(Instance.Bitmap)) then begin cButton.ComCaption := Instance.Caption; cButton.Width := w + CButton.Canvas.TextWidth(CButton.ComCaption)+8; end; if CButton.Width < 22 then cButton.Width := 22; CButton.ShowHint := true; CButton.Hint := Instance.Caption; Instance.Button := cButton; cButton.align := alNone; Result := cButton; end; function TPCadCommand.CreateInstance: TCommandInstance; begin Result := TCommandInstance.Create(Self,Name,Bitmap); Instances.Add(result); SyncronizeInstances; end; function TPCadCommand.CreateMenuItem(Menu: Tmenu; Instance: TCommandInstance): TCommandMenuItem; var mnItem : TCommandMenuItem; begin mnItem := TCommandMenuItem.Create(Menu,Instance); mnItem.Caption := Instance.Caption; if assigned(Instance.Bitmap) then begin if mnItem.Bitmap.Width = 0 then begin mnItem.Bitmap.Height := 16; mnItem.Bitmap.Width := 16; end; Instance.Bitmap.Transparent := False; mnItem.Bitmap.Canvas.Draw(0,0,Instance.Bitmap); end else begin if assigned(mnItem.Bitmap) then begin mnItem.Bitmap.Free; mnItem.Bitmap := nil; mnItem.Bitmap := Tbitmap.Create; end; end; Result := MnItem; end; destructor TPCadCommand.Destroy; begin if assigned(Bitmap) then Bitmap.Free; {$ifndef Designer} if assigned(EventHandle) then begin TPowerCad(CadControl).UnRegisterEvent(EventId,EventHandle); end; {$endif} inherited; end; procedure TPCadCommand.Enter(Sender: TObject); var IsMenu:Boolean; begin //isMenu := TControl(sender).Owner is TFrmMenuFace; //if IsMenu then TFrmMenuFace(TControl(sender).Owner).SetFocus; TWinControl(TControl(Sender).Owner).SetFocus; end; procedure TPCadCommand.Leave(Sender: TObject); begin end; procedure TPCadCommand.LoadFromStream(Stream:Tstream;GUI:TcadInterface); var ComName:String; bmp: TBitmap; bool: Byte; grp:string; oGrp:TgroupList; begin Name := ReadStringFromStream(Stream); Stream.Read(ID,4); Stream.Read(CatId,4); EventId := 0; Stream.Read(EventId,4); {$ifndef Designer} if (EventId <> 0) and assigned(Gui.CadControl) then begin EventHandle := Gui.CadControl.RegisterEvent(EventId,Self,GUIEventCallback); end; {$endif} Grp := ReadStringFromStream(Stream); if Grp <> '' then begin oGrp := GUI.FindGroup(grp); Gui.AddToGroup(oGrp,Self); end; Stream.Read(bool,1); if bool = 1 then begin Bmp := Tbitmap.Create; Bmp.LoadFromStream(Stream); //Bmp.Transparent := False; Bitmap := Tbitmap.Create; Bitmap.Width := bmp.Width; Bitmap.Height := bmp.Height; Bitmap.Canvas.Draw(0,0,bmp); bmp.Free; end; GInterface := GUI; end; procedure TPCadCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then begin TCommandButton(pCom.Button).Enabled := enabled; end; if assigned(pCom.MenuItem) then begin TCommandMenuItem(pCom.MenuItem).Enabled := Enabled; end; end; end; procedure TPCadCommand.WriteToStream(Stream: TStream); var bool: Byte; grp:string; begin WriteString(Stream,Name); Stream.Write(Id,4); Stream.Write(CatId,4); Stream.Write(EventId,4); if assigned (GroupOwner) then grp := GroupOwner.Name else grp := ''; WriteString(Stream,grp); if assigned(bitmap) then begin bool := 1;Stream.Write(Bool,1); Bitmap.SaveToStream(Stream); end else begin bool := 0;Stream.Write(Bool,1); end; end; { TCommandButton } procedure TCommandButton.CMMouseEnter(var Message: TMessage); begin inherited; if assigned(FMouseEnter) then FMouseEnter(Self); end; procedure TCommandButton.CMMouseLeave(var Message: TMessage); begin inherited; if assigned(FMouseLeave) then FMouseLeave(Self); end; constructor TCommandButton.Create(aOwner: TComponent; aCom: TCommandInstance); begin inherited Create(aOwner); ComInst := aCom; OnClick := ComInst.Command.Clicked; OnMouseEnter := ComInst.Command.Enter; OnMouseLeave := ComInst.Command.Leave; ComBitmap := TBitmap.Create; ComCaption := ''; Caps := 0; end; destructor TCommandButton.Destroy; begin if assigned(ComInst) then ComInst.Button := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited destroy;; end; procedure TCommandButton.Paint; var CapY: Integer; begin inherited; if Height < 22 then capY := 2 else CapY := 4; if ComBitmap.Width > 0 then begin ComBitmap.Transparent := True; DrawBitmap(Canvas,ComBitmap,3,3,Enabled); if CapS = 0 then Caps := ComBitmap.Width + 8; end else begin if CapS = 0 then Caps := 2; end; if enabled then Canvas.textOut(Caps,CapY,ComCaption) else begin Canvas.Brush.Style := bsClear; Canvas.Font.Color := clWhite; Canvas.textOut(Caps+1,CapY+1,ComCaption); Canvas.Font.Color := clGray; Canvas.textOut(Caps,CapY,ComCaption); end; end; { TColorCommandButton } Procedure TColorCommandButton.SetColor(Value: TColor); begin FColor := value; Refresh; end; Procedure TColorCommandButton.Paint; var xRect: TRect; Points: Array [0..2] of Tpoint; xs,ys,l,h: integer; xColor : TColor; tx : integer; begin inherited; if FColor = -255 then xColor := 255 else xColor:= FColor; Canvas.Brush.Color := xColor; Canvas.Brush.Style := bsSolid; Canvas.Pen.Color := clBlack; Canvas.Pen.Style := psSolid; if not Enabled then begin Canvas.Brush.Style := bsClear; Canvas.Pen.Color := clSilver; end; if ComBitmap.Width > 0 then begin Canvas.Rectangle(22,5,34,17); tx := 25; end else begin Canvas.Rectangle(2,5,15,17); tx := 5; end; If enabled and (FColor = -255) then begin Canvas.Font.Name := 'Arial Black'; Canvas.Font.Size := 7; Canvas.Font.Style := []; Canvas.font.Color := clWhite; Canvas.Brush.Style := bsClear; Canvas.textOut(tx,5,'L'); end; if MouseInControl then begin xRect := Rect (Width-12,2,Width,20); DrawEdge(Canvas.Handle,xRect,EDGE_ETCHED,BF_LEFT); end; Canvas.Pen.Color := clBlack; Canvas.Brush.Color := clBlack; Canvas.Brush.Style := bsSolid; if not Enabled then begin Canvas.Brush.Style := bsClear; Canvas.Pen.Color := clSilver; end; xs := width-9; ys := 8; l := 3; h := 3; points[0] := Point(xs,ys); points[1] := Point(xs+l+l,ys); points[2] := Point(xs+l,ys+h); Canvas.Polygon(points); end; { TPCColorCommand } procedure TPCColorCommand.Clicked(Sender: TObject); var Control:TControl; pt:Tpoint; begin if not assigned(PopUp) then CreateDialog; PopUp.Color := color; Control := TControl(Sender); pt := Control.ClientToScreen(Point(0,0)); PopUp.Popup(pt.x,pt.y); end; procedure TPCColorCommand.ColorChanged(Sender: TObject;xColor: TColor); {$ifndef Designer}var Cad: TPowerCad;{$endif} begin {$ifndef Designer} Color := xColor; TPowerCad(CadControl).CurrentColor := xColor; TPowerCad(CadControl).ExecuteTBCommand(ID); SyncronizeInstances; {$endif} end; constructor TPCColorCommand.Create; begin inherited; Color := -255; end; function TPCColorCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cButton : TColorCommandButton; w: integer; begin if not assigned(PopUp) then CreateDialog; if assigned(Instance.Button) then begin cButton := TColorCommandButton(Instance.Button); end else begin cButton := TColorCommandButton.Create(aOwner,Instance); end; w := 0; cButton.Color := Color; cButton.Parent := TWinControl(aOwner); cButton.Visible := true; cButton.Flat := True; cButton.Font.Name := 'Tahoma'; cButton.Font.Size := 8; cButton.ComCaption := ''; w := 16; cButton.CapS := 25; if assigned(Instance.Bitmap) then begin if cButton.ComBitmap.Height = 0 then begin cButton.ComBitmap.Height := 16; cButton.ComBitmap.Width := 16; end; Instance.Bitmap.Transparent := False; cButton.ComBitmap.Canvas.Draw(0,0,Instance.Bitmap); w := w + 22; cButton.CapS := 40; end; cButton.Width := w; if (not assigned(Instance.Bitmap)) then begin cButton.ComCaption := Instance.Caption; cButton.Width := w+CButton.Canvas.TextWidth(CButton.ComCaption)+10; end; if (not assigned(Instance.Bitmap)) and (assigned(cButton.ComBitmap)) then begin cButton.ComBitmap.Free; cButton.ComBitmap := TBitmap.Create; end; CButton.Hint := Instance.Caption; CButton.ShowHint := True; if CButton.Width < 22 then cButton.width := 22; cButton.width := cButton.width + 10; Instance.Button := cButton; Result := cButton; end; procedure TPCColorCommand.CreateDialog; begin PopUp := TColorPopUp.Create(nil); PopUp.OnColorChange := ColorChanged; end; function TPCColorCommand.CreateMenuItem(Menu: TMenu; Instance: TCommandInstance): TCommandMenuItem; var mnItem : TColorMnItem; begin mnItem := TColorMnItem.Create(Menu,Instance); mnItem.SetColor(Color); mnItem.Caption := Instance.Caption; if assigned(Instance.Bitmap) then begin if mnItem.Bitmap.Width = 0 then begin mnItem.Bitmap.Height := 16; mnItem.Bitmap.Width := 16; end; Instance.Bitmap.Transparent := False; mnItem.Bitmap.Canvas.Draw(0,0,Instance.Bitmap); end else begin if assigned(mnItem.Bitmap) then begin mnItem.Bitmap.Free; mnItem.Bitmap := nil; mnItem.Bitmap := Tbitmap.Create; end; end; Result := MnItem; end; destructor TPCColorCommand.Destroy; begin if assigned(popUp) then Popup.Free; inherited; end; procedure TPCColorCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then begin TColorCommandButton(pCom.Button).Enabled := enabled; TColorCommandButton(pCom.Button).Color := TPCColorCommand(pCom.Command).Color; end; if assigned(pCom.MenuItem) then begin TColorMnItem(pCom.MenuItem).Enabled := Enabled; TColorMnItem(pCom.MenuItem).Color := TPCColorCommand(pCom.Command).Color; end; end; end; { TBSCommandCombo } procedure TBSCommandCombo.Clicked(Sender: TObject); {$ifndef Designer} var CadControl: TPowerCad;{$endif} begin {$ifndef Designer} TStyleCommand(ComInst.Command).Style := ItemIndex; CadControl := TPowerCad(ComInst.Command.CadControl); CadControl.CurrentStyle := ItemIndex; CadControl.ExecuteTBCommand(ComInst.Command.ID); ComInst.Command.SyncronizeInstances; {$endif} end; constructor TBSCommandCombo.Create(aOwner: TComponent; aCom: TCommandInstance); begin inherited create(aOwner); ComInst := aCom; OnChange := Clicked; end; destructor TBSCommandCombo.Destroy; begin if assigned(ComInst) then ComInst.Button := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited; end; { TPSCommandCombo } procedure TPSCommandCombo.Clicked(Sender: TObject); {$ifndef Designer} var CadControl: TPowerCad;{$endif} begin {$ifndef Designer} TStyleCommand(ComInst.Command).Style := ItemIndex; CadControl := TPowerCad(ComInst.Command.CadControl); CadControl.CurrentStyle := ItemIndex; CadControl.ExecuteTBCommand(ComInst.Command.ID); ComInst.Command.SyncronizeInstances; {$endif} end; constructor TPSCommandCombo.Create(aOwner: TComponent; aCom: TCommandInstance); begin inherited create(aOwner); ComInst := aCom; OnChange := Clicked; end; destructor TPSCommandCombo.Destroy; begin if assigned(ComInst) then ComInst.Button := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited; end; { TPWCommandCombo } procedure TPWCommandCombo.Clicked(Sender: TObject); {$ifndef Designer}var CadControl: TPowerCad;{$endif} begin {$ifndef Designer} TStyleCommand(ComInst.Command).Style := ItemIndex; CadControl := TPowerCad(ComInst.Command.CadControl); CadControl.CurrentStyle := ItemIndex; CadControl.ExecuteTBCommand(ComInst.Command.ID); ComInst.Command.SyncronizeInstances; {$endif} end; constructor TPWCommandCombo.Create(aOwner: TComponent; aCom: TCommandInstance); begin inherited create(aOwner); ComInst := aCom; OnChange := Clicked; end; destructor TPWCommandCombo.Destroy; begin if assigned(ComInst) then ComInst.Button := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited; end; { TRSCommandCombo } procedure TRSCommandCombo.Clicked(Sender: TObject); {$ifndef Designer}var CadControl: TPowerCad;{$endif} begin {$ifndef Designer} TStyleCommand(ComInst.Command).Style := ItemIndex; CadControl := TPowerCad(ComInst.Command.CadControl); CadControl.CurrentStyle := ItemIndex; CadControl.ExecuteTBCommand(ComInst.Command.ID); ComInst.Command.SyncronizeInstances; {$endif} end; constructor TRSCommandCombo.Create(aOwner: TComponent; aCom: TCommandInstance); begin inherited create(aOwner); ComInst := aCom; OnChange := Clicked; end; destructor TRSCommandCombo.Destroy; begin if assigned(ComInst) then ComInst.Button := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited; end; { TStyleCommand } procedure TStyleCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then TStyleCombo(pCom.Button).Enabled := Enabled; if assigned(pCom.Button) then TStyleCombo(pCom.Button).ItemIndex := Style; end; end; { TPCFontNameCommand } constructor TPCFontNameCommand.Create; begin inherited; CanMenu := False; end; function TPCFontNameCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cCombo: TFontCommandCombo; begin if assigned(Instance.Button) then begin result := TControl(Instance.Button); exit; end; cCombo := TFontCommandCombo.Create(aOwner,Instance); cCombo.Parent := TWinControl(aOwner); cCombo.Visible := true; cCombo.Width := 140; cCombo.Font.Name := 'Tahoma'; cCombo.Font.Size := 8; Instance.Button := cCombo; Result := cCombo; end; procedure TPCFontNameCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then TFontComboBox(pCom.Button).Enabled := Enabled; if assigned(pCom.Button) then TFontComboBox(pCom.Button).ItemIndex := TFontComboBox(pCom.Button).Items.IndexOf(FontName); end; end; { TFontCommandCombo } procedure TFontCommandCombo.Clicked(Sender: TObject); {$ifndef Designer}var CadControl: TPowerCad;{$endif} begin {$ifndef Designer} TPCFontNameCommand(ComInst.Command).FontName := Text; CadControl := TPowerCad(ComInst.Command.CadControl); CadControl.CurrentString := Text; CadControl.ExecuteTBCommand(ComInst.Command.ID); ComInst.Command.SyncronizeInstances; {$endif} end; constructor TFontCommandCombo.Create(aOwner: TComponent; aCom: TCommandInstance); begin inherited create(aOwner); ComInst := aCom; OnChange := Clicked; end; destructor TFontCommandCombo.Destroy; begin if assigned(ComInst) then ComInst.Button := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited; end; { TPCToggleCommand } procedure TPCToggleCommand.Clicked(Sender: TObject); {$ifndef Designer}var Cad: TPowerCad;{$endif} begin {$ifndef Designer} Flag := not Flag; Cad := TPowerCad(CadControl); Cad.CurrentFlag := Flag; Cad.ExecuteTBCommand(ID); SyncronizeInstances; {$endif} end; function TPCToggleCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cButton : TCommandButton; w : integer; begin if assigned(Instance.Button) then begin cButton := TCommandButton(Instance.Button); end else begin cButton := TCommandButton.Create(aOwner,Instance); end; w := 0; cButton.Parent := TWinControl(aOwner); cButton.Visible := true; cButton.Flat := True; cButton.Font.Name := 'Tahoma'; cButton.Font.Size := 8; cButton.GroupIndex := Integer(Instance); cButton.AllowAllUp := True; cButton.ComCaption := ''; CButton.Caps := 0; cButton.Down := Flag; if assigned(Instance.Bitmap) then begin if cButton.ComBitmap.Height = 0 then begin cButton.ComBitmap.Height := 16; cButton.ComBitmap.Width := 16; end; Instance.Bitmap.Transparent := False; cButton.ComBitmap.Canvas.Draw(0,0,Instance.Bitmap); w := 22; end; cButton.Width := w; if (not assigned(Instance.Bitmap)) then begin cButton.ComCaption := Instance.Caption; cButton.Width := w + CButton.Canvas.TextWidth(CButton.ComCaption) + 8; end; if (not assigned(Instance.Bitmap)) and (assigned(cButton.ComBitmap)) then begin cButton.ComBitmap.Free; cButton.ComBitmap := TBitmap.Create; end; CButton.Hint := Instance.Caption; CButton.ShowHint := True; if CButton.Width < 22 then cButton.width := 22; Instance.Button := cButton; Result := cButton; end; function TPCToggleCommand.CreateMenuItem(Menu: TMenu; Instance: TCommandInstance): TCommandMenuItem; begin result := inherited CreateMenuItem(Menu,Instance); result.Checked := Flag; end; procedure TPCToggleCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then TCommandButton(pCom.Button).Enabled := Enabled; if assigned(pCom.MenuItem) then TCommandMenuItem(pCom.MenuItem).Enabled := Enabled; if assigned(pCom.Button) then TCommandButton(pCom.Button).Down := Flag; if assigned(pCom.MenuItem) then TCommandMenuItem(pCom.MenuItem).Checked := Flag; end; end; Procedure GroupButtonsUp(Command:TPcadCommand); var i: integer; xCom: TPcadCommand; k: integer; pCom : TCommandInstance; begin for k := 0 to Command.Instances.Count -1 do begin pCom := TCommandInstance(Command.Instances[k]); TcommandButton(pCom.Button).Down := True; end; for i := 0 to Command.GroupOwner.Count-1 do begin xCom := TPCadCommand(Command.GroupOwner[i]); if (xCom <> Command) then begin for k := 0 to xCom.Instances.Count -1 do begin pCom := TCommandInstance(xCom.Instances[k]); TcommandButton(pCom.Button).Down := false; end; end; end; end; { TPCOptionsCommand } procedure TPCOptionsCommand.AddOption(xBitmap: TBitmap; oName: String;OValue:Byte=255;Break:Boolean=False); var txBitmap : TBitmap; begin txBitmap := nil; if assigned(xBitmap) then begin txBitmap := TBitmap.Create; txBitmap.Width := xBitmap.Width; txBitmap.Height := 16; txBitmap.Canvas.Draw(0,0,xBitmap); txBitmap.Transparent := xBitmap.Transparent; bmpWidth := xBitmap.Width; end; Bitmaps.Add(txBitmap); if OValue < 255 then begin oName := oName+'|'+inttostr(oValue); end; if Break then oName := oName+'>'; Options.Add(oName); if assigned(xBitmap) then xBitmap.Free; end; procedure TPCOptionsCommand.Clicked(Sender: TObject); var Control:TControl; pt:Tpoint; begin if not assigned(PopUp) then CreateDialog; PopUp.Value := Value; Control := TControl(Sender); pt := Control.ClientToScreen(Point(0,0)); PopUp.Popup(pt.x,pt.y); end; constructor TPCOptionsCommand.Create; begin inherited; Options:= TStringList.Create; Bitmaps := TList.Create; BmpWidth := 16; UseText := False; end; function TPCOptionsCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cButton : TOptionsCommandButton; w: integer; begin if not assigned(PopUp) then CreateDialog; if assigned(Instance.Button) then begin result := TControl(Instance.Button); exit; end; w := 0; cButton := TOptionsCommandButton.Create(aOwner,Instance); cButton.Parent := TWinControl(aOwner); cButton.Visible := true; cButton.Flat := True; cButton.Font.Name := 'Tahoma'; cButton.Font.Size := 8; cButton.Value := Value; cButton.SelIndex := Index; Instance.Button := cButton; Result := cButton; w := bmpWidth+16; cButton.Width := w; CButton.Hint := Instance.Caption; CButton.ShowHint := True; end; procedure TPCOptionsCommand.CreateDialog; begin PopUp := ToptionsPopUp.Create(nil,Bitmaps,Options,usetext); PopUp.OnOptionChange := OptionChanged; PopUp.Value := Value; end; function TPCOptionsCommand.CreateMenuItem(Menu: TMenu; Instance: TCommandInstance): TCommandMenuItem; var mnItem : TOptionsMenuItem; begin mnItem := TOptionsMenuItem.Create(Menu,Instance,UseText); mnItem.Caption := Instance.Caption; mnItem.OnClick := nil; if assigned(Instance.Bitmap) then begin if mnItem.Bitmap.Width = 0 then begin mnItem.Bitmap.Height := 16; mnItem.Bitmap.Width := 16; end; Instance.Bitmap.Transparent := False; mnItem.Bitmap.Canvas.Draw(0,0,Instance.Bitmap); end else begin if assigned(mnItem.Bitmap) then begin mnItem.Bitmap.Free; mnItem.Bitmap := nil; mnItem.Bitmap := Tbitmap.Create; end; end; mnItem.Value := Value; Result := MnItem; end; destructor TPCOptionsCommand.Destroy; begin if assigned(popUp) then Popup.Free; inherited; end; procedure TPCOptionsCommand.LoadFromStream(Stream: TStream; GUI: TCadInterface); var i,cnt: integer; xBmp,oBmp : TBitmap; txt:string; bool: byte; begin inherited; Stream.Read(cnt,4); Options.Text := ReadStringFromStream(Stream); Stream.Read(bool,1); UseText := (bool = 1); for i := 0 to cnt -1 do begin xBmp := Tbitmap.Create; xBmp.LoadFromStream(Stream); xBmp.Transparent := False; oBmp := Tbitmap.Create; oBmp.Width := xBmp.Width; oBmp.Height := xBmp.Height; oBmp.Canvas.Draw(0,0,xBmp); xBmp.Free; Bitmaps.Add(oBmp); BmpWidth := oBmp.Width; end; end; procedure TPCOptionsCommand.OptionChanged(Sender: Tobject;xValue: Byte;xIndex:Byte); {$ifndef Designer}var Cad: TPowerCad;{$endif} begin {$ifndef Designer} Value := xValue; Index := xIndex; Cad := TPowerCad(CadControl); if (Id=cBrushStyle) and (Value = 8) and assigned(GInterface.FillDialog) then GInterface.FillDialog.Show else begin EventEnabled := False; Cad.CurrentStyle := Value; Cad.ExecuteTBCommand(ID); EventEnabled := True; SyncronizeInstances; end; {$endif} end; procedure TPCOptionsCommand.SetValue(FValue: Byte); var i:Integer; txt:String; Val:String; xVal:Byte; p:Integer; begin Value := FValue; for i := 0 to Options.Count-1 do begin txt := Options[i]; txt := StringReplace(txt,'>','',[]); xVal := i; p := Pos('|',txt); if p > 0 then begin val := Copy(txt,p+1,length(txt)); xVal := StrToInt64Def(val,xVal); end; if xVal = Fvalue then begin Index := i; exit; end; end; end; procedure TPCOptionsCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then TCommandButton(pCom.Button).Enabled := Enabled; if assigned(pCom.MenuItem) then TCommandMenuItem(pCom.MenuItem).Enabled := Enabled; if assigned(pCom.Button) then begin TOptionsCommandButton(pCom.Button).Value := Value; TOptionsCommandButton(pCom.Button).SelIndex := Index; end; if assigned(pCom.MenuItem) then TOptionsMenuItem(pCom.MenuItem).Value := Value; end; end; procedure TPCOptionsCommand.WriteToStream(Stream: TStream); var i: integer; xBmp: TBitmap; cnt: Integer; bool:byte; begin inherited; cnt := Options.Count; Stream.Write(cnt,4); WriteString(Stream,Options.Text); if UseText then bool := 1 else bool := 0; Stream.Write(bool,1); for i := 0 to cnt -1 do begin xbmp := TBitmap(Bitmaps[i]); xbmp.SaveToStream(Stream); end; end; { TOptionsCommandButton } procedure TOptionsCommandButton.Paint; var xRect: TRect; Points: Array [0..2] of Tpoint; xs,ys,l,h: integer; begin inherited; if MouseInControl and enabled then begin xRect := Rect (Width-12,2,Width,20); DrawEdge(Canvas.Handle,xRect,EDGE_ETCHED,BF_LEFT); end; Canvas.Pen.Color := clBlack; Canvas.Brush.Color := clBlack; Canvas.Brush.Style := bsSolid; if not enabled then begin Canvas.Pen.Color := clSilver; Canvas.Brush.Color := clBlack; Canvas.Brush.Style := bsClear; end; xs := width-9; ys := 8; l := 3; h := 3; points[0] := Point(xs,ys); points[1] := Point(xs+l+l,ys); points[2] := Point(xs+l,ys+h); Canvas.Polygon(points); end; procedure TOptionsCommandButton.SetIndex(const Value: Byte); var xBitmap: TBitmap; xCom: TPCOptionsCommand; tr:Boolean; begin FIndex := Value; xCom := TPCOptionsCommand(ComInst.Command); if Fvalue < xCom.Bitmaps.Count then begin xBitmap := TPCOptionsCommand(ComInst.Command).Bitmaps[FIndex]; if assigned(xBitmap) then begin ComBitmap.Width := xBitmap.Width; ComBitmap.Height := 16; tr := xBitmap.Transparent; xBitmap.Transparent := False; ComBitmap.Canvas.Draw(0,0,xBitmap); xBitmap.Transparent := tr; end else begin ComBitmap.Width := 0; ComBitmap.Height := 0; end; end; Refresh; end; procedure TOptionsCommandButton.SetValue(aValue: Byte); begin FValue := aValue; end; { TPCFileCommand } procedure TPCFileNameCommand.Clicked(Sender: TObject); {$ifndef Designer}var Cad: TPowerCad;{$endif} begin {$ifndef Designer} Cad := TPowerCad(CadControl); Cad.CurrentFileName := FileName; Cad.ExecuteTBCommand(ID); if assigned(GroupOwner) then begin GroupOwner.Syncronize(Self); end; {$Endif} end; { TCommandList } Function TCommandList.AddCommand(xCommand: TPcadCommand;BeginGroup:Boolean):TCommandInstance; var i: integer; sInst: TCommandInstance; begin result := nil; if not assigned(xCommand) then exit; ComList.Add(xCommand); sInst := xCommand.CreateInstance; sInst.BeginGroup := BeginGroup; InstList.Add(sInst); result := sInst; end; procedure TCommandList.Clicked(Sender: TObject); var IsMenu: Boolean; Control: TControl; pt: TPoint; begin Control := TControl(Sender); pt := Control.ClientToScreen(Point(0,0)); PopUp.Popup(pt.x,pt.y); end; constructor TCommandList.Create; begin inherited; ComList := TList.Create; InstList := TList.Create; PopUp := Nil; end; procedure TCommandList.CreateContentFromTempList(GUI: TCadInterface); var i: integer; bGrp: Boolean; ComName: String; str: String; tRec : TTempRecord; pCom: TCommandInstance; begin if not assigned(Templist) then exit; for i := 0 to TempList.Count -1 do begin tRec := TTempRecord(TempList[i]); pCom := AddCommand(GUI.FindCommand(trec.ComName),tRec.BeginGroup); if assigned(pCom) then begin pCom.Caption := tRec.Caption; pCom.BitmapChanged := tRec.bmpChanged; if tRec.bmpChanged then begin if tRec.bmpWritten then begin if not assigned(pCom.Bitmap) then begin pCom.Bitmap := Tbitmap.Create; pCom.Bitmap.Width := 16; pCom.Bitmap.Height := 16; end; pCom.Bitmap.Canvas.Draw(0,0,tRec.Bitmap); end else begin if assigned(pCom.Bitmap) then begin pCom.Bitmap.Free; pCom.Bitmap := nil; end; end; end; end; trec.Free; end; TempList.Free; Templist := nil; end; function TCommandList.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cButton : TListCommandButton; i,y: Integer; xCom: TCommandInstance; but: TControl; w,wMax: integer; MenuButton: Boolean; SubItem: TCommandMenuItem; Bevel: TmenuItem; begin if assigned(Instance.Button) then begin cButton := TListCommandButton(Instance.Button); end else begin cButton := TListCommandButton.Create(aOwner,Instance); end; cButton.CapS := 0; w := 0; MenuButton := false; if aOwner is TPCOfficeBar then MenuButton := (TPCOfficeBar(aOwner).Tag = 0); cButton.Parent := TWinControl(aOwner); cButton.Visible := true; cButton.Flat := True; cButton.Font.Name := 'Tahoma'; cButton.Font.Size := 8; if not MenuButton then w := 10; if MenuButton then cButton.Height := 18; if MenuButton then cButton.CapS := 4; if assigned(Instance.Bitmap) and (not MenuButton) then begin if cButton.ComBitmap.Height = 0 then begin cButton.ComBitmap.Height := 16; cButton.ComBitmap.Width := 16; end; Instance.Bitmap.Transparent := False; cButton.ComBitmap.Canvas.Draw(0,0,Instance.Bitmap); w := w + 22; end; if not assigned(Instance.Bitmap) then begin if assigned(cButton.ComBitmap) then begin cButton.ComBitmap.Free; cButton.ComBitmap := TBitmap.Create; end; end; cButton.ComCaption := Instance.Caption; cButton.Width := w + CButton.Canvas.TextWidth(CButton.ComCaption)+8; if cButton.Width < 0 then cButton.Width := 22; Instance.Button := cButton; Result := TControl(Instance.Button); if not assigned(PopUp) then begin PopUp := TPopUpMenu.Create(aOwner); PopUp.OwnerDraw := True; end; PopUp.Items.Clear; For i := 0 to InstList.Count -1 do begin xCom := TCommandInstance(InstList[i]); if xCom.BeginGroup then begin Bevel := TMenuItem.Create(PopUp); Bevel.Caption := '-'; PopUp.Items.Add(Bevel); end; SubItem := nil; SubItem := xCom.Command.CreateMenuItem(PopUp,xCom); if assigned(SubItem) then begin PopUp.Items.Add(SubItem); end; end; end; function TCommandList.CreateInstance: TCommandInstance; begin Result := TCommandInstance.Create(Self,Name,Bitmap); Instances.Add(result); CreateInstances; end; procedure TCommandList.CreateInstances; var i: integer; sInst: TCommandInstance; xCom: TPcadCommand; begin if InstList.Count = 0 then begin for i := 0 to ComList.Count - 1 do begin xCom := TPCadCommand(ComList[i]); sInst := xCom.CreateInstance; InstList.Add(sInst); end; end; end; function TCommandList.CreateMenuItem(Menu: TMenu; Instance: TCommandInstance): TCommandMenuItem; var i: Integer; xCom: TCommandInstance; mnItem,SubItem: TCommandMenuItem; Bevel: TMenuItem; begin mnItem := inherited CreateMenuItem(Menu,Instance); mnItem.OnClick := nil; For i := 0 to InstList.Count -1 do begin xCom := TCommandInstance(InstList[i]); if xCom.BeginGroup then begin Bevel := TMenuItem.Create(Menu); Bevel.Caption := '-'; mnItem.Add(Bevel); end; SubItem := nil; SubItem := xCom.Command.CreateMenuItem(Menu,xCom); if assigned(SubItem) then begin mnItem.Add(SubItem); xCom.MenuItem := SubItem; end; end; Result := mnItem; end; destructor TCommandList.Destroy; var i: integer; pCom: TCommandInstance; begin for i := 0 to InstList.Count -1 do begin pCom := TCommandInstance(InstList[i]); pCom.Free; end; InstList.Free; ComList.Free; if assigned(TempList) then begin Templist.Free; TempList := nil; end; if assigned(Popup) then begin //popup.free; popup := nil; end; inherited; end; procedure TCommandList.LoadFromStream(Stream: TStream;GUI:TcadInterface); var Comcnt,i: integer; comName,cap:String; bool: byte; ComId: Integer; bgGroup,bmpChanged,bmpWritten: Byte; xBmp: Tbitmap; tRec: TtempRecord; begin inherited; Templist := TList.Create; ComCnt := 0;Stream.Read(ComCnt,4); for i := 0 to ComCnt-1 do begin tRec := TTempRecord.Create; Stream.Read(comId,4); comName := ReadStringFromStream(Stream); cap := ReadStringFromStream(Stream); Stream.Read(bgGroup,1); Stream.Read(bmpChanged,1); // bitmap changed Stream.Read(bmpWritten,1); // bitmap written tRec.ComName := ComName; tRec.Caption := Cap; tRec.BeginGroup := (bgGroup = 1); tRec.BmpChanged := (bmpChanged = 1); tRec.BmpWritten := (bmpWritten = 1); tRec.Bitmap := nil; if tRec.BmpWritten then begin tRec.Bitmap := TBitmap.Create; tRec.Bitmap.LoadFromStream(Stream); end; TempList.Add(trec); end; (* for i := 0 to Cnt -1 do begin ComName := ReadStringFromStream(Stream); Stream.Read(Bool,1); TempList.Add(Inttostr(bool)+ComName); end; *) end; procedure TCommandList.RemoveCommand(xCommand: TPCadCommand); var idx: integer; sInst: TCommandInstance; begin idx := ComList.IndexOf(xCommand); ComList.Delete(idx); sInst := TCommandInstance(InstList[idx]); InstList.delete(Idx); sInst.Free; end; procedure TCommandList.SyncronizeInstances; begin inherited; end; procedure TCommandList.WriteToStream(Stream: TStream); var i:integer; pCom : TCommandInstance; ComId: Integer; bool:byte; begin inherited; Stream.Write(ComList.Count,4); for i := 0 to ComList.Count -1 do begin pCom := TCommandInstance(InstList[i]); comId := pcom.Command.Id; Stream.Write(comId,4); WriteString(Stream,pcom.Command.Name); WriteString(Stream,pcom.Caption); if pCom.BeginGroup then bool := 1 else bool := 0; Stream.Write(bool,1); if (pCom.bitmapchanged) then bool := 1 else bool := 0; Stream.Write(bool,1); if assigned(pCom.Bitmap) and (pCom.bitmapchanged) then begin bool := 1;Stream.Write(bool,1); pCom.Bitmap.SaveToStream(Stream); end else begin bool := 0;Stream.Write(bool,1); end; end; end; { TPCBrushStyleCommand } function TPCBrushStyleCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cCombo: TBSCommandCombo; begin if assigned(Instance.Button) then begin result := TControl(Instance.Button); exit; end; cCombo := TBSCommandCombo.Create(aOwner,Instance); cCombo.Parent := TWinControl(aOwner); cCombo.Visible := true; cCombo.Width := 90; cCombo.Font.Name := 'Tahoma'; cCombo.Font.Size := 8; Instance.Button := cCombo; Result := cCombo; end; { TPCPenStyleCommand } function TPCPenStyleCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cCombo: TPSCommandCombo; begin if assigned(Instance.Button) then begin result := TControl(Instance.Button); exit; end; cCombo := TPSCommandCombo.Create(aOwner,Instance); cCombo.Parent := TWinControl(aOwner); cCombo.Visible := true; cCombo.Width := 90; cCombo.Font.Name := 'Tahoma'; cCombo.Font.Size := 8; Instance.Button := cCombo; Result := cCombo; end; { TPCRowStyleCommand } function TPCRowStyleCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cCombo: TRSCommandCombo; begin if assigned(Instance.Button) then begin result := TControl(Instance.Button); exit; end; cCombo := TRSCommandCombo.Create(aOwner,Instance); cCombo.Parent := TWinControl(aOwner); cCombo.Visible := true; cCombo.Width := 90; cCombo.Font.Name := 'Tahoma'; cCombo.Font.Size := 8; Instance.Button := cCombo; Result := cCombo; end; { TPCPenWidthCommand } function TPCPenWidthCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cCombo: TPWCommandCombo; begin if assigned(Instance.Button) then begin result := TControl(Instance.Button); exit; end; cCombo := TPWCommandCombo.Create(aOwner,Instance); cCombo.Parent := TWinControl(aOwner); cCombo.Visible := true; cCombo.Width := 90; cCombo.Font.Name := 'Tahoma'; cCombo.Font.Size := 8; Instance.Button := cCombo; Result := cCombo; end; { TListCommandButton } procedure TListCommandButton.Paint; var xRect: TRect; Points: Array [0..2] of Tpoint; xs,ys,l,h: integer; MenuButton: Boolean; begin MenuButton := false; if Owner is TPCOfficeBar then MenuButton := (TPCOfficeBar(Owner).Tag = 0); inherited; if MouseInControl and (not MenuButton) then begin xRect := Rect (Width-12,2,Width,20); DrawEdge(Canvas.Handle,xRect,EDGE_ETCHED,BF_LEFT); end; Canvas.Pen.Color := clBlack; Canvas.Brush.Color := clBlack; Canvas.Brush.Style := bsSolid; if not enabled then begin Canvas.Pen.Color := clSilver; Canvas.Brush.Style := bsClear; end; xs := width-9; ys := 8; l := 3; h := 3; points[0] := Point(xs,ys); points[1] := Point(xs+l+l,ys); points[2] := Point(xs+l,ys+h); if not MenuButton then Canvas.Polygon(points); end; { TGUIProperty } (* procedure TGUIProperty.Edit; var GUI: TcadInterface; frm: TFrmCustom; Stream: TFileStream; begin GUI := TCadInterface(GetOrdValue); if FileExists(GUI.FileName) then begin Stream := TFileStream.Create(GUI.FileName,fmOpenRead); GUI.LoadFromStream(Stream); Stream.Free; end; frm := TFrmCustom.Create(Application); frm.GUI := GUI; frm.DesignMode := True; frm.ch1.Checked := not GUI.Enabled; frm.ch2.Checked := GUI.CanCustomize; frm.ShowModal; frm.Free; Designer.Modified; Stream := TFileStream.Create(GUI.FileName,fmCreate); GUI.SaveToStream(Stream); Stream.Free; end; function TGUIProperty.GetAttributes: TpropertyAttributes; begin result := [paDialog]; end; *) destructor TToolbarDef.Destroy; var pCom:TCommandInstance; i: integer; begin for i := 0 to Commands.Count -1 do begin pCom := TCommandInstance(Commands[i]); pCom.free; end; Commands.Clear; Commands.Free; if assigned(Toolbar) then Toolbar.Free; inherited destroy; end; { TCommandInstance } constructor TCommandInstance.Create(aCommand: TPcadCommand; aCaption:String; aBitmap:Graphics.TBitmap); begin inherited Create; Command := aCommand; Caption := aCaption; BitmapChanged := False; Button := Nil; Bevel := Nil; Bitmap := nil; if assigned(aBitmap) then begin Bitmap := TBitmap.Create; Bitmap.Height := 16; Bitmap.Width := 16; aBitmap.Transparent := False; Bitmap.Canvas.Draw(0,0,aBitmap); end; end; destructor TCommandInstance.Destroy; begin if assigned(bitmap) then bitmap.free; if assigned(button) then button.free; if assigned(bevel) then bevel.free; Command.Instances.Remove(self); inherited destroy; end; { TGroupList } constructor TGroupList.Create(aName: String;Owner:Pointer); begin inherited Create; Name := aName; EventId := 0; CadControl:= Owner; end; destructor TGroupList.Destroy; begin {$ifndef Designer} if assigned(EventHandle) then begin TPowerCad(CadControl).UnRegisterEvent(EventId,EventHandle); end; {$endif} inherited; end; procedure TGroupList.Syncronize(dCom: TObject); var Command: TPCadCommand; i: integer; xCom: TPcadCommand; k: integer; pCom : TCommandInstance; begin Command := nil; if assigned(dCom) then begin Command := TPcadCommand(dCom); for k := 0 to Command.Instances.Count -1 do begin pCom := TCommandInstance(Command.Instances[k]); TcommandButton(pCom.Button).Down := True; end; end; for i := 0 to Count-1 do begin xCom := TPCadCommand(Items[i]); if (xCom <> Command) then begin for k := 0 to xCom.Instances.Count -1 do begin pCom := TCommandInstance(xCom.Instances[k]); TcommandButton(pCom.Button).Down := false; end; end; end; end; procedure GUIEventCallback(Client:TObject; EventId: Integer; NumVal:Integer; Strval:String; DblVal:Double; Enabled:Boolean);stdcall; var pCom: TPcadCommand; gList: TGroupList; cInt: TCadInterface; begin {$ifndef Designer} if EventId = cDrawTool then begin cInt := TCadInterface(Client); cInt.SetToolIndex; end else if Client is TPcadCommand then begin pCom := TPcadCommand(Client); if pCom.EventEnabled then begin pCom.Enabled := Enabled; if pCom is TPCOptionsCommand then TPCOptionsCommand(pCom).SetValue(NumVal) else if pCom is TPCColorCommand then TPCColorCommand(pCom).Color := NumVal else if pCom is TPCFontNameCommand then TPCFontNameCommand(pCom).FontName := StrVal else if pCom is TPCToggleCommand then TPCToggleCommand(pCom).Flag := (NumVal = 1) else if pCom is TPCTextSizeCommand then TPCTextSizeCommand(pCom).Value := Dblval else if pCom is TInfoCommand then TInfoCommand(pCom).Info := StrVal; pCom.SyncronizeInstances; end; end; {$endif} end; { TToolCommand } procedure TToolCommand.Clicked(Sender: TObject); {$ifndef Designer}var Cad: TPowerCad;{$Endif} begin {$ifndef Designer} Cad := TPowerCad(CadControl); EventEnabled := False; Cad.SetTool(TPCTool(ToolIndex),ToolName,0); EventEnabled := True; GInterface.SetToolIndex; {$endif} end; constructor TToolCommand.Create; begin inherited; ToolIndex := 0; ToolName := ''; Selected := False; end; Procedure TToolCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then TCommandButton(pCom.Button).Enabled := Enabled; if assigned(pCom.Button) then TCommandButton(pCom.Button).Down := Selected; if assigned(pCom.MenuItem) then TCommandMenuItem(pCom.MenuItem).Enabled := Enabled; if assigned(pCom.MenuItem) then TCommandMenuItem(pCom.MenuItem).Checked := Selected; end; end; function TToolCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; begin result := inherited CreateControl(aOwner,Instance); TCommandButton(Result).GroupIndex := integer(Instance); TCommandButton(Result).AllowAllUp := True; TCommandButton(Result).Down := Selected; end; Procedure TToolCommand.WriteToStream(Stream: TStream); var sel: Byte; begin inherited; Stream.Write(ToolIndex,1); if Selected then Sel := 1 else sel := 0; Stream.Write(Sel,1); WriteString(Stream,ToolName); end; Procedure TToolCommand.LoadFromStream(Stream:TStream;GUI:TCadInterface); var sel: Byte; begin inherited; Stream.Read(ToolIndex,1); Stream.Read(Sel,1); Selected := (Sel = 1); Toolname := ReadStringFromStream(Stream); end; { TCommandMenuItem } constructor TCommandMenuItem.Create(aOwner: TComponent; aCom:TCommandInstance); begin inherited Create(aOwner); ComInst := aCom; OnClick := ComInst.Command.Clicked; Bitmap := TBitmap.Create; Caption := ''; OnAdvancedDrawItem := SelfAdvancedDrawItem; OnMeasureItem := SelfMeasureItem; FOwnerDraw := True; //Caps := 0; end; destructor TCommandMenuItem.Destroy; begin if assigned(bitmap) then bitmap.free; if assigned(ComInst) then ComInst.MenuItem := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited; end; procedure TCommandMenuItem.SelfAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var Caps: Integer; xCaption : String; i: Integer; xRect: Trect; begin xCaption := ComInst.Caption; ACanvas.Font.Color := clBlack; Acanvas.Brush.Color := clMenu; Acanvas.Brush.Style := bsSolid; ACanvas.FillRect(ARect); Acanvas.Pen.Style := psSolid; ACanvas.Pen.Color := ClBlack; xRect := Rect(Arect.Left+2, Arect.Top+2, Arect.Right-2,Arect.Bottom-2); if odChecked in State then begin Acanvas.Brush.Color := RGB(230,230,230); Acanvas.FillRect(xRect); DrawEdge(Acanvas.handle,xRect,BDR_SUNKENOUTER,BF_RECT); end; if (odSelected in State) and not (odDisabled in State) then begin DrawEdge(Acanvas.handle,xRect,BDR_RAISEDINNER,BF_RECT); end; if Bitmap.Width > 0 then begin Bitmap.Transparent := True; DrawBitmap(ACanvas,Bitmap,ARect.Left+3,Arect.Top+4,Enabled); end; ACanvas.Brush.Style := bSClear; Caps := Arect.Left+24; if Enabled then begin ACanvas.Font.Color := clBlack; ACanvas.textOut(Caps,Arect.Top+4,xCaption); end else begin ACanvas.Font.Color := clWhite; ACanvas.textOut(Caps+1,Arect.Top+5,xCaption); ACanvas.Font.Color := clGray; ACanvas.textOut(Caps,Arect.Top+4,xCaption); end; ACanvas.Brush.Style := bsSolid; end; procedure TCommandMenuItem.SelfMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); begin Width := ACanvas.TextWidth(Caption)+18; Height := 24; end; procedure TCommandMenuItem.SetBitmap(aBitmap: TBitmap); begin end; procedure TCommandMenuItem.SetOwnerDraw(const Value: Boolean); begin FOwnerDraw := Value; if value then begin OnAdvancedDrawItem := SelfAdvancedDrawItem; OnMeasureItem := SelfMeasureItem; end else begin OnAdvancedDrawItem := nil; OnMeasureItem := nil; end; end; { TColorMnItem } constructor TColorMnItem.Create(aOwner: TComponent; aCom: TCommandInstance); var cItem:TMenuItem; i,k:integer; begin inherited; for i := 1 to 5 do begin for k := 1 to 10 do begin cItem := TMenuItem.Create(self); Self.Add(cItem); if (i = 1) and (k = 1) then begin CItem.Tag := -255;CItem.Hint := csLayerDefault; end else if (i = 5) and (k = 10) then begin CItem.Tag := -500;Citem.Hint := csMoreColors; end else cItem.Tag := BasicColors[((k-1)*5+i)-1]; cItem.Caption := inttostr(k); cItem.OnMeasureItem := ChildMeasureItem; cItem.OnAdvancedDrawItem := ChildAdvancedDrawItem; cItem.OnClick := ColorSelected; if (i>1) and (k=1) then cItem.Break := mbBreak; if (k = 4) and (i=3) then begin cItem.Checked := true; SelectedItem := cItem; end; end; end; end; procedure TColorMnItem.SelfAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var ctext,xCaption: String; i: Integer; textStart,rectStart: Integer; Begin xCaption := ComInst.Caption; ACanvas.Font.Color := clBlack; Acanvas.Brush.Color := clMenu; Acanvas.Brush.Style := bsSolid; ACanvas.FillRect(ARect); Acanvas.Pen.Style := psSolid; ACanvas.Pen.Color := ClBlack; if (odSelected in State) and not (odDisabled in State) then begin DrawEdge(Acanvas.handle,ARect,BDR_RAISEDINNER,BF_RECT); end; if assigned(Bitmap) then begin Bitmap.Transparent := True; DrawBitmap(ACanvas,Bitmap,Arect.Left+3,ARect.top+3,Enabled); end; if fColor = -255 then begin Acanvas.Brush.Color := clRed; cText:= 'L'; end else begin Acanvas.Brush.Color := FColor; cText:= ''; end; RectStart := aRect.left + 24; TextStart := aRect.left + 38; if odDisabled in State then begin Acanvas.Brush.Color := clSilver; ACanvas.Pen.Color := clSilver; Acanvas.Brush.Style := bsClear; Acanvas.Rectangle(RectStart, Arect.Top+5,RectStart+10,Arect.Top+15); end else Acanvas.Rectangle(RectStart, Arect.Top+5,RectStart+10,Arect.Top+15); Acanvas.Brush.Style := bsClear; if odDisabled in State then begin ACanvas.Font.Color := clWhite; Acanvas.TextOut(TextStart+1,Arect.Top+4,xCaption); ACanvas.Font.Color := clGray; Acanvas.TextOut(TextStart,Arect.Top+3,xCaption); end else begin Acanvas.TextOut(TextStart,Arect.Top+3,xCaption); end; if enabled and (Ctext <> '') then begin ACanvas.Font.Name := 'Tahoma'; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Size := 7; ACanvas.Font.Color := clWhite; Acanvas.TextOut(RectStart + 2,Arect.Top+4,Ctext); end; end; procedure TColorMnItem.SelfMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); var xCaption: String; begin xCaption := ComInst.Caption; Width := ACanvas.TextWidth(xCaption)+40; Height := 22; end; procedure TColorMnItem.ChildMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); begin width := 2; Height := 16; end; procedure TColorMnItem.ChildAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var xRect: Trect; xColor:Integer; text: string; begin text := ''; Acanvas.Brush.Color := clMenu; Acanvas.Brush.Style := bsSolid; Acanvas.FillRect(aRect); xColor := TMenuItem(Sender).Tag; if xColor = -255 then begin Acanvas.Brush.Color := 255;Text := 'L'; end else if xColor = -500 then begin Acanvas.Brush.Color := clNavy;Text := 'M'; end else Acanvas.Brush.Color := xColor; Acanvas.Pen.Color := clBlack; Acanvas.Pen.Style := psSolid; Acanvas.Pen.Width := 1; xRect := Rect(Arect.left+1,ARect.Top+2,Arect.Right-1,Arect.Bottom-2); if odSelected in State then begin Acanvas.Rectangle(aRect); end else begin Acanvas.Rectangle(xRect); end; if odChecked in State then begin Acanvas.Pen.Color := clMenu; Acanvas.Pen.Style := psSolid; Acanvas.Pen.Width := 2; DrawEdge(Acanvas.handle,xRect,EDGE_SUNKEN,BF_RECT); end; If text <> '' then begin ACanvas.Font.Name := 'Tahoma'; ACanvas.Font.Size := 7; ACanvas.Font.Style := [fsBold]; Acanvas.Font.Color := clWhite; Acanvas.Brush.Style := bsClear; Drawtext(Acanvas.handle,pChar(Text),1,xRect,DT_VCENTER or DT_CENTER); end; end; Procedure TColorMnItem.ColorSelected(Sender:TObject); var dlg: TColorDialog; sColor:TColor; begin sColor := (Sender as TmenuItem).Tag; if SColor <> - 500 then begin (Sender as TMenuItem).Checked := True; FColor := SColor; SelectedItem.Checked := False; SelectedItem := (Sender as TMenuItem); end else begin dlg := TColorDialog.Create(Self); dlg.Color := FColor; if dlg.Execute then begin SelectedItem.Checked := False; Color := dlg.Color; end; end; TPCColorCommand(ComInst.Command).ColorChanged(Sender,Color); end; procedure TColorMnItem.SetColor(Value: TColor); var i: Integer; cItem: TmenuItem; begin For i := 0 to Count-1 do begin cItem := Items[i]; cItem.Checked := False; if cItem.Tag = Value then begin cItem.Checked := true; SelectedItem := cItem; end; end; FColor := Value; end; { TOptionsMenuItem } procedure TOptionsMenuItem.ChildAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var xBitmap: TBitmap; ctext,xCaption: String; i: Integer; textStart,rectStart: Integer; xRect: Trect; begin xBitmap := TBitmap(Bitmaps[(Sender as TMenuItem).Tag]); ACanvas.Font.Color := clBlack; Acanvas.Brush.Color := clMenu; Acanvas.Brush.Style := bsSolid; ACanvas.FillRect(ARect); Acanvas.Pen.Style := psSolid; ACanvas.Pen.Color := ClBlack; xRect := Rect(Arect.Left+2, Arect.Top+2, Arect.Right-2,Arect.Bottom-2); xCaption := Options[(Sender as TMenuItem).Tag]; if odChecked in State then begin Acanvas.Brush.Color := RGB(230,230,230); Acanvas.FillRect(xRect); DrawEdge(Acanvas.handle,xRect,BDR_SUNKENOUTER,BF_RECT); end; if odSelected in State then begin DrawEdge(Acanvas.handle,xRect,BDR_RAISEDINNER,BF_RECT); end; if assigned(xBitmap) then begin xBitmap.Transparent := True; ACanvas.Draw(Arect.Left+6,ARect.top+6,xBitmap); xBitmap.Transparent := False; end; if useText then begin Acanvas.Brush.Style := bsClear; Acanvas.textOut(aRect.Left+BmpWidth+12,aRect.top+6,xCaption); end; end; procedure TOptionsMenuItem.ChildMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); begin Width := BmpWidth; Height := BmpHeight+12; if useText then Width := Width + Acanvas.textWidth((sender as TMenuItem).Hint)+8; end; constructor TOptionsMenuItem.Create(aOwner: TComponent; aCom: TCommandInstance;aUseText: Boolean); var cItem:TMenuItem; i,k:integer; xBitmap: Tbitmap; begin inherited Create(aOwner,aCom); UseText := aUsetext; FValue := 0; Bitmaps := TPCOptionsCommand(aCom.Command).Bitmaps; Options := TPCOptionsCommand(aCom.Command).Options; if not Assigned(Options) then exit; if not Assigned(Bitmaps) then exit; xBitmap := TBitmap(Bitmaps[0]); if assigned(xBitmap) then begin BmpWidth := TBitmap(Bitmaps[0]).Width; BmpHeight := TBitmap(Bitmaps[0]).Height; end else begin BmpWidth := 4; BmpHeight := 22; end; for i := 0 to Options.Count -1 do begin cItem := TMenuItem.Create(self); cItem.Tag := i; Self.Add(cItem); cItem.Caption := inttostr(i); cItem.Hint := Options[i]; cItem.OnMeasureItem := ChildMeasureItem; cItem.OnAdvancedDrawItem := ChildAdvancedDrawItem; cItem.OnClick := OptionSelected; if i = FValue then begin cItem.Checked := true; SelectedItem := cItem; end; end; end; procedure TOptionsMenuItem.OptionSelected(Sender: TObject); var mnItem: TmenuItem; begin mnItem := Sender as TMenuItem; if assigned(SelectedItem) then SelectedItem.Checked := False; Value := mnItem.Tag; FIndex := Self.IndexOf(mnItem); TPCOptionsCommand(ComInst.Command).OptionChanged(Self,Value,FIndex); end; procedure TOptionsMenuItem.SelfAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var xBitmap: TBitmap; xCaption: String; begin xBitmap := TBitmap(Bitmaps[Value]); xCaption := ComInst.Caption; ACanvas.Font.Color := clBlack; Acanvas.Brush.Color := clMenu; Acanvas.Brush.Style := bsSolid; ACanvas.FillRect(ARect); Acanvas.Pen.Style := psSolid; ACanvas.Pen.Color := ClBlack; if enabled and (odSelected in State) then begin DrawEdge(Acanvas.handle,ARect,BDR_RAISEDINNER,BF_RECT); end; if assigned(xBitmap) then begin xBitmap.Transparent := True; DrawBitmap(Acanvas,xBitmap,ARect.Left+3,Arect.Top+3,Enabled); xBitmap.Transparent := False; end; if enabled then begin ACanvas.Brush.Style := bSClear; ACanvas.textOut(ARect.Left+7+BmpWidth,Arect.Top+3,xCaption); end else begin ACanvas.Brush.Style := bSClear; ACanvas.Font.Color := clWhite; ACanvas.textOut(ARect.Left+8+BmpWidth,Arect.Top+4,xCaption); ACanvas.Font.Color := clGray; ACanvas.textOut(ARect.Left+7+BmpWidth,Arect.Top+3,xCaption); end; end; procedure TOptionsMenuItem.SelfMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); begin Width := BMpWidth + Acanvas.TextWidth(ComInst.Caption)+5; Height := 22; end; procedure TOptionsMenuItem.setValue(const xValue: Byte); var i: Integer; cItem:TmenuItem; begin FValue := xValue; if FValue < 0 then FValue := 0; if FValue > Options.Count -1 then FValue := 0; For i := 0 to Count-1 do begin cItem := Items[i]; cItem.Checked := False; if cItem.Tag = FValue then begin cItem.Checked := true; SelectedItem := cItem; end; end; end; { TOptionsPopUp } procedure TOptionsPopUp.ChildAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var xBitmap: TBitmap; ctext,xCaption: String; i: Integer; textStart,rectStart: Integer; xRect:Trect; index: Integer; begin index := Self.Items.IndexOf(Sender as TMenuItem); xBitmap := TBitmap(Bitmaps[Index]); ACanvas.Font.Color := clBlack; Acanvas.Brush.Color := clMenu; Acanvas.Brush.Style := bsSolid; ACanvas.FillRect(ARect); Acanvas.Pen.Style := psSolid; ACanvas.Pen.Color := ClBlack; Acanvas.Brush.Color := clBlack; xRect := Rect(Arect.Left+2, Arect.Top+2, Arect.Right-2,Arect.Bottom-2); if odChecked in State then begin Acanvas.Brush.Color := RGB(230,230,230); Acanvas.FillRect(xRect); DrawEdge(Acanvas.handle,xRect,BDR_SUNKENOUTER,BF_RECT); end; if odSelected in State then begin DrawEdge(Acanvas.handle,xRect,BDR_RAISEDINNER,BF_RECT); end; if assigned(xBitmap) then begin xBitmap.Transparent := True; ACanvas.Draw(Arect.Left+6,ARect.top+6,xBitmap); end; if useText then begin ACanvas.Brush.Style := bSClear; Acanvas.textOut(aRect.Left+BmpWidth+12,aRect.top+6,(Sender as TMenuItem).Hint); end; end; procedure TOptionsPopUp.ChildMeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); var cItem: TMenuItem; index: Integer; begin cItem := sender as TMenuItem; index := Self.Items.IndexOf(cItem); Width := BmpWidth; Height := BmpHeight+12; //if index = 2 then Height := Height+16; if useText then Width := Width + Acanvas.textWidth(cItem.Hint)+8; end; constructor TOptionsPopUp.Create(aOwner: TComponent; aBitmaps: Tlist; aOptions: TStringList;aUsetext:Boolean); var cItem: TMenuItem; i,k,p:integer; xBitmap: TBitmap; txt: String; val: String; begin inherited Create(aOwner); Usetext := aUseText; OwnerDraw := True; FValue := 0; Bitmaps := aBitmaps; Options := AOptions; xBitmap := TBitmap(Bitmaps[0]); if assigned(xBitmap) then begin BmpWidth := TBitmap(Bitmaps[0]).Width; BmpHeight := TBitmap(Bitmaps[0]).Height; end else begin BmpWidth := 4; BmpHeight := 22; end; if not Assigned(Options) then exit; if not Assigned(Bitmaps) then exit; for i := 0 to Options.Count -1 do begin cItem := TMenuItem.Create(self); cItem.Tag := i; Items.Add(cItem); cItem.Caption := inttostr(i); txt := Options[i]; if Pos('>',txt) > 0 then begin cItem.Break := mbBarBreak; txt := StringReplace(txt,'>','',[]); end; p := Pos('|',txt); if p > 0 then begin Val := Copy(txt,p+1,Length(txt)); cItem.Tag := StrToInt64Def(Val,i); txt := copy(txt,1,p-1); end; cItem.Hint := txt; cItem.OnMeasureItem := ChildMeasureItem; cItem.OnAdvancedDrawItem := ChildAdvancedDrawItem; cItem.OnClick := OptionSelected; if i = FValue then begin cItem.Checked := true; SelectedItem := cItem; end; end; end; procedure TOptionsPopUp.OptionSelected(Sender: TObject); var mnItem: TmenuItem; begin mnItem := Sender as TMenuItem; if assigned(SelectedItem) then SelectedItem.Checked := False; Value := mnItem.Tag; FIndex := Self.Items.IndexOf(mnItem); if assigned(FOptionChange) then FOptionChange(Self,Value,FIndex); end; procedure TOptionsPopUp.setValue(const xValue: Byte); var i: Integer; cItem:TmenuItem; begin For i := 0 to Items.Count-1 do begin cItem := Items[i]; cItem.Checked := False; if cItem.Tag = xValue then begin cItem.Checked := true; SelectedItem := cItem; end; end; FValue := xValue; end; { TTempRecord } Constructor TTempRecord.Create; begin inherited; Bitmap := nil; end; destructor TTempRecord.Destroy; begin if assigned(Bitmap) then Bitmap.Free; inherited; end; { TTextSizeCommandCombo } procedure TTextSizeCommandCombo.Clicked(Sender: TObject); {$ifndef Designer}var CadControl: TPowerCad;{$endif} begin {$ifndef Designer} TPCTextSizeCommand(ComInst.Command).Value := StrToFloat_My(Text); CadControl := TPowerCad(ComInst.Command.CadControl); CadControl.CurrentValue := StrToFloat_My(Text); CadControl.ExecuteTBCommand(ComInst.Command.ID); ComInst.Command.SyncronizeInstances; {$endif} end; constructor TTextSizeCommandCombo.Create(aOwner: TComponent; aCom: TCommandInstance); begin inherited create(aOwner); ComInst := aCom; OnChange := Clicked; end; destructor TTextSizeCommandCombo.Destroy; begin if assigned(ComInst) then ComInst.Button := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited; end; { TPCTextSizeCommand } Constructor TPCTextSizeCommand.Create; begin inherited; CanMenu := False; end; function TPCTextSizeCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var cCombo: TTextSizeCommandCombo; begin if assigned(Instance.Button) then begin result := TControl(Instance.Button); exit; end; cCombo := TTextSizeCommandCombo.Create(aOwner,Instance); cCombo.Parent := TWinControl(aOwner); cCombo.Visible := true; cCombo.Width := 45; cCombo.Font.Name := 'Tahoma'; cCombo.Font.Size := 8; Instance.Button := cCombo; cCombo.Items.Add('4');cCombo.Items.Add('5'); cCombo.Items.Add('6');cCombo.Items.Add('7'); cCombo.Items.Add('8');cCombo.Items.Add('9'); cCombo.Items.Add('10');cCombo.Items.Add('11'); cCombo.Items.Add('12');cCombo.Items.Add('13'); cCombo.Items.Add('14');cCombo.Items.Add('15'); cCombo.Items.Add('20');cCombo.Items.Add('22'); cCombo.Items.Add('24');cCombo.Items.Add('28'); cCombo.Items.Add('30');cCombo.Items.Add('36'); cCombo.Items.Add('38');cCombo.Items.Add('40'); Result := cCombo; end; procedure TPCTextSizeCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then TTextSizeCommandCombo(pCom.Button).Enabled := Enabled; if assigned(pCom.Button) then TTextSizeCommandCombo(pCom.Button).Text := FloatToStr(Value); end; end; { TInfoCommand } function TInfoCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var pan: TPanel; begin if assigned(Instance.Button) then begin result := TControl(Instance.Button); exit; end; pan := TCommandPanel.Create(aOwner,Instance); Pan.Tag := Id; Pan.OnClick := Clicked; Instance.Button := pan; Result := pan; end; procedure TInfoCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin if not enabled then Info := ''; for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then TCommandPanel(pCom.Button).Caption := Info; if assigned(pCom.Button) then TCommandPanel(pCom.Button).Enabled := Enabled; end; end; Procedure TInfoCommand.Clicked(Sender:TObject); begin //*** end; { TEditCommand } constructor TEditCommand.Create; begin inherited; History := TstringList.Create; HId := 0; end; function TEditCommand.CreateControl(aOwner: TComponent; Instance: TCommandInstance): TControl; var edit: TEdit; begin if assigned(Instance.Button) then begin result := TControl(Instance.Button); exit; end; edit := TCommandEdit.Create(aOwner,Instance); edit.OnKeyUp := KeyClicked; edit.Tag := Id; Instance.Button := edit; Result := edit; end; destructor TEditCommand.Destroy; begin History.free; inherited; end; procedure TEditCommand.KeyClicked(Sender: TObject; var Key: Word; Shift: TShiftState); var edit: TCommandEdit; begin edit := sender as TCommandEdit; if Key = vk_up then begin if HId < History.Count-1 then begin HId := HId+1; Text := History[HId]; SyncronizeInstances; end else if HId = History.Count-1 then begin HId := HId+1; Text := ''; SyncronizeInstances; end; end else if Key = vk_down then begin if (HId > 0) then begin HId := HId-1; Text := History[HId]; SyncronizeInstances; end; end else if Key = vk_return then begin Text := edit.Text; if HId = History.Count then begin History.Add(Text); HId := History.Count-1; end; {$ifndef Designer} if assigned(CadControl) then begin TPowerCad(CadControl).CurrentString := Text; if Id = -1 then TPowerCad(CadControl).ExecuteCustomCommand(Name) else TPowerCad(CadControl).ExecuteTBCommand(ID); end; {$endif} SyncronizeInstances; end; end; procedure TEditCommand.SyncronizeInstances; var i: integer; pCom: TCommandInstance; begin for i := 0 to instances.count-1 do begin pCom := TCommandInstance(Instances[i]); if assigned(pCom.Button) then TEdit(pCom.Button).Text := Text; if assigned(pCom.Button) then TEdit(pCom.Button).Enabled := Enabled; end; end; { TCommandPanel } constructor TCommandPanel.Create(aOwner: TComponent; aCom: TCommandInstance); begin inherited Create(aOwner); ComInst := aCom; Parent := TWinControl(aOwner); Visible := true; Width := 120; Height := 18; BevelInner := bvNone; BevelOuter := bvLowered; Alignment := taLeftJustify; Font.Name := 'Tahoma'; Font.Size := 8; end; destructor TCommandPanel.Destroy; begin if assigned(ComInst) then ComInst.Button := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited destroy;; end; { TCommandEdit } constructor TCommandEdit.Create(aOwner: TComponent; aCom: TCommandInstance); begin inherited Create(aOwner); ComInst := aCom; Parent := TWinControl(aOwner); Visible := True; Width := 120; Font.Name := 'Courier New'; Font.Size := 10; end; destructor TCommandEdit.Destroy; begin if assigned(ComInst) then ComInst.Button := nil; if assigned(ComInst) then ComInst.Bevel := nil; inherited destroy;; end; initialization CommandClasses := TList.Create; CommandClasses.Add(TPcadCommand); CommandClasses.Add(TPCColorCommand); CommandClasses.Add(TPCToggleCommand); CommandClasses.Add(TPCFileNameCommand); CommandClasses.Add(TPCOptionsCommand); CommandClasses.Add(TCommandList); CommandClasses.Add(TPCBrushStyleCommand); CommandClasses.Add(TPCPenStyleCommand); CommandClasses.Add(TPCRowStyleCommand); CommandClasses.Add(TPCPenWidthCommand); CommandClasses.Add(TPCFontNameCommand); CommandClasses.Add(TPCTextSizeCommand); CommandClasses.Add(TToolCommand); CommandClasses.Add(TInfoCommand); CommandClasses.Add(TEditCommand); finalization CommandClasses.Free; end.