Measure/Frames/StandardBillsFme.pas

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.