{******************************************************************************* 单元名称: 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); 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 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; 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; end.