UpFileManageFrame.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486
  1. {*******************************************************************************
  2. 单元名称: UpFileManageFrame.pas
  3. 单元说明: 计量支付附件,UI界面。
  4. 作者时间: Chenshilong, 2015-01-13
  5. *******************************************************************************}
  6. unit UpFileManageFrame;
  7. interface
  8. uses
  9. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10. Dialogs, StdCtrls, ExtCtrls, PNGButton, UpFileFrame, UpFileManageUnit, sdDB,
  11. Menus, Buttons;
  12. type
  13. TUpFileManageView = class(TFrame)
  14. pnlHead: TPanel;
  15. lblBillName: TLabel;
  16. btnSelectUpFile: TPNGButton;
  17. Shape5: TShape;
  18. Label6: TLabel;
  19. Label7: TLabel;
  20. Shape6: TShape;
  21. pnlDetail: TPanel;
  22. btnEditNo: TPNGButton;
  23. btnEdit: TPNGButton;
  24. lblCaption: TLabel;
  25. Shape1: TShape;
  26. Shape2: TShape;
  27. Shape3: TShape;
  28. btnDown: TPNGButton;
  29. Shape4: TShape;
  30. Label1: TLabel;
  31. Label2: TLabel;
  32. lblUper: TLabel;
  33. lblUpTime: TLabel;
  34. Label3: TLabel;
  35. lblExt: TLabel;
  36. Label5: TLabel;
  37. lblCategory: TLabel;
  38. Label4: TLabel;
  39. btnEditYes: TPNGButton;
  40. mmMemo: TMemo;
  41. edtFileName: TEdit;
  42. sbFile: TScrollBox;
  43. tDelView: TTimer;
  44. pmUp: TPopupMenu;
  45. miLocalUp: TMenuItem;
  46. miServerUp: TMenuItem;
  47. procedure btnEditClick(Sender: TObject);
  48. procedure btnEditYesClick(Sender: TObject);
  49. procedure btnEditNoClick(Sender: TObject);
  50. procedure btnSelectUpFileClick(Sender: TObject);
  51. procedure tDelViewTimer(Sender: TObject);
  52. procedure btnDownClick(Sender: TObject);
  53. procedure miLocalUpClick(Sender: TObject);
  54. private
  55. FDetailIsEdit: Boolean;
  56. FSelected: TUpFileView;
  57. FDatas: TUpFiles;
  58. FWaitForDelete: TUpFileView;
  59. FOwner: TObject;
  60. FProjectData: TObject;
  61. FRec: TsdDataRecord;
  62. procedure SetSelected(const Value: TUpFileView);
  63. procedure SetDetailIsEdit(const Value: Boolean);
  64. procedure SetDatas(const Value: TUpFiles);
  65. procedure RefreshOtherFileFrames;
  66. procedure RefreshDetail;
  67. procedure RefreshBill;
  68. procedure ClearViews;
  69. procedure ClearDetail;
  70. procedure RefreshViews;
  71. procedure DetailOutEditStatus;
  72. procedure DetailIntoEditStatus;
  73. procedure AddUpFileView(AUpFile: TUpFile);
  74. procedure SetWaitForDelete(const Value: TUpFileView);
  75. procedure SetOwner(const Value: TObject);
  76. procedure SetProjectData(const Value: TObject);
  77. procedure SetRec(const Value: TsdDataRecord);
  78. procedure SelectUpFile;
  79. public
  80. constructor Create(AOwner: TComponent); override;
  81. procedure DeleteViewAndData(AView: TUpFileView);
  82. procedure DoOnBillChange(ARec: TsdDataRecord);
  83. property ProjectData: TObject read FProjectData write SetProjectData;
  84. property Owner: TObject read FOwner write SetOwner;
  85. property Selected: TUpFileView read FSelected write SetSelected;
  86. property DetailIsEdit: Boolean read FDetailIsEdit write SetDetailIsEdit; // 明细部分处理编辑状态
  87. property Datas: TUpFiles read FDatas write SetDatas;
  88. property WaitForDelete: TUpFileView read FWaitForDelete write SetWaitForDelete;
  89. property Rec: TsdDataRecord read FRec write SetRec;
  90. end;
  91. implementation
  92. uses PHPWebDm, ProjectData, IdGlobal, ProjectFme, ConstUnit, MainFrm,
  93. BillsMeasureDm, UtilMethods;
  94. {$R *.dfm}
  95. { TUpFileManageView }
  96. procedure TUpFileManageView.ClearDetail;
  97. begin
  98. edtFileName.Text := '';
  99. lblExt.Caption := '';
  100. lblUper.Caption := '';
  101. lblUpTime.Caption := '';
  102. lblCategory.Caption := '';
  103. mmMemo.Clear;
  104. end;
  105. procedure TUpFileManageView.DetailIntoEditStatus;
  106. begin
  107. edtFileName.BorderStyle := bsSingle;
  108. edtFileName.ReadOnly := False;
  109. mmMemo.BorderStyle := bsSingle;
  110. mmMemo.ReadOnly := False;
  111. btnEdit.Visible := False;
  112. btnEditYes.Visible := True;
  113. btnEditNo.Visible := True;
  114. end;
  115. procedure TUpFileManageView.DetailOutEditStatus;
  116. begin
  117. edtFileName.BorderStyle := bsNone;
  118. edtFileName.ReadOnly := True;
  119. mmMemo.BorderStyle := bsNone;
  120. mmMemo.ReadOnly := True;
  121. btnEdit.Visible := True;
  122. btnEditYes.Visible := False;
  123. btnEditNo.Visible := False;
  124. end;
  125. procedure TUpFileManageView.ClearViews;
  126. var i: Integer;
  127. begin
  128. for i := sbFile.ControlCount - 1 downto 0 do
  129. TUpFileView(sbFile.Controls[i]).Free;
  130. end;
  131. procedure TUpFileManageView.RefreshViews;
  132. var i: Integer;
  133. begin
  134. ClearViews;
  135. ClearDetail;
  136. {'HasAttachment'是不可靠的。一但它不可靠,会导致:有附件却不显示,用户会以为
  137. 附件丢失。不可靠表现为:
  138. ①用户上传成功,本地标记修改完成,之后却因死机或程序出错导致项目没有保存成功,
  139. 这样本地标记没有保存,线上线下不一致。
  140. ②当前用户非工作状态,上传了附件。却因下次从服务器更新覆盖了本地项目,标记丢失。}
  141. if (FRec <> nil) {and (FRec.ValueByName('HasAttachment').AsBoolean = True)} then
  142. for i := 0 to Datas.Count - 1 do
  143. begin
  144. if Datas[i].BillID = FRec.ValueByName('ID').AsInteger then
  145. AddUpFileView(Datas[i]);
  146. end;
  147. end;
  148. procedure TUpFileManageView.RefreshDetail;
  149. var vFile: TUpFile;
  150. begin
  151. if DetailIsEdit then
  152. DetailOutEditStatus;
  153. vFile := Selected.Data;
  154. if vFile.Status <> ufsNormal then
  155. ClearDetail
  156. else
  157. begin
  158. edtFileName.Text := ExtractFileNameWithoutExt(vFile.DisplayName);
  159. lblExt.Caption := ExtractFileExt(vFile.LocalFile);
  160. lblUper.Caption := vFile.UperName;
  161. lblUpTime.Caption := vFile.UpTime;
  162. lblCategory.Caption := vFile.Category;
  163. mmMemo.Text := vFile.Memo;
  164. end;
  165. btnEdit.Enabled := edtFileName.Text <> '';
  166. end;
  167. procedure TUpFileManageView.RefreshOtherFileFrames;
  168. var i: Integer;
  169. begin
  170. for i := 0 to sbFile.ControlCount - 1 do
  171. begin
  172. if TUpFileView(sbFile.Controls[i]) <> Selected then
  173. TUpFileView(sbFile.Controls[i]).ShowNormal;
  174. end;
  175. end;
  176. procedure TUpFileManageView.SetSelected(const Value: TUpFileView);
  177. begin
  178. FSelected := Value;
  179. RefreshOtherFileFrames;
  180. if G_IsCloud then
  181. RefreshDetail;
  182. end;
  183. procedure TUpFileManageView.SetDetailIsEdit(const Value: Boolean);
  184. begin
  185. FDetailIsEdit := Value;
  186. end;
  187. procedure TUpFileManageView.btnEditClick(Sender: TObject);
  188. begin
  189. DetailIntoEditStatus;
  190. DetailIsEdit := True;
  191. end;
  192. procedure TUpFileManageView.btnEditYesClick(Sender: TObject);
  193. var sURL, sExt, sNewName, sNewMemo, sNewFile: string;
  194. vArr: array of string;
  195. begin
  196. sExt := Selected.Data.Ext;
  197. sNewName := Trim(edtFileName.Text);
  198. if HasExt(sNewName) then
  199. sNewName := ExtractFileNameWithoutExt(sNewName);
  200. sNewFile := ExtractFilePath(Selected.Data.LocalFile) + sNewName + sExt;
  201. // 以下这个不能判断:如果我只改了备注,没有改文件名,会提交不上。
  202. // if FileExists(sNewFile) then
  203. // begin
  204. // Application.MessageBox('本地已存在同名文件,请更换其它名称!', '编辑失败', MB_OK + MB_ICONWARNING);
  205. // Exit;
  206. // end;
  207. sURL := Format('%stender/attachment/info/%d/update', [PHPWeb.MeasureURL, Selected.Data.ID]);
  208. sNewMemo := mmMemo.Text;
  209. vArr := VarArrayOf(['msg']);
  210. if PHPWeb.Search(sURL, ['FileName', 'Memo'], [sNewName, sNewMemo], vArr) = 1 then
  211. begin
  212. if FileExists(Selected.Data.LocalFile) then
  213. if not RenameFile(Selected.Data.LocalFile, sNewFile) then
  214. begin
  215. Application.MessageBox('本地文件被占用,更换文件名失败,请关闭占用文件后重试!', '编辑失败', MB_OK + MB_ICONWARNING);
  216. Exit;
  217. end;
  218. Selected.Data.LocalFile := sNewFile;
  219. Selected.Data.DisplayName := sNewName + sExt;
  220. Selected.Data.Memo := sNewMemo;
  221. Selected.Refresh;
  222. edtFileName.Text := sNewName;
  223. DetailOutEditStatus;
  224. DetailIsEdit := False;
  225. end
  226. else
  227. begin
  228. Application.MessageBox('因网络原因导致编辑失败,请重试!', '编辑失败', MB_OK + MB_ICONWARNING);
  229. Exit;
  230. end;
  231. end;
  232. procedure TUpFileManageView.btnEditNoClick(Sender: TObject);
  233. begin
  234. DetailOutEditStatus;
  235. DetailIsEdit := False;
  236. edtFileName.Text := Selected.Data.DisplayName;
  237. mmMemo.Text := Selected.Data.Memo;
  238. end;
  239. procedure TUpFileManageView.btnSelectUpFileClick(Sender: TObject);
  240. var
  241. P: TPoint;
  242. begin
  243. GetCursorPos(P);
  244. pmUp.Popup(P.X, P.Y);
  245. end;
  246. procedure TUpFileManageView.SetDatas(const Value: TUpFiles);
  247. begin
  248. FDatas := Value;
  249. end;
  250. procedure TUpFileManageView.AddUpFileView(AUpFile: TUpFile);
  251. var vVew: TUpFileView;
  252. begin
  253. vVew := TUpFileView.Create(Self);
  254. vVew.Name := Format('UpFileView%d', [AUpFile.No]); // 此时ID尚末获取,不能用ID
  255. vVew.Owner := Self;
  256. vVew.ProjectData := FProjectData;
  257. vVew.parent := sbFile;
  258. vVew.Align := alTop;
  259. vVew.Data := AUpFile;
  260. end;
  261. procedure TUpFileManageView.DeleteViewAndData(AView: TUpFileView);
  262. begin
  263. WaitForDelete := AView;
  264. tDelView.Enabled := True;
  265. end;
  266. procedure TUpFileManageView.tDelViewTimer(Sender: TObject);
  267. var vUpFile: TUpFile;
  268. begin
  269. tDelView.Enabled := False;
  270. vUpFile := WaitForDelete.Data;
  271. WaitForDelete.Free;
  272. Datas.Delete(vUpFile);
  273. end;
  274. procedure TUpFileManageView.SetWaitForDelete(const Value: TUpFileView);
  275. begin
  276. FWaitForDelete := Value;
  277. end;
  278. procedure TUpFileManageView.SetOwner(const Value: TObject);
  279. begin
  280. FOwner := Value;
  281. TProjectFrame(FOwner).BillsMeasureFrame.BillsMeasureData.OnRecChange := DoOnBillChange;
  282. TProjectFrame(FOwner).BillsCompileFrame.BillsCompileData.OnRecChange := DoOnBillChange;
  283. end;
  284. procedure TUpFileManageView.SetProjectData(const Value: TObject);
  285. begin
  286. FProjectData := Value;
  287. end;
  288. procedure TUpFileManageView.btnDownClick(Sender: TObject);
  289. var svDlg: TSaveDialog;
  290. sFile: string;
  291. begin
  292. if not Assigned(Selected) then Exit;
  293. svDlg := TSaveDialog.Create(nil);
  294. svDlg.InitialDir := ExtractFilePath(Application.ExeName) + 'UserData\';
  295. try
  296. if svDlg.Execute then
  297. begin
  298. if FileExists(svDlg.FileName) then
  299. begin
  300. if Application.MessageBox('文件已存在,是否覆盖?', '询问', MB_YESNO) = ID_NO then
  301. Exit;
  302. end;
  303. Screen.Cursor := crHourGlass;
  304. Selected.Data.Status := ufsDowning;
  305. sFile := svDlg.FileName;
  306. if PHPWeb.DownFile(Selected.Data.DownURL, sFile) then
  307. begin
  308. Selected.Data.Status := ufsNormal;
  309. end
  310. else
  311. begin
  312. Selected.Data.Status := ufsDownFail;
  313. end;
  314. end
  315. else
  316. Exit;
  317. finally
  318. svDlg.Free;
  319. Screen.Cursor := crDefault;
  320. end;
  321. end;
  322. constructor TUpFileManageView.Create(AOwner: TComponent);
  323. begin
  324. inherited;
  325. FRec := nil;
  326. lblBillName.Caption := '';
  327. lblBillName.Update;
  328. pnlDetail.Visible := G_IsCloud;
  329. end;
  330. procedure TUpFileManageView.DoOnBillChange(ARec: TsdDataRecord);
  331. begin
  332. FRec := ARec;
  333. with TProjectFrame(Owner) do
  334. begin
  335. if not (jpsAssistant.Visible and (jpsAssistant.ActivePage = jpsAssistantUpFile)) then
  336. Exit;
  337. end;
  338. RefreshBill;
  339. RefreshViews;
  340. end;
  341. procedure TUpFileManageView.SetRec(const Value: TsdDataRecord);
  342. begin
  343. FRec := Value;
  344. end;
  345. procedure TUpFileManageView.RefreshBill;
  346. var sCode: string;
  347. begin
  348. if FRec <> nil then
  349. begin
  350. if FRec.ValueByName('Code').AsString <> '' then
  351. sCode := FRec.ValueByName('Code').AsString
  352. else
  353. sCode := FRec.ValueByName('B_Code').AsString;
  354. if sCode <> '' then
  355. sCode := sCode + ' ';
  356. lblBillName.Caption := sCode + FRec.ValueByName('Name').AsString;
  357. end
  358. else
  359. lblBillName.Caption := '';
  360. lblBillName.Update;
  361. end;
  362. procedure TUpFileManageView.SelectUpFile;
  363. var vODlg: TOpenDialog;
  364. i, iBillID, iPhase: Integer;
  365. vFile: TUpFile;
  366. sFile, sName: string;
  367. iV: Int64;
  368. begin
  369. vODlg := TOpenDialog.Create(nil);
  370. vODlg.Options := vODlg.Options + [ofAllowMultiSelect];
  371. if vODlg.Execute then
  372. begin
  373. for i := 0 to vODlg.Files.Count - 1 do
  374. begin
  375. sFile := vODlg.Files[i];
  376. iV := FileSizeByName(sFile);
  377. if iV >= 10485760 then
  378. begin
  379. Application.MessageBox(PChar('“' + sFile + '”过大,单个文件上传不能超过10M!'), '提示', MB_OK + MB_ICONINFORMATION);
  380. Continue;
  381. end;
  382. with MainForm.CurProjectFrame.dxsbViewControl do
  383. begin
  384. if SelectedItem = Groups[0].Items[0] then
  385. iBillID := TProjectData(FProjectData).BillsCompileData.BillsCompileTree.Selected.ID
  386. else if SelectedItem = Groups[0].Items[1] then
  387. iBillID := TProjectData(FProjectData).BillsMeasureData.BillsMeasureTree.Selected.ID;
  388. end;
  389. iPhase := TProjectData(FProjectData).PhaseIndex;
  390. sName := ExtractFileName(sFile);
  391. vFile := Datas.Add(iBillID, iPhase);
  392. vFile.OrgFile := sFile;
  393. vFile.Category := '台帐附件';
  394. vFile.Memo := '我的备注';
  395. vFile.LocalFile := Datas.Path + sName;
  396. vFile.DisplayName := sName;
  397. vFile.Status := ufsNeedUp;
  398. if G_IsCloud then
  399. begin
  400. // 添加到类→上传到服务器,生成ID→再到类中修改ID。为什么不先上传到服务器生成ID
  401. // 再添加到类并设置ID这样可以一气呵成呢?因为需要给用户一个交互界面让用户可以批量
  402. // 操作并决定取消某几个上传。这个交互界面的数据来自类。
  403. vFile.WebID := TProjectData(FProjectData).WebID;
  404. vFile.UperID := PHPWeb.UserID;
  405. vFile.UperName := PHPWeb.RealName;
  406. vFile.UpTime := FormatDateTime('yyyy-mm-dd hh:mm', Now);
  407. end
  408. else
  409. begin
  410. //
  411. end;
  412. AddUpFileView(vFile);
  413. end;
  414. end;
  415. Application.ProcessMessages;
  416. end;
  417. procedure TUpFileManageView.miLocalUpClick(Sender: TObject);
  418. begin
  419. SelectUpFile;
  420. end;
  421. end.