Measure/Forms/UpFileManageFrame.pas

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

  单元说明：  计量支付附件，UI界面。

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

interface

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

type
  TUpFileManageView = class(TFrame)
    pnlHead: TPanel;
    lblBillName: TLabel;
    btnSelectUpFile: TPNGButton;
    Shape5: TShape;
    Label6: TLabel;
    Label7: TLabel;
    Shape6: TShape;
    pnlDetail: TPanel;
    btnEditNo: TPNGButton;
    btnEdit: TPNGButton;
    lblCaption: TLabel;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    btnDown: TPNGButton;
    Shape4: TShape;
    Label1: TLabel;
    Label2: TLabel;
    lblUper: TLabel;
    lblUpTime: TLabel;
    Label3: TLabel;
    lblExt: TLabel;
    Label5: TLabel;
    lblCategory: TLabel;
    Label4: TLabel;
    btnEditYes: TPNGButton;
    mmMemo: TMemo;
    edtFileName: TEdit;
    sbFile: TScrollBox;
    tDelView: TTimer;
    pmUp: TPopupMenu;
    miLocalUp: TMenuItem;
    miServerUp: TMenuItem;
    procedure btnEditClick(Sender: TObject);
    procedure btnEditYesClick(Sender: TObject);
    procedure btnEditNoClick(Sender: TObject);
    procedure btnSelectUpFileClick(Sender: TObject);
    procedure tDelViewTimer(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure miLocalUpClick(Sender: TObject);
    procedure miServerUpClick(Sender: TObject);
    procedure FrameMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    FDetailIsEdit: Boolean;
    FSelected: TUpFileView;
    FDatas: TUpFiles;
    FWaitForDelete: TUpFileView;
    FDeleteAttachmentOnLine: Boolean;
    FOwner: TObject;
    FProjectData: TObject;
    FRec: TsdDataRecord;
    procedure SetSelected(const Value: TUpFileView);
    procedure SetDetailIsEdit(const Value: Boolean);
    procedure SetDatas(const Value: TUpFiles);
    procedure RefreshOtherFileFrames;
    procedure RefreshDetail;
    procedure RefreshBill;
    procedure ClearViews;
    procedure ClearDetail;
    procedure RefreshViews;
    procedure DetailOutEditStatus;
    procedure DetailIntoEditStatus;
    procedure AddUpFileView(AUpFile: TUpFile);
    procedure SetWaitForDelete(const Value: TUpFileView);
    procedure SetOwner(const Value: TObject);
    procedure SetProjectData(const Value: TObject);
    procedure SetRec(const Value: TsdDataRecord);
    procedure SelectUpFile;

  public
    constructor Create(AOwner: TComponent); override;
    procedure DeleteViewAndData(AView: TUpFileView; ANeedDeleteOnLine: Boolean);
    procedure DoOnBillChange(ARec: TsdDataRecord);

    property ProjectData: TObject read FProjectData write SetProjectData;
    property Owner: TObject read FOwner write SetOwner;
    property Selected: TUpFileView read FSelected write SetSelected;
    property DetailIsEdit: Boolean read FDetailIsEdit write SetDetailIsEdit;   // 明细部分处理编辑状态
    property Datas: TUpFiles read FDatas write SetDatas;
    property WaitForDelete: TUpFileView read FWaitForDelete write SetWaitForDelete;
    property Rec: TsdDataRecord read FRec write SetRec;
  end;

implementation

uses PHPWebDm, ProjectData, IdGlobal, ProjectFme, ConstUnit, MainFrm,
  BillsMeasureDm, UtilMethods, UpFileSelectOnLineFrm;


{$R *.dfm}



{ TUpFileManageView }


procedure TUpFileManageView.ClearDetail;
begin
  edtFileName.Text := '';
  lblExt.Caption := '';
  lblUper.Caption := '';
  lblUpTime.Caption := '';
  lblCategory.Caption := '';
  mmMemo.Clear;
  btnEdit.Enabled := False;
  btnDown.Enabled := False;
end;

procedure TUpFileManageView.DetailIntoEditStatus;
begin
  edtFileName.BorderStyle := bsSingle;
  edtFileName.ReadOnly := False;
  mmMemo.BorderStyle := bsSingle;
  mmMemo.ReadOnly := False;
  btnEdit.Visible := False;
  btnEditYes.Visible := True;
  btnEditNo.Visible := True;
end;

procedure TUpFileManageView.DetailOutEditStatus;
begin
  edtFileName.BorderStyle := bsNone;
  edtFileName.ReadOnly := True;
  mmMemo.BorderStyle := bsNone;
  mmMemo.ReadOnly := True;
  btnEdit.Visible := True;
  btnEditYes.Visible := False;
  btnEditNo.Visible := False;
end;

procedure TUpFileManageView.ClearViews;
var i: Integer;
begin
  for i := sbFile.ControlCount - 1 downto 0 do
    TUpFileView(sbFile.Controls[i]).Free;
end;

procedure TUpFileManageView.RefreshViews;
var i: Integer;
begin
  LockWindowUpdate(Self.Handle);
  try
    ClearViews;
    ClearDetail;
    {'HasAttachment'是不可靠的。一但它不可靠，会导致：有附件却不显示，用户会以为
     附件丢失。不可靠表现为：
     ①用户上传成功，本地标记修改完成，之后却因死机或程序出错导致项目没有保存成功，
       这样本地标记没有保存，线上线下不一致。
     ②当前用户非工作状态，上传了附件。却因下次从服务器更新覆盖了本地项目，标记丢失。}
    if (FRec <> nil) {and (FRec.ValueByName('HasAttachment').AsBoolean = True)} then
      for i := 0 to Datas.Count - 1 do
      begin
        if (Datas[i].BillID = FRec.ValueByName('ID').AsInteger) and (Datas[i].Phase = TProjectData(FProjectData).PhaseIndex) then
          AddUpFileView(Datas[i]);
      end;
  finally
    pnlHead.Repaint;
    LockWindowUpdate(0);
  end;
end;

procedure TUpFileManageView.RefreshDetail;
var vFile: TUpFile;
begin
  if DetailIsEdit then
    DetailOutEditStatus;

  vFile := Selected.Data;
  if vFile.Status <> ufsNormal then
    ClearDetail
  else
  begin
    edtFileName.Text :=  ExtractFileNameWithoutExt(vFile.DisplayName);
    lblExt.Caption := ExtractFileExt(vFile.LocalFile);
    lblUper.Caption := vFile.UperName;
    lblUpTime.Caption := vFile.UpTime;
    lblCategory.Caption := vFile.Category;
    mmMemo.Text := vFile.Memo;
  end;

  btnEdit.Enabled := (edtFileName.Text <> '') and (PHPWeb.UserID = vFile.UperID); // TProjectData(FProjectData).CurUserIsAuthor;
  btnDown.Enabled := (edtFileName.Text <> '');
end;

procedure TUpFileManageView.RefreshOtherFileFrames;
var i: Integer;
begin
  for i := 0 to sbFile.ControlCount - 1 do
  begin
    if TUpFileView(sbFile.Controls[i]) <> Selected then
      TUpFileView(sbFile.Controls[i]).ShowNormal;
  end;
end;

procedure TUpFileManageView.SetSelected(const Value: TUpFileView);
begin
  FSelected := Value;
  RefreshOtherFileFrames;
  if G_IsCloud then
    RefreshDetail;
end;

procedure TUpFileManageView.SetDetailIsEdit(const Value: Boolean);
begin
  FDetailIsEdit := Value;
end;

procedure TUpFileManageView.btnEditClick(Sender: TObject);
begin
  DetailIntoEditStatus;
  DetailIsEdit := True;
end;

procedure TUpFileManageView.btnEditYesClick(Sender: TObject);
var sURL, sExt, sNewName, sNewMemo, sNewFile: string;
  vArr: array of string;
begin
  sExt := Selected.Data.Ext;
  sNewName := Trim(edtFileName.Text);
  if HasExt(sNewName) then
    sNewName := ExtractFileNameWithoutExt(sNewName);

  sNewFile := ExtractFilePath(Selected.Data.LocalFile) + sNewName + sExt;
  // 以下这个不能判断：如果我只改了备注，没有改文件名，会提交不上。
//  if FileExists(sNewFile) then
//  begin
//    Application.MessageBox('本地已存在同名文件，请更换其它名称！', '编辑失败', MB_OK + MB_ICONWARNING);
//    Exit;
//  end;

  sURL := Format('%stender/attachment/info/%d/update', [PHPWeb.MeasureURL, Selected.Data.ID]);
  sNewMemo := mmMemo.Text;
  vArr := VarArrayOf(['msg']);

  if PHPWeb.Search(sURL, ['FileName', 'Memo'], [sNewName, sNewMemo], vArr) = 1 then
  begin
    if FileExists(Selected.Data.LocalFile) then
      if not RenameFile(Selected.Data.LocalFile, sNewFile) then
      begin
        Application.MessageBox('本地文件被占用，更换文件名失败，请关闭占用文件后重试！', '编辑失败', MB_OK + MB_ICONWARNING);
        Exit;
      end;

    Selected.Data.LocalFile := sNewFile;
    Selected.Data.DisplayName := sNewName + sExt;
    Selected.Data.Memo := sNewMemo;
    Selected.Refresh;
    edtFileName.Text := sNewName;

    DetailOutEditStatus;
    DetailIsEdit := False;
  end
  else
  begin
    Application.MessageBox('因网络原因导致编辑失败，请重试！', '编辑失败', MB_OK + MB_ICONWARNING);
    Exit;
  end;
end;

procedure TUpFileManageView.btnEditNoClick(Sender: TObject);
begin
  DetailOutEditStatus;
  DetailIsEdit := False;
  edtFileName.Text := Selected.Data.DisplayName;
  mmMemo.Text := Selected.Data.Memo;
end;

procedure TUpFileManageView.btnSelectUpFileClick(Sender: TObject);
var
  P: TPoint;
begin
  GetCursorPos(P);
  pmUp.Popup(P.X, P.Y);
end;

procedure TUpFileManageView.SetDatas(const Value: TUpFiles);
begin
  FDatas := Value;
end;

procedure TUpFileManageView.AddUpFileView(AUpFile: TUpFile);
var vVew: TUpFileView;
begin
  vVew := TUpFileView.Create(Self);
// 先删再增会重复。
//  vVew.Name := Format('UpFileView%d', [AUpFile.No]);    // 此时ID尚末获取，不能用ID
  vVew.Name := Format('UpFileView_%s', [PHPWeb.TempName]);
  vVew.Owner := Self;
  vVew.ProjectData := FProjectData;
  vVew.parent := sbFile;
  vVew.Align := alTop;
  vVew.Data := AUpFile;
end;

procedure TUpFileManageView.DeleteViewAndData(AView: TUpFileView; ANeedDeleteOnLine: Boolean);
begin
  WaitForDelete := AView;
  FDeleteAttachmentOnLine := ANeedDeleteOnLine;
  tDelView.Enabled := True;
end;

procedure TUpFileManageView.tDelViewTimer(Sender: TObject);
var vUpFile: TUpFile;
begin
  tDelView.Enabled := False;
  vUpFile := WaitForDelete.Data;
  if FDeleteAttachmentOnLine then
    if PHPWeb.DeleteAttachment(vUpFile.ID) <> 1 then
    begin
      Application.MessageBox('线上附件移除失败，请重试！', '警告', MB_OK + MB_ICONWARNING);
      Exit;
    end;
  WaitForDelete.Free;
  Datas.Delete(vUpFile);
end;

procedure TUpFileManageView.SetWaitForDelete(const Value: TUpFileView);
begin
  FWaitForDelete := Value;
end;

procedure TUpFileManageView.SetOwner(const Value: TObject);
begin
  FOwner := Value;
  TProjectFrame(FOwner).BillsMeasureFrame.BillsMeasureData.OnRecChange := DoOnBillChange;
  TProjectFrame(FOwner).BillsCompileFrame.BillsCompileData.OnRecChange := DoOnBillChange;
end;

procedure TUpFileManageView.SetProjectData(const Value: TObject);
begin
  FProjectData := Value;
end;

procedure TUpFileManageView.btnDownClick(Sender: TObject);
var svDlg: TSaveDialog;
  sFile: string;
begin
  if not Assigned(Selected) then Exit;

  svDlg := TSaveDialog.Create(nil);
  svDlg.InitialDir := ExtractFilePath(Application.ExeName) + 'UserData\';
  svDlg.FileName := Selected.Data.DisplayName;

  try
    if svDlg.Execute then
    begin 
      if FileExists(svDlg.FileName) then
       begin
         if Application.MessageBox('文件已存在，是否覆盖？', '询问', MB_YESNO) = ID_NO then
           Exit;
       end;

      Screen.Cursor := crHourGlass;
      Selected.Data.Status := ufsDowning;
      sFile := svDlg.FileName;
      if PHPWeb.DownFile(Selected.Data.DownURL, sFile) then
      begin
        Selected.Data.Status := ufsNormal;
      end
      else
      begin
        Selected.Data.Status := ufsDownFail;
      end;
    end 
    else 
      Exit;
  finally
    svDlg.Free;
    Screen.Cursor := crDefault;
  end;
end;

constructor TUpFileManageView.Create(AOwner: TComponent);
begin
  inherited;
  FRec := nil;
  lblBillName.Caption := '';
  lblBillName.Update;

  pnlDetail.Visible := G_IsCloud;
end;

procedure TUpFileManageView.DoOnBillChange(ARec: TsdDataRecord);
begin
  FRec := ARec;

  with TProjectFrame(Owner) do
  begin
    if not (jpsAssistant.Visible and (jpsAssistant.ActivePage = jpsAssistantUpFile)) then
      Exit;
  end;

  RefreshBill;
  RefreshViews;
end;

procedure TUpFileManageView.SetRec(const Value: TsdDataRecord);
begin
  FRec := Value;
end;

procedure TUpFileManageView.RefreshBill;
var sCode: string;
begin
  if FRec <> nil then
  begin
    if FRec.ValueByName('Code').AsString <> '' then
      sCode := FRec.ValueByName('Code').AsString
    else
      sCode := FRec.ValueByName('B_Code').AsString;
    if sCode <> '' then
      sCode := sCode + ' ';

    lblBillName.Caption := sCode + FRec.ValueByName('Name').AsString;
  end
  else
    lblBillName.Caption := '';
    
  lblBillName.Update;
end;

procedure TUpFileManageView.SelectUpFile;
var vODlg: TOpenDialog;
  i, iBillID: Integer;
  vFile: TUpFile;
  sFile, sName: string;
  iV: Int64;
begin
  vODlg := TOpenDialog.Create(nil);
  vODlg.Options := vODlg.Options + [ofAllowMultiSelect];

  if vODlg.Execute then
  begin
    for i := 0 to vODlg.Files.Count - 1 do
    begin
      sFile := vODlg.Files[i];
      iV := FileSizeByName(sFile);
      if iV >= 10485760 then
      begin
        Application.MessageBox(PChar('“' + sFile + '”过大，单个文件上传不能超过10M！'), '提示', MB_OK + MB_ICONINFORMATION);
        Continue;
      end;

      with MainForm.CurProjectFrame.dxsbViewControl do
      begin
        if SelectedItem = Groups[0].Items[0] then
          iBillID := TProjectData(FProjectData).BillsCompileData.BillsCompileTree.Selected.ID
        else if SelectedItem = Groups[0].Items[1] then
          iBillID := TProjectData(FProjectData).BillsMeasureData.BillsMeasureTree.Selected.ID;
      end;

      sName := ExtractFileName(sFile);

      vFile := Datas.Add(iBillID);
      vFile.Phase := TProjectData(FProjectData).PhaseIndex;
      vFile.OrgFile := sFile;
      vFile.Category := '台帐附件';
      vFile.Memo := '我的备注';
      vFile.LocalFile := Datas.Path + sName;
      vFile.DisplayName := sName;
      vFile.Status := ufsNeedUp;

      if G_IsCloud then
      begin
        // 添加到类→上传到服务器，生成ID→再到类中修改ID。为什么不先上传到服务器生成ID
        // 再添加到类并设置ID这样可以一气呵成呢？因为需要给用户一个交互界面让用户可以批量
        // 操作并决定取消某几个上传。这个交互界面的数据来自类。
        vFile.WebID := TProjectData(FProjectData).WebID;
        vFile.UperID := PHPWeb.UserID;
        vFile.UperName := PHPWeb.RealName;
        vFile.UpTime := FormatDateTime('yyyy-mm-dd hh:mm', Now);
      end
      else
      begin
        //
      end;

      AddUpFileView(vFile);
    end;
  end;
  Application.ProcessMessages;
end;

procedure TUpFileManageView.miLocalUpClick(Sender: TObject);
begin
  SelectUpFile;
end;

procedure TUpFileManageView.miServerUpClick(Sender: TObject);
var
  vForm: TUpFileSelectOnLineForm;
begin
  vForm := TUpFileSelectOnLineForm.Create(nil);
  try
    vForm.InitData(FDatas.List);
    if vForm.ModalResult = mrOK then
    begin
      vForm.UpOnlineFiles;
    end;
  finally
    vForm.Free;
  end;

end;

procedure TUpFileManageView.FrameMouseWheel(Sender: TObject;
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  var Handled: Boolean);
begin
  if WheelDelta < 0 then
    sbFile.Perform(WM_VSCROLL, SB_LINEDOWN, 0)
  else
    sbFile.Perform(WM_VSCROLL, SB_LINEUP, 0);
end;

end.