UpFileFrame.pas 7.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313
  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: 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.UpAttachmentFile(PHPWeb.UserID, TProjectData(FProjectData).WebID, Data.BillID,
  120. Data.OrgFile, Data.Category, Data.Memo, IntToStr(Data.Phase), sWebName) 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. end
  126. else
  127. begin
  128. Application.MessageBox('当前附件上传失败,请重试!', '系统提示', MB_OK);
  129. Data.Status := ufsNeedUp;
  130. end;
  131. end;
  132. // else
  133. // begin
  134. // if FileExists(Data.LocalFile) then
  135. // if Application.MessageBox('已存在同名的本地附件,该附件将会被覆盖,是否继续?', '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then
  136. // begin
  137. // Data.Status := ufsNeedUp;
  138. // Exit;
  139. // end;
  140. //
  141. // if Data.Owner.LocalSaveToDB(Data) > -1 then
  142. // begin
  143. // CopyFile(PChar(Data.OrgFile), PChar(Data.LocalFile), False);
  144. // Data.Status := ufsNormal;
  145. // end
  146. // else
  147. // begin
  148. // Application.MessageBox('当前附件保存失败,请重试!', '系统提示', MB_OK);
  149. // Data.Status := ufsNeedUp;
  150. // end;
  151. // end;
  152. finally
  153. Screen.Cursor := crDefault;
  154. end;
  155. end;
  156. procedure TUpFileView.btnPlayClick(Sender: TObject);
  157. var sName, sPath: string;
  158. begin
  159. sName := ExtractFileName(Data.LocalFile);
  160. sPath := ExtractFilePath(Data.LocalFile);
  161. FrameClick(Sender);
  162. ShellExecute(Handle, 'open', pchar(sName), nil, pchar(sPath), SW_SHOWNORMAL);
  163. end;
  164. procedure TUpFileView.lblFileClick(Sender: TObject);
  165. begin
  166. FrameClick(Sender);
  167. end;
  168. procedure TUpFileView.FrameClick(Sender: TObject);
  169. begin
  170. ShowSelected;
  171. TUpFileManageView(Owner).Selected := Self;
  172. end;
  173. procedure TUpFileView.RefreshStatus(AStatus: TUpFileStatus);
  174. begin
  175. case Data.Status of
  176. ufsNeedUp:
  177. begin
  178. pnlOrder.Visible := True;
  179. pnlPlay.Visible := False;
  180. lblInfo.Visible := False;
  181. end;
  182. ufsNormal:
  183. begin
  184. pnlOrder.Visible := False;
  185. pnlPlay.Visible := FileExists(Data.LocalFile);
  186. lblInfo.Visible := True;
  187. lblInfo.Font.Color := clBlack;
  188. lblInfo.Caption := Data.UperName;
  189. lblInfo.Update;
  190. end;
  191. ufsUping:
  192. begin
  193. pnlOrder.Visible := False;
  194. pnlPlay.Visible := False;
  195. lblInfo.Visible := True;
  196. lblInfo.Font.Color := clRed;
  197. if G_IsCloud then
  198. lblInfo.Caption := '上传中...'
  199. else
  200. lblInfo.Caption := '保存中...';
  201. lblInfo.Update;
  202. end;
  203. ufsDowning:
  204. begin
  205. pnlOrder.Visible := False;
  206. pnlPlay.Visible := False;
  207. lblInfo.Visible := True;
  208. lblInfo.Font.Color := clRed;
  209. lblInfo.Caption := '下载中...';
  210. lblInfo.Update;
  211. end;
  212. ufsDownFail:
  213. begin
  214. pnlOrder.Visible := False;
  215. pnlPlay.Visible := False;
  216. lblInfo.Visible := True;
  217. lblInfo.Font.Color := clRed;
  218. lblInfo.Caption := '下载失败!';
  219. lblInfo.Update;
  220. end;
  221. end;
  222. Application.ProcessMessages;
  223. end;
  224. procedure TUpFileView.btnDeleteClick(Sender: TObject);
  225. begin
  226. TUpFileManageView(Owner).DeleteViewAndData(Self, True);
  227. //ShellExecute(Handle, nil, PChar('explorer.exe'), PChar('/e,/select,' + Data.LocalFile), nil, SW_Show);
  228. end;
  229. procedure TUpFileView.SetProjectData(const Value: TObject);
  230. begin
  231. FProjectData := Value;
  232. end;
  233. procedure TUpFileView.DoOnStatusChange(AStatus: TUpFileStatus);
  234. begin
  235. RefreshStatus(AStatus);
  236. end;
  237. constructor TUpFileView.Create(AOwner: TComponent);
  238. const
  239. G_Left = 268;
  240. G_Top = 12;
  241. begin
  242. inherited;
  243. lblInfo.Left := G_Left;
  244. pnlPlay.ParentColor := True;
  245. pnlPlay.BevelOuter := bvNone;
  246. pnlPlay.Left := G_Left + 45;
  247. pnlPlay.Top := G_Top;
  248. pnlOrder.ParentColor := True;
  249. pnlOrder.BevelOuter := bvNone;
  250. pnlOrder.Left := G_Left;
  251. pnlPlay.Top := G_Top;
  252. if G_IsCloud then
  253. btnUp.Caption := '上传'
  254. else
  255. btnUp.Caption := '保存';
  256. end;
  257. procedure TUpFileView.Refresh;
  258. var iW: Integer;
  259. begin
  260. lblFile.Caption := Data.DisplayName;
  261. lblFile.Hint := Data.DisplayName;
  262. RefreshStatus(Data.Status);
  263. end;
  264. end.