UpFileFrame.pas 7.8 KB

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