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.