unit ExportExFrm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, CheckLst, ImgList, dximctrl, ActnList, ComCtrls, ToolWin; type TExportExForm = class(TForm) Panel1: TPanel; btnOK: TButton; btnCancel: TButton; Panel2: TPanel; Label1: TLabel; Splitter1: TSplitter; Panel3: TPanel; Label2: TLabel; clbProjectBills: TCheckListBox; lbBidLot: TListBox; imgsSmall: TImageList; ActionList: TActionList; actnUpMove: TAction; actnDownMove: TAction; ToolBar1: TToolBar; ToolButton3: TToolButton; ToolButton1: TToolButton; ToolButton2: TToolButton; labMergeOptions: TLabel; rbMergeOptions: TGroupBox; rdbtnCodeName: TRadioButton; rdbtnCode: TRadioButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure clbProjectBillsClick(Sender: TObject); procedure btnCancelClick(Sender: TObject); procedure actnUpMoveExecute(Sender: TObject); procedure actnDownMoveExecute(Sender: TObject); procedure actnUpMoveUpdate(Sender: TObject); procedure actnDownMoveUpdate(Sender: TObject); private { Private declarations } FStrings: TStrings; FExportEx: Boolean; function GetStringsIdx(aIdx: Integer): Integer; function IsMergeByCode: Boolean; public { Public declarations } procedure InitForMergeProject(const aBuildProject: string); procedure InitForSelectExcel; end; { Export Excel } function ExportExForm(aBidLots, aProjectBills: TStrings): Boolean; { Gather Project } function SelectProjectForm(aProjectList: TStrings; const aBuildProject: string; var MergeByCode: Boolean): Boolean; { TODO : 导入Excel } function SelectExcelSheet(aCaptions: TStrings): Boolean; implementation {$R *.dfm} function ExportExForm(aBidLots, aProjectBills: TStrings): Boolean; var I, J: Integer; sFullName: string; ExportExForm: TExportExForm; begin ExportExForm := TExportExForm.Create(nil); try for I := 0 to aBidLots.Count - 1 do begin sFullName := string(aBidLots.Objects[I]); ExportExForm.lbBidLot.Items.AddObject(aBidLots[I], Pointer(sFullName){aBidLots.Objects[I]}); Integer(sFullName) := 0; end; for I := 0 to aProjectBills.Count - 1 do begin sFullName := string(aProjectBills.Objects[I]); ExportExForm.clbProjectBills.Items.AddObject(aProjectBills[I], Pointer(sFullName){aProjectBills.Objects[I]}); Integer(sFullName) := 0; end; ExportExForm.FExportEx := True; ExportExForm.lbBidLot.ItemIndex := 0; if ExportExForm.ShowModal = mrOk then begin for I := 0 to aBidLots.Count - 1 do begin aBidLots[I] := '1'; end; J := 1; for I := 0 to ExportExForm.FStrings.Count - 1 do begin if ExportExForm.FStrings[I] <> '' then begin aBidLots.InsertObject(J, '2', Pointer(ExportExForm.FStrings[I])); Inc(J, 2); end else Inc(J, 3); end; Result := True; end else Result := False; finally ExportExForm.Free; end; end; function SelectProjectForm(aProjectList: TStrings; const aBuildProject: string; var MergeByCode: Boolean): Boolean; var I: Integer; sProject: string; ProjectsForm: TExportExForm; begin Result := False; ProjectsForm := TExportExForm.Create(nil); try ProjectsForm.InitForMergeProject(aBuildProject); for I := 0 to aProjectList.Count - 1 do begin sProject := string(aProjectList.Objects[I]); ProjectsForm.clbProjectBills.Items.AddObject(aProjectList[I], Pointer(sProject)); Integer(sProject) := 0; end; if ProjectsForm.ShowModal = mrOK then begin aProjectList.Clear; MergeByCode := ProjectsForm.IsMergeByCode; for I := 0 to ProjectsForm.clbProjectBills.Count - 1 do begin if ProjectsForm.clbProjectBills.Checked[I] then begin sProject := string(ProjectsForm.clbProjectBills.Items.Objects[I]); aProjectList.Add(sProject); Integer(sProject) := 0; end; end; Result := True; end; finally ProjectsForm.Free; end; end; function SelectExcelSheet(aCaptions: TStrings): Boolean; var I: Integer; sProject: string; ProjectsForm: TExportExForm; begin Result := False; ProjectsForm := TExportExForm.Create(nil); try ProjectsForm.InitForSelectExcel; for I := 0 to aCaptions.Count - 1 do ProjectsForm.clbProjectBills.Items.AddObject(aCaptions[I], aCaptions.Objects[I]); if ProjectsForm.ShowModal = mrOK then begin aCaptions.Clear; for I := 0 to ProjectsForm.clbProjectBills.Count - 1 do begin if ProjectsForm.clbProjectBills.Checked[I] then aCaptions.AddObject(ProjectsForm.clbProjectBills.Items[I], ProjectsForm.clbProjectBills.Items.Objects[I]); end; Result := True; end; finally ProjectsForm.Free; end; end; procedure TExportExForm.FormCreate(Sender: TObject); begin FStrings := TStringList.Create; end; procedure TExportExForm.FormDestroy(Sender: TObject); begin FStrings.Free; end; function TExportExForm.GetStringsIdx(aIdx: Integer): Integer; var I, iBidIdx: Integer; begin Result := -1; for I := 0 to FStrings.Count - 1 do begin iBidIdx := Integer(FStrings.Objects[I]); if iBidIdx = aIdx then begin Result := I; Break; end; end; end; procedure TExportExForm.clbProjectBillsClick(Sender: TObject); var I, iIdx: Integer; begin if not FExportEx then Exit; iIdx := GetStringsIdx(lbBidLot.ItemIndex); if clbProjectBills.Checked[clbProjectBills.ItemIndex] then begin if iIdx = -1 then begin FStrings.AddObject(string(clbProjectBills.Items.Objects[clbProjectBills.ItemIndex]), Pointer(lbBidLot.ItemIndex)); end else begin FStrings[iIdx] := string(clbProjectBills.Items.Objects[clbProjectBills.ItemIndex]); end; for I := 0 to clbProjectBills.Count - 1 do begin if I <> clbProjectBills.ItemIndex then clbProjectBills.Checked[I] := False; end; end else begin if iIdx <> -1 then FStrings[iIdx] := ''; end; end; procedure TExportExForm.btnCancelClick(Sender: TObject); begin Close; end; procedure TExportExForm.InitForMergeProject(const aBuildProject: string); begin Caption := '建设项目 - [' + aBuildProject + ']'; Width := 450; Height := 380; Panel2.Visible := False; Label2.Caption := '标段分项清单:'; FExportEx := False; rbMergeOptions.Visible := True; labMergeOptions.Visible := True; end; procedure TExportExForm.InitForSelectExcel; begin Caption := '导入Excel文件'; Width := 450; Height := 380; Panel2.Visible := False; Label2.Caption := '选择工作表:'; FExportEx := False; end; procedure TExportExForm.actnUpMoveExecute(Sender: TObject); var iIndex: Integer; begin iIndex := clbProjectBills.ItemIndex; clbProjectBills.Items.Exchange(iIndex, iIndex - 1); end; procedure TExportExForm.actnDownMoveExecute(Sender: TObject); var iIndex: Integer; begin iIndex := clbProjectBills.ItemIndex; clbProjectBills.Items.Exchange(iIndex, iIndex + 1); end; procedure TExportExForm.actnUpMoveUpdate(Sender: TObject); begin actnUpMove.Enabled := clbProjectBills.ItemIndex > 0; end; procedure TExportExForm.actnDownMoveUpdate(Sender: TObject); begin actnDownMove.Enabled := (clbProjectBills.Items.Count > 1) and (clbProjectBills.ItemIndex < clbProjectBills.Items.Count - 1); end; function TExportExForm.IsMergeByCode: Boolean; begin if rdbtnCodeName.Checked then Result := False else Result := True; end; end.