Measure/Forms/UpFileFrame.pas

{*******************************************************************************
  单元名称：  UpFileFrame.pas

  单元说明：  计量支付附件，每个小文件。

  作者时间：  Chenshilong, 2015-01-13
*******************************************************************************}

unit UpFileFrame;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, ExtCtrls, PNGButton, StdCtrls, Buttons, UpFileManageUnit;

type
  TUpFileView = class(TFrame)
    lblInfo: TLabel;
    shpBottom: TShape;
    imgFile: TImage;
    lblFile: TLabel;
    pnlPlay: TPanel;
    btnPlay: TPNGButton;
    btnDelete: TPNGButton;
    pnlOrder: TPanel;
    btnUp: TSpeedButton;
    btnCancel: TSpeedButton;
    btnOpen: TPNGButton;
    procedure btnCancelClick(Sender: TObject);
    procedure btnUpClick(Sender: TObject);
    procedure btnPlayClick(Sender: TObject);
    procedure lblFileClick(Sender: TObject);
    procedure FrameClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
  private
    FData: TUpFile;
    FProjectData: TObject;
    procedure SetData(const Value: TUpFile);
    procedure SetProjectData(const Value: TObject);
    { Private declarations }
  public
    { Public declarations }
    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;

  Data.AssignIcon(imgFile.Picture);

  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.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 Create(AOwner);
  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;

procedure TUpFileView.btnOpenClick(Sender: TObject);
var
  sDownFile: string;
begin
  sDownFile := TProjectData(FProjectData).AttachmentInfoData.GetAttachmentPath(Data.ID);
  if (sDownFile <> '') then
  begin
    if FileExists(sDownFile) then
      ShellExecute(0, 'open', PChar(ExtractFileName(sDownFile)), '', PChar(ExtractFilePath(sDownFile)), SW_SHOWNORMAL)
    else
      TipMessage('当前文件不存在，请重新下载');
  end
  else if FileExists(Data.LocalFile) then
    ShellExecute(0, 'open', PChar(ExtractFileName(Data.LocalFile)), '', PChar(ExtractFilePath(Data.LocalFile)), SW_SHOWNORMAL)
  else
    TipMessage('当前文件不存在，请重新下载');
end;

end.