UpFileFrame.pas 8.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330
  1. {*******************************************************************************
  2. 单元名称: UpFileFrame.pas
  3. 单元说明: 计量支付附件,每个小文件。
  4. 作者时间: Chenshilong, 2015-01-13
  5. *******************************************************************************}
  6. unit UpFileFrame;
  7. interface
  8. uses
  9. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10. Dialogs, ExtCtrls, PNGButton, StdCtrls, Buttons, UpFileManageUnit;
  11. type
  12. TUpFileView = class(TFrame)
  13. lblInfo: TLabel;
  14. shpBottom: TShape;
  15. imgFile: TImage;
  16. lblFile: TLabel;
  17. pnlPlay: TPanel;
  18. btnPlay: TPNGButton;
  19. btnDelete: TPNGButton;
  20. pnlOrder: TPanel;
  21. btnUp: TSpeedButton;
  22. btnCancel: TSpeedButton;
  23. btnOpen: TPNGButton;
  24. procedure btnCancelClick(Sender: TObject);
  25. procedure btnUpClick(Sender: TObject);
  26. procedure btnPlayClick(Sender: TObject);
  27. procedure lblFileClick(Sender: TObject);
  28. procedure FrameClick(Sender: TObject);
  29. procedure btnDeleteClick(Sender: TObject);
  30. procedure btnOpenClick(Sender: TObject);
  31. private
  32. FData: TUpFile;
  33. FProjectData: TObject;
  34. procedure SetData(const Value: TUpFile);
  35. procedure SetProjectData(const Value: TObject);
  36. { Private declarations }
  37. public
  38. { Public declarations }
  39. property Data: TUpFile read FData write SetData;
  40. property ProjectData: TObject read FProjectData write SetProjectData;
  41. procedure ShowNormal;
  42. procedure ShowSelected;
  43. procedure UpProgress(APos: Integer);
  44. procedure RefreshStatus(AStatus: TUpFileStatus);
  45. procedure DoOnStatusChange(AStatus: TUpFileStatus);
  46. procedure Refresh;
  47. constructor Create(AOwner: TComponent); override;
  48. end;
  49. implementation
  50. uses ShellAPI, UpFileManageFrame, UtilMethods, Math, PHPWebDm, ProjectData,
  51. ConstUnit;
  52. var G_Pos: Integer;
  53. {$R *.dfm}
  54. { TUpFileView }
  55. procedure TUpFileView.SetData(const Value: TUpFile);
  56. var iW: Integer;
  57. begin
  58. FData := Value;
  59. Data.AssignIcon(imgFile.Picture);
  60. iW := lblInfo.Left - lblFile.Left - 20;
  61. // lblFile.AutoSize := True;
  62. lblFile.Caption := Data.DisplayName;
  63. lblFile.Hint := Data.DisplayName;
  64. lblFile.Width := Min(lblFile.Width, iW);
  65. lblFile.AutoSize := False; // 防止选中后自动变为实际长度
  66. lblFile.Width := lblFile.Width + 5;
  67. lblFile.Update;
  68. RefreshStatus(Data.Status);
  69. Data.OnStatusChange := DoOnStatusChange;
  70. end;
  71. procedure TUpFileView.ShowNormal;
  72. begin
  73. Color := clWindow;
  74. lblFile.Font.Style := lblFile.Font.Style - [fsBold];
  75. lblInfo.Font.Style := lblInfo.Font.Style - [fsBold];
  76. end;
  77. procedure TUpFileView.ShowSelected;
  78. begin
  79. Color := $00FFD7D7;
  80. lblFile.Font.Style := lblFile.Font.Style + [fsBold];
  81. lblInfo.Font.Style := lblInfo.Font.Style + [fsBold];
  82. end;
  83. procedure TUpFileView.UpProgress(APos: Integer);
  84. begin
  85. if APos = 100 then
  86. begin
  87. lblInfo.Caption := '上传成功!';
  88. lblInfo.Font.Color := $0000B500;
  89. G_Pos := 0;
  90. end
  91. else
  92. lblInfo.Caption := '上传中 ' + IntToStr(APos) + '%';
  93. lblInfo.Update;
  94. end;
  95. procedure TUpFileView.btnCancelClick(Sender: TObject);
  96. begin
  97. TUpFileManageView(Owner).DeleteViewAndData(Self, False);
  98. end;
  99. procedure TUpFileView.btnUpClick(Sender: TObject);
  100. var sWebName, sPhase, sID, sDownURL: string;
  101. begin
  102. Screen.Cursor := crHourGlass;
  103. try
  104. Data.Status := ufsUping;
  105. G_Pos := 0; // 刷新本地
  106. Data.Phase := TProjectData(FProjectData).PhaseIndex;
  107. // case iPhase of
  108. // 0: sPhase := '台账'
  109. // else sPhase := IntToStr(iPhase) + '期';
  110. // end;
  111. if G_IsCloud then
  112. begin
  113. if PHPWeb.UpAttachment(PHPWeb.UserID, TProjectData(FProjectData).WebID, Data.BillID, Data.Phase,
  114. Data.OrgFile, Data.Category, Data.Memo, sWebName, sID, sDownURL) then
  115. begin
  116. // TUpFileManageView(Owner).Rec.ValueByName('HasAttachment').AsBoolean := True;
  117. CopyFile(PChar(Data.OrgFile), PChar(Data.LocalFile), False);
  118. Data.Status := ufsNormal;
  119. Data.ID := StrToInt(sID);
  120. Data.DownURL := sDownURL;
  121. FrameClick(Sender);
  122. end
  123. else
  124. begin
  125. Application.MessageBox('当前附件上传失败,请重试!', '系统提示', MB_OK);
  126. Data.Status := ufsNeedUp;
  127. end;
  128. end;
  129. // else
  130. // begin
  131. // if FileExists(Data.LocalFile) then
  132. // if Application.MessageBox('已存在同名的本地附件,该附件将会被覆盖,是否继续?', '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then
  133. // begin
  134. // Data.Status := ufsNeedUp;
  135. // Exit;
  136. // end;
  137. //
  138. // if Data.Owner.LocalSaveToDB(Data) > -1 then
  139. // begin
  140. // CopyFile(PChar(Data.OrgFile), PChar(Data.LocalFile), False);
  141. // Data.Status := ufsNormal;
  142. // end
  143. // else
  144. // begin
  145. // Application.MessageBox('当前附件保存失败,请重试!', '系统提示', MB_OK);
  146. // Data.Status := ufsNeedUp;
  147. // end;
  148. // end;
  149. finally
  150. Screen.Cursor := crDefault;
  151. end;
  152. end;
  153. procedure TUpFileView.btnPlayClick(Sender: TObject);
  154. var sName, sPath: string;
  155. begin
  156. sName := ExtractFileName(Data.LocalFile);
  157. sPath := ExtractFilePath(Data.LocalFile);
  158. FrameClick(Sender);
  159. ShellExecute(Handle, 'open', pchar(sName), nil, pchar(sPath), SW_SHOWNORMAL);
  160. end;
  161. procedure TUpFileView.lblFileClick(Sender: TObject);
  162. begin
  163. FrameClick(Sender);
  164. end;
  165. procedure TUpFileView.FrameClick(Sender: TObject);
  166. begin
  167. ShowSelected;
  168. TUpFileManageView(Owner).Selected := Self;
  169. TUpFileManageView(Owner).SetFocus; // 这句使其取得焦点以响应滚动事件
  170. end;
  171. procedure TUpFileView.RefreshStatus(AStatus: TUpFileStatus);
  172. begin
  173. case Data.Status of
  174. ufsNeedUp:
  175. begin
  176. pnlOrder.Visible := True;
  177. pnlPlay.Visible := False;
  178. lblInfo.Visible := False;
  179. end;
  180. ufsNormal:
  181. begin
  182. pnlOrder.Visible := False;
  183. // pnlPlay.Visible := PHPWeb.UserID = Data.UperID;
  184. pnlPlay.Visible := (not TProjectData(FProjectData).IsHistoryPhase) and (not TProjectData(FProjectData).IsGuest);
  185. lblInfo.Visible := True;
  186. lblInfo.Font.Color := clBlack;
  187. lblInfo.Caption := Data.UperName;
  188. lblInfo.Update;
  189. end;
  190. ufsUping:
  191. begin
  192. pnlOrder.Visible := False;
  193. pnlPlay.Visible := False;
  194. lblInfo.Visible := True;
  195. lblInfo.Font.Color := clRed;
  196. if G_IsCloud then
  197. lblInfo.Caption := '上传中...'
  198. else
  199. lblInfo.Caption := '保存中...';
  200. lblInfo.Update;
  201. end;
  202. ufsDowning:
  203. begin
  204. pnlOrder.Visible := False;
  205. pnlPlay.Visible := False;
  206. lblInfo.Visible := True;
  207. lblInfo.Font.Color := clRed;
  208. lblInfo.Caption := '下载中...';
  209. lblInfo.Update;
  210. end;
  211. ufsDownFail:
  212. begin
  213. pnlOrder.Visible := False;
  214. pnlPlay.Visible := False;
  215. lblInfo.Visible := True;
  216. lblInfo.Font.Color := clRed;
  217. lblInfo.Caption := '下载失败!';
  218. lblInfo.Update;
  219. end;
  220. end;
  221. Application.ProcessMessages;
  222. end;
  223. procedure TUpFileView.btnDeleteClick(Sender: TObject);
  224. begin
  225. if Application.MessageBox('确定要在线上移除该附件吗?', '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then
  226. Exit;
  227. TUpFileManageView(Owner).DeleteViewAndData(Self, True);
  228. //ShellExecute(Handle, nil, PChar('explorer.exe'), PChar('/e,/select,' + Data.LocalFile), nil, SW_Show);
  229. end;
  230. procedure TUpFileView.SetProjectData(const Value: TObject);
  231. begin
  232. FProjectData := Value;
  233. end;
  234. procedure TUpFileView.DoOnStatusChange(AStatus: TUpFileStatus);
  235. begin
  236. RefreshStatus(AStatus);
  237. end;
  238. constructor TUpFileView.Create(AOwner: TComponent);
  239. const
  240. G_Left = 268;
  241. G_Top = 12;
  242. begin
  243. inherited Create(AOwner);
  244. lblInfo.Left := G_Left;
  245. pnlPlay.ParentColor := True;
  246. pnlPlay.BevelOuter := bvNone;
  247. pnlPlay.Left := G_Left + 53;
  248. pnlPlay.Top := G_Top;
  249. pnlOrder.ParentColor := True;
  250. pnlOrder.BevelOuter := bvNone;
  251. pnlOrder.Left := G_Left;
  252. pnlPlay.Top := G_Top;
  253. if G_IsCloud then
  254. btnUp.Caption := '上传'
  255. else
  256. btnUp.Caption := '保存';
  257. end;
  258. procedure TUpFileView.Refresh;
  259. var iW: Integer;
  260. begin
  261. lblFile.Caption := Data.DisplayName;
  262. lblFile.Hint := Data.DisplayName;
  263. RefreshStatus(Data.Status);
  264. end;
  265. procedure TUpFileView.btnOpenClick(Sender: TObject);
  266. var
  267. sDownFile: string;
  268. begin
  269. sDownFile := TProjectData(FProjectData).AttachmentInfoData.GetAttachmentPath(Data.ID);
  270. if (sDownFile <> '') then
  271. begin
  272. if FileExists(sDownFile) then
  273. ShellExecute(0, 'open', PChar(ExtractFileName(sDownFile)), '', PChar(ExtractFilePath(sDownFile)), SW_SHOWNORMAL)
  274. else
  275. TipMessage('当前文件不存在,请重新下载');
  276. end
  277. else if FileExists(Data.LocalFile) then
  278. ShellExecute(0, 'open', PChar(ExtractFileName(Data.LocalFile)), '', PChar(ExtractFilePath(Data.LocalFile)), SW_SHOWNORMAL)
  279. else
  280. TipMessage('当前文件不存在,请重新下载');
  281. end;
  282. end.