mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
5461 lines
159 KiB
ObjectPascal
5461 lines
159 KiB
ObjectPascal
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.
|
|
|