mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 22:45:39 +02:00
1188 lines
34 KiB
ObjectPascal
1188 lines
34 KiB
ObjectPascal
unit pcCustomForm;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
ComCtrls, StdCtrls, Buttons, CheckLst, Menus, ExtCtrls,
|
|
GUIStrings,PCTypesUtils,ClipBrd,pcMsbar;
|
|
|
|
type
|
|
TfrmCustom = class(TForm)
|
|
lbCat: TListBox;
|
|
lbCom: TListBox;
|
|
PageControl1: TPageControl;
|
|
TabSheet1: TTabSheet;
|
|
TabSheet2: TTabSheet;
|
|
lbToolBars: TCheckListBox;
|
|
newTB: TSpeedButton;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
newMn: TSpeedButton;
|
|
Bevel1: TBevel;
|
|
Bevel2: TBevel;
|
|
lbTbCom: TListBox;
|
|
lbMnCom: TListBox;
|
|
lbMenus: TListBox;
|
|
PopupMenu2: TPopupMenu;
|
|
mnGrp: TMenuItem;
|
|
ChangeCaption1: TMenuItem;
|
|
mnBmp1: TMenuItem;
|
|
N1: TMenuItem;
|
|
mnBmp2: TMenuItem;
|
|
mnBmp3: TMenuItem;
|
|
mnBmp4: TMenuItem;
|
|
N2: TMenuItem;
|
|
cImage: TImage;
|
|
N3: TMenuItem;
|
|
RemoveCommand1: TMenuItem;
|
|
PopupMenu1: TPopupMenu;
|
|
mnRemove: TMenuItem;
|
|
mnChangeCap: TMenuItem;
|
|
N4: TMenuItem;
|
|
PopupMenu3: TPopupMenu;
|
|
PopupMenu4: TPopupMenu;
|
|
mnDeleteCat: TMenuItem;
|
|
mnCBmp1: TMenuItem;
|
|
mnCbmp2: TMenuItem;
|
|
mnCBmp3: TMenuItem;
|
|
mnCbmp4: TMenuItem;
|
|
N5: TMenuItem;
|
|
RemoveCommand2: TMenuItem;
|
|
N6: TMenuItem;
|
|
ChnageCommandName1: TMenuItem;
|
|
pnDesign: TPanel;
|
|
nb1: TSpeedButton;
|
|
nb2: TSpeedButton;
|
|
nb3: TSpeedButton;
|
|
sc1: TSpeedButton;
|
|
sc2: TSpeedButton;
|
|
sc3: TSpeedButton;
|
|
sc4: TSpeedButton;
|
|
Bevel3: TBevel;
|
|
OpenDialog1: TOpenDialog;
|
|
SaveDialog1: TSaveDialog;
|
|
SpeedButton2: TSpeedButton;
|
|
SpeedButton3: TSpeedButton;
|
|
SpeedButton4: TSpeedButton;
|
|
procedure FormShow(Sender: TObject);
|
|
procedure lbCatClick(Sender: TObject);
|
|
procedure lbComDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
procedure lbTbComDragOver(Sender, Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
procedure newTBClick(Sender: TObject);
|
|
procedure lbToolBarsClickCheck(Sender: TObject);
|
|
procedure lbToolBarsClick(Sender: TObject);
|
|
procedure lbTbComDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
procedure lbTbComDragDrop(Sender, Source: TObject; X, Y: Integer);
|
|
procedure FormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure lbMenusClick(Sender: TObject);
|
|
procedure lbMnComDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
procedure lbMnComDragOver(Sender, Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
procedure lbMnComDragDrop(Sender, Source: TObject; X, Y: Integer);
|
|
procedure PopupMenu2Popup(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure lbTbComClick(Sender: TObject);
|
|
procedure lbMnComClick(Sender: TObject);
|
|
procedure newMnClick(Sender: TObject);
|
|
procedure mnGrpClick(Sender: TObject);
|
|
procedure ChangeCaption1Click(Sender: TObject);
|
|
procedure mnBmp3Click(Sender: TObject);
|
|
procedure mnBmp2Click(Sender: TObject);
|
|
procedure mnBmp4Click(Sender: TObject);
|
|
procedure RemoveCommand1Click(Sender: TObject);
|
|
procedure mnChangeCapClick(Sender: TObject);
|
|
procedure PopupMenu1Popup(Sender: TObject);
|
|
procedure mnRemoveClick(Sender: TObject);
|
|
procedure nb2Click(Sender: TObject);
|
|
procedure nb1Click(Sender: TObject);
|
|
procedure PopupMenu3Popup(Sender: TObject);
|
|
procedure mnDeleteCatClick(Sender: TObject);
|
|
procedure lbComClick(Sender: TObject);
|
|
procedure ChnageCommandName1Click(Sender: TObject);
|
|
procedure RemoveCommand2Click(Sender: TObject);
|
|
procedure mnCbmp2Click(Sender: TObject);
|
|
procedure mnCBmp3Click(Sender: TObject);
|
|
procedure mnCbmp4Click(Sender: TObject);
|
|
procedure PopupMenu4Popup(Sender: TObject);
|
|
procedure nb3Click(Sender: TObject);
|
|
procedure sc1Click(Sender: TObject);
|
|
procedure sc2Click(Sender: TObject);
|
|
procedure sc3Click(Sender: TObject);
|
|
procedure sc4Click(Sender: TObject);
|
|
procedure SpeedButton2Click(Sender: TObject);
|
|
procedure SpeedButton3Click(Sender: TObject);
|
|
procedure SpeedButton4Click(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
public
|
|
{ Public declarations }
|
|
DesignMode: Boolean;
|
|
GUI: Pointer;
|
|
Procedure UpdateComList;
|
|
Procedure LoadGUIVals;
|
|
Procedure LoadMenus;
|
|
Procedure LoadToolbars;
|
|
Procedure LoadToolBarCommands;
|
|
Procedure LoadMenuCommands;
|
|
Procedure RefreshCatList;
|
|
end;
|
|
|
|
var
|
|
frmCustom: TfrmCustom;
|
|
CurrentpCom : Pointer;
|
|
CurrentCom: Pointer;
|
|
|
|
implementation
|
|
|
|
uses pcGUI;
|
|
|
|
{$R *.DFM}
|
|
|
|
procedure TfrmCustom.FormShow(Sender: TObject);
|
|
begin
|
|
if DesignMode then begin
|
|
pnDesign.Show;
|
|
Height := 510;
|
|
lbcat.PopupMenu := PopupMenu3;
|
|
lbCom.PopupMenu := PopUpMenu4;
|
|
end else begin
|
|
pnDesign.Hide;
|
|
Height := 400;
|
|
lbcat.PopupMenu := nil;
|
|
lbCom.PopupMenu := nil;
|
|
end;
|
|
|
|
RefreshCatList;
|
|
end;
|
|
|
|
procedure TfrmCustom.UpdateComList;
|
|
var i,CatId: Integer;
|
|
pCom: TPCadCommand;
|
|
xGUi: TCadInterface;
|
|
all: boolean;
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
lbCom.Items.Clear;
|
|
CatId := lbCat.ItemIndex;
|
|
all := false;
|
|
if catId = lbCat.items.count -1 then all := true;
|
|
for i:= 0 to xGui.CommandList.Count-1 do
|
|
begin
|
|
pCom := TPCadCommand(xGui.CommandList[i]);
|
|
if (all) or (pCom.CatID = CatId) then
|
|
begin
|
|
lbCom.Items.Add(pCom.Name);
|
|
lbCom.Items.Objects[lbCom.Items.Count-1] := pCom;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TfrmCustom.lbCatClick(Sender: TObject);
|
|
begin
|
|
UpdateComList;
|
|
end;
|
|
|
|
procedure TfrmCustom.lbComDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
var pCom: TPCadCommand;
|
|
Caption,c : String;
|
|
i: integer;
|
|
sRect,dRect: Trect;
|
|
fBrush: HBRUSH;
|
|
cbmp: TBitmap;
|
|
points: array[0..2] of TPoint;
|
|
aColor: TColor;
|
|
begin
|
|
lbCom.Canvas.FillRect(Rect);
|
|
pCom := nil;
|
|
pCom := TPCadCommand(lbCom.Items.Objects[Index]);
|
|
if not assigned(pcom) then exit;
|
|
for i := 1 to Length(pCom.name) do
|
|
begin
|
|
c := Copy(pCom.Name,i,1);
|
|
if c <> '&' then Caption := Caption + c;
|
|
end;
|
|
if assigned(Pcom.Bitmap) then begin
|
|
pcom.Bitmap.Transparent := true;
|
|
sRect := Classes.Rect(rect.left+2,rect.top+4,
|
|
rect.left+18,rect.top+20);
|
|
fBrush := CreateSolidBrush(clwhite);
|
|
FillRect(lbCom.Canvas.Handle,sRect,fbrush);
|
|
DeleteObject(fBrush);
|
|
lbCom.Canvas.Draw(rect.left+2,rect.top+4,pcom.bitmap);
|
|
lbCom.Canvas.TextOut(rect.left+22,rect.top+4,Caption);
|
|
end else
|
|
lbCom.Canvas.TextOut(rect.left+2,rect.top+4,Caption);
|
|
dRect := Classes.Rect(rect.right-92,rect.top,
|
|
rect.right,rect.bottom);
|
|
sRect := Classes.Rect(0,0,0,0);
|
|
if pCom is TPCBrushStyleCommand then
|
|
sRect := Classes.Rect(0,0,92,24)
|
|
else if pCom is TPCPenStyleCommand then
|
|
sRect := Classes.Rect(0,24,92,48)
|
|
else if pCom is TPCPenWidthCommand then
|
|
sRect := Classes.Rect(0,48,92,72)
|
|
else if pCom is TPCRowStyleCommand then
|
|
sRect := Classes.Rect(0,72,92,96)
|
|
else if pCom is TPCFontNameCommand then
|
|
sRect := Classes.Rect(0,96,92,120)
|
|
else if pCom is TPCTextSizeCommand then
|
|
sRect := Classes.Rect(0,120,92,144)
|
|
else if (pCom is TPCColorCommand) or (pCom is TPCOptionsCommand)
|
|
or (pCom is TCommandList) then
|
|
begin
|
|
lbCom.Canvas.Pen.Color := clBlack;
|
|
lbCom.Canvas.Brush.Color := clBlack;
|
|
lbCom.Canvas.Brush.Style := bsSolid;
|
|
points[0] := Point(rect.right - 10,rect.top+8);
|
|
points[1] := Point(rect.right - 10+4,rect.top+8+4);
|
|
points[2] := Point(rect.right - 10,rect.top+8+4+4);
|
|
lbCom.Canvas.Polygon(points);
|
|
end;
|
|
|
|
if sRect.right <> 0 then
|
|
lbcom.Canvas.CopyRect(dRect,cImage.Picture.Bitmap.Canvas,sRect);
|
|
end;
|
|
|
|
procedure TfrmCustom.lbTbComDragOver(Sender, Source: TObject; X,
|
|
Y: Integer; State: TDragState; var Accept: Boolean);
|
|
begin
|
|
if lbToolBars.ItemIndex < 0 then exit;
|
|
if Source is TListBox then
|
|
begin
|
|
if (Source as TListBox) = lbCom then Accept := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.newTBClick(Sender: TObject);
|
|
var Value: String;
|
|
xGUi: TCadInterface;
|
|
nTb: TToolBarDef;
|
|
begin
|
|
Value := '';
|
|
if InputQuery('New Toolbar','Enter the name for the Toolbar',Value) then
|
|
begin
|
|
if Value <> '' then begin
|
|
xGUI := TCadInterface(GUI);
|
|
nTb := xGUI.NewToolBar(Value);
|
|
lbToolBars.Items.Add(Value);
|
|
lbToolbars.Items.Objects[lbToolbars.Items.Count-1] := nTb;
|
|
lbToolBars.Checked[lbToolbars.Items.Count-1] := True;
|
|
lbToolBars.ItemIndex := lbToolbars.Items.Count-1;
|
|
LoadToolBarCommands;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.LoadGUIVals;
|
|
begin
|
|
LoadToolbars;
|
|
LoadMenus;
|
|
end;
|
|
|
|
procedure TfrmCustom.lbToolBarsClickCheck(Sender: TObject);
|
|
begin
|
|
TToolBarDef(lbToolbars.Items.Objects[lbToolbars.ItemIndex]).Visible :=
|
|
lbToolBars.Checked[lbToolbars.ItemIndex];
|
|
end;
|
|
|
|
procedure TfrmCustom.LoadToolBarCommands;
|
|
var tbDef: TToolbarDef;
|
|
i: integer;
|
|
tbCom: TCommandInstance;
|
|
begin
|
|
lbTbCom.Clear;
|
|
if lbToolBars.ItemIndex < 0 then exit;
|
|
tbDef := TToolbarDef(lbToolbars.Items.Objects[lbToolbars.ItemIndex]);
|
|
for i := 0 to tbDef.Commands.Count - 1 do
|
|
begin
|
|
tbCom := tCommandInstance(tbDef.Commands[i]);
|
|
lbTbCom.Items.Add(tbCom.Caption);
|
|
lbTbCom.Items.Objects[i] := tbCom;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.lbToolBarsClick(Sender: TObject);
|
|
begin
|
|
LoadToolBarCommands;
|
|
end;
|
|
|
|
procedure TfrmCustom.lbTbComDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
var pCom: TCommandInstance;
|
|
Caption,c : String;
|
|
i: integer;
|
|
sRect,dRect: Trect;
|
|
fBrush: HBRUSH;
|
|
cbmp: TBitmap;
|
|
points: array[0..2] of TPoint;
|
|
begin
|
|
lbTbCom.Canvas.FillRect(Rect);
|
|
pCom := TCommandInstance(lbTbCom.Items.Objects[Index]);
|
|
for i := 1 to Length(pCom.Caption) do
|
|
begin
|
|
c := Copy(pCom.Caption,i,1);
|
|
if c <> '&' then Caption := Caption + c;
|
|
end;
|
|
|
|
if pCom.BeginGroup then
|
|
begin
|
|
lbTbCom.Canvas.Pen.Color := clBlack;
|
|
lbTbCom.Canvas.Pen.Style := psSolid;
|
|
lbTbCom.Canvas.MoveTo(rect.left,rect.top);
|
|
lbTbCom.Canvas.LineTo(rect.right,rect.top);
|
|
end;
|
|
lbTbCom.Canvas.Brush.Style := bsClear;
|
|
if assigned(Pcom.Bitmap) then begin
|
|
pcom.Bitmap.Transparent := true;
|
|
sRect := Classes.Rect(rect.left+2,rect.top+4,
|
|
rect.left+18,rect.top+20);
|
|
fBrush := CreateSolidBrush(clwhite);
|
|
FillRect(lbTbCom.Canvas.Handle,sRect,fbrush);
|
|
DeleteObject(fBrush);
|
|
lbTbCom.Canvas.Draw(rect.left+2,rect.top+4,pcom.bitmap);
|
|
lbTbCom.Canvas.TextOut(rect.left+22,rect.top+4,Caption);
|
|
end else
|
|
lbTbCom.Canvas.TextOut(rect.left+2,rect.top+4,Caption);
|
|
dRect := Classes.Rect(rect.right-92,rect.top,
|
|
rect.right,rect.bottom);
|
|
sRect := Classes.Rect(0,0,0,0);
|
|
if pCom.Command is TPCBrushStyleCommand then
|
|
sRect := Classes.Rect(0,0,92,24)
|
|
else if pCom.Command is TPCPenStyleCommand then
|
|
sRect := Classes.Rect(0,24,92,48)
|
|
else if pCom.Command is TPCPenWidthCommand then
|
|
sRect := Classes.Rect(0,48,92,72)
|
|
else if pCom.Command is TPCRowStyleCommand then
|
|
sRect := Classes.Rect(0,72,92,96)
|
|
else if pCom.Command is TPCFontNameCommand then
|
|
sRect := Classes.Rect(0,96,92,120)
|
|
else if pCom.Command is TPCTextSizeCommand then
|
|
sRect := Classes.Rect(0,120,92,144)
|
|
else if (pCom.Command is TPCColorCommand) or (pCom.Command is TPCOptionsCommand)
|
|
or (pCom.Command is TCommandList) then
|
|
begin
|
|
lbTbCom.Canvas.Pen.Color := clBlack;
|
|
lbTbCom.Canvas.Brush.Color := clBlack;
|
|
lbTbCom.Canvas.Brush.Style := bsSolid;
|
|
points[0] := Point(rect.right - 10,rect.top+8);
|
|
points[1] := Point(rect.right - 10+4,rect.top+8+4);
|
|
points[2] := Point(rect.right - 10,rect.top+8+4+4);
|
|
lbTbCom.Canvas.Polygon(points);
|
|
end;
|
|
|
|
if sRect.right <> 0 then
|
|
lbTbCom.Canvas.CopyRect(dRect,cImage.Picture.Bitmap.Canvas,sRect);
|
|
|
|
end;
|
|
|
|
procedure TfrmCustom.lbTbComDragDrop(Sender, Source: TObject; X,
|
|
Y: Integer);
|
|
var xGUI : TCadInterface;
|
|
pCom: TPCadCommand;
|
|
begin
|
|
if lbToolBars.ItemIndex < 0 then exit;
|
|
if Source is TListBox then
|
|
begin
|
|
if (Source as TListBox) = lbCom then
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
pCom := TPCadCommand(lbCom.Items.Objects[lbCom.ItemIndex]);
|
|
xGUI.AddTBCommand(lbToolbars.ItemIndex,pCom,False);
|
|
LoadToolBarCommands;
|
|
lbtbCom.TopIndex := lbtbCom.Items.Count-1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TFrmCustom.FormClose(Sender: TObject; var Action: TCloseAction);
|
|
var i: integer;
|
|
xGUI: TCadInterface;
|
|
begin
|
|
if Assigned(GUI) then
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
for i := 0 to lbToolBars.Items.Count-1 do
|
|
begin
|
|
TToolBarDef(xGUI.ToolBars[i]).Visible := lbToolBars.Checked[i];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.LoadMenuCommands;
|
|
var mnDef: TCommandList;
|
|
i: integer;
|
|
tbCom: TCommandInstance;
|
|
begin
|
|
lbMnCom.Clear;
|
|
if lbMenus.ItemIndex < 0 then exit;
|
|
mnDef := TCommandList(lbMenus.Items.Objects[lbMenus.ItemIndex]);
|
|
if assigned(mndef) then
|
|
begin
|
|
for i := 0 to mnDef.InstList.Count - 1 do
|
|
begin
|
|
tbCom := tCommandInstance(mnDef.InstList[i]);
|
|
lbMnCom.Items.Add(tbCom.Caption);
|
|
lbMnCom.Items.Objects[i] := tbCom;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.lbMenusClick(Sender: TObject);
|
|
begin
|
|
LoadMenuCommands;
|
|
end;
|
|
|
|
procedure TfrmCustom.lbMnComDrawItem(Control: TWinControl; Index: Integer;
|
|
Rect: TRect; State: TOwnerDrawState);
|
|
var pCom: TCommandInstance;
|
|
Caption,c : String;
|
|
i: integer;
|
|
sRect,dRect: Trect;
|
|
fBrush: HBRUSH;
|
|
cbmp: TBitmap;
|
|
points: array[0..2] of TPoint;
|
|
begin
|
|
lbMnCom.Canvas.FillRect(Rect);
|
|
if index = 9 then begin
|
|
pCom := TCommandInstance(lbMnCom.Items.Objects[Index]);
|
|
end;
|
|
pCom := TCommandInstance(lbMnCom.Items.Objects[Index]);
|
|
for i := 1 to Length(pCom.Caption) do
|
|
begin
|
|
c := Copy(pCom.Caption,i,1);
|
|
if c <> '&' then Caption := Caption + c;
|
|
end;
|
|
|
|
if pCom.BeginGroup then
|
|
begin
|
|
lbMnCom.Canvas.Pen.Color := clBlack;
|
|
lbMnCom.Canvas.Pen.Style := psSolid;
|
|
lbMnCom.Canvas.MoveTo(rect.left,rect.top);
|
|
lbMnCom.Canvas.LineTo(rect.right,rect.top);
|
|
end;
|
|
|
|
lbMnCom.Canvas.Brush.Style := bsClear;
|
|
if assigned(Pcom.Bitmap) then begin
|
|
pcom.Bitmap.Transparent := true;
|
|
sRect := Classes.Rect(rect.left+2,rect.top+4,
|
|
rect.left+18,rect.top+20);
|
|
fBrush := CreateSolidBrush(clwhite);
|
|
FillRect(lbMnCom.Canvas.Handle,sRect,fbrush);
|
|
DeleteObject(fBrush);
|
|
lbMnCom.Canvas.Draw(rect.left+2,rect.top+4,pcom.bitmap);
|
|
lbMnCom.Canvas.TextOut(rect.left+22,rect.top+4,Caption);
|
|
end else
|
|
lbMnCom.Canvas.TextOut(rect.left+2,rect.top+4,Caption);
|
|
dRect := Classes.Rect(rect.right-92,rect.top,
|
|
rect.right,rect.bottom);
|
|
sRect := Classes.Rect(0,0,0,0);
|
|
if pCom.Command is TPCBrushStyleCommand then
|
|
sRect := Classes.Rect(0,0,92,24)
|
|
else if pCom.Command is TPCPenStyleCommand then
|
|
sRect := Classes.Rect(0,24,92,48)
|
|
else if pCom.Command is TPCPenWidthCommand then
|
|
sRect := Classes.Rect(0,48,92,72)
|
|
else if pCom.Command is TPCRowStyleCommand then
|
|
sRect := Classes.Rect(0,72,92,96)
|
|
else if pCom.Command is TPCFontNameCommand then
|
|
sRect := Classes.Rect(0,96,92,120)
|
|
else if pCom.Command is TPCTextSizeCommand then
|
|
sRect := Classes.Rect(0,120,92,144)
|
|
else if (pCom.Command is TPCColorCommand) or (pCom.Command is TPCOptionsCommand)
|
|
or (pCom.Command is TCommandList) then
|
|
begin
|
|
lbMnCom.Canvas.Pen.Color := clBlack;
|
|
lbMnCom.Canvas.Brush.Color := clBlack;
|
|
lbMnCom.Canvas.Brush.Style := bsSolid;
|
|
points[0] := Point(rect.right - 10,rect.top+8);
|
|
points[1] := Point(rect.right - 10+4,rect.top+8+4);
|
|
points[2] := Point(rect.right - 10,rect.top+8+4+4);
|
|
lbMnCom.Canvas.Polygon(points);
|
|
end;
|
|
|
|
if sRect.right <> 0 then
|
|
lbMnCom.Canvas.CopyRect(dRect,cImage.Picture.Bitmap.Canvas,sRect);
|
|
|
|
end;
|
|
|
|
procedure TfrmCustom.lbMnComDragOver(Sender, Source: TObject; X,
|
|
Y: Integer; State: TDragState; var Accept: Boolean);
|
|
begin
|
|
Accept := False;
|
|
if lbMenus.ItemIndex < 0 then exit;
|
|
if Source is TListBox then
|
|
begin
|
|
if (Source as TListBox) = lbCom then Accept := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.lbMnComDragDrop(Sender, Source: TObject; X,
|
|
Y: Integer);
|
|
var mnCom : TCommandList;
|
|
pCom: TPCadCommand;
|
|
begin
|
|
if lbMenus.ItemIndex < 0 then exit;
|
|
if Source is TListBox then
|
|
begin
|
|
if (Source as TListBox) = lbCom then
|
|
begin
|
|
mnCom := TCommandList(lbMenus.Items.Objects[lbMenus.ItemIndex]);
|
|
pCom := TPCadCommand(lbCom.Items.Objects[lbCom.ItemIndex]);
|
|
if mncom = pCom then exit;
|
|
if not pCom.CanMenu then exit;
|
|
mnCom.AddCommand(pCom,false);
|
|
LoadMenuCommands;
|
|
lbMnCom.TopIndex := lbMnCom.Items.Count-1;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TfrmCustom.PopupMenu2Popup(Sender: TObject);
|
|
var clpHasBmp,comHasBmp: Boolean;
|
|
begin
|
|
if not assigned(CurrentpCom) then exit;
|
|
clpHasBmp := ClipBoard.HasFormat(CF_BITMAP);
|
|
comHasBmp := Assigned(TCommandInstance(CurrentpCom).Bitmap);
|
|
mnGrp.Checked := TCommandInstance(CurrentpCom).BeginGroup;
|
|
if TCommandInstance(CurrentpCom).Command is TPCOptionsCommand then
|
|
begin
|
|
mnBmp1.Enabled := False;mnBmp2.Enabled := False;
|
|
mnBmp3.Enabled := False;mnBmp4.Enabled := False;
|
|
end else begin
|
|
mnBmp1.Enabled := True;
|
|
mnBmp2.Enabled := ComHasBmp;
|
|
mnBmp3.Enabled := ClpHasBmp;
|
|
mnBmp4.Enabled := ComHasBmp;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.FormCreate(Sender: TObject);
|
|
begin
|
|
CurrentpCom := nil;
|
|
DesignMode := False;
|
|
{$ifdef Designer}
|
|
DesignMode := True;
|
|
GUI := TCadInterface.Create(nil);
|
|
Caption := 'GUI Designer For Powercad';
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TfrmCustom.lbTbComClick(Sender: TObject);
|
|
begin
|
|
if lbTBCom.ItemIndex < 0 then exit;
|
|
CurrentpCom := lbTbCom.Items.Objects[lbTbCom.ItemIndex];
|
|
end;
|
|
|
|
procedure TfrmCustom.lbMnComClick(Sender: TObject);
|
|
begin
|
|
if lbMnCom.ItemIndex < 0 then exit;
|
|
CurrentpCom := lbMnCom.Items.Objects[lbMnCom.ItemIndex];
|
|
end;
|
|
|
|
procedure TfrmCustom.newMnClick(Sender: TObject);
|
|
var Value: String;
|
|
xGUi: TCadInterface;
|
|
nMn: TCommandList;
|
|
begin
|
|
Value := '';
|
|
if InputQuery('New Menu','Enter the name for the Menu',Value) then
|
|
begin
|
|
if Value <> '' then begin
|
|
xGUI := TCadInterface(GUI);
|
|
nMn := xGUI.NewMenu(Value,ciMenus,0,nil);
|
|
lbMenus.Items.Add(Value);
|
|
lbMenus.Items.Objects[lbMenus.Items.Count-1] := nMn;
|
|
lbMenus.ItemIndex := lbMenus.Items.Count-1;
|
|
LoadMenuCommands;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.mnGrpClick(Sender: TObject);
|
|
begin
|
|
if assigned (CurrentpCom) then
|
|
begin
|
|
TCommandInstance(CurrentPCom).BeginGroup :=
|
|
not TCommandInstance(CurrentPCom).BeginGroup;
|
|
lbTbCom.Refresh;
|
|
lbMnCom.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.ChangeCaption1Click(Sender: TObject);
|
|
var Value : String;
|
|
begin
|
|
if assigned (CurrentpCom) then
|
|
begin
|
|
Value := TCommandInstance(CurrentPCom).Caption;
|
|
if InputQuery('New Caption','Enter the New Caption for the Button',Value) then
|
|
begin
|
|
TCommandInstance(CurrentPCom).Caption := Value;
|
|
end;
|
|
lbTbCom.Refresh;
|
|
lbMnCom.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.mnBmp3Click(Sender: TObject);
|
|
var cBitmap: TBitmap;
|
|
begin
|
|
if assigned (CurrentpCom) and ClipBoard.HasFormat(CF_BITMAP) then
|
|
begin
|
|
if TCommandInstance(CurrentpCom).Command is TPCOptionsCommand then exit;
|
|
cBitmap := Tbitmap.Create;
|
|
if not assigned(TCommandInstance(CurrentpCom).Bitmap) then
|
|
begin
|
|
TCommandInstance(CurrentpCom).Bitmap := TBitmap.Create;
|
|
TCommandInstance(CurrentpCom).Bitmap.Width := 16;
|
|
TCommandInstance(CurrentpCom).Bitmap.Height := 16;
|
|
end;
|
|
cBitmap.handle := ClipBoard.GetAsHandle(CF_BITMAP);
|
|
TCommandInstance(CurrentpCom).Bitmap.Canvas.Draw(0,0,cBitmap);
|
|
TCommandInstance(CurrentpCom).BitmapChanged := True;
|
|
cBitmap.Free;
|
|
lbTbCom.Refresh;
|
|
lbMnCom.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.mnBmp2Click(Sender: TObject);
|
|
var cBitmap: TBitmap;
|
|
str : TMemoryStream;
|
|
Data: Cardinal;
|
|
Format: Word;
|
|
Palette: HPALETTE;
|
|
|
|
begin
|
|
if assigned (CurrentpCom) and
|
|
assigned(TCommandInstance(CurrentpCom).Bitmap) then
|
|
begin
|
|
Str := TMemoryStream.Create;
|
|
cBitmap := TCommandInstance(CurrentpCom).Bitmap;
|
|
cBitmap.SaveToStream(str);
|
|
cBitmap.SaveToClipboardFormat(Format,Data,Palette);
|
|
OpenClipBoard(0);
|
|
SetClipboardData(Format, Data);
|
|
if Palette <> 0 then SetClipboardData(CF_PALETTE, Palette);
|
|
CloseClipBoard;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TfrmCustom.mnBmp4Click(Sender: TObject);
|
|
var cBitmap: TBitmap;
|
|
begin
|
|
if assigned (CurrentpCom) and
|
|
assigned(TCommandInstance(CurrentpCom).Bitmap) then
|
|
begin
|
|
cBitmap := TCommandInstance(CurrentpCom).Bitmap;
|
|
cBitmap.Free;
|
|
TCommandInstance(CurrentpCom).Bitmap := nil;
|
|
TCommandInstance(CurrentpCom).BitmapChanged := True;
|
|
lbTbCom.Refresh;
|
|
lbMnCom.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.RemoveCommand1Click(Sender: TObject);
|
|
var xGui:TCadInterface;
|
|
lCom: TCommandList;
|
|
begin
|
|
if assigned (CurrentpCom) then
|
|
begin
|
|
if PageControl1.ActivePage = TabSheet1 then
|
|
begin
|
|
if lbToolbars.ItemIndex < 0 then exit;
|
|
xGUI := TCadInterface(GUI);
|
|
xGUI.RemoveTBCommand(lbToolbars.ItemIndex,CurrentPCom);
|
|
CurrentPCom := nil;
|
|
LoadToolBarCommands;
|
|
end else begin
|
|
if lbMenus.ItemIndex < 0 then exit;
|
|
lCom := TCommandList(lbMenus.items.Objects[lbMenus.ItemIndex]);
|
|
lCom.RemoveCommand(TCommandInstance(CurrentPcom).Command);
|
|
CurrentPCom := nil;
|
|
LoadMenuCommands;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.mnChangeCapClick(Sender: TObject);
|
|
var tb: TToolBarDef;
|
|
Value: String;
|
|
begin
|
|
if PageControl1.ActivePage = TabSheet1 then
|
|
begin
|
|
if lbToolbars.ItemIndex < 0 then exit;
|
|
tb := TToolBarDef(lbToolbars.Items.Objects[lbToolbars.ItemIndex]);
|
|
Value := tb.Caption;
|
|
if InputQuery('New Caption','Enter the New Caption for the Toolbar',Value) then
|
|
begin
|
|
tb.Caption := Value;
|
|
lbToolbars.Items[lbToolbars.ItemIndex] := value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.PopupMenu1Popup(Sender: TObject);
|
|
begin
|
|
mnRemove.Enabled := true;
|
|
mnChangeCap.Enabled := True;
|
|
if PageControl1.ActivePage = TabSheet2 then
|
|
mnChangeCap.Enabled := false
|
|
else begin
|
|
if lbToolbars.ItemIndex < 3 then mnRemove.Enabled := false;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TfrmCustom.mnRemoveClick(Sender: TObject);
|
|
var tb: TToolBarDef;
|
|
xGui:TCadInterface;
|
|
pCom: TPcadCommand;
|
|
begin
|
|
if PageControl1.ActivePage = TabSheet1 then
|
|
begin
|
|
if lbToolbars.ItemIndex < 1 then exit;
|
|
tb := TToolBarDef(lbToolbars.Items.Objects[lbToolbars.ItemIndex]);
|
|
xGUI := TCadInterface(GUI);
|
|
xGui.RemoveToolbar(tb);
|
|
lbToolbars.Items.Delete(lbToolbars.ItemIndex);
|
|
LoadToolbarCommands;
|
|
end else
|
|
begin
|
|
if lbMenus.ItemIndex < 0 then exit;
|
|
pCom := TPCadCommand(lbMenus.Items.Objects[lbMenus.ItemIndex]);
|
|
lbMenus.Items.Delete(lbMenus.ItemIndex);
|
|
xGUI := TCadInterface(GUI);
|
|
xGui.RemoveCommand(pCom);
|
|
LoadMenuCommands;
|
|
LoadToolbarCommands;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.nb2Click(Sender: TObject);
|
|
var value:String;
|
|
xGui: TCadInterface;
|
|
pCom: TPCadCommand;
|
|
catID: integer;
|
|
begin
|
|
catId := lbCat.ItemIndex;
|
|
if catId < 0 then exit;
|
|
Value := 'New Command';
|
|
if InputQuery('New Command',
|
|
'Enter the Name for the New Command',
|
|
Value) then
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
pCom := xGui.NewCommand(Value,-1,catId,nil);
|
|
pCom.IsCustom := true;
|
|
UpdateComList;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TfrmCustom.nb1Click(Sender: TObject);
|
|
|
|
var value:String;
|
|
xGui: TCadInterface;
|
|
pCom: TPCadCommand;
|
|
catID: integer;
|
|
begin
|
|
Value := 'New Category';
|
|
if InputQuery('New Category',
|
|
'Enter the Name for the New Category',
|
|
Value) then
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
if xGui.CatList.IndexOf(Value) <> -1 then
|
|
begin
|
|
ShowMessage(emDuplicateCat);
|
|
exit;
|
|
end;
|
|
xGui.CatList.Add(Value);
|
|
lbCat.Items.Insert(xGui.CatList.Count-1,Value);
|
|
lbCat.ItemIndex := lbCat.Items.Count -2;
|
|
UpdateComList;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.PopupMenu3Popup(Sender: TObject);
|
|
begin
|
|
if (lbCat.itemindex = -1) or (lbcat.itemindex = lbcat.items.count-1 )then
|
|
mnDeleteCat.enabled := false
|
|
else
|
|
mnDeleteCat.enabled := True;
|
|
end;
|
|
|
|
procedure TfrmCustom.mnDeleteCatClick(Sender: TObject);
|
|
var xGui: TCadInterface;
|
|
idx : integer;
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
idx := lbcat.itemindex;
|
|
xGui.RemoveCategory(lbcat.itemindex);
|
|
lbCat.Items.Delete(lbcat.itemindex);
|
|
if idx > 0 then
|
|
lbCat.ItemIndex := idx-1
|
|
else
|
|
lbCat.ItemIndex := 0;
|
|
UpdateComList;
|
|
end;
|
|
|
|
procedure TfrmCustom.lbComClick(Sender: TObject);
|
|
begin
|
|
if lbCom.ItemIndex < 0 then exit;
|
|
CurrentCom := lbCom.Items.Objects[lbCom.ItemIndex];
|
|
end;
|
|
|
|
procedure TfrmCustom.ChnageCommandName1Click(Sender: TObject);
|
|
var Value : String;
|
|
i: Integer;
|
|
xCom: TPcadCommand;
|
|
iCom: TCommandInstance;
|
|
|
|
begin
|
|
if assigned (CurrentCom) then
|
|
begin
|
|
xCom := TPCadCommand(CurrentCom);
|
|
Value := xCom.Name;
|
|
if InputQuery('New Name','Enter the New Name for the Command',Value) then
|
|
begin
|
|
xCom.Name := Value;
|
|
for i := 0 to xCom.Instances.Count - 1 do
|
|
begin
|
|
iCom := TCommandInstance(xCom.Instances[i]);
|
|
iCom.Caption := Value;
|
|
end;
|
|
end;
|
|
lbCom.Refresh;
|
|
lbTbCom.Refresh;
|
|
lbMnCom.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.RemoveCommand2Click(Sender: TObject);
|
|
var
|
|
xGUI: TCadInterface;
|
|
isMenu: Boolean;
|
|
begin
|
|
if assigned (CurrentCom) then
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
if TPcadCommand(Currentcom) is TCommandList then isMenu := true;
|
|
xGui.RemoveCommand(CurrentCom);
|
|
UpdateComList;
|
|
LoadToolBarCommands;
|
|
if isMenu then LoadMenus;
|
|
LoadMenuCommands;
|
|
lbCom.Refresh;
|
|
lbTbCom.Refresh;
|
|
lbMnCom.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.mnCbmp2Click(Sender: TObject);
|
|
var cBitmap: TBitmap;
|
|
str : TMemoryStream;
|
|
Data: Cardinal;
|
|
Format: Word;
|
|
Palette: HPALETTE;
|
|
|
|
begin
|
|
if assigned (CurrentCom) and
|
|
assigned(TPCadCommand(CurrentCom).Bitmap) then
|
|
begin
|
|
Str := TMemoryStream.Create;
|
|
cBitmap := TPCadCommand(CurrentCom).Bitmap;
|
|
cBitmap.SaveToStream(str);
|
|
cBitmap.SaveToClipboardFormat(Format,Data,Palette);
|
|
OpenClipBoard(0);
|
|
SetClipboardData(Format, Data);
|
|
if Palette <> 0 then SetClipboardData(CF_PALETTE, Palette);
|
|
CloseClipBoard;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TfrmCustom.mnCBmp3Click(Sender: TObject);
|
|
var cBitmap: TBitmap;
|
|
xCom: TPcadCommand;
|
|
iCom: TCommandInstance;
|
|
i: Integer;
|
|
begin
|
|
if assigned (CurrentCom) and ClipBoard.HasFormat(CF_BITMAP) then
|
|
begin
|
|
xCom := TPCadCommand(CurrentCom);
|
|
if xCom is TPCOptionsCommand then exit;
|
|
cBitmap := Tbitmap.Create;
|
|
if not assigned(xCom.Bitmap) then
|
|
begin
|
|
xCom.Bitmap := TBitmap.Create;
|
|
xCom.Bitmap.Width := 16;
|
|
xCom.Bitmap.Height := 16;
|
|
end;
|
|
cBitmap.handle := ClipBoard.GetAsHandle(CF_BITMAP);
|
|
xCom.Bitmap.Canvas.Draw(0,0,cBitmap);
|
|
|
|
for i := 0 to xCom.Instances.Count - 1 do
|
|
begin
|
|
iCom := TCommandInstance(xCom.Instances[i]);
|
|
if not assigned(iCom.Bitmap) then
|
|
begin
|
|
iCom.Bitmap := TBitmap.Create;
|
|
iCom.Bitmap.Width := 16;
|
|
iCom.Bitmap.Height := 16;
|
|
end;
|
|
iCom.Bitmap.Canvas.Draw(0,0,cBitmap);
|
|
iCom.BitmapChanged := False;
|
|
end;
|
|
cBitmap.Free;
|
|
lbCom.Refresh;
|
|
lbTbCom.Refresh;
|
|
lbMnCom.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.mnCbmp4Click(Sender: TObject);
|
|
var cBitmap: TBitmap;
|
|
xCom: TPcadCommand;
|
|
iCom: TCommandInstance;
|
|
i: Integer;
|
|
begin
|
|
if assigned (CurrentCom) and
|
|
assigned(TPCadCommand(CurrentCom).Bitmap) then
|
|
begin
|
|
xCom := TPCadCommand(CurrentCom);
|
|
cBitmap := xCom.Bitmap;
|
|
cBitmap.Free;
|
|
xCom.Bitmap := nil;
|
|
for i := 0 to xCom.Instances.Count - 1 do
|
|
begin
|
|
iCom := TCommandInstance(xCom.Instances[i]);
|
|
if assigned(iCom.Bitmap) then
|
|
begin
|
|
iCom.Bitmap.Free;
|
|
iCom.Bitmap := nil;
|
|
end;
|
|
iCom.BitmapChanged := False;
|
|
end;
|
|
|
|
lbCom.Refresh;
|
|
lbTbCom.Refresh;
|
|
lbMnCom.Refresh;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.PopupMenu4Popup(Sender: TObject);
|
|
var clpHasBmp,comHasBmp: Boolean;
|
|
begin
|
|
if not assigned(CurrentCom) then exit;
|
|
clpHasBmp := ClipBoard.HasFormat(CF_BITMAP);
|
|
comHasBmp := Assigned(TPCadCommand(CurrentCom).Bitmap);
|
|
|
|
if TPCadCommand(CurrentCom) is TPCOptionsCommand then
|
|
begin
|
|
mncBmp1.Enabled := False;mncBmp2.Enabled := False;
|
|
mncBmp3.Enabled := False;mncBmp4.Enabled := False;
|
|
end else begin
|
|
mncBmp1.Enabled := True;
|
|
mncBmp2.Enabled := ComHasBmp;
|
|
mncBmp3.Enabled := ClpHasBmp;
|
|
mncBmp4.Enabled := ComHasBmp;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.nb3Click(Sender: TObject);
|
|
var
|
|
xGUI: TCadInterface;
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
xGui.ClearToolbars;
|
|
xGui.ClearCommands;
|
|
xGui.CatList.Clear;
|
|
xGui.CreateCategories;
|
|
xGui.CreateStandartCommands;
|
|
xGui.BuildStandartInterface;
|
|
RefreshCatList;
|
|
end;
|
|
|
|
procedure TfrmCustom.RefreshCatList;
|
|
var xGui:TCadInterface;
|
|
i: Integer;
|
|
begin
|
|
lbCat.Items.Clear;
|
|
xGUI := TCadInterface(GUI);
|
|
for i:= 0 to xGUI.CatList.Count-1 do
|
|
begin
|
|
lbCat.Items.Add(xGUI.Catlist[i]);
|
|
end;
|
|
lbCat.Items.Add(csAllCommands);
|
|
if lbCat.Items.Count > 0 then lbCat.ItemIndex := 0;
|
|
UpdateComList;
|
|
LoadGUIVals;
|
|
end;
|
|
|
|
procedure TfrmCustom.LoadMenus;
|
|
var i: integer;
|
|
xGUI: TCadInterface;
|
|
pCom: TPCadCommand;
|
|
begin
|
|
if Assigned(GUI) then
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
lbMenus.Items.Clear;
|
|
for i:= 0 to xGui.CommandList.Count-1 do
|
|
begin
|
|
pCom := TPCadCommand(xGui.CommandList[i]);
|
|
if pCom is TCommandlist then
|
|
begin
|
|
lbMenus.Items.Add(pCom.Name);
|
|
lbMenus.Items.Objects[lbMenus.Items.Count-1] := pCom;
|
|
end;
|
|
end;
|
|
if lbMenus.Items.Count > 0 then lbMenus.ItemIndex := 0;
|
|
LoadMenuCommands;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.LoadToolbars;
|
|
var i: integer;
|
|
xGUI: TCadInterface;
|
|
pCom: TPCadCommand;
|
|
|
|
begin
|
|
if Assigned(GUI) then
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
lbToolBars.Items.Clear;
|
|
for i := 0 to xGUI.ToolBars.Count - 1 do
|
|
begin
|
|
lbToolBars.Items.Add(TToolBarDef(xGUI.ToolBars[i]).Caption);
|
|
lbToolbars.Items.Objects[i] := xGUI.ToolBars[i];
|
|
lbToolBars.Checked[i] := TToolBarDef(xGUI.ToolBars[i]).Visible;
|
|
if assigned(TToolBarDef(xGUI.ToolBars[i]).ToolBar) then
|
|
lbToolBars.Checked[i] := TPCOfficebar(TToolBarDef(xGUI.ToolBars[i]).ToolBar).Visible;
|
|
end;
|
|
if lbToolbars.Items.Count > 0 then lbToolbars.ItemIndex := 0;
|
|
LoadToolBarCommands;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TfrmCustom.sc1Click(Sender: TObject);
|
|
var tb: TToolbarDef;
|
|
idx: Integer;
|
|
begin
|
|
if lbToolbars.ItemIndex < 0 then exit;
|
|
if lbTBCom.ItemIndex < 1 then exit;
|
|
tb := TToolBarDef(lbToolbars.Items.Objects[lbToolbars.ItemIndex]);
|
|
idx := lbTBCom.ItemIndex-1;
|
|
tb.Commands.Exchange(lbTBCom.ItemIndex,idx);
|
|
LoadToolBarCommands;
|
|
lbTBCom.ItemIndex := idx;
|
|
CurrentpCom := lbTbCom.Items.Objects[lbTbCom.ItemIndex];
|
|
end;
|
|
|
|
procedure TfrmCustom.sc2Click(Sender: TObject);
|
|
var xGui:TCadInterface;
|
|
tb: TToolbarDef;
|
|
idx: Integer;
|
|
begin
|
|
if lbToolbars.ItemIndex < 0 then exit;
|
|
if lbTBCom.ItemIndex < 0 then exit;
|
|
if lbTBCom.ItemIndex = lbtbCom.Items.Count-1 then exit;
|
|
tb := TToolBarDef(lbToolbars.Items.Objects[lbToolbars.ItemIndex]);
|
|
idx := lbTBCom.ItemIndex+1;
|
|
tb.Commands.Exchange(lbTBCom.ItemIndex,idx);
|
|
LoadToolBarCommands;
|
|
lbTBCom.ItemIndex := idx;
|
|
CurrentpCom := lbTbCom.Items.Objects[lbTbCom.ItemIndex];
|
|
end;
|
|
|
|
procedure TfrmCustom.sc3Click(Sender: TObject);
|
|
var lCom: TCommandList;
|
|
idx1,idx2: Integer;
|
|
begin
|
|
if lbMenus.ItemIndex < 0 then exit;
|
|
if lbMNCom.ItemIndex < 1 then exit;
|
|
lCom := TCommandList(lbMenus.items.Objects[lbMenus.ItemIndex]);
|
|
idx1 := lbMNCom.ItemIndex;
|
|
idx2 := idx1-1;
|
|
lCom.ComList.Exchange(idx1,idx2);
|
|
lCom.InstList.Exchange(idx1,idx2);
|
|
LoadMenuCommands;
|
|
lbMNCom.ItemIndex := idx2;
|
|
CurrentpCom := lbMnCom.Items.Objects[lbMnCom.ItemIndex];
|
|
end;
|
|
|
|
procedure TfrmCustom.sc4Click(Sender: TObject);
|
|
var lCom: TCommandList;
|
|
idx1,idx2: Integer;
|
|
begin
|
|
if lbMenus.ItemIndex < 0 then exit;
|
|
if lbMNCom.ItemIndex < 0 then exit;
|
|
if lbMNCom.ItemIndex = lbMnCom.Items.Count-1 then exit;
|
|
lCom := TCommandList(lbMenus.items.Objects[lbMenus.ItemIndex]);
|
|
idx1 := lbMNCom.ItemIndex;
|
|
idx2 := idx1+1;
|
|
lCom.ComList.Exchange(idx1,idx2);
|
|
lCom.InstList.Exchange(idx1,idx2);
|
|
LoadMenuCommands;
|
|
lbMNCom.ItemIndex := idx2;
|
|
CurrentpCom := lbMnCom.Items.Objects[lbMnCom.ItemIndex];
|
|
end;
|
|
|
|
procedure TfrmCustom.SpeedButton2Click(Sender: TObject);
|
|
var
|
|
xGUI: TCadInterface;
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
if OpenDialog1.Execute then
|
|
begin
|
|
xGUI.LoadFromFile(OpenDialog1.FileName);
|
|
RefreshCatList;
|
|
Caption := 'GUI Designer For Powercad-'+ExtractFileName(xGUI.FileName);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmCustom.SpeedButton3Click(Sender: TObject);
|
|
var
|
|
xGUI: TCadInterface;
|
|
Stream: TFileStream;
|
|
FName: String;
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
FName := xGUI.FileName;
|
|
if FName = '' then begin
|
|
if SaveDialog1.Execute then
|
|
FName := SaveDialog1.FileName
|
|
else exit;
|
|
end;
|
|
xGUI.SaveToFile(FName);
|
|
Caption := 'GUI Designer For Powercad-'+ExtractFileName(xGUI.FileName);
|
|
end;
|
|
|
|
procedure TfrmCustom.SpeedButton4Click(Sender: TObject);
|
|
var
|
|
xGUI: TCadInterface;
|
|
Fname: String;
|
|
begin
|
|
xGUI := TCadInterface(GUI);
|
|
if SaveDialog1.Execute then
|
|
FName := SaveDialog1.FileName
|
|
else exit;
|
|
XGui.SaveToFile(FName);
|
|
Caption := 'GUI Designer For Powercad-'+ExtractFileName(xGUI.FileName);
|
|
end;
|
|
|
|
end.
|