{******************************************************************************* 单元名称: UpFileFrame.pas 单元说明: 计量支付附件,每个小文件。 作者时间: Chenshilong, 2015-01-13 *******************************************************************************} unit UpFileFrame; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxHint, ExtCtrls, PNGButton, StdCtrls, Buttons, UpFileManageUnit; type TUpFileView = class(TFrame) lblInfo: TLabel; shpBottom: TShape; imgFile: TImage; lblFile: TLabel; cxHintStyleController1: TcxHintStyleController; pnlPlay: TPanel; btnPlay: TPNGButton; btnDelete: TPNGButton; pnlOrder: TPanel; btnUp: TSpeedButton; btnCancel: TSpeedButton; procedure btnCancelClick(Sender: TObject); procedure btnUpClick(Sender: TObject); procedure btnPlayClick(Sender: TObject); procedure lblFileClick(Sender: TObject); procedure FrameClick(Sender: TObject); procedure btnDeleteClick(Sender: TObject); private FOwner: TObject; FData: TUpFile; FProjectData: TObject; procedure SetData(const Value: TUpFile); procedure SetOwner(const Value: TObject); procedure SetProjectData(const Value: TObject); { Private declarations } public { Public declarations } property Owner: TObject read FOwner write SetOwner; property Data: TUpFile read FData write SetData; property ProjectData: TObject read FProjectData write SetProjectData; procedure ShowNormal; procedure ShowSelected; procedure UpProgress(APos: Integer); procedure RefreshStatus(AStatus: TUpFileStatus); procedure DoOnStatusChange(AStatus: TUpFileStatus); procedure Refresh; constructor Create(AOwner: TComponent); override; end; implementation uses ShellAPI, UpFileManageFrame, UtilMethods, Math, PHPWebDm, ProjectData, ConstUnit; var G_Pos: Integer; {$R *.dfm} { TUpFileView } procedure TUpFileView.SetData(const Value: TUpFile); var iW: Integer; begin FData := Value; imgFile.Picture.Graphic := Data.Icon; iW := lblInfo.Left - lblFile.Left - 20; // lblFile.AutoSize := True; lblFile.Caption := Data.DisplayName; lblFile.Hint := Data.DisplayName; lblFile.Width := Min(lblFile.Width, iW); lblFile.AutoSize := False; // 防止选中后自动变为实际长度 lblFile.Width := lblFile.Width + 5; lblFile.Update; RefreshStatus(Data.Status); Data.OnStatusChange := DoOnStatusChange; end; procedure TUpFileView.SetOwner(const Value: TObject); begin FOwner := Value; end; procedure TUpFileView.ShowNormal; begin Color := clWindow; lblFile.Font.Style := lblFile.Font.Style - [fsBold]; lblInfo.Font.Style := lblInfo.Font.Style - [fsBold]; end; procedure TUpFileView.ShowSelected; begin Color := $00FFD7D7; lblFile.Font.Style := lblFile.Font.Style + [fsBold]; lblInfo.Font.Style := lblInfo.Font.Style + [fsBold]; end; procedure TUpFileView.UpProgress(APos: Integer); begin if APos = 100 then begin lblInfo.Caption := '上传成功!'; lblInfo.Font.Color := $0000B500; G_Pos := 0; end else lblInfo.Caption := '上传中 ' + IntToStr(APos) + '%'; lblInfo.Update; end; procedure TUpFileView.btnCancelClick(Sender: TObject); begin TUpFileManageView(Owner).DeleteViewAndData(Self, False); end; procedure TUpFileView.btnUpClick(Sender: TObject); var sWebName, sPhase, sID, sDownURL: string; begin Screen.Cursor := crHourGlass; try Data.Status := ufsUping; G_Pos := 0; // 刷新本地 Data.Phase := TProjectData(FProjectData).PhaseIndex; // case iPhase of // 0: sPhase := '台账' // else sPhase := IntToStr(iPhase) + '期'; // end; if G_IsCloud then begin if PHPWeb.UpAttachment(PHPWeb.UserID, TProjectData(FProjectData).WebID, Data.BillID, Data.Phase, Data.OrgFile, Data.Category, Data.Memo, sWebName, sID, sDownURL) then begin // TUpFileManageView(Owner).Rec.ValueByName('HasAttachment').AsBoolean := True; CopyFile(PChar(Data.OrgFile), PChar(Data.LocalFile), False); Data.Status := ufsNormal; Data.ID := StrToInt(sID); Data.DownURL := sDownURL; FrameClick(Sender); end else begin Application.MessageBox('当前附件上传失败,请重试!', '系统提示', MB_OK); Data.Status := ufsNeedUp; end; end; // else // begin // if FileExists(Data.LocalFile) then // if Application.MessageBox('已存在同名的本地附件,该附件将会被覆盖,是否继续?', '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then // begin // Data.Status := ufsNeedUp; // Exit; // end; // // if Data.Owner.LocalSaveToDB(Data) > -1 then // begin // CopyFile(PChar(Data.OrgFile), PChar(Data.LocalFile), False); // Data.Status := ufsNormal; // end // else // begin // Application.MessageBox('当前附件保存失败,请重试!', '系统提示', MB_OK); // Data.Status := ufsNeedUp; // end; // end; finally Screen.Cursor := crDefault; end; end; procedure TUpFileView.btnPlayClick(Sender: TObject); var sName, sPath: string; begin sName := ExtractFileName(Data.LocalFile); sPath := ExtractFilePath(Data.LocalFile); FrameClick(Sender); ShellExecute(Handle, 'open', pchar(sName), nil, pchar(sPath), SW_SHOWNORMAL); end; procedure TUpFileView.lblFileClick(Sender: TObject); begin FrameClick(Sender); end; procedure TUpFileView.FrameClick(Sender: TObject); begin ShowSelected; TUpFileManageView(Owner).Selected := Self; TUpFileManageView(Owner).SetFocus; // 这句使其取得焦点以响应滚动事件 end; procedure TUpFileView.RefreshStatus(AStatus: TUpFileStatus); begin case Data.Status of ufsNeedUp: begin pnlOrder.Visible := True; pnlPlay.Visible := False; lblInfo.Visible := False; end; ufsNormal: begin pnlOrder.Visible := False; // pnlPlay.Visible := PHPWeb.UserID = Data.UperID; pnlPlay.Visible := (not TProjectData(FProjectData).IsHistoryPhase) and (not TProjectData(FProjectData).IsGuest); lblInfo.Visible := True; lblInfo.Font.Color := clBlack; lblInfo.Caption := Data.UperName; lblInfo.Update; end; ufsUping: begin pnlOrder.Visible := False; pnlPlay.Visible := False; lblInfo.Visible := True; lblInfo.Font.Color := clRed; if G_IsCloud then lblInfo.Caption := '上传中...' else lblInfo.Caption := '保存中...'; lblInfo.Update; end; ufsDowning: begin pnlOrder.Visible := False; pnlPlay.Visible := False; lblInfo.Visible := True; lblInfo.Font.Color := clRed; lblInfo.Caption := '下载中...'; lblInfo.Update; end; ufsDownFail: begin pnlOrder.Visible := False; pnlPlay.Visible := False; lblInfo.Visible := True; lblInfo.Font.Color := clRed; lblInfo.Caption := '下载失败!'; lblInfo.Update; end; end; Application.ProcessMessages; end; procedure TUpFileView.btnDeleteClick(Sender: TObject); begin if Application.MessageBox('确定要在线上移除该附件吗?', '询问', MB_YESNO + MB_ICONQUESTION) = ID_No then Exit; TUpFileManageView(Owner).DeleteViewAndData(Self, True); //ShellExecute(Handle, nil, PChar('explorer.exe'), PChar('/e,/select,' + Data.LocalFile), nil, SW_Show); end; procedure TUpFileView.SetProjectData(const Value: TObject); begin FProjectData := Value; end; procedure TUpFileView.DoOnStatusChange(AStatus: TUpFileStatus); begin RefreshStatus(AStatus); end; constructor TUpFileView.Create(AOwner: TComponent); const G_Left = 268; G_Top = 12; begin inherited; lblInfo.Left := G_Left; pnlPlay.ParentColor := True; pnlPlay.BevelOuter := bvNone; pnlPlay.Left := G_Left + 53; pnlPlay.Top := G_Top; pnlOrder.ParentColor := True; pnlOrder.BevelOuter := bvNone; pnlOrder.Left := G_Left; pnlPlay.Top := G_Top; if G_IsCloud then btnUp.Caption := '上传' else btnUp.Caption := '保存'; end; procedure TUpFileView.Refresh; var iW: Integer; begin lblFile.Caption := Data.DisplayName; lblFile.Hint := Data.DisplayName; RefreshStatus(Data.Status); end; end.