unit ProjectManagerFme; interface uses ProjectManagerDm, ZhAPI, NewProjectFrm, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ZjGridDBA, ZJGrid, ComCtrls, ToolWin, ActnList, dxBar, sdGridDBA, sdGridTreeDBA, sdIDTree, CslJson, ExtCtrls, StdCtrls, sdDB, CslButton, OrderCheckerFme, Contnrs; type TStrArr = array of string; TProjectManagerFrame = class(TFrame) ToolBar: TToolBar; tobtnOpen: TToolButton; zgProjects: TZJGrid; tobtnDelete: TToolButton; ActionList1: TActionList; actnOpen: TAction; actnDelete: TAction; dxpmProjectManager: TdxBarPopupMenu; actnReceiveProject: TAction; stdProjects: TsdGridTreeDBA; actnNewProject: TAction; actnNewSubProject: TAction; actnNewTender: TAction; pnlTenderProperty: TPanel; sdTenderProperty: TsdGridDBA; sprProperty: TSplitter; tobtnRenane: TToolButton; actnRename: TAction; tobtnImport: TToolButton; tobtnExport: TToolButton; actnImport: TAction; actnExport: TAction; tobtn1: TToolButton; pnlWeb: TPanel; pnlProject: TPanel; shp2: TShape; shp1: TShape; shp3: TShape; shp4: TShape; pnlTenderTitle: TPanel; lblBidName: TLabel; pnlShadow: TPanel; pnlProgress: TPanel; lblPeriodTotal: TLabel; lblPeriodState: TLabel; lblProgress: TLabel; lblPeriod: TLabel; pnlBelongProject: TPanel; lblBelongProject: TLabel; lblProjName: TLabel; lblLeftHalfBracket: TLabel; lblOnwerCompany: TLabel; lblOnwerName: TLabel; pnlProjectType: TPanel; lblProjectType: TLabel; lblWebProjCtgyName: TLabel; zgTenderProperty: TZJGrid; actnOpenBackupFolder: TAction; sbChecker: TScrollBox; actnSignOnline: TAction; actnGuest: TAction; procedure actnOpenExecute(Sender: TObject); procedure actnDeleteExecute(Sender: TObject); procedure zgProjectsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure actnReceiveProjectExecute(Sender: TObject); procedure actnNewProjectExecute(Sender: TObject); procedure actnNewSubProjectExecute(Sender: TObject); procedure actnNewTenderExecute(Sender: TObject); procedure zgProjectsDrawCellText(ACanvas: TCanvas; const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid; const Text: String; var ADefaultDraw: Boolean); procedure actnNewSubProjectUpdate(Sender: TObject); procedure actnNewTenderUpdate(Sender: TObject); procedure zgProjectsCurrentChanged(Sender: TObject; Col, Row: Integer); procedure actnSubmitProjectUpdate(Sender: TObject); procedure actnReplyProjectUpdate(Sender: TObject); procedure actnRenameExecute(Sender: TObject); procedure actnOpenUpdate(Sender: TObject); procedure actnImportExecute(Sender: TObject); procedure actnExportExecute(Sender: TObject); procedure actnDeleteUpdate(Sender: TObject); procedure actnOpenBackupFolderExecute(Sender: TObject); procedure actnRenameUpdate(Sender: TObject); procedure zgProjectsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); procedure actnExportUpdate(Sender: TObject); procedure actnOpenBackupFolderUpdate(Sender: TObject); procedure pnlProgressClick(Sender: TObject); procedure actnSignOnlineExecute(Sender: TObject); procedure actnSignOnlineUpdate(Sender: TObject); procedure actnGuestExecute(Sender: TObject); procedure actnGuestUpdate(Sender: TObject); private FProjectManagerData: TProjectManagerData; // Chenshilong,2016.03.24 // 这部分线上和本地一致,无需区分 FID: Integer; // 本地标段文件ID FWebID: Integer; // 关联服务器用的ID(服务器有自己的ID体系) FWebAuthorID: Integer; // 编制人 FWebOwnerID: Integer; // 业主 // 本地存储值、线上存储值。线上修改后,需要同步到本地 FWebMD5_Local: string; // 本地存储的MD5 FWebMD5_OnLine: string; // 线上存储的最新的MD5(下同) FWebBidName_Local: string; // 标段名 (当无法同线上取得联系时,本地需要用到该名称来提示) FWebBidName_OnLine: string; FWebFolder_OnLine: string; // 这个命名不妥,但很直观。线上的项目名称、项目类型概念跟本地颠倒,很混乱。 FWebSubFolder_OnLine: string; FWebOwnerCompany: string; FWebOwnerRole: string; FWebOwnerName: string; FWebCheckStatusMy: TCheckStatus; // 登陆用户在当前项目中的工作状态。 FWebCheckStatusProject: TCheckStatus; // 项目的审核状态。 FOnLineCheckerBegin: Integer; // 线上审批的起始人。 010110111 起7止9。 0101101110 起0止0。 FOnLineCheckerEnd: Integer; // 线上审批的截止人。 FOnLineCheckerEndIsOwner: Boolean; // 终审是线上审批 FPhaseTotal: Integer; FPhaseNo: Integer; FCurPos: Integer; // 用来控制审核人的添加位置 FCheckers: TOVArr; FCheckerFrames: TObjectList; FSignOnlineSwitch: Integer; function ReceiveFile(const AFileName: string; AIsReback: Boolean = False): Boolean; function ImportFile(const AFileName: string; AFileMD5: string = ''): Boolean; procedure ConnectButtonWithAction; function GetImportProjectName(const AFileName: string; AParent: TsdIDTreeNode): string; function IsProject(ANode: TsdIDTreeNode): Boolean; function IsLeafProject(ANode: TsdIDTreeNode): Boolean; function IsUnEmptyLeafProject(ANode: TsdIDTreeNode): Boolean; function CheckOpened(ANode: TsdIDTreeNode): Boolean; procedure SetPropertyVisible(AVisible: Boolean); procedure ShowProjectInfoTopAndCheckers; // 网络上的目录结构,本地有则定位,没有则创建。 procedure CheckWebFolders(AFolderID, ASubFolderID: Integer; AFolderName, ASubFolderName: string); // ANewBidName: 项目的最新标段名(取自服务器,有人改名了,本地的就变成旧的) procedure CheckBidName(AID: Integer; ANewBidName: string); overload; procedure CheckBidName(AUserID, AWebID: Integer; ANewBidName: string); overload; procedure ClearLocalValues; procedure GetLocalValues(ARec: TsdDataRecord); overload; // 用户ID、网络标段ID、Type=1可以定位一个标段。 procedure GetLocalValues(AUserID, AWebID: Integer); overload; // 1 等待我审核的标段文件; 2 我参与的全部标段文件 procedure DoBatchReceiveOnline(ARequestType: Integer); function LocalMD5(AUserID, AWebID: Integer): string; procedure BubbleSortProjects; // AReceiveKind: 1 接收; 2 导入 function FileDownAndReceive(ADownURL: string; AReceiveKind: Integer): Boolean; // 线上审批的起止人 procedure OnLineChecker(AAr: TOVArr; var ABegin, AEnd: Integer; var AOnLineEndIsOwner: Boolean); procedure LoadSignOnlineSwitch; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure DoBatchReceiveAllOnline; // AType: -2 繁忙; -1 正常读取; 0 第0期; 1 第1期。 procedure ShowProjectInfoTop(AType: Integer = -1); function Rec(AProjectID: Integer): TsdDataRecord; function CurRec: TsdDataRecord; function CurRecAttachmentPath: string; function AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer; function UserIsChecker(UserID: Integer): Boolean; // 判断指定ID的用户是否是参与人 function IsGuest: Boolean; property ProjectCheckStatus: TCheckStatus read FWebCheckStatusProject; end; implementation uses MainFrm, UtilMethods, ProjectCommands, Globals, ConfigDoc, ConstUnit, WebNewTenderFrm, PHPWebDm, Math, mProgressFrm, ProgressHintFrm, ShellAPI, ProjectFme, SelectOnlineSignPhaseFrm, SignOnlineReportsFrm, ConditionalDefines, SetGuestFrm; {$R *.dfm} procedure TProjectManagerFrame.ConnectButtonWithAction; begin SetDxBtnAction(actnNewProject, MainForm.dxbtnNewProject); SetDxBtnAction(actnNewSubProject, MainForm.dxbtnNewSubProject); SetDxBtnAction(actnNewTender, MainForm.dxbtnNewTender); SetDxBtnAction(actnOpen, MainForm.dxbtnOpenProject); SetDxBtnAction(actnDelete, MainForm.dxbtnDeleteProject); SetDxBtnAction(actnReceiveProject, MainForm.dxbtnReceiveProject); SetDxBtnAction(actnOpenBackupFolder, MainForm.dxbtnOpenBackupFolder); SetDxBtnAction(actnRename, MainForm.dxbtnRename); SetDxBtnAction(actnSignOnline, MainForm.dxbtnSignOnline); SetDxBtnAction(actnGuest, MainForm.dxbtnGuest); end; constructor TProjectManagerFrame.Create(AOwner: TComponent); begin inherited; FCheckerFrames := TObjectList.Create; FProjectManagerData := ProjectManager; FProjectManagerData.Open; stdProjects.IDTree := FProjectManagerData.ProjectsTree; sdTenderProperty.DataView := FProjectManagerData.sdvTenderProperty; ConnectButtonWithAction; SetPropertyVisible(False); sbChecker.Height := 0; if G_IsCloud then begin Application.HintPause := 200; Application.HintHidePause := 60000; LoadSignOnlineSwitch; tobtnImport.Visible := False; stdProjects.TreeOptions := stdProjects.TreeOptions - [aoAllowUpLevel, aoAllowDownLevel]; stdProjects.Options := stdProjects.Options - [aoAllowUpMove, aoAllowDownMove]; CreateProgress('正在从云端下载新项目'); try actnReceiveProject.Execute; finally CloseProgress; end; end; end; // 双击打开项目 TagB procedure TProjectManagerFrame.actnOpenExecute(Sender: TObject); var vSel: TsdIDTreeNode; vRec: TsdDataRecord; sHint: string; function SearchFileOnline(AURL: string; var ADownURL, AFolder, ASubFolder, ABidName, AMD5Web, AError: string; var AFolderID, ASubFolderID: Integer): Integer; var vArr: TOVArr; begin Result := PHPWeb.Search(AURL, [''], [''], vArr); AError := ''; if Result = 1 then begin if High(vArr) >= 0 then begin ADownURL := vArr[0, 0]; AFolder := vArr[0, 2]; ASubFolder := vArr[0, 3]; AMD5Web := vArr[0, 1]; AFolderID := StrToInt(vArr[0, 4]); ASubFolderID := StrToInt(vArr[0, 5]); ABidName := vArr[0, 6]; end else Result := 10; // 返回10,表示无记录。用这个数字代表是否觉得怪异?没办法,0被占用了。 end else if Result = 0 then AError := PHPWeb.PageError('标段更新数据失败') else if Result = -1 then AError := PHPWeb.NetError('标段更新数据失败'); end; function CanOpen: Boolean; var sSearchURL, sDownURL, sMD5_UnLock, sError, sLocalFile: string; iSearch, iFolderID, iSubFolderID: Integer; bLock, bCanImp: Boolean; vFileCheck: TTenderFileChecker; begin Result := False; // 先按正常接口找到最新的MD5码看是否需要更新 sSearchURL := Format('%stender/get/%d/update', [PHPWeb.MeasureURL, FWebID]); iSearch := SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, FWebMD5_OnLine, sError, iFolderID, iSubFolderID); if iSearch = 1 then begin try CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine); CheckBidName(FID, FWebBidName_OnLine); finally if vSel <> nil then vSel.LocateInControl; end; // 打开前一定要先下载最新的标段文件(无论审核有没有通过) if FWebMD5_OnLine <> FWebMD5_Local then if not FileDownAndReceive(sDownURL, 1) then Exit; // 编制人且项目末通过 if (FWebAuthorID = PHPWeb.UserID) and (FWebCheckStatusProject = csNotPass) then begin sHint := '本期计量审批不通过,你现在可以:' + #10#13 + '点击【是(Y)】重新开始本期计量,软件将打开本期上报时的数据,开始重新计量;' + #10#13 +'点击【否(N)】查看不通过计量,软件将打开本期最后审批的数据,重新打开标段' + '可再次打开本确认窗口。'; if Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_Yes then begin // 查找原报的文件 sSearchURL := Format('%suser/get/%d/%d/report/file', [PHPWeb.MeasureURL, FWebID, FPhaseNo]); case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of 1: ; // 原报文件已正确找到 0, -1: begin sHint := sError + ' 因网络出错,无法连接到云端以获取本期原报上传的文件,无法重新开始本期,请重试。'; Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; end; if FileDownAndReceive(sDownURL, 2) then begin // 这里在线上创建新一期审批人列表、更改标段状态。不再使用同步更新等。 sSearchURL := Format('%suser/create/%d/%d/new/audit', [PHPWeb.MeasureURL, FWebID, FPhaseNo]); case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of 1, 10: // 执行到这里线上审核人列表已创建完毕。无需返回记录值,所以返回值为10。1是为了兼容。 begin sHint := '【十分重要】:本期计量已重新开始,原报在本次上报完成前,请勿删除该标段或更换电脑。'; Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION); end; 0, -1: begin sHint := sError + ' 因网络出错,无法在线上创建新一期审批人列表、提交项目状态等,请重试。'; Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; end; end else Exit; end; end; end else if (iSearch = 10) then begin if not PHPWeb.ExistInServer(FWebID) then begin sHint :='该项目[' + FWebBidName_Local + ']在云端已被删除,点击"确定"后,可手动删除该项目。'; Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION); Exit; end; end else if (iSearch = 0) or (iSearch = -1) then begin sHint := sError + '(因网络出错,无法检测[' + FWebBidName_Local + ']在云端是否有更新,本次操作已取消,请重试)。'; Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; Result := True; end; var CurProjectFme: TProjectFrame; begin // 打开前先下载更新 Screen.Cursor := crHourGlass; try vSel := stdProjects.IDTree.Selected; vRec := vSel.Rec; if G_IsCloud then begin GetLocalValues(CurRec); // 以下这段已经包含在MainForm.OpenProject(vRec)中了,但在调用这句之前,网络版要提前用一下。 if MainForm.HasOpened(FID) then begin MainForm.LocateProject(FID); Exit; end; if not CanOpen then Exit; end; CurProjectFme := MainForm.OpenProject(vRec); if G_IsCloud then begin // 云版,如果用户在打开项目的过程中,切换界面回项目管理,MainFrom.CurProjectFrame值为nil,后面的调用,包括MainForm.actnCloseProject.Execute都会出错 // 其中由于前面调用的MainForm.LocateProject触发的一系列事件中,调用到了SetPropertyVisible,其中执行了Screen.Cursor := crDefault // 导致鼠标状态还原,用户可以点击,单机版下测试,属性状态为crHourGlass时,亦可以切换会项目管理 // 按逻辑,CheckFileAndCloudCheckerList这种方法不应在界面,应在控制器,亦不可直接调用MainForm.actnCloseProject.Execute // 怕按逻辑改动引起更多Bug,故继续错下去,检查MainForm.CurProjectFrame是否正确,并再次禁用鼠标 if CurProjectFme <> MainForm.CurProjectFrame then begin Screen.Cursor := crHourGlass; MainForm.LocateProject(CurProjectFme.ProjectData.ProjectID); end; if not MainForm.CurProjectFrame.CheckFileAndCloudChekerList then begin sHint := '“'+ FWebBidName_OnLine +'”无法打开,本地与云端审批人不一致。' + #10#13 + '1、如当前项目审批不通过并已重新开始计量:请回到原电脑操作;' + #10#13 + '2、审批中/审批完成项目:请删除本地项目重新从云端获取。' + #10#13 + '如仍然存在同样问题,请联系纵横服务人员。'; Application.MessageBox(PChar(sHint), '文件错误', MB_OK +MB_ICONWARNING); MainForm.actnCloseProject.Execute; Exit; end; end; finally Screen.Cursor := crDefault; end; end; procedure TProjectManagerFrame.actnDeleteExecute(Sender: TObject); begin if stdProjects.IDTree.Count = 0 then Exit; with stdProjects.IDTree.Selected.Rec do if QuestMessage(Format('确定要删除[%s]吗?', [ValueByName('Name').AsString])) then begin Screen.Cursor := crHourGlass; try FProjectManagerData.Delete; finally Screen.Cursor := crDefault; end; end; end; procedure TProjectManagerFrame.zgProjectsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbRight then dxpmProjectManager.PopupFromCursorPos else if (zgProjects.CurCol = 1) and (Button = mbLeft) and (ssDouble in Shift) and Assigned(stdProjects.IDTree.Selected) then begin if IsProject(stdProjects.IDTree.Selected) then stdProjects.IDTree.Selected.Expand else actnOpen.Execute; end; end; function TProjectManagerFrame.ReceiveFile(const AFileName: string; AIsReback: Boolean): Boolean; var vRP: TReceiveProject; vNode: TsdIDTreeNode; begin Result := False; vRP := TReceiveProject.Create(stdProjects.IDTree.Selected); try ProjectManager.RefreshSeedID; if G_IsCloud then begin vRP.IsReback := AIsReback; vRP.Lock := (FWebAuthorID = PHPWeb.UserID) or ((FWebAuthorID <> PHPWeb.UserID) and (FWebCheckStatusMy <> csChecking)); vNode := vRP.ReceiveForLost(AFileName, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner); if vNode <> nil then begin vNode.Rec.BeginUpdate; vNode.Rec.ValueByName('WebMD5').AsString := FWebMD5_OnLine; vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; vNode.Rec.EndUpdate; end; end else vNode := vRP.Receive(AFileName); finally case vRP.MessageID of 0: begin Result := True; vNode.LocateInControl; end; 1: ErrorMessage('当前标段处于打开状态,未能成功接收,请先关闭标段再次接收。'); 2: ErrorMessage('下载数据与审批状态不一致,未能成功接收,请再次接收。'); 3: ErrorMessage('升级数据失败,未能成功接收,请再次接收。'); end; vRP.Free; FProjectManagerData.Save; end; end; // 登录后自动扫描等待我审核的项目 TagC procedure TProjectManagerFrame.actnReceiveProjectExecute(Sender: TObject); procedure DoReceiveLocal; var sFileName: string; begin if SelectFile(sFileName, '.rmf;*.arf') then begin ShowProgressHint('正在接收项目并升级数据'); try ReceiveFile(sFileName); finally CloseProgressHint; end; end; end; var OnCC: TZjCellNotifyEvent; begin Screen.Cursor := crHourGlass; try if G_IsCloud then begin OnCC := zgProjects.OnCurrentChanged; try zgProjects.OnCurrentChanged := nil; DoBatchReceiveOnline(1); if stdProjects.IDTree.FirstNode <> nil then stdProjects.IDTree.FirstNode.LocateInControl; finally zgProjects.OnCurrentChanged := OnCC; end; end else DoReceiveLocal; finally Screen.Cursor := crDefault; end; end; function TProjectManagerFrame.GetImportProjectName( const AFileName: string; AParent: TsdIDTreeNode): string; begin Result := ExtractSimpleFileName(AFileName); while FProjectManagerData.ExistProject(Result, AParent) do if not InputNewProjectName(Result, '导入', AParent) then Abort; end; procedure TProjectManagerFrame.actnNewProjectExecute(Sender: TObject); var sName: string; begin if G_IsCloud then Exit; // 云版线上与本地要保持同步,不允许本地新建 if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then FProjectManagerData.InsertProject(sName, stdProjects.IDTree.Selected); end; procedure TProjectManagerFrame.actnNewSubProjectExecute(Sender: TObject); var sName: string; begin if G_IsCloud then Exit; if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then FProjectManagerData.InsertSubProject(sName, stdProjects.IDTree.Selected); end; procedure TProjectManagerFrame.actnNewTenderExecute(Sender: TObject); function AddAndOpenTender(const ATenderName: string): TsdIDTreeNode; begin Result := FProjectManagerData.InsertTender(ATenderName, stdProjects.IDTree.Selected); MainForm.OpenProject(Result.Rec); end; // 网络版新建标段 TagD procedure NewProjectWithOnline; var WebNewTenderForm: TWebNewTenderForm; sName, sKey, sURL: string; stnNew: TsdIDTreeNode; iID, iFolderID, iSubFolderID: Integer; vRec: TsdDataRecord; vArr: array of string; begin WebNewTenderForm := TWebNewTenderForm.Create(nil); try WebNewTenderForm.ShowModal; if WebNewTenderForm.ModalResult = mrOK then begin sKey := WebNewTenderForm.edtKey.Text; sName := WebNewTenderForm.edtTenderName.Text; // 同服务器取得联系 iID := -1; vArr := VarArrayOf(['catid', 'name', 'company', 'phone', 'mobile', 'qq', 'pname', 'ptype', 'jobs', 'avatar', 'ownuid', 'pnameid', 'ptypeid']); sURL := Format('%s%d/%s/%s/creatmeasure', [PHPWeb.MeasureURL, PHPWeb.UserID, sName, sKey]); // AnsiToUtf8(sName) case PHPWeb.Search(sURL, [], [], vArr) of 1: begin iID := StrToInt(vArr[0]); iFolderID := StrToInt(vArr[11]); iSubFolderID := StrToInt(vArr[12]); CheckWebFolders(iFolderID, iSubFolderID, vArr[6], vArr[7]); end; 0: begin Application.MessageBox(PChar(PHPWeb.PageError('创建标段失败' + '[' + vArr[0] + ']')), '警告', MB_OK + MB_ICONWARNING); Exit; end; -1: begin Application.MessageBox(PChar(PHPWeb.NetError('创建标段失败')), '警告', MB_OK + MB_ICONWARNING); Exit; end; end; // 本地创建 stnNew := FProjectManagerData.InsertTender(sName, stdProjects.IDTree.Selected); // 这里把Web获取的信息存储到项目管理里面。 vRec := stnNew.Rec; vRec.BeginUpdate; vRec.ValueByName('WebID').AsInteger := iID; vRec.ValueByName('WebOwnerID').AsInteger := StrToInt(vArr[10]); // 业主 vRec.ValueByName('WebAuthorID').AsInteger := PHPWeb.UserID; // 编制人 vRec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; // 当前用户,用于只显示自己的项目 vRec.ValueByName('WebKey').AsString := sKey; vRec.EndUpdate; GetLocalValues(vRec); FWebOwnerName := vArr[1]; FWebOwnerCompany := vArr[2]; FWebOwnerRole := vArr[8]; FWebFolder_OnLine := vArr[6]; FWebSubFolder_OnLine := vArr[7]; // WebOwnerImage := vArr[9]; // WebOwnerPhone := vArr[3]; // WebOwnerMobile := vArr[4]; // WebOwnerQQ := vArr[5]; ShowProjectInfoTop(0); FProjectManagerData.Save; MainForm.OpenProject(vRec); end; finally WebNewTenderForm.Free; end; end; procedure NewProject; var sName: string; begin if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then AddAndOpenTender(sName); end; begin if G_IsCloud then NewProjectWithOnline else NewProject; end; procedure TProjectManagerFrame.zgProjectsDrawCellText(ACanvas: TCanvas; const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid; const Text: String; var ADefaultDraw: Boolean); procedure GetBitmap(AImage: TBitmap; ANode: TsdIDTreeNode); begin if Assigned(ANode) and Assigned(ANode.Rec) then begin if ANode.Rec.ValueByName('Type').AsInteger = 0 then if ANode.Expanded and ANode.HasChildren then MainForm.Images.GetBitmap(34, AImage) else MainForm.Images.GetBitmap(34, AImage) else MainForm.Images.GetBitmap(11, AImage); end else AImage := nil; end; const rIconWidth = 16; rIconHeight = 16; var Img: TBitmap; Cell: TZjCell; rImg: TRect; vNode: TsdIDTreeNode; begin if (ACoord.X = 1) and (ACoord.Y > zgProjects.FixedRowCount - 1) then begin Cell := zgProjects.Cells[ACoord.X, ACoord.Y]; Img := TBitmap.Create; try vNode := stdProjects.IDTree.Items[ACoord.Y-zgProjects.FixedRowCount]; GetBitmap(Img, vNode); case Cell.Align of gaTopLeft, gaTopCenter, gaTopRight: rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight); gaCenterLeft, gaCenterCenter, gaCenterRight: rImg := Rect(ARect.Left + 2, ARect.Top + (ARect.Bottom - ARect.Top - rIconHeight) div 2, ARect.Left + rIconWidth, ARect.Bottom - (ARect.Bottom - ARect.Top - rIconHeight) div 2); gaBottomLeft, gaBottomCenter, gaBottomRight: rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom); end; ACanvas.StretchDraw(rImg, Img); WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom) , 2, 2, Text, Cell.Align, False); ADefaultDraw := False; finally Img.Free; end; end; end; procedure TProjectManagerFrame.actnNewSubProjectUpdate(Sender: TObject); begin TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and IsProject(stdProjects.IDTree.Selected) and (not IsUnEmptyLeafProject(stdProjects.IDTree.Selected)); end; procedure TProjectManagerFrame.actnNewTenderUpdate(Sender: TObject); var bCloud: Boolean; vNode: TsdIDTreeNode; begin bCloud := G_IsCloud; // 只有编制人才能创建新标段?逻辑先后有问题:编制人是在创建标段之后产生的。 // 创建前,当前用户只是一个帐户,它是不是编制人末知,因为它还可以是其它角色。 // 同一帐户在不同的标段可以作为不同的角色。 if bCloud then begin TAction(Sender).Enabled := True; end else begin vNode := stdProjects.IDTree.Selected; TAction(Sender).Enabled := Assigned(vNode) and IsProject(vNode) and IsLeafProject(vNode); end; end; function TProjectManagerFrame.IsLeafProject(ANode: TsdIDTreeNode): Boolean; begin if ANode.HasChildren then Result := ANode.FirstChild.Rec.ValueByName('Type').AsInteger = 1 else Result := ANode.Rec.ValueByName('Type').AsInteger = 0; end; function TProjectManagerFrame.IsProject(ANode: TsdIDTreeNode): Boolean; begin Result := ANode.Rec.ValueByName('Type').AsInteger = 0; end; function TProjectManagerFrame.IsUnEmptyLeafProject( ANode: TsdIDTreeNode): Boolean; begin Result := ANode.HasChildren and (ANode.Rec.ValueByName('Type').AsInteger = 1); end; procedure TProjectManagerFrame.SetPropertyVisible(AVisible: Boolean); begin // 单击刷新项目信息 TagA if G_IsCloud then begin if CurRec = nil then Exit; pnlTenderProperty.Visible := False; pnlWeb.Visible := AVisible; if AVisible then begin CreateProgress('云端读取项目信息'); try ShowProjectInfoTopAndCheckers; finally CloseProgress; end; end; end else begin pnlWeb.Visible := False; pnlTenderProperty.Visible := AVisible; sprProperty.Visible := AVisible; end; end; procedure TProjectManagerFrame.zgProjectsCurrentChanged(Sender: TObject; Col, Row: Integer); begin if G_IsCloud then begin if CurRec <> nil then begin // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新 // if FID <> CurRec.ValueByName('ID').AsInteger then SetPropertyVisible(CurRec.ValueByName('Type').AsInteger = 1); // OnCurrentChanged取得的 CurRec.ValueByName() 值并不总是可靠,这里加保险。 // 如调用locateInControl后,执行到这里取得的CurRec.ValueByName('ID')值还是上一条的。 if (CurRec.ValueByName('Type').AsInteger = 1) and (not pnlWeb.Visible) then pnlWeb.Visible := True; end; end; end; procedure TProjectManagerFrame.actnSubmitProjectUpdate(Sender: TObject); begin TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1) and (stdProjects.IDTree.Selected.Rec.ValueByName('AuditStatus').AsInteger < iMaxStageCount-1); end; procedure TProjectManagerFrame.actnReplyProjectUpdate(Sender: TObject); begin TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1); end; procedure TProjectManagerFrame.actnRenameExecute(Sender: TObject); function CanRename(ARec: TsdDataRecord; const ANewName: string): Boolean; var sURL: string; iRename: Integer; vArr: array [0..0] of string; begin Result := True; if not G_IsCloud then Exit; // 云版 重命名须确保同步服务器 sURL := Format('%stender/%d/%s/update', [PHPWeb.MeasureURL, ARec.ValueByName('WebID').AsInteger, ANewName]); iRename := PHPWeb.Search(sURL, [], [], vArr); Result := iRename = 1; case iRename of 1: ShowMessage('新的标段名称已同步到服务器!'); 0: Application.MessageBox(PChar(PHPWeb.PageError('重命名同步到云端失败' + '[' + vArr[0] + ']')), '警告', MB_OK + MB_ICONWARNING); -1: Application.MessageBox(PChar(PHPWeb.NetError('重命名同步到云端失败')), '警告', MB_OK + MB_ICONWARNING); end; end; var stnNode: TsdIDTreeNode; sName: string; begin stnNode := stdProjects.IDTree.Selected; sName := stnNode.Rec.ValueByName('Name').AsString; if not Assigned(OpenProjectManager.FindProjectData(stnNode.ID)) then begin if InputNewProjectName(sName, '重命名', stnNode.Parent, stnNode.ID) then begin if (sName <> stnNode.Rec.ValueByName('Name').AsString) and CanRename(stnNode.Rec, sName) then begin stnNode.Rec.ValueByName('Name').AsString := sName; ProjectManager.Save; end; end; end else ErrorMessage(Format('项目[%s]已经打开,无法重命名!', [sName])); end; procedure TProjectManagerFrame.actnOpenUpdate(Sender: TObject); begin TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1); end; procedure TProjectManagerFrame.actnImportExecute(Sender: TObject); procedure ImportTender(const AFileName, AProjectName: string); var Importor: TTenderImport; begin Importor := TTenderImport.Create(stdProjects.IDTree.Selected, AProjectName, AFileName); try Importor.Execute; finally Importor.Free; end; end; procedure ImportProject(const AFileName, AProjectName: string); var Importor: TProjectImport; begin Importor := TProjectImport.Create(stdProjects.IDTree.Selected, AProjectName, AFileName); try Importor.Execute; finally Importor.Free; end; end; var sFileName, sProjectName: string; vCur: TsdIDTreeNode; begin if SelectFile(sFileName, '.mtf;*.mpf') then begin vCur := stdProjects.IDTree.Selected; if Assigned(vCur) then begin if SameText(ExtractFileExt(sFileName), '.mtf') and (vCur.Rec.ValueByName('Type').AsInteger = 0) then sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected) else sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected.Parent); end else sProjectName := GetImportProjectName(sFileName, vCur); Screen.Cursor := crHourGlass; try if SameText(ExtractFileExt(sFileName), '.mtf') then ImportTender(sFileName, sProjectName) else ImportProject(sFileName, sProjectName); finally Screen.Cursor := crDefault; end; end; FProjectManagerData.Save; end; procedure TProjectManagerFrame.actnExportExecute(Sender: TObject); procedure ExportTender(ANode: TsdIDTreeNode); var Exportor: TTenderExport; sFileName, sHint: string; bExpAtch: Boolean; iCount: Integer; begin bExpAtch := False; sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mtf'; if SaveFile(sFileName, '.mtf') then begin if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then Exit; Screen.Cursor := crHourGlass; try Exportor := TTenderExport.Create(ANode.Rec, sFileName); try { if not G_IsCloud then begin iCount := FileCount(CurRecAttachmentPath); if iCount > 1 then // 排除管理文件库 begin sHint := Format('本标段包含 %d 个附件,是否将附件一起导出?', [iCount - 1]); bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes; end; end; } // FFFFF Exportor.Execute(bExpAtch); finally Exportor.Free; end; finally Screen.Cursor := crDefault; end; end; end; procedure ExportProject(ANode: TsdIDTreeNode); var Exportor: TProjectExport; sFileName, sHint: string; bExpAtch: Boolean; iCount: Integer; begin sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mpf'; if SaveFile(sFileName, '.mpf') then begin if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then Exit; Screen.Cursor := crHourGlass; try bExpAtch := False; { if not G_IsCloud then begin iCount := AttachmentFileCountsWithoutManageFile(ANode); if iCount > 0 then begin sHint := Format('本建设项目共包含 %d 个附件,是否将附件一起导出?', [iCount]); bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes; end; end; } // FFFFF Exportor := TProjectExport.Create(ANode, sFileName, bExpAtch); try Exportor.Execute; finally Exportor.Free; end; finally Screen.Cursor := crDefault; end; end; end; var stnNode: TsdIDTreeNode; begin stnNode := stdProjects.IDTree.Selected; if stnNode.Rec.ValueByName('Type').AsInteger = 1 then begin ExportTender(stnNode); end else ExportProject(stnNode); end; procedure TProjectManagerFrame.actnDeleteUpdate(Sender: TObject); begin if Assigned(stdProjects.IDTree.Selected) then TAction(Sender).Enabled := not CheckOpened(stdProjects.IDTree.Selected) else TAction(Sender).Enabled := False; end; function TProjectManagerFrame.CheckOpened(ANode: TsdIDTreeNode): Boolean; var iChild: Integer; begin Result := False; if ANode.Rec.ValueByName('Type').AsInteger = 1 then Result := OpenProjectManager.ProjectIndex(ANode.ID) > -1 else begin if not ANode.HasChildren then Result := False else begin for iChild := 0 to ANode.ChildCount - 1 do Result := Result or CheckOpened(ANode.ChildNodes[iChild]); end end; end; procedure TProjectManagerFrame.ShowProjectInfoTopAndCheckers; var vPSArr: TStrArr; vCArr: TOVArr; // Checkers sPicPath, sURL: string; procedure ShowProjectCheckers; var i, j, k, n: Integer; vOwner: array of string; // 业主信息 procedure AddCheckerFrame(AType: TCheckerFrameType; AArr: array of string); var vChecker: TOrderCheckerFrame; begin vChecker := TOrderCheckerFrame.Create(self); FCheckerFrames.Add(vChecker); vChecker.Owner := Self; sbChecker.VertScrollBar.Range := sbChecker.VertScrollBar.Range + vChecker.Height; sbChecker.Height := Min(sbChecker.Height + vChecker.Height, pnlWeb.Height - pnlProject.Height); vChecker.Parent := sbChecker; vChecker.Top := FCurPos; FCurPos := FCurPos + vChecker.Height; vChecker.Align := alTop; sPicPath := PHPWeb.UserPath + '1_' + AArr[0] + '.jpg'; PHPWeb.DownFile(AArr[4], sPicPath); vChecker.Init(AType, StrToInt(AArr[0]), AArr[1], AArr[3], AArr[2], sPicPath, AArr[6], TCheckStatus(StrToInt(AArr[5])-1), AArr[8], StrToInt(AArr[7])); vChecker.Name := 'ProjectOrderFrame' + AArr[0]; end; begin sbChecker.Height := 0; FCurPos := 0; n := Length(vCArr[Low(vCArr)]); SetLength(vOwner, n); sbChecker.VertScrollBar.Range := 0; for i := Low(vCArr) to High(vCArr) do begin if StrToInt(vCArr[i, 0]) = PHPWeb.UserID then FWebCheckStatusMy := TCheckStatus(StrToInt(vCArr[i, 5])-1); if StrToInt(vCArr[i, 0]) = FWebOwnerID then begin for j := 0 to n - 1 do vOwner[j] := vCArr[i, j]; Continue; end; AddCheckerFrame(cftChecker, vCArr[i]); end; if vOwner[0] <> '' then AddCheckerFrame(cftOwner, vOwner); for k := 0 to sbChecker.ControlCount - 1 do TOrderCheckerFrame(sbChecker.Controls[k]).Order := k + 1; OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner); end; begin FCheckerFrames.Clear; GetLocalValues(CurRec); if FWebID = 0 then Exit; SetLength(vPSArr, 8); sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]); SetLength(FCheckers, 0); if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then begin FCheckers := vCArr; LockWindowUpdate(pnlWeb.Handle); try FPhaseNo := StrToInt(vPSArr[0]); FWebCheckStatusProject := TCheckStatus(StrToInt(vPSArr[1])-1); FPhaseTotal := StrToInt(vPSArr[2]); FWebFolder_OnLine := vPSArr[3]; FWebSubFolder_OnLine := vPSArr[4]; FWebOwnerName := vPSArr[5]; FWebOwnerCompany := vPSArr[6]; FWebOwnerRole := vPSArr[7]; ShowProjectInfoTop; ShowProjectCheckers; finally LockWindowUpdate(0); end; end else begin FPhaseNo := 0; FWebCheckStatusProject := csNotBegin; FPhaseTotal := 0; FWebFolder_OnLine := ''; FWebSubFolder_OnLine := ''; FWebOwnerName := ''; FWebOwnerCompany := ''; FWebOwnerRole := ''; ShowProjectInfoTop; sbChecker.Height := 0; end; end; procedure TProjectManagerFrame.ShowProjectInfoTop(AType: Integer); procedure ShowOwner; begin lblBidName.Caption := FWebBidName_Local; lblBidName.Update; lblProjName.Caption := FWebFolder_OnLine; lblProjName.Update; lblWebProjCtgyName.Caption := FWebSubFolder_OnLine; lblWebProjCtgyName.Update; lblOnwerName.Caption := FWebOwnerName; lblOnwerName.Update; lblOnwerCompany.Caption := Format('-%s)', [FWebOwnerCompany]); lblOnwerCompany.Update; lblOnwerCompany.Left := lblOnwerName.Left + lblOnwerName.Width; end; procedure ShowStatus(ANo: Integer; AState: TCheckStatus); begin lblPeriod.Caption := Format('第%d期', [ANo]); lblPeriod.Update; lblPeriodState.Caption := CheckStatusNames[AState]; lblPeriodState.Font.Color := CheckStatusColors[AState]; lblPeriodState.Update; lblPeriodState.Left := lblPeriod.Left + lblPeriod.Width + 5; lblPeriodTotal.Caption := Format('(共%d期)', [ANo]); lblPeriodTotal.Update; lblPeriodTotal.Left := lblPeriodState.Left + lblPeriodState.Width + 3; end; begin GetLocalValues(CurRec); case AType of -2: begin lblPeriod.Caption := '正在从云端读取状态信息...'; lblPeriod.Update; end; -1: begin ShowOwner; ShowStatus(FPhaseNo, FWebCheckStatusProject); end; 0: begin ShowOwner; ShowStatus(0, csNotBegin); end; end; end; // 检查后,应该定位到最后一层目录,不应该回到原先的选择节点。否则从网络拉下来的项目无法组织正确的树结构。 procedure TProjectManagerFrame.CheckWebFolders(AFolderID, ASubFolderID: Integer; AFolderName, ASubFolderName: string); var vTree: TsdIDTree; vNode, vSubNode: TsdIDTreeNode; i: Integer; sName: string; iUserID, iWebID, iWebFolderLevel: Integer; bExist, bSubExist, bModified: Boolean; begin bExist := False; bSubExist := False; bModified := False; vTree := stdProjects.IDTree; for i := 0 to vTree.Count - 1 do begin vNode := vTree.Items[i]; sName := vNode.Rec.ValueByName('Name').AsString; iUserID := vNode.Rec.ValueByName('WebUserID').AsInteger; iWebID := vNode.Rec.ValueByName('WebID').AsInteger; iWebFolderLevel := vNode.Rec.ValueByName('WebFolderLevel').AsInteger; if (iWebID = AFolderID) and (iWebFolderLevel = G_WFL_ProjName) and (iUserID = PHPWeb.UserID) then begin bExist := True; vNode.LocateInControl; if not SameText(sName, AFolderName) then begin vNode.Rec.ValueByName('Name').AsString := AFolderName; bModified := True; end; Break; end; end; if not bExist then begin vNode := vTree.Items[0]; if Assigned(vNode) then vNode.LocateInControl; vNode := FProjectManagerData.InsertProject(AFolderName, stdProjects.IDTree.Selected, AFolderID, G_WFL_ProjName); vNode.LocateInControl; end; for i := 0 to vNode.ChildCount - 1 do begin vSubNode := vNode.ChildNodes[i]; sName := vSubNode.Rec.ValueByName('Name').AsString; iUserID := vSubNode.Rec.ValueByName('WebUserID').AsInteger; iWebID := vSubNode.Rec.ValueByName('WebID').AsInteger; iWebFolderLevel := vSubNode.Rec.ValueByName('WebFolderLevel').AsInteger; if (iWebID = ASubFolderID) and (iWebFolderLevel = G_WFL_BidType) and (iUserID = PHPWeb.UserID) then begin bSubExist := True; vSubNode.LocateInControl; if not SameText(sName, ASubFolderName) then begin vSubNode.Rec.ValueByName('Name').AsString := ASubFolderName; bModified := True; end; Break; end; end; if not bSubExist then begin vNode.LocateInControl; vNode := FProjectManagerData.InsertSubProject(ASubFolderName, stdProjects.IDTree.Selected, ASubFolderID, G_WFL_BidType); vNode.LocateInControl; end; if bModified then ProjectManager.Save; end; function TProjectManagerFrame.Rec(AProjectID: Integer): TsdDataRecord; var i: Integer; vTree: TsdIDTree; begin vTree := stdProjects.IDTree; if vTree.Selected.Rec.ValueByName('ID').AsInteger = AProjectID then begin Result := stdProjects.IDTree.Selected.Rec; Exit; end; for i := 0 to vTree.Count - 1 do begin if vTree.Items[i].Rec.ValueByName('ID').AsInteger = AProjectID then begin Result := vTree.Items[i].Rec; vTree.Items[i].LocateInControl; Break; end; end; end; destructor TProjectManagerFrame.Destroy; begin FCheckerFrames.Free; inherited; end; procedure TProjectManagerFrame.DoBatchReceiveOnline(ARequestType: Integer); var sURL, sCheckersURL, sHint: string; vArr: TOVArr; i, iFolderID, iSubFolderID: Integer; vPSArr: TStrArr; vCArr: TOVArr; // Checkers begin // 查询等待我审核的标段文件,杰哥说分三种:①业主未审核 ②业主审核中 ③审核人审核中 (为什么加①?问杰哥) case PHPWeb.Search(PHPWeb.MeasureURL + 'user/get/audit/project', ['audituid', 'RequestType'], [IntToStr(PHPWeb.UserID), IntToStr(ARequestType)], vArr) of 1: begin CreateProgress('正在从云端下载新项目'); try for i := Low(vArr) to High(vArr) do begin sURL := vArr[i, 0]; FWebFolder_OnLine := vArr[i, 1]; FWebSubFolder_OnLine := vArr[i, 2]; FWebMD5_OnLine := vArr[i, 3]; FWebID := StrToInt(vArr[i, 5]); iFolderID := StrToInt(vArr[i, 6]); iSubFolderID := StrToInt(vArr[i, 7]); FWebCheckStatusMy := TCheckStatus(StrToInt(vArr[i, 8])-1); // vArr[i, 4]项目审核状态;vArr[i, 8]当前登陆用户的审核状态 FWebAuthorID := StrToInt(vArr[i, 9]); FWebBidName_OnLine := vArr[i, 10]; FWebMD5_Local := LocalMD5(PHPWeb.UserID, FWebID); CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine); CheckBidName(PHPWeb.UserID, FWebID, FWebBidName_OnLine); if FWebMD5_OnLine <> FWebMD5_Local then begin sCheckersURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]); if PHPWeb.Search(sCheckersURL, [''], [''], 3, vPSArr, vCArr) = 1 then OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner) else begin FOnLineCheckerBegin := 0; FOnLineCheckerEnd := 0; end; if not FileDownAndReceive(sURL, 1) then Exit; end; end; BubbleSortProjects; finally CloseProgress; end; end; 0: begin sHint := 'Web页返回错误(000J),无法查询云端项目的更新情况,请重试!'; Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; -1: begin sHint := '网络较差,服务器断开连接,无法查询云端项目的更新情况,请重试!'; Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; end; end; function TProjectManagerFrame.ImportFile(const AFileName: string; AFileMD5: string): Boolean; var vImport: TTenderImport; vNode: TsdIDTreeNode; begin Result := False; vNode := stdProjects.IDTree.Selected; vImport := TTenderImport.Create(vNode, '', AFileName); try try vImport.ImportToSelect; vNode.LocateInControl; Result := True; except Result := False; end; finally vImport.Free; vNode.Rec.BeginUpdate; vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5; vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; vNode.Rec.EndUpdate; FProjectManagerData.Save; end; end; procedure TProjectManagerFrame.actnOpenBackupFolderExecute( Sender: TObject); var stnNode: TsdIDTreeNode; begin stnNode := stdProjects.IDTree.Selected; if stnNode.Rec.ValueByName('BackupFolder').AsString = '' then TipMessage('该项目暂无备份数据!') else ShellExecute(Handle, 'open', 'Explorer.exe', PChar(FProjectManagerData.BackupPath(stnNode.ID)), nil, 1); end; procedure TProjectManagerFrame.actnRenameUpdate(Sender: TObject); var Rec: TsdDataRecord; bNet, bEnabled: Boolean; begin if Assigned(stdProjects.IDTree.Selected) and Assigned(stdProjects.IDTree.Selected.Rec) then begin bEnabled := True; Rec := stdProjects.IDTree.Selected.Rec; bNet := G_IsCloud; if bNet then begin bEnabled := (Rec.ValueByName('Type').AsInteger = 1) and (Rec.ValueByName('WebAuthorID').AsInteger = PHPWeb.UserID); end; end else bEnabled := False; if bEnabled <> TAction(Sender).Enabled then TAction(Sender).Enabled := bEnabled; end; procedure TProjectManagerFrame.CheckBidName(AID: Integer; ANewBidName: string); var vNode: TsdIDTreeNode; begin vNode := stdProjects.IDTree.FindNode(AID); if vNode = nil then Exit; if vNode.Rec.ValueByName('Name').AsString <> ANewBidName then begin vNode.Rec.ValueByName('Name').AsString := ANewBidName; ProjectManager.Save; end; end; procedure TProjectManagerFrame.DoBatchReceiveAllOnline; var OnCC: TZjCellNotifyEvent; begin OnCC := zgProjects.OnCurrentChanged; try zgProjects.OnCurrentChanged := nil; DoBatchReceiveOnline(2); if stdProjects.IDTree.FirstNode <> nil then stdProjects.IDTree.FirstNode.LocateInControl; finally zgProjects.OnCurrentChanged := OnCC; end; end; procedure TProjectManagerFrame.GetLocalValues(ARec: TsdDataRecord); begin if not Assigned(ARec) then begin ClearLocalValues; Exit; end; // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新 // if ARec.ValueByName('ID').AsInteger <> FID then begin FID := ARec.ValueByName('ID').AsInteger; FWebID := ARec.ValueByName('WebID').AsInteger; FWebAuthorID := ARec.ValueByName('WebAuthorID').AsInteger; FWebOwnerID := ARec.ValueByName('WebOwnerID').AsInteger; FWebMD5_Local := ARec.ValueByName('WebMD5').AsString; FWebBidName_Local := ARec.ValueByName('Name').AsString; end; end; procedure TProjectManagerFrame.GetLocalValues(AUserID, AWebID: Integer); var i: Integer; vTree: TsdIDTree; vRec: TsdDataRecord; begin ClearLocalValues; // 先清空,以防没找到。 if (CurRec <> nil) and (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and (CurRec.ValueByName('WebID').AsInteger = AWebID) and (CurRec.ValueByName('Type').AsInteger = 1) then begin GetLocalValues(CurRec); Exit; end; vTree := stdProjects.IDTree; for i := 0 to vTree.Count - 1 do begin vRec := vTree.Items[i].Rec; if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and (vRec.ValueByName('WebID').AsInteger = AWebID) and (vRec.ValueByName('Type').AsInteger = 1) then begin GetLocalValues(vRec); Break; end; end; end; procedure TProjectManagerFrame.ClearLocalValues; begin FID := -1; FWebID := -1; FWebAuthorID := -1; FWebOwnerID := -1; FWebMD5_Local := ''; FWebBidName_Local := ''; end; function TProjectManagerFrame.LocalMD5(AUserID, AWebID: Integer): string; var i: Integer; vTree: TsdIDTree; vRec: TsdDataRecord; begin Result := '本地无MD5码'; if (CurRec <> nil) and (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and (CurRec.ValueByName('WebID').AsInteger = AWebID) and (CurRec.ValueByName('Type').AsInteger = 1) then begin Result := CurRec.ValueByName('WebMD5').AsString; Exit; end; vTree := stdProjects.IDTree; for i := 0 to vTree.Count - 1 do begin vRec := vTree.Items[i].Rec; if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and (vRec.ValueByName('WebID').AsInteger = AWebID) and (vRec.ValueByName('Type').AsInteger = 1) then begin Result := vRec.ValueByName('WebMD5').AsString; Break; end; end; end; function TProjectManagerFrame.CurRec: TsdDataRecord; begin if stdProjects.IDTree.Selected = nil then Result := nil else Result := stdProjects.IDTree.Selected.Rec; end; procedure TProjectManagerFrame.CheckBidName(AUserID, AWebID: Integer; ANewBidName: string); var i: Integer; vTree: TsdIDTree; vRec: TsdDataRecord; begin if (CurRec <> nil) and (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and (CurRec.ValueByName('WebID').AsInteger = AWebID) and (CurRec.ValueByName('Type').AsInteger = 1) then begin if (CurRec.ValueByName('Name').AsString <> ANewBidName) then begin CurRec.ValueByName('Name').AsString := ANewBidName; ProjectManager.Save; end; Exit; end; vTree := stdProjects.IDTree; for i := 0 to vTree.Count - 1 do begin vRec := vTree.Items[i].Rec; if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and (vRec.ValueByName('WebID').AsInteger = AWebID) and (vRec.ValueByName('Type').AsInteger = 1) then begin if vRec.ValueByName('Name').AsString <> ANewBidName then begin vRec.ValueByName('Name').AsString := ANewBidName; ProjectManager.Save; end; Break; end; end; end; function TProjectManagerFrame.CurRecAttachmentPath: string; begin if G_IsCloud then Result := PHPWeb.WebPath + 'Projects\' + CurRec.ValueByName('WebID').AsString + '\Attachment\' else Result := GetMyProjectsFilePath + 'Attachment\' + CurRec.ValueByName('FileName').AsString + '\'; end; function TProjectManagerFrame.AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer; function GetCount(ANode: TsdIDTreeNode): Integer; var sPath: string; begin if not Assigned(ANode) then Exit; Result := 0; if ANode.Rec.ValueByName('Type').AsInteger = 0 then Result := Result + 0 else begin sPath := GetMyProjectsFilePath + 'Attachment\' + ANode.Rec.ValueByName('FileName').AsString + '\'; Result := Result + FileCount(sPath, '.*') - 1; end; if Assigned(ANode.FirstChild) then Result := Result + GetCount(ANode.FirstChild); if Assigned(ANode.NextSibling) then Result := Result + GetCount(ANode.NextSibling); end; begin if not Assigned(ANode) then Exit; if Assigned(ANode.FirstChild) then Result := GetCount(ANode.FirstChild) else Result := 0; end; procedure TProjectManagerFrame.BubbleSortProjects; // 不能排最顶层 procedure BubbleSort(ANode: TsdIDTreeNode); var n, t, c, temp: Integer; bSwap: Boolean; vNode1, vNode2, vTempNode: TsdIDTreeNode; begin if ANode = nil then Exit; // if ANode.Rec.ValueByName('WebFolderLevel').AsInteger = G_WFL_ProjName then Exit; n := ANode.ChildCount; for t := 1 to n - 1 do begin bSwap := False; for c := 1 to (n - t) do begin vNode1 := ANode.ChildNodes[c - 1]; vNode2 := ANode.ChildNodes[c]; if AnsiCompareStr(vNode1.Rec.ValueByName('Name').AsString, vNode2.Rec.ValueByName('Name').AsString) = 1 then begin vNode1.DownMove; bSwap := True; end; end; if bSwap = False then Break; end; if Assigned(ANode.FirstChild) then BubbleSort(ANode.FirstChild); if Assigned(ANode.NextSibling) then BubbleSort(ANode.NextSibling); end; begin BubbleSort(stdProjects.IDTree.FirstNode); end; procedure TProjectManagerFrame.zgProjectsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint); var vCell: TZjCell; vNode: TsdIDTreeNode; iLevelWidth: Integer; rText: TRect; procedure CalcTextRect(var R: TRect); var DC: HDC; iTextHeight: Integer; begin DC := CreateCompatibleDC(0); try SelectObject(DC, vCell.Font.Handle); iTextHeight := DrawText(DC, PChar(vCell.Text), Length(vCell.Text), R, DT_SINGLELINE or DT_VCenter or DT_NOCLIP or DT_CALCRECT); finally DeleteDC(DC); end; end; begin if (ACoord.Y < 1) and (ACoord.X <> 1) then Exit; vCell := zgProjects.Cells[ACoord.X, ACoord.Y]; with HintInfo do begin vNode := stdProjects.IDTree.Items[ACoord.Y - 1]; if not Assigned(vNode) then Exit; iLevelWidth := (vNode.Level + 1) * 20 + 16; rText := CursorRect; CalcTextRect(rText); if (rText.Right - rText.Left + iLevelWidth > CursorRect.Right - CursorRect.Left) or (rText.Right > ClientWidth) then begin CanShow := True; HintStr := vCell.Text; GetCursorPos(HintPos); end; end; end; function TProjectManagerFrame.FileDownAndReceive(ADownURL: string; AReceiveKind: Integer): Boolean; var sLocalFile, sHint: string; bCanImp: Boolean; vFileCheck: TTenderFileChecker; begin Result := False; // 下载 sLocalFile := PHPWeb.UserPath + ExtractFileName(ADownURL); if not PHPWeb.DownFile(ADownURL, sLocalFile) then begin sHint := Format('云端已找到 [%s] 的新文件,但由于网络原因下载失败!请重试!', [FWebBidName_Local]); Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING); Exit; end; // 接收前先检验原报文件是否正确(审核不通过打回) if AReceiveKind = 2 then begin // 有时原报文件出错:包含了1审2审的数据。 vFileCheck := TTenderFileChecker.Create; try // 有一期以上数据,且最新期数据审核状态为原报 bCanImp := vFileCheck.CheckFileValid(sLocalFile) and (vFileCheck.PhaseCount > 0) and (vFileCheck.AuditStatus = 0); if not bCanImp then begin Application.MessageBox(PChar('已从云端下载原报文件到本地,但文件有错误(包含1审数据)禁止接收!请致电纵横服务人员以获取帮助。'), '警告', MB_OK + MB_ICONWARNING); Exit; end; finally vFileCheck.Free; end; {注意: 审核末通过的导入更新,这里的MD5码应取最终审核不通过项目的,否则会带来下载循环问题。 问题描述: ①编制人运行软件,双击项目,发现审核不通过,自动下载无锁文件,开始新一期,保存关闭。 ②编制人再次运行软件,双击项目,MD5码不同,自动下载旧的审核不通过文件,覆盖本地。 ③编制人再次运行软件,双击项目,发现审核不通过,重复①,循环.... 问:①那里下载无锁文件后不能改成新的MD5码吗? 答:不能,因为审核人的项目会变成无锁文件,看不到不通过项目。MD5码只能在上传后更新。 且编制人有个交互界面2种选择:a.下载更新不通过项目查看;b.下载更新无锁文件开始新一期。} end; // 接收更新 if not ReceiveFile(sLocalFile, (AReceiveKind = 2)) then begin sHint := Format('已从云端下载新的 [%s] 到本地 [%s],但接收失败,请删除该项目然后重新从云端获取!', [FWebBidName_OnLine, sLocalFile]); Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING); Exit; end; if FileExists(sLocalFile) then DeleteFile(sLocalFile); Result := True; end; // 为了跟PHP的数组兼容,这里限制数组的第一个元素是A[0](不能是A[1]) procedure TProjectManagerFrame.OnLineChecker(AAr: TOVArr; var ABegin, AEnd: Integer; var AOnLineEndIsOwner: Boolean); var i, j: Integer; vCS: TCheckStatus; begin i := 0; j := 0; ABegin := 0; AEnd := 0; AOnLineEndIsOwner := AAr[High(AAr), 7] = '1'; // 接口返回的第7列是线上审批标记 // 数组必须在位置n处截断,后面的部分作废。n的取值情况: // ①轮到工作中的那个人的前一个人 ②审核不通过的那个人 ③ 审核通过的人是业主 if AOnLineEndIsOwner then AEnd := High(AAr) + 1 else begin for i := High(AAr) downto 0 do begin vCS := TCheckStatus(StrToInt(AAr[i, 5]) - 1); if vCS = csChecking then begin if (i > 0) and (AAr[i - 1, 7] = '1') then // 前一个人且不是第一个人 AEnd := i; Break; end else if vCS = csNotPass then begin if AAr[i, 7] = '1' then AEnd := i + 1; Break; end; end; end; if AEnd = 0 then Exit; if AEnd = 1 then begin ABegin := 1; Exit; end; for j := AEnd -2 downto 0 do begin if AAr[j, 7] = '0' then begin ABegin := j + 2; Break; end else begin if j = 0 then ABegin := 1; end; end; end; procedure TProjectManagerFrame.actnExportUpdate(Sender: TObject); begin TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected); end; procedure TProjectManagerFrame.actnOpenBackupFolderUpdate(Sender: TObject); begin TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1); end; procedure TProjectManagerFrame.pnlProgressClick(Sender: TObject); var s: string; begin if (GetKeyState(VK_LSHIFT) < 0) and (GetKeyState(VK_LCONTROL) < 0) then begin s := Format('%d, %d, %s', [FOnLineCheckerBegin, FOnLineCheckerEnd, BoolToStr(FOnLineCheckerEndIsOwner)]); Application.MessageBox(Pchar(s), 'Hint'); end; end; procedure TProjectManagerFrame.actnSignOnlineExecute(Sender: TObject); var iPhase: Integer; begin LoadSignOnlineSwitch; if (FSignOnlineSwitch = 0) then WarningMessage('云端未开启在线签署功能。') else if SelectOnlineSignPhase(iPhase, stdProjects.IDTree.Selected.Rec) then SignOnline(stdProjects.IDTree.Selected, iPhase); end; procedure TProjectManagerFrame.actnSignOnlineUpdate(Sender: TObject); function HasCompletePhase(ARec: TsdDataRecord): Boolean; begin if (ARec.ValueByName('PhaseCount').AsInteger > 1) then Result := True else if (ARec.ValueByName('PhaseCount').AsInteger < 1) then Result := False else Result := ARec.ValueByName('AuditStatus').AsInteger = -1; end; begin TAction(Sender).Visible := G_IsCloud and (not IsGuest); TAction(Sender).Enabled := (FSignOnlineSwitch = 1) and Assigned(stdProjects.IDTree.Selected) and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1) and HasCompletePhase(stdProjects.IDTree.Selected.Rec); end; procedure TProjectManagerFrame.LoadSignOnlineSwitch; var iResult: Integer; sResult: string; begin FSignOnlineSwitch := 0; iResult := PHPWeb.UrlGet(PhPWeb.MeasureURL + 'sign/switch', nil, sResult); case iResult of 1: FSignOnlineSwitch := StrToIntDef(sResult, 0); 0: WarningMessage('网络错误:' + sResult); -1: WarningMessage('网络错误:无法连接到云端'); end; end; procedure TProjectManagerFrame.actnGuestExecute(Sender: TObject); var SetGuestForm: TSetGuestForm; begin CreateProgress('云端取最新审核人列表'); try ShowProjectInfoTopAndCheckers; finally CloseProgress; end; SetGuestForm := TSetGuestForm.Create(CurRec.ValueByName('WebID').AsInteger); SetGuestForm.Owner := Self; try SetGuestForm.ShowModal; finally SetGuestForm.Free; end; end; procedure TProjectManagerFrame.actnGuestUpdate(Sender: TObject); begin TAction(Sender).Visible := G_IsCloud and (not IsGuest); TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1); end; function TProjectManagerFrame.UserIsChecker(UserID: Integer): Boolean; var i: Integer; begin Result := False; if FWebAuthorID = UserID then begin Result := True; Exit; end; for i := Low(FCheckers) to High(FCheckers) do begin if StrToInt(FCheckers[i, 0]) = UserID then begin Result := True; Break; end; end; end; function TProjectManagerFrame.IsGuest: Boolean; begin Result := not UserIsChecker(PHPWeb.UserID); end; end.