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, ExtCtrls, StdCtrls, sdDB, CslButton, OrderCheckerFme, Contnrs; type 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; 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); private FProjectManagerData: TProjectManagerData; FID: Integer; FWebID: Integer; FWebAuthorID: Integer; FWebOwnerID: Integer; FWebMD5: string; FBidName: string; FWebProjCtgyName: string; FWebOwnerCompany: string; FWebProjectName: string; FWebOwnerRole: string; FWebOwnerName: string; FPhaseTotal: Integer; FPhaseNo: Integer; FMyCheckStatus: TCheckStatus; // 登陆用户在当前项目中的工作状态。 FProjectCheckStatus: TCheckStatus; // 项目的审核状态。 FCurPos: Integer; // 用来控制审核人的添加位置 FCheckerList: TObjectList; function ReceiveFile(const AFileName: string; AFileMD5: string = ''; ANeedLock: 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 SearchAndShowProjAllWebInfo(ARec: TsdDataRecord); // 网络上的目录结构，本地有则定位，没有则创建。 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; overload; 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; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure DoBatchReceiveAllOnline; // AType: -2 繁忙; -1 正常读取； 0 第0期； 1 第1期。 procedure ShowProjWebInfoTop(AType: Integer = -1); function Rec(AProjectID: Integer): TsdDataRecord; function CurRec: TsdDataRecord; function CurRecAttachmentPath: string; function AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer; property ProjectCheckStatus: TCheckStatus read FProjectCheckStatus; end; implementation uses MainFrm, UtilMethods, ProjectCommands, Globals, ConfigDoc, ConstUnit, WebNewTenderFrm, PHPWebDm, Math, CslJson, mProgressFrm, ProgressHintFrm, ShellAPI; {$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); end; constructor TProjectManagerFrame.Create(AOwner: TComponent); begin inherited; FCheckerList := 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; tobtnImport.Visible := False; stdProjects.TreeOptions := stdProjects.TreeOptions - [aoAllowUpLevel, aoAllowDownLevel]; stdProjects.Options := stdProjects.Options - [aoAllowUpMove, aoAllowDownMove]; CreateProgress('正在从云端下载新项目'); try actnReceiveProject.Execute; finally CloseProgress; end; end; end; 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; // 双击打开项目 TagB procedure TProjectManagerFrame.actnOpenExecute(Sender: TObject); var vSel: TsdIDTreeNode; vRec: TsdDataRecord; sHint: string; function CanOpen: Boolean; var sSearchURL, sDownURL, sFolder, sSubFolder, sNewName, sMD5, sMD5_UnLock, sError, sLocalFile: string; iSearch, iFolderID, iSubFolderID: Integer; bLock, bCanImp: Boolean; vFileCheck: TTenderFileChecker; function HasWebBidInfo(AWebID: Integer): Boolean; var vArr: array of string; iResult: Integer; begin sSearchURL := Format('%stender/get/%d/exist', [PHPWeb.MeasureURL, AWebID]); vArr := VarArrayOf(['id', 'name']); iResult := PHPWeb.Search(sSearchURL, [''], [''], vArr); if (iResult = 1) and (High(vArr) >= 0) then Result := True else Result := False; end; begin Result := False; // 先按正常接口找到最新的MD5码看是否需要更新 sSearchURL := Format('%stender/get/%d/update', [PHPWeb.MeasureURL, FWebID]); iSearch := SearchFileOnline(sSearchURL, sDownURL, sFolder, sSubFolder, sNewName, sMD5, sError, iFolderID, iSubFolderID); if iSearch = 1 then begin try CheckWebFolders(iFolderID, iSubFolderID, sFolder, sSubFolder); CheckBidName(FID, sNewName); finally if vSel <> nil then vSel.LocateInControl; end; // 打开前一定要先下载最新的标段文件（无论审核有没有通过） if sMD5 <> FWebMD5 then begin // 下载 sLocalFile := PHPWeb.UserPath + ExtractFileName(sDownURL); if not PHPWeb.DownFile(sDownURL, sLocalFile) then begin sHint := Format('云端已找到"%s"的新文件，但由于网络原因下载失败，请重试！', [FBidName]); Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; // 接收更新 bLock := (FWebAuthorID = PHPWeb.UserID) or ((FWebAuthorID <> PHPWeb.UserID) and (FMyCheckStatus <> csChecking)); if not ReceiveFile(sLocalFile, sMD5, bLock) then begin sHint := Format('已从云端下载新的"%s"到本地[%s]，但接收失败，请删除该项目然后重新从云端获取！', [FBidName, sLocalFile]); Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; end; // 编制人且项目末通过 if (FWebAuthorID = PHPWeb.UserID) and (FProjectCheckStatus = 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/create/%d/%d/new/audit', [PHPWeb.MeasureURL, FWebID, FPhaseNo]); case SearchFileOnline(sSearchURL, sDownURL, sFolder, sSubFolder, sNewName, sMD5_UnLock, sError, iFolderID, iSubFolderID) of 1: {注意这里的MD5码应取最终审核不通过项目的，否则会带来下载循环问题。 问题描述： ①编制人运行软件，双击项目，发现审核不通过，自动下载无锁文件，开始新一期，保存关闭。 ②编制人再次运行软件，双击项目，MD5码不同，自动下载旧的审核不通过文件，覆盖本地。 ③编制人再次运行软件，双击项目，发现审核不通过，重复①，循环.... 问：①那里下载无锁文件后不能改成新的MD5码吗？ 答：不能，因为审核人的项目会变成无锁文件，看不到不通过项目。MD5码只能在上传后更新。 且编制人有个交互界面2种选择：a.下载更新不通过项目查看；b.下载更新无锁文件开始新一期。 } begin // 下载 sLocalFile := PHPWeb.UserPath + ExtractFileName(sDownURL); if not PHPWeb.DownFile(sDownURL, sLocalFile) then begin sHint := '云端已找到原报上传的无锁文件，但因网络出错无法下载，本次操作已取消。请重试！'; Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; // 导入更新------------------------------------------------------- // 导入前须检测无锁文件中仅含有原报数据 vFileCheck := TTenderFileChecker.Create; try // 有一期以上数据，且最新期数据审核状态为原报 bCanImp := vFileCheck.CheckFileValid(sLocalFile) and (vFileCheck.PhaseCount > 0) and (vFileCheck.AuditStatus = 0); if not bCanImp then begin Application.MessageBox(PChar('已从云端下载原报上传的无锁文件到本地，但文件有错误，禁止导入！请致电纵横服务人员以获取帮助。'), '警告', MB_OK + MB_ICONWARNING); Exit; end; finally vFileCheck.Free; end; if not ImportFile(sLocalFile, sMD5) then begin Application.MessageBox(PChar('已从云端下载原报上传的无锁文件到本地，但导入失败！请重试。'), '警告', MB_OK + MB_ICONWARNING); Exit; end; // 导入更新---------------------------------↑↑↑↑↑↑↑↑↑↑↑ end; 0, -1: begin sHint := sError + '（因网络出错，无法连接到云端以获取本期原报上传的无锁文件，无法重新开始本期，本次操作已取消。请重试。'; Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; end; end; end; end else if (iSearch = 10) then begin if not HasWebBidInfo(FWebID) then begin sHint :='该项目[' + FBidName + ']在云端已被删除，点击"确定"后，可手动删除该项目。'; Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION); Exit; end; end else if (iSearch = 0) or (iSearch = -1) then begin sHint := sError + '（因网络出错，无法检测[' + FBidName + ']在云端是否有更新，本次操作已取消，请重试）。'; Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING); Exit; end; Result := True; end; begin // 打开前先下载更新 Screen.Cursor := crHourGlass; try vSel := stdProjects.IDTree.Selected; vRec := vSel.Rec; if G_IsCloud then begin GetLocalValues; // 以下这段已经包含在MainForm.OpenProject(vRec)中了，但在调用这句之前，网络版要提前用一下。 if MainForm.HasOpened(FID) then begin MainForm.LocateProject(FID); Exit; end; if not CanOpen then Exit; end; MainForm.OpenProject(vRec); if G_IsCloud then begin if not MainForm.CurProjectFrame.CheckFileAndCloudChekerList then begin sHint := '项目校验：“' + FBidName + '”文件中的审核人和云端的审核人不一致，' + '禁止继续操作，项目即将关闭！请删除本地项目重新从云端获取，' + '重新获取后如果仍然存在同样的问题，请联系纵横服务人员以寻求帮助。'; 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; AFileMD5: string; ANeedLock: Boolean): Boolean; var Recevier: TReceiveProject; vNode: TsdIDTreeNode; begin Result := False; Recevier := TReceiveProject.Create(stdProjects.IDTree.Selected); try try if G_IsCloud then Recevier.Lock := ANeedLock; ProjectManager.RefreshSeedID; vNode := Recevier.Receive(AFileName); if G_IsCloud then begin vNode.Rec.BeginUpdate; vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5; vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; vNode.Rec.EndUpdate; end; vNode.LocateInControl; Result := True; except Result := False; end; finally if Recevier.MessageID = 1 then ErrorMessage('当前标段处于打开状态，未能成功接收，请先关闭标段再次接收。'); Recevier.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]; FWebProjectName := vArr[6]; FWebProjCtgyName := vArr[7]; // WebOwnerImage := vArr[9]; // WebOwnerPhone := vArr[3]; // WebOwnerMobile := vArr[4]; // WebOwnerQQ := vArr[5]; ShowProjWebInfoTop(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); begin with stdProjects.IDTree.Items[ACoord.Y - 1] do if Rec.ValueByName('Type').AsInteger = 0 then if Expanded and HasChildren then MainForm.Images.GetBitmap(34, AImage) else MainForm.Images.GetBitmap(34, AImage) else MainForm.Images.GetBitmap(11, AImage); end; const rIconWidth = 16; rIconHeight = 16; var Img: TBitmap; Cell: TZjCell; rImg: TRect; begin if (ACoord.X = 1) and (ACoord.Y > zgProjects.FixedRowCount - 1) then begin Cell := zgProjects.Cells[ACoord.X, ACoord.Y]; Img := TBitmap.Create; try GetBitmap(Img); 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 SearchAndShowProjAllWebInfo(CurRec); 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 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 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; begin if SelectFile(sFileName, '.mtf;*.mpf') then begin if SameText(ExtractFileExt(sFileName), '.mtf') and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 0) then sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected) else sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected.Parent); 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); 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.SearchAndShowProjAllWebInfo(ARec: TsdDataRecord); var vPSArr: array[0..7] of string; vCArr: TOVArr; // Checkers vChecker: TOrderCheckerFrame; sPicPath, sURL: string; procedure AddChecker(AType: TCheckerFrameType; AArr: array of string); begin vChecker := TOrderCheckerFrame.Create(self); FCheckerList.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)); vChecker.Name := 'ProjectOrderFrame' + AArr[0]; end; procedure RepairOrder; var k: Integer; begin for k := 0 to sbChecker.ControlCount - 1 do TOrderCheckerFrame(sbChecker.Controls[k]).Order := k + 1; end; procedure RefreshProjectCheckers; var i, j: Integer; vOwner: array[0..6] of string; // 业主信息 begin FCheckerList.Clear; sbChecker.Height := 0; FCurPos := 0; sbChecker.VertScrollBar.Range := 0; for i := Low(vCArr) to High(vCArr) do begin if StrToInt(vCArr[i, 0]) = PHPWeb.UserID then FMyCheckStatus := TCheckStatus(StrToInt(vCArr[i, 5])-1); if StrToInt(vCArr[i, 0]) = FWebOwnerID then begin for j := 0 to 6 do vOwner[j] := vCArr[i, j]; Continue; end; AddChecker(cftChecker, vCArr[i]); end; if vOwner[0] <> '' then AddChecker(cftOwner, vOwner); RepairOrder; end; begin GetLocalValues(ARec); if FWebID = 0 then Exit; sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]); if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then begin LockWindowUpdate(pnlWeb.Handle); try FPhaseNo := StrToInt(vPSArr[0]); FProjectCheckStatus := TCheckStatus(StrToInt(vPSArr[1])-1); FPhaseTotal := StrToInt(vPSArr[2]); FWebProjectName := vPSArr[3]; FWebProjCtgyName := vPSArr[4]; FWebOwnerName := vPSArr[5]; FWebOwnerCompany := vPSArr[6]; FWebOwnerRole := vPSArr[7]; ShowProjWebInfoTop; RefreshProjectCheckers; finally LockWindowUpdate(0); end; end else begin FPhaseNo := 0; FProjectCheckStatus := csNotBegin; FPhaseTotal := 0; FWebProjectName := ''; FWebProjCtgyName := ''; FWebOwnerName := ''; FWebOwnerCompany := ''; FWebOwnerRole := ''; ShowProjWebInfoTop; sbChecker.Height := 0; end; end; procedure TProjectManagerFrame.ShowProjWebInfoTop(AType: Integer); procedure ShowOwner; begin lblBidName.Caption := FBidName; lblBidName.Update; lblProjName.Caption := FWebProjectName; lblProjName.Update; lblWebProjCtgyName.Caption := FWebProjCtgyName; 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; case AType of -2: begin lblPeriod.Caption := '正在从云端读取状态信息...'; lblPeriod.Update; end; -1: begin ShowOwner; ShowStatus(FPhaseNo, FProjectCheckStatus); 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 FCheckerList.Free; inherited; end; procedure TProjectManagerFrame.DoBatchReceiveOnline(ARequestType: Integer); var sURL, sFolder, sSubFolder, sMD5, sName, sHint, sLocalFile: string; vMyCheckStatus: TCheckStatus; vArr: TOVArr; bLock: Boolean; i, iWebID, iFolderID, iSubFolderID, iAuthorID: Integer; 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]; sFolder := vArr[i, 1]; sSubFolder := vArr[i, 2]; sMD5 := vArr[i, 3]; iWebID := StrToInt(vArr[i, 5]); iFolderID := StrToInt(vArr[i, 6]); iSubFolderID := StrToInt(vArr[i, 7]); vMyCheckStatus := TCheckStatus(StrToInt(vArr[i, 8])-1); // vArr[i, 4]项目审核状态；vArr[i, 8]当前登陆用户的审核状态 iAuthorID := StrToInt(vArr[i, 9]); // 编制人ID sName := vArr[i, 10]; // 标段名称 CheckWebFolders(iFolderID, iSubFolderID, sFolder, sSubFolder); CheckBidName(PHPWeb.UserID, iWebID, sName); if sMD5 <> LocalMD5(PHPWeb.UserID, iWebID) then begin // 下载 sLocalFile := PHPWeb.UserPath + ExtractFileName(sURL); if not PHPWeb.DownFile(sURL, sLocalFile) then begin sHint := Format('云端已找到"%s"的新文件，但由于网络原因下载失败！请点击菜单“同步更新我参与的全部项目”重新下载！', [sName]); Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING); end; // 接收更新 bLock := (iAuthorID = PHPWeb.UserID) or ((iAuthorID <> PHPWeb.UserID) and (vMyCheckStatus <> csChecking)); if not ReceiveFile(sLocalFile, sMD5, bLock) then begin sHint := Format('已从云端下载新的"%s"到本地，但接收失败，请删除该项目然后重新从云端获取！', [sName]); Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING); Exit; end; end; end; BubbleSortProjects; finally CloseProgress; end; end; 0, -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: Boolean; begin if stdProjects.IDTree.Selected = nil then Exit; Rec := stdProjects.IDTree.Selected.Rec; if Rec = nil then Exit; bNet := G_IsCloud; if bNet then begin tobtnRenane.Enabled := (Rec.ValueByName('Type').AsInteger = 1) and (Rec.ValueByName('WebAuthorID').AsInteger = PHPWeb.UserID); end; 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; begin GetLocalValues(CurRec); 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 := ARec.ValueByName('WebMD5').AsString; FBidName := 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(vRec); 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 := ''; FBidName := ''; 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 := vRec.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; end.