unit StandardBillsFme; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, XPMenu, ZjGridDBA, ZjGridTreeDBA, ZJGrid, StdCtrls, Buttons, ExtCtrls, StandardLibs, StandardLib, ActnList, dxBar, sdGridDBA, sdGridTreeDBA; type TBillsType = (btXm, btGcl); TStandardBillsFrame = class(TFrame) pnlTop: TPanel; spbtnLibs: TSpeedButton; edtLibName: TEdit; zgBills: TZJGrid; xpm: TXPMenu; ActionList1: TActionList; dxpmStandardBills: TdxBarPopupMenu; actnInsertBillsFromLib: TAction; stdBills: TsdGridTreeDBA; odLib: TOpenDialog; actnExportStdJson: TAction; procedure actnInsertBillsFromLibExecute(Sender: TObject); procedure zgBillsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure spbtnLibsClick(Sender: TObject); procedure dxpmStandardBillsPopup(Sender: TObject); procedure actnExportStdJsonExecute(Sender: TObject); private FStandardLibs: TStandardLibs; FBillsType: TBillsType; procedure SetBillsType(const Value: TBillsType); function GetStandardLib: TStandardLib; procedure AdjustColumnType; public constructor Create(AStandardLibs: TStandardLibs); procedure ConnectStandardLib; property BillsType: TBillsType read FBillsType write SetBillsType; property StandardLib: TStandardLib read GetStandardLib; end; implementation uses SupportUnit, Globals, ConditionalDefines, UtilMethods, MainFrm; {$R *.dfm} { TStandBillsFrame } procedure TStandardBillsFrame.AdjustColumnType; procedure AdjustXmColumnType; begin stdBills.Columns.Delete(stdBills.ColumnIndex('B_Code')); end; procedure AdjustGclColumnType; begin stdBills.Columns.Delete(stdBills.ColumnIndex('Code')); end; begin if FBillsType = btXm then AdjustXmColumnType else if FBillsType = btGcl then AdjustGclColumnType; end; procedure TStandardBillsFrame.ConnectStandardLib; begin stdBills.IDTree := StandardLib.StandardBillsData.BillsTree; edtLibName.Text := StandardLib.LibName; end; constructor TStandardBillsFrame.Create(AStandardLibs: TStandardLibs); begin inherited Create(nil); FStandardLibs := AStandardLibs; stdBills.TopLevelBold := False; end; function TStandardBillsFrame.GetStandardLib: TStandardLib; begin case FBillsType of btXm: Result := FStandardLibs.StandardXmLib; btGcl: Result := FStandardLibs.StandardGclLib; end; end; procedure TStandardBillsFrame.SetBillsType(const Value: TBillsType); begin FBillsType := Value; AdjustColumnType; end; procedure TStandardBillsFrame.zgBillsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbRight) and (_IsDebugView) then dxpmStandardBills.PopupFromCursorPos else if (Button = mbLeft) and (ssDouble in Shift) then actnInsertBillsFromLib.Execute; end; procedure TStandardBillsFrame.actnInsertBillsFromLibExecute( Sender: TObject); begin with OpenProjectManager.CurProjectData.BillsCompileData do if Assigned(stdBills.IDTree.Selected) then AddBillsFromLib(stdBills.IDTree.Selected, BillsType); end; procedure TStandardBillsFrame.spbtnLibsClick(Sender: TObject); procedure ChangeStandardBills(const sFileName: string); var sOldName: string; begin Screen.Cursor := crHourGlass; try try case FBillsType of btXm: begin sOldName := SupportManager.ConfigInfo.StandardXmLib; SupportManager.ConfigInfo.StandardXmLib := ExtractFileName(odLib.FileName); end; btGcl: begin sOldName := SupportManager.ConfigInfo.StandardGclLib; SupportManager.ConfigInfo.StandardGclLib := ExtractFileName(odLib.FileName); end; end; ConnectStandardLib; except ErrorMessage('选择的标准清单不可识别'); case FBillsType of btXm: SupportManager.ConfigInfo.StandardXmLib := ExtractFileName(sOldName); btGcl: SupportManager.ConfigInfo.StandardGclLib := ExtractFileName(sOldName); end; ConnectStandardLib; end; finally Screen.Cursor := crDefault; end; end; var sLibPath, sSelectLib, sNewLib: string; vLib: TStandardLib; begin case FBillsType of btXm: sLibPath := ExtractFileDir(FStandardLibs.StandardXmLib.FileName); btGcl: sLibPath := ExtractFileDir(FStandardLibs.StandardGclLib.FileName); end; if odLib.Execute then begin sSelectLib := odLib.FileName; if ExtractFileDir(sSelectLib) <> sLibPath then begin sNewLib := sLibPath + '\' + ExtractFileName(sSelectLib); if FileExists(sNewLib) then begin if QuestMessageYesNo('选择的标准清单不在默认路径下,默认路径下存在同名标准清单,仅可打开默认路径下的标准清单,是否继续?') then ChangeStandardBills(sNewLib); end else if QuestMessageYesNo('选择的标准清单不在默认路径下,是否复制到默认路径下并打开?') then begin CopyFile(PChar(sSelectLib), PChar(sNewLib), false); ChangeStandardBills(sNewLib); end; end else ChangeStandardBills(sSelectLib); end; end; procedure TStandardBillsFrame.dxpmStandardBillsPopup(Sender: TObject); begin SetDxBtnAction(actnExportStdJson, MainForm.dxbtnExportStdJson); end; procedure TStandardBillsFrame.actnExportStdJsonExecute(Sender: TObject); var sFileName: string; begin if SaveFile(sFileName, '.json') then StandardLib.StandardBillsData.RecursiveExportBillsJson(sFileName); end; end.