Measure/Forms/UpFileFrame.pas

{*******************************************************************************
  单元名称：  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;
    btnFolder: 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 btnFolderClick(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);
end;

procedure TUpFileView.btnUpClick(Sender: TObject);
var sWebName, sPhase: 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.UpAttachmentFile(PHPWeb.UserID, TProjectData(FProjectData).WebID, Data.BillID,
        Data.OrgFile, Data.Category, Data.Memo, IntToStr(Data.Phase), sWebName) then
      begin
  //      TUpFileManageView(Owner).Rec.ValueByName('HasAttachment').AsBoolean := True;
        CopyFile(PChar(Data.OrgFile), PChar(Data.LocalFile), False);
        Data.Status := ufsNormal;
      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;
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 := FileExists(Data.LocalFile);
      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.btnFolderClick(Sender: TObject);
begin
  FrameClick(Sender);
  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 + 45;
  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.