procedure TCB_IMGPSScanX.WMMOUSEWHEEL(var message: TWMMouseWheel); var I: Integer; iISB : TImageScrollBox; begin inherited; //lb1.Caption:=IntToStr(message.Keys); if (message.WheelDelta = WHEEL_DELTA) Then begin if ScrollBox1.Focused then begin ScrollBox1.VertScrollBar.Increment := 50; ScrollBox1.Perform(WM_VSCROLL,SB_Lineup,0); end; if DisplayISB <> nil then begin if (DisplayISB.Focused) and (message.Keys=0) then begin DisplayISB.VertScrollBar.Increment := 50; DisplayISB.Perform(WM_VSCROLL,SB_Lineup,0); end; if (DisplayISB.Focused) and (message.Keys=50) then begin DisplayISB.ZoomMode := zmPercent; if DisplayISB.ZoomPercent < 90 then DisplayISB.ZoomPercent := DisplayISB.ZoomPercent+10; end; end; i:=0; while FindComponent(ISBName+inttostr(i)) <> nil do begin iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i))); if iISB.Focused then begin ScrollBox1.VertScrollBar.Increment := 50; ScrollBox1.Perform(WM_VSCROLL,SB_Lineup,0); end; inc(i); end; end else if (message.WheelDelta = -WHEEL_DELTA) then begin if ScrollBox1.Focused then begin ScrollBox1.VertScrollBar.Increment := 50; ScrollBox1.Perform(WM_VSCROLL, SB_LINEDOWN, 0); end; if DisplayISB <> nil then begin if (DisplayISB.Focused) and (message.Keys=0) then begin DisplayISB.VertScrollBar.Increment := 50; DisplayISB.Perform(WM_VSCROLL,SB_LINEDOWN,0); end; if (DisplayISB.Focused) and (message.Keys=50) then begin DisplayISB.ZoomMode := zmPercent; if DisplayISB.ZoomPercent > 10 then DisplayISB.ZoomPercent := DisplayISB.ZoomPercent-10; end; end; i:=0; while FindComponent(ISBName+inttostr(i)) <> nil do begin iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i))); if iISB.Focused then begin ScrollBox1.VertScrollBar.Increment := 50; ScrollBox1.Perform(WM_VSCROLL,SB_Lineup,0); end; inc(i); end; end; end; procedure TCB_IMGPSScanX.WNoteBtnClick(Sender: TObject); var i,n,v,v1:Integer; SortMemoForm : TSortMemoForm; M_Content,M_ID,M_Name : String; S : TStringlist; begin ShowText := _Msg('備註輸入中,請稍候'); DataLoading(True,True); SortMemoForm := TSortMemoForm.Create(Self); S := TStringlist.Create; try InitialLanguage(SortMemoForm); //載入多國語言 SortMemoForm.ContentList := TStringlist.Create; //註記內容 SortMemoForm.MemoIDList := TStringlist.Create; //註記代號 SortMemoForm.MemoNameList := TStringlist.Create; //註記名稱 for i := 1 to MEMO_INF_List.Count - 1 do begin M_Content := GetSQLData(MEMO_INF_List,'T1.MEMO_CONTENT',i); M_ID := GetSQLData(MEMO_INF_List,'T1.MEMO_TYPE',i); M_Name := GetSQLData(MEMO_INF_List,'T2.MEMO_TYPE_NAME',i); SortMemoForm.ComboBox1.Items.Add(M_Name+'-->'+M_Content); SortMemoForm.ContentList.Add(M_Content); //註記內容 SortMemoForm.MemoIDList.Add(M_ID); //註記代號 SortMemoForm.MemoNameList.Add(M_Name); //註記名稱 end; if FileExists(DisplayPath+'Scan_Memo.dat') then begin S.LoadFromFile(DisplayPath+'Scan_Memo.dat'); for I := 0 to S.Count - 1 do begin v := Pos(',',S.Strings[i]); v1 := length(S.Strings[i]); M_ID := copy(S.Strings[i],1,v-1); M_Name := MemoInfoTransfer('ID',M_ID,SortMemoForm.MemoIDList,SortMemoForm.MemoNameList); M_Content := copy(S.Strings[i],v+1,v1-v); SortMemoForm.ResoureMemo.Add(M_Name+'-->'+M_Content); With SortMemoForm.MemoLV.Items.Add do begin Caption := M_Content; SubItems.Add(M_Name); end; end; end; if SortMemoForm.ShowModal = mrOk then begin S.Clear; for I := 0 to SortMemoForm.MemoLV.Items.Count - 1 do begin M_Content := SortMemoForm.MemoLV.Items.Item[i].Caption; M_Name := SortMemoForm.MemoLV.Items.Item[i].SubItems.Strings[0]; M_ID := MemoInfoTransfer('NAME',M_Name,SortMemoForm.MemoIDList,SortMemoForm.MemoNameList); S.Add(M_ID+','+M_Content); end; S.SaveToFile(DisplayPath+'Scan_Memo.dat'); end; SortMemoForm.ContentList.Free; //註記內容 SortMemoForm.MemoIDList.Free; //註記代號 SortMemoForm.MemoNameList.Free; //註記名稱 finally SortMemoForm.Free; S.Free; DataLoading(False,False); if Ch_WriteNote then begin Ch_WriteNote := False; CaseHelpBtnClick(self); ErrIndex := 0; end; end; end; procedure TCB_IMGPSScanX.EventSinkChanged(const EventSink: IUnknown); begin FEvents := EventSink as ICB_IMGPSScanXEvents; inherited EventSinkChanged(EventSink); end; procedure TCB_IMGPSScanX.FC0Click(Sender: TObject); begin IF NowClick = 0 Then begin DesableImage; Exit; end; EnableImage(0 ,Sender); NowClick := 0; end; procedure TCB_IMGPSScanX.FC1Click(Sender: TObject); begin IF NowClick = 1 Then begin DesableImage; Exit; end; EnableImage(1 ,Sender); NowClick := 1; end; procedure TCB_IMGPSScanX.FC2Click(Sender: TObject); begin IF NowClick = 2 Then begin DesableImage; Exit; end; EnableImage(2,Sender); NowClick := 2; end; procedure TCB_IMGPSScanX.FC3Click(Sender: TObject); begin IF NowClick = 3 Then begin DesableImage; Exit; end; EnableImage(3 ,Sender); NowClick := 3; end; procedure TCB_IMGPSScanX.FC4Click(Sender: TObject); begin IF NowClick = 4 Then begin DesableImage; Exit; end; EnableImage(4 ,Sender); NowClick := 4; end; procedure TCB_IMGPSScanX.FC5Click(Sender: TObject); begin IF NowClick = 5 Then begin DesableImage; Exit; end; EnableImage(5 ,Sender); NowClick := 5; end; procedure TCB_IMGPSScanX.FC6Click(Sender: TObject); begin {IF NowClick = 6 Then begin DesableImage; Exit; end; EnableImage(6 ,Sender); NowClick := 6;} PM605Click(nil); end; procedure TCB_IMGPSScanX.ISB1Click(Sender: TObject); var p : Integer; begin DisplayISB := TImageScrollBox(Sender); Shape1.Left := TPanel(TImageScrollBox(Sender).Parent).Left - Seg; Shape1.Top := TPanel(TImageScrollBox(Sender).Parent).Top - Seg; P := strtoint(copy(DisplayISB.Name,4,1)) + ScrollBar1.Position-2; if P <= PageLV.Items.Count-1 then begin if PageLVclear then begin PageLV.ClearSelection; end; NowPage := p+1; PageLV.ItemIndex := P; end; //DisplayISB.SetFocus; end; procedure TCB_IMGPSScanX.ISB1EndScroll(Sender: TObject); var ISB : TImageScrollBox; begin ISB := TImageScrollBox(Sender); SetScrollData(ISB,ISB.HorzScrollBar.Position,ISB.VertScrollBar.Position,ISB.ZoomPercent); {if (TImageScrollBox(Sender) = MpsViewX1) and SortMode then begin ReczoomPercent := MpsViewX1.ZoomPercent; RecHozPos := MpsViewX1.HorzScrollBarPos; RecVerPos := MpsViewX1.VertScrollBarPos; end;} end; procedure TCB_IMGPSScanX.ISB1ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var p : Integer; begin DisplayISB := TImageScrollBox(Sender); if NowClick<>0 then DisplayISB.SetFocus; Shape1.Left := TPanel(TImageScrollBox(Sender).Parent).Left - Seg; Shape1.Top := TPanel(TImageScrollBox(Sender).Parent).Top - Seg; P := strtoint(copy(DisplayISB.Name,4,1)) + ScrollBar1.Position-2; if P <= PageLV.Items.Count-1 then begin NowPage := p+1; PageLV.ClearSelection; PageLV.ItemIndex := P; //PageLV.Selected := PageLV.Items.Item[PageLV.ItemIndex]; end; if (NowClick = -1) and (Button=TMouseButton(mbLeft)) and (DisplayISB.FileName <> '') then begin {for P := 1 to 8 do begin TImageScrollBox(FindComponent('ISB'+inttostr(p))).Enabled := False; end; } DisplayISB.BeginDrag(True); end; case TImageScrollBox(Sender).MouseMode of mmR90,mmR180,mmR270: begin TImageScrollBox(Sender).LoadFromFile(TImageScrollBox(Sender).FileName,1); end; end; end; procedure TCB_IMGPSScanX.ISB1ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin //Edit1.SetFocus; //TImageScrollBox(Sender).SetFocus; if TImageScrollBox(Sender).FileName = '' then TImageScrollBox(Sender).MouseMode := mmUser Else ViewMouseMode(NowClick); ISB1.AlwaysShowAnnotations := False; // if TImageScrollBox(Sender).FileName = '' then // begin ////ShowMessage('AAA'); //Label3.Caption:='FileName='+TImageScrollBox(Sender).FileName+' time='+FormatDateTime('yyyy/mm/dd HH:MM:SS', now); // TImageScrollBox(Sender).MouseMode := mmUser // end // Else // begin //Label3.Caption:='FileName='+TImageScrollBox(Sender).FileName; // ViewMouseMode(NowClick); // end; end; procedure TCB_IMGPSScanX.ISB1ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Var p : Integer; ISB : TImageScrollBox; begin case TImageScrollBox(Sender).MouseMode of mmDelete: begin PM508Click(Self); end; mmR90,mmR180,mmR270: begin if TImageScrollBox(Sender).Graphic.ImageFormat <> ifBlackWhite then begin TJpegGraphic(TImageScrollBox(Sender).Graphic).SaveQuality := 30; TJpegGraphic(TImageScrollBox(Sender).Graphic).SaveToFile(TImageScrollBox(Sender).FileName); end Else TImageScrollBox(Sender).SaveToFile(TImageScrollBox(Sender).FileName); SelectISB.Graphic.Assign(TImageScrollBox(Sender).Graphic); SelectISB.Redraw(True); FitPreViewISB; ISBClick(SelectISB); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 end; end; ISB := TImageScrollBox(Sender); if (ISB.MouseMode = mmZoom) or (ISB.MouseMode = mmDrag) then SetScrollData(ISB,ISB.HorzScrollBar.Position,ISB.VertScrollBar.Position,ISB.ZoomPercent); end; function TCB_IMGPSScanX.Get_AutoScroll: WordBool; begin Result := AutoScroll; end; function TCB_IMGPSScanX.Get_KeyPreview: WordBool; begin Result := KeyPreview; end; function TCB_IMGPSScanX.Get_MouseInClient: WordBool; begin Result := MouseInClient; end; procedure TCB_IMGPSScanX.ActivateEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnActivate; end; procedure TCB_IMGPSScanX.ClickEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnClick; end; procedure TCB_IMGPSScanX.CreateEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnCreate; end; procedure TCB_IMGPSScanX.DblClickEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnDblClick; end; procedure TCB_IMGPSScanX.DeactivateEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnDeactivate; end; procedure TCB_IMGPSScanX.DestroyEvent(Sender: TObject); begin //********清單區******** Doc_Inf_List.Free; //Doc_Inf 清單 Docno + 版本為key DM_FORM_INF_List.Free; //DM_FORM_INF 清單 Docno + 版本為key FORM_INF_List.Free; //FORM_INF的清單 CHECK_RULE_INF_List.Free; //CHECK_RULE_INF 清單 MEMO_INF_List.Free; //MEMO_INF 清單 WORK_INF_List.Free; //WORK_INF 清單 LASTEST_FORM_INF_List.Free; // LASTEST_FORM_INF 清單 FindResult.Free ; //找SQLData的結果 OMRFileList.Free; //要OMR檢核的文件(只檢查每種Form的第一頁) FormCode_PageSize.Free; //文件的預設大小 FormCode_Height_Width DocNo_NeedDoc.Free; //有Docno時要相依的文件 DocNo_相依文件_相依文件 DocNo_NoDoc.Free; //有Docno時互斥的文件 DocNo_互斥文件_互斥文件 DocNo_VerinCase.Free; //案件裡的DocNo+版本的清單 CaseDocNoList.Free; //案件裡的DocNo清單 CaseDocNo_CopiesList.Free; //案件裡的DocNo份數清單 CaseList.Free; //記錄掃瞄案件的順序 NoSaveBarCodeList.Free; //不儲存的條碼清單 FormID_List.Free; //FormID清單 DocNo_List.Free; //DocNo清單 Context_DocnoList.Free; //案件裡的檔案Docno清單 ContextList.Free; //案件裡的檔案清單 AttContextList.Free; //案件裡的附加檔案清單 NowShowFileList.Free; //目前顯示的影像清單 NowSelectFileList.Free; //目前被點選的影像清單 Cust_DocNoList.Free; //自行定義文件名稱 IN_WH_DocNoList.Free; //入庫的文件清單 GuideFormIDList.Free; //要當導引頁表單清單 DivPageFormIDList.Free; //要當分案頁表單清單 LastInitFormidList.Free; LastAddFormidList.Free; SampleFormIDList.Free; ExistImgList.Free; reSizeExistImgList.Free; //********清單區******** if (FMode = 'DSCAN') or (FMode = 'ESCAN') then //重掃件及異動件要只能掃指定編號的件 begin if ImagePath<>'' then _Deltree(ImagePath); end; if FEvents <> nil then FEvents.OnDestroy; end; procedure TCB_IMGPSScanX.KeyPressEvent(Sender: TObject; var Key: Char); var TempKey: Smallint; begin TempKey := Smallint(Key); if FEvents <> nil then FEvents.OnKeyPress(TempKey); Key := Char(TempKey); end; procedure TCB_IMGPSScanX.mode1Click(Sender: TObject); begin VMode := 0; GoViewMode; //ScrollBar1Change(Self); Panel14.Visible := False; end; procedure TCB_IMGPSScanX.mode2Click(Sender: TObject); begin VMode := 1; GoViewMode; //ScrollBar1Change(Self); Panel14.Visible := True; end; procedure TCB_IMGPSScanX.mode3Click(Sender: TObject); begin VMode := 2; GoViewMode; ScrollBar1Change(Self); end; procedure TCB_IMGPSScanX.mode4Click(Sender: TObject); begin VMode := 3; GoViewMode; ScrollBar1Change(Self); end; procedure TCB_IMGPSScanX.MouseEnterEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnMouseEnter; end; procedure TCB_IMGPSScanX.MouseLeaveEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnMouseLeave; end; procedure TCB_IMGPSScanX.PaintEvent(Sender: TObject); begin if FEvents <> nil then FEvents.OnPaint; end; procedure TCB_IMGPSScanX.Set_AutoScroll(Value: WordBool); begin AutoScroll := Value; end; procedure TCB_IMGPSScanX.Set_KeyPreview(Value: WordBool); begin KeyPreview := Value; end; procedure TCB_IMGPSScanX.PM401Click(Sender: TObject); var i : Integer; FromIndex : Integer; CaseID : String; NewPath : String; OldName,NewName:String; S : TStringlist; begin S := TStringlist.Create; try FromIndex := PageLv.ItemIndex; if FromIndex = 0 then begin Showmessage(_Msg('不能從第1頁分案')); Exit; end; If MessageDlg(Format(_Msg('是否確定從%d頁分出新案'),[PageLV.ItemIndex+1]),Mtconfirmation,[mbyes,mbcancel],0) = mrcancel Then Exit; ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 CaseID := GetNoNameCase(ImageSavePath); NewPath := ImageSavePath + CaseID+'\'; Str2Dir(NewPath); for i := FromIndex to ContextList.Count - 1 do begin OldName := ContextList.Strings[i]; //NewName := Add_Zoo(S.Count+1,3)+Copy(OldName,4,length(OldName)-3); NewName := Add_Zoo(S.Count+1,3)+FileName2NoQuene_Filename(OldName); ReNameFile(DisplayPath+OldName,NewPath+NewName); S.Add(NewName); S.SaveToFile(NewPath+'Context.dat'); end; for i := ContextList.Count - 1 downto FromIndex do begin ContextList.Delete(i); ContextList.SaveToFile(DisplayPath+'Context.dat'); end; SetCaseList('I',MyTreeNode1.IndexOf(MyTreeNode2)+1,CaseID); if FileExists(DisplayPath+'CaseIndex.dat') then //把原經辦代號取出來再寫入新件裡 begin S.LoadFromFile(DisplayPath+'CaseIndex.dat'); end; DisplayPath := ''; ClearCaseIndex; WriteCaseIndex(NewPath); finally S.Free; end; LoadImgFile; Showmessage(_Msg('分案完成')); end; procedure TCB_IMGPSScanX.PM402Click(Sender: TObject); var i : Integer; begin for i := 0 to PageLV.Items.Count - 1 do begin PageLV.Items.Item[i].Selected := True; end; end; procedure TCB_IMGPSScanX.PM403Click(Sender: TObject); var i : Integer; begin for i := 0 to PageLV.Items.Count - 1 do begin PageLV.Items.Item[i].Selected := False; end; end; procedure TCB_IMGPSScanX.PM404Click(Sender: TObject); var i : Integer; DocListForm : TDocListForm; OldName,NewName,Ext : String; FormID,FormName : String; PreNode2Name : String; begin PreNode2Name := ''; if TreeView1.Selected.Parent = MyTreeNode1 then PreNode2Name:= GetNode2Name(MyTreeNode2); ShowText := _Msg('文件歸類中,請稍候'); DataLoading(True,True); DocListForm := TDocListForm.Create(self); try InitialLanguage(PatchDlg); //載入多國語言 for i := 1 to FORM_INF_List.Count - 1 do begin FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); FormName := GetSQLData(FORM_INF_List,'T1.FORM_DESC',i); if (FormID <> NowFormCode) and FormIDExists(FormID,True,0) then begin DocListForm.FormIDList.Add(FormID+'#@#'+FormName); With DocListForm.DocLV.Items.Add do begin Caption := FormID; SubItems.Add(FormName); end; end; end; if DocListForm.ShowModal = mrOk then begin FormID := DocListForm.DocLV.Selected.Caption; if (TreeView1.Selected.Level=1) then begin PageReplaceFormID(DisplayPath,'ALL',FormID); end Else if (TreeView1.Selected.Level=2) and (NowFormCode = '') then PageReplaceFormID(DisplayPath,'',FormID) Else begin PageReplaceFormID(DisplayPath,NowFormCode,FormID); end; //DrawDocItem(MytreeNode1,FORM_INF_List,NowCaseno); //DrawDocItem1(MytreeNode1,Doc_Inf_List,NowCaseno); //201408280改 DrawDocItem2(MytreeNode1,NowCaseno); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 //Showmessage(_Msg('歸類完成')); //20101103 User要求拿掉 if PreNode2Name <> '' then // 回到原本點選的文件節點上 begin for i := 0 to MyTreeNode1.Count - 1 do begin if GetNode2Name(MyTreeNode1.Item[i]) = PreNode2Name then begin TreeView1.Selected := MyTreeNode1.Item[i]; Break; end; end; end; TreeView1click(self); end; finally DocListForm.Free; DataLoading(False,False); end; end; procedure TCB_IMGPSScanX.PM601Click(Sender: TObject); var i : Integer; DocListForm : TDocListForm; OldName,NewName,Ext : String; FormID,FormName,DocNo,DocDir : String; PreNode2Name : String; iFormID : String; iISBName : String; iISB : TImageScrollBox; GoAtt : Boolean; AttLv : Integer; ST1 :TStringList; begin PreNode2Name := ''; ST1:=TStringList.Create; if TreeView1.Selected.Parent = MyTreeNode1 then PreNode2Name:= GetNode2Name(MyTreeNode2); ShowText := _Msg('文件歸類中,請稍候'); LogFile1.LogToFile(logTimeString+'縮圖 歸類開始'); DataLoading(True,True); GoAtt := False; if (MytreeNode2 <> nil) and (Pos('Attach',MyTreeNode2.Text)>0) then begin AttLv := TreeView1.Selected.Level; GoAtt := True; end; DocListForm := TDocListForm.Create(self); try InitialLanguage(DocListForm); //載入多國語言 //InitialLanguage(PatchDlg); //載入多國語言 DocListForm.CheckBox1.Visible:=False; for i := 1 to FORM_INF_List.Count - 1 do begin FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); FormName := GetSQLData(FORM_INF_List,'T1.FORM_DESC',i); DocNo := GetSQLData(FORM_INF_List,'T1.DOC_NO',i)+GetSQLData(FORM_INF_List,'T1.DOC_VERSION',i); if not FormIDAppear(FormID) then Continue; //20170816 先秀全部 //Showmessage(FORM_INF_List.Text); //showmessage(inttostr(FORM_INF_List.Count)+#13+inttostr(self.Doc_Inf_List.Count)); if (FormID <> FileName2FormCode(DisplayISB.FileName)) and FormIDExists(FormID,False,i) then begin DocListForm.FormIDList.Add(FormID+'#@#'+FormName); With DocListForm.DocLV.Items.Add do begin Caption := FormID; SubItems.Add(FormName); end; end; end; if DocListForm.ShowModal = mrOk then begin for i := 0 to ComponentCount -1 do begin if (Components[i] is TShape) and (copy(Components[i].Name,1,2)='SP') then begin iISBName := ShapeName2PreViewISBName(TShape(Components[i])); iISB := TImageScrollBox(FindComponent(iISBName)); OldName := ExtractFileName(iISB.FileName); Ext := ExtractFileExt(OldName); if DocListForm.CheckBox1.Checked then begin FormID := DocListForm.Edit1.Text; DocNo := GetNewCustomDocNo(DisplayPath,FormID); end else begin FormID := DocListForm.DocLV.Selected.Caption; DocNo := FormCode2DocNo(FormID); end; if DocNoDir2DocNo(Path2DocDir(ExtractFilePath(iISB.FileName),NowCaseno)) = DocNo then DocDir := Path2DocDir(ExtractFilePath(iISB.FileName),NowCaseNo) Else DocDir := FindLastestDocDir(NowCaseno,DocNo); //ShowMessage('DocNoNeedDiv(DocNo)='+BoolToStr(DocNoNeedDiv(DocNo),true)); //ShowMessage('DocDir='+DocDir); if DocNoNeedDiv(DocNo) then //要分份數 begin if ((FormCode2Page(FormID) = '01') and (GetDocDir_Page(NowCaseno,DocDir)>0)) or (DocDir = '') then begin DocDir := DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',DocNo); end else begin //20171016 真對補件影響 所加的判斷 ST1.Clear; if FileExists(ImageSavePath + NowCaseno+'\'+DocDir+'\Context.dat') then begin ST1.LoadFromFile(ImageSavePath + NowCaseno+'\'+DocDir+'\Context.dat'); if (ST1.Count > 0) and ISExistImg(ImageSavePath + NowCaseno+'\'+DocDir+'\'+ST1.Strings[0]) then //20181210 多增加判斷ST1>0 否則會有機會出現List out of bound Hong begin DocDir := DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',DocNo); end; end; end; end Else //不分份數 begin if DocNo <> '' then DocDir := DocNo else //Attach 附件 DocDir := DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',DocNo); end; if (not DirectoryExists(ImageSavePath + NowCaseno+'\'+DocDir+'\')) and (DocDir <> AttName) then SetDocNoList('A',-1,NowCaseno,DocDir,'1'); {if DocDir = '' then begin DocDir := DocNo; if DocNoNeedDiv(DocNo) then DocDir:=DocNo2DocNoDir(ImageSavePath+NowCaseno+'\',DocNo); SetDocNoList('A',-1,NowCaseno,DocDir); end; } LogFile1.LogToFile(logTimeString+'縮圖 FormID='+FormID); if Not DirectoryExists(ImageSavePath+NowCaseno+'\'+DocDir) then Mkdir(ImageSavePath+NowCaseno+'\'+DocDir); ContextList.Clear; if FileExists(ImageSavePath+NowCaseno+'\'+DocDir+'\Context.dat') then ContextList.LoadFromFile(ImageSavePath+NowCaseno+'\'+DocDir+'\Context.dat'); NewName := Add_Zoo(ContextList.Count+1,3)+'_'+FormID+Ext; CopyFile(PWideChar(iISB.FileName),PwideChar(ImageSavePath+NowCaseno+'\'+DocDir+'\'+NewName),False); {ContextList.Add(NewName); ContextList.SaveToFile(ImageSavePath+NowCaseno+'\'+DocDir+'\Context.dat'); } SetContextList('A',-1,NowCaseNo,DocDir,NewName); DeleteImageFile(ExtractFilePath(iISB.FileName),ExtractFileName(iISB.FileName),NowCaseNo); //RenameFile(iISB.FileName,ImageSavePath+NowCaseno+'\'+DocDir+'\'+NewName); //ReNameContext(iISB.FileName,OldName,NewName); end; end; //ShowMessage('KKKK'); ReSortFileName(ExtractFilePath(iISB.FileName)); DrawDocItem2(MytreeNode1,NowCaseno); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 if GoAtt then begin GotoAttach(AttLv); end; TreeView1click(self); end; finally DataLoading(False,False); DocListForm.Free; ST1.Free; end; end; procedure TCB_IMGPSScanX.PM602Click(Sender: TObject); var FileList:TStringlist; SavePath : String; DocDir : String; CustomDocName : String; CustomDocNo : String; i : Integer; OldName,NewName,Ext : String; FormID,FormName,DocNo : String; PreNode2Name : String; iFormID : String; iISBName : String; iISB : TImageScrollBox; GoAtt : Boolean; AttLv : Integer; begin GoAtt := False; if (MytreeNode2 <> nil) and (Pos('Attach',MyTreeNode2.Text)>0) then begin AttLv := TreeView1.Selected.Level; GoAtt := True; end; if InputQuery(_Msg('輸入其他文件名稱'),_Msg('文件名稱'),CustomDocName) then begin if FindCustomDocName(DisplayPath,CustomDocName) then begin Showmessage(Format(_Msg('文件名稱:"%s"己存在'),[CustomDocName])); Exit; end; CustomDocNo := GetNewCustomDocNo(DisplayPath,CustomDocName); end; if CustomDocNo = '' then Exit; DocDir := CustomDocNo; LogFile1.LogToFile(logTimeString+'縮圖 歸類自訂文件 DocDir='+DocDir); SavePath := ImageSavePath+NowCaseNo+'\'+DocDir+'\'; Str2Dir(SavePath); SetDocNoList('A',-1,NowCaseNo,DocDir,'1'); FileList := TStringlist.Create; try FileList.Clear; if FileExists(SavePath+'Context.dat') then FileList.LoadFromFile(SavePath+'Context.dat'); for i := 0 to ComponentCount -1 do begin if (Components[i] is TShape) and (copy(Components[i].Name,1,2)='SP') then begin iISBName := ShapeName2PreViewISBName(TShape(Components[i])); iISB := TImageScrollBox(FindComponent(iISBName)); OldName := ExtractFileName(iISB.FileName); Ext := ExtractFileExt(OldName); NewName := Add_Zoo(FileList.Count+1,3)+'_'+GetCustomFormID(ImageSavePath+NowCaseNo+'\',CustomDocNo)+ext; //Showmessage(iISB.FileName+#13+ImageSavePath+NowCaseno+'\'+DocDir+'\'+NewName); CopyFile(PWideChar(iISB.FileName),PwideChar(ImageSavePath+NowCaseno+'\'+DocDir+'\'+NewName),False); SetContextList('A',-1,NowCaseno,DocDir,NewName); FileList.Add(NewName); {FileList.Add(NewName); FileList.SaveToFile(ImageSavePath+NowCaseno+'\'+DocDir+'\Context.dat');} DeleteImageFile(ExtractFilePath(iISB.FileName),ExtractFileName(iISB.FileName),NowCaseNo); end; end; finally FileList.Free; end; ReSortFileName(ExtractFilePath(iISB.FileName)); DrawDocItem2(MytreeNode1,NowCaseno); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 if GoAtt then begin GotoAttach(AttLv); end; TreeView1click(self); MyTreeNode1.Expand(True); end; procedure TCB_IMGPSScanX.PM604Click(Sender: TObject); var i : Integer; iISBName : String; iISB : TImageScrollBox; begin //Showmessage(inttostr(ComponentCount)); for i := 0 to ComponentCount -1 do begin if (Components[i] is TShape) and (copy(Components[i].Name,1,2)='SP') then begin //Showmessage(Components[i].Name); iISBName := ShapeName2PreViewISBName(TShape(Components[i])); iISB := TImageScrollBox(FindComponent(iISBName)); DeskewImg(iISB.Graphic); iISB.Redraw(True); iISB.SaveToFile(iISB.FileName); DisplayISB.LoadFromFile(DisplayISB.FileName,1); end; end; //TreeView1Click(nil); end; procedure TCB_IMGPSScanX.PM605Click(Sender: TObject); var i : Integer; iISBName,OldName : String; iISB : TImageScrollBox; begin if MessageDlg(_Msg('是否確定刪除??'),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; for i := 0 to ComponentCount -1 do begin if (Components[i] is TShape) and (copy(Components[i].Name,1,2)='SP') then begin //Showmessage(Components[i].Name); iISBName := ShapeName2PreViewISBName(TShape(Components[i])); iISB := TImageScrollBox(FindComponent(iISBName)); //ShowMessage('iISB.FileName='+iISB.FileName); //ShowMessage(ExtractFilePath(iISB.FileName)+','+ExtractFileName(iISB.FileName)+','+NowCaseNo); // if (FMode = 'ESCAN') and (FModeName<>'異動件') then // begin // if ISExistImg(iISB.FileName) then // begin // ShowMessage(_Msg('此圖為非當次掃瞄,不可刪除')); // Exit; // end; // end; LogFile1.LogToFile(logTimeString+'縮圖刪除 iISB.FileName='+iISB.FileName); DeleteImageFile(ExtractFilePath(iISB.FileName),ExtractFileName(iISB.FileName),NowCaseNo); end; end; //ShowMessage('iISB.FileName='+iISB.FileName); ReSortFileName(ExtractFilePath(iISB.FileName)); DrawDocItem2(MytreeNode1,NowCaseno); MyTreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]); NewTreeNodeRefresh; ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 TreeView1click(self); end; procedure TCB_IMGPSScanX.N1Click(Sender: TObject); var mp:string; begin mp := InputBox(_Msg('移動頁數'),_Msg('請輸入移入頁碼'),''); if (mp <> '') then begin MoveImage(DisplayPath+NowDocDir+'\',strtoint(mp)); end; end; procedure TCB_IMGPSScanX.N51Click(Sender: TObject); begin VMode := 4; GoViewMode; ScrollBar1Change(Self); end; procedure TCB_IMGPSScanX.NewScanBtnClick(Sender: TObject); begin IF not InitialOk Then begin Showmessage(_msg('資訊尚未下載完成,請稍候或重新進入')); Exit; end; LogFile1.LogToFile(logTimeString+'掃瞄開始'); if (FMode = 'RSCAN') or (FMode = 'ESCAN') or (FMode = 'DSCAN') then begin if NewTreeNode.Count > 0 then begin TreeView1.Selected := NewTreeNode.Item[0]; TreeView1click(nil); FirstDocDir := ''; NowGuideFormID := ''; NowDivPageFormID :=''; AddScanBtnclick(nil); end; end Else begin TreeView1.Selected := NewTreeNode; NewTreeNode.Expand(False); TreeView1Click(self); Panel1.Enabled := False; Panel2.Enabled := False; ScanMode := smNew; ScanInfo.ImageCount := 0; ScanPath := ''; ScanCaseno := ''; NowGuideFormID := ''; NowDivPageFormID :=''; ClearView(1); ContextList.Clear; Try StatrTwainScan; LogFile1.LogToFile(logTimeString+'掃瞄結束'); Except Panel1.Enabled := True; Panel2.Enabled := True; end; Panel1.Enabled := True; Panel2.Enabled := True; LoadImgFile; end; end; procedure TCB_IMGPSScanX.NextPageBtnClick(Sender: TObject); var page : Integer; begin {page := ScrollBar1.Position; Case Vmode of 0 : Inc(page); 1 : Page := Page + 2; 2 : Page := Page + 4; 3 : Page := Page + 6; 4 : Page := Page + 8; end; IF page <= ScrollBar1.Max Then begin ScrollBar1.Position := page; end;} if selectISB = nil then Exit; NextPage(SelectPage); if SelectISB.Parent.Top+SelectISB.Parent.Height+4 > scrollBox1.Height then ScrollBox1.VertScrollBar.Position := scrollBox1.VertScrollBar.Position + (SelectISB.Parent.Top+SelectISB.Parent.Height-ScrollBox1.Height+8); end; procedure TCB_IMGPSScanX.OptionBtnClick(Sender: TObject); var PatchDlg : TPatchDlg; i : Integer; begin IF not InitialOk Then begin Showmessage(_msg('資訊尚未下載完成,請稍候或重新進入')); Exit; end; ShowText := _Msg('掃瞄參數設定中,請稍候'); DataLoading(True,True); PatchDlg := TPatchDlg.Create(self); try InitialLanguage(PatchDlg); //載入多國語言 PatchDlg.BlankuseCB.Checked := DeviceDelete; if PatchDlg.BlankuseCB.Checked then PatchDlg.SpinEdit5.Enabled := True else PatchDlg.SpinEdit5.Enabled := False; PatchDlg.SpinEdit5.Value := DeviceDeleteSize; For i := 0 to PatchDlg.ComboBox1.Items.Count -1 do begin If inttostr(ScanDpi) = PatchDlg.ComboBox1.Items.Strings[i] Then PatchDlg.ComboBox1.ItemIndex := i; end; PatchDlg.DuplexCB.Checked := ScanDuplex; PatchDlg.ReverseCB.Checked := ScannerReverse; PatchDlg.BorderCB.Checked := BoardClear; PatchDlg.DeskewCB.Checked := ScanDeskew; PatchDlg.ImgSetUseCB.Checked := ScanImgSetUse; PatchDlg.SpinEdit1.Value := ScanBright; PatchDlg.SpinEdit2.Value := ScanContrast; case ScanRotate of 0 : PatchDlg.ScanRotateRG.ItemIndex := 0; 270 : PatchDlg.ScanRotateRG.ItemIndex := 1; 180 : PatchDlg.ScanRotateRG.ItemIndex := 2; 90 : PatchDlg.ScanRotateRG.ItemIndex := 3; end; Case ScanImgShowMode of 0 : PatchDlg.ScanShowRG.ItemIndex := 0; 1 : PatchDlg.ScanShowRG.ItemIndex := 1; 2 : PatchDlg.ScanShowRG.ItemIndex := 2; end; If PatchDlg.ShowModal = mrOk then begin DeviceDelete := PatchDlg.BlankuseCB.Checked; DeviceDeleteSize := PatchDlg.SpinEdit5.Value; ScanDpi := Strtoint(PatchDlg.ComboBox1.Text); ScannerReverse := PatchDlg.ReverseCB.Checked; BoardClear := PatchDlg.BorderCB.Checked; ScanDeskew := PatchDlg.DeskewCB.Checked; ScanDuplex := PatchDlg.DuplexCB.Checked; ScanImgSetUse := PatchDlg.ImgSetUseCB.Checked; ScanBright := PatchDlg.SpinEdit1.Value; ScanContrast := PatchDlg.SpinEdit2.Value; Case PatchDlg.ScanRotateRG.ItemIndex of 0:ScanRotate := 0; 1:ScanRotate := 270; 2:ScanRotate := 180; 3:ScanRotate := 90; end; Case PatchDlg.ScanShowRG.ItemIndex of 0:ScanImgShowMode := 0; 1:ScanImgShowMode := 1; 2:ScanImgShowMode := 2; end; R_W_ScanIni('W'); ScanDuplexCB.Checked := ScanDuplex; end; finally PatchDlg.Free; DataLoading(False,False); end; end; procedure TCB_IMGPSScanX.PageLVClick(Sender: TObject); begin IF PageLV.Selected = nil Then Exit; PageLVclear := False; ScrollBar1.Position := PageLV.Selected.Index+1; PageLVclear := True; end; procedure TCB_IMGPSScanX.PageLVKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin IF PageLV.Selected = nil Then Exit; ScrollBar1.Position := PageLV.Selected.Index+1; end; procedure TCB_IMGPSScanX.PageLVMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF Button = TMouseButton(MbRight) Then begin If PageLV.GetItemAt(X,Y) = nil then Exit; PageLV.Selected := PageLV.GetItemAt(X,Y); PageLVClick(self); PageLV.PopupMenu.Popup(Mouse.CursorPos.X ,Mouse.CursorPos.Y); end; end; procedure TCB_IMGPSScanX.Panel11DblClick(Sender: TObject); begin // Button3.Visible := not Button3.Visible; //Button4.Visible := not Button4.Visible; //self.FCustDocYN := 'N'; end; procedure TCB_IMGPSScanX.Panel1DblClick(Sender: TObject); begin Button1.Visible := not Button1.Visible; Button2.Visible := not Button2.Visible; end; procedure TCB_IMGPSScanX.Panel9Resize(Sender: TObject); begin GoViewMode; end; procedure TCB_IMGPSScanX.PM101Click(Sender: TObject); var P,v,v1,v2,ln,i : Integer; iDocDir,iDocNo : String; begin LogFile1.LogToFile(logTimeString+'Tree 按下刪除'); if TreeView1.Selected = NewTreeNode then //全刪 //新掃描件 begin LogFile1.LogToFile(logTimeString+'Tree 全部刪除'); If Messagedlg(_Msg('是否刪除所有案件?'),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; clearView(1); Application.ProcessMessages; _DelTree(ImageSavePath); if (FMode = 'ESCAN') then begin MkDir(ImageSavePath+FCaseID); CreateEmptyCase(ImageSavePath,FCaseID); end; LoadImgFile; Showmessage(_Msg('刪除完成')); end Else if TreeView1.Selected = MyTreeNode1 then //案件編號 begin LogFile1.LogToFile(logTimeString+'Tree 案件編號刪除 NowCaseno='+NowCaseno); If Messagedlg(Format(_Msg('編號(%s)是否刪除?'),[NowCaseno]),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; clearView(1); Application.ProcessMessages; if (FMode = 'ESCAN') then begin for i := 0 to MyTreeNode1.Count - 1 do begin MyTreenode2 := MyTreeNode1.Item[i]; v := Posend('{',MyTreenode2.Text); v1 := Posend('}',MyTreenode2.Text); v2 := posend('-',MyTreenode2.Text); ln := length(MyTreenode2.Text); iDocDir := Copy(MyTreeNode2.Text,v+1,v1-v-1); iDocNo := DocNoDir2DocNo(iDocDir); _DelTree(ImageSavePath+NowCaseno+'\'+iDocDir); SetUseCase('D',ImageSavePath+NowCaseno+'\',iDocDir,'',''); SetDocNoList('D',-1,NowCaseNo,iDocDir,''); if (Copy(iDocNo,1,5)='ZZZZZ') then //20140703 刪除自定文件時要刪ini檔資料 DeleteCustomDocDir(ImageSavePath+NowCaseno+'\',iDocDir); end end Else begin _DelTree(DisplayPath); SetCaseList('D',NewTreeNode.IndexOf(MyTreeNode1),''); end; ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 if (FMode = 'ESCAN') then begin if not DirectoryExists(ImageSavePath+FCaseID) then begin MkDir(ImageSavePath+FCaseID); CreateEmptyCase(ImageSavePath,FCaseID); end; end; LoadImgFile; end Else if TreeView1.Selected = MyTreeNode2 then //文件層 begin If Messagedlg(Format(_Msg('文件(%s)是否刪除?'),[DocNo2DocName(NowCaseno,NowDocNo)]),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; ClearView(1); Application.ProcessMessages; //ShowMessage(NowDocDir); LogFile1.LogToFile(logTimeString+'Tree 文件層號刪除 NowDocDir='+NowDocDir); if (Length(NowDocDir)=8) or (NowDocDir=AttName) then begin //ShowMessage('DeleteDocNoFileForESCAN'); DeleteDocNoFileForESCAN(ImageSavePath+NowCaseno+'\'+NowDocDir,NowDocDir); end else begin _DelTree(ImageSavePath+NowCaseno+'\'+NowDocDir); SetDocNoList('D',-1,NowCaseNo,NowDocDir,''); end; SetUseCase('D',ImageSavePath+NowCaseno+'\',NowDocDir,'',''); if (Copy(NowDocNo,1,5)='ZZZZZ') then //20140703 刪除自定文件時要刪ini檔資料 DeleteCustomDocDir(ImageSavePath+NowCaseno+'\',NowDocDir); DrawDocItem2(MytreeNode1,NowCaseno); MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 NewTreeNodeRefresh; end Else if TreeView1.Selected = MyTreeNode3 then //FormID層 begin If Messagedlg(Format(_Msg('文件(%s)是否刪除?'),[NowFormName]),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; LogFile1.LogToFile(logTimeString+'Tree FormID層號刪除 NowFormCode='+NowFormCode); DeleteFormCodeFile(NowCaseNo,NowDocDir,NowFormCode); SetRecordEditedDocDir('A',NowCaseNo,NowDocDir); DrawDocItem2(MytreeNode1,NowCaseno); MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 NewTreeNodeRefresh; end; end; procedure TCB_IMGPSScanX._DelTreeForExistImg(ASourceDir:String); var i:integer; ST:TStringList; begin end; procedure TCB_IMGPSScanX.PM102Click(Sender: TObject); var NewCaseID,ShowNewCaseID,ShowNowCaseID : String; i,P,v : Integer; InputOk : Boolean; begin VMode := 0; GoViewMode; ISB1.ZoomMode := zmFitWidth; NewCaseID := InputBox(_Msg('修改案件編號'),_Msg('新案件編號'),''); ShowNewCaseID := NewCaseID; ShowNowCaseID := NowCaseno; if NewCaseID = '' then Exit; IF Length(NewCaseID)<>CaseIDLength Then begin Showmessage(_Msg('輸入格式錯誤')); Exit; end; if DirectoryExists(ImageSavePath+NewCaseID) then begin Showmessage(NewCaseID+_Msg('己存在,無法修改')); Exit; end; if Messagedlg(Format(_Msg('是否將%s改為%s'),[ShowNowCaseID,ShowNewCaseID]),Mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; ClearView(1); RenameFile(ImageSavePath+NowCaseno,ImageSavePath+NewCaseID); SetCaseList('E',NewTreeNode.IndexOf(MyTreeNode1),NewCaseID); //P := ContextList.Count; MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NewCaseID,GetCasePage(ImageSavePath,NewCaseID)]); //DrawDocItem(MyTreeNode1,FORM_INF_List,NewCaseID); DrawDocItem2(MytreeNode1,NewCaseID); Showmessage(_Msg('修改完成')); end; procedure TCB_IMGPSScanX.PM103Click(Sender: TObject); begin if TreeView1.Selected = nil then Exit; {if Treeview1.Selected = NewTreeNode then begin ShowMessage('AAAAA'); end; if Treeview1.Selected = MyTreeNode1 then begin ShowMessage('BBBBB'); end; if Treeview1.Selected = MyTreeNode2 then begin ShowMessage('CCCCC'); end; if Treeview1.Selected = MyTreeNode3 then begin ShowMessage('DDDDD'); end; } if (Treeview1.Selected = NewTreeNode) {or (Treeview1.Selected = MyTreeNode1)} then begin //ShowMessage('NewScanBtnClick'); LogFile1.LogToFile(logTimeString+'Tree NewScanBtnClick'); NewScanBtnClick(self) end Else begin //ShowMessage('AddScanBtnclick'); LogFile1.LogToFile(logTimeString+'Tree AddScanBtnclick'); AddScanBtnclick(self); end; end; Procedure TCB_IMGPSScanX.PM104Click(Sender: TObject); Var i, n, m, ii, P, v, v1, page, imageCount: Integer; FName: String; CaseID, DocNo, FormID: String; DocDir: String; SavePath, SaveFilename: String; ISB: TImageScrollBox; FileRec: TSearchrec; iGraphic, iGraphic_First, iGraphic_sec: TTiffGraphic; iRect : TRect; JpgGr : TJpegGraphic; SaveStream : TFileStream; SaveStreamA:TFileStream; SaveStreamB:TFileStream; cooom:integer; Begin OpenDialog1.Filter := 'Image files|*.TIF;*.JPG;*.PNG'; If OpenDialog1.Execute Then Begin ISB := TImageScrollBox.Create(self); try ShowText := _Msg('檔案加入中,請稍候'); LogFile1.LogToFile(logTimeString+'檔案加入中開始'); DataLoading(True, True); If TreeView1.Selected = Nil Then Exit; FName := OpenDialog1.FileName; FindFirst(FName, faAnyfile, FileRec); If FFileSizeLimit = 0 Then Begin FFileSizeLimit := 5 * 1024; End; //FFileSizeLimit:=20*5*1024; //ShowMessage(IntToStr(FileRec.Size)+','+IntToStr(FFileSizeLimit * 1024)); If FileRec.Size > FFileSizeLimit * 1024 Then // 檢查檔案大小 Begin ShowMessage(Format(_Msg('目前檔案大小為 %.3f MB,已超過單一檔案匯入限制%1.f MB'),[FileRec.Size / (1024*1024),FFileSizeLimit/1024])); {ShowMessage(Format('目前檔案大小為 %.3f MB', [FileRec.Size / (1024*1024)]) + ',已超過單一檔案匯入限制'+Format('%.1f',[FFileSizeLimit/1024])+'MB');} FindClose(FileRec); DataLoading(false, false); Exit; End; //MessageDlg() //cooom:=StrToInt(InputBox('輸入百分比','輸入百分比','')); cooom:=FJpgCompression;//20171211彩色tif採jpg壓縮的比例 FindClose(FileRec); CaseID := NowCaseno; imageCount := 0; P := ISB.ImageCountFromFile(OpenDialog1.FileName); For i := 1 To P Do Begin ShowText := Format(_Msg('檔案加入中,請稍候(%d/%d)'),[i,p]); //ShowText := _Msg('檔案加入中,請稍候')+'(' + inttostr(i) + '/' + inttostr(P) + ')'; DataLoading(True, True); ISB.LoadFromFile(FName, i); DeskewImg(ISB.Graphic); ISB_BW.Graphic.Assign(ISB.Graphic); //20180104 If ISB.Graphic.ImageFormat <> ifBlackWhite Then //20180104 begin ConvertToBW(ISB_BW.Graphic); end; ///ISB_BW.SaveToFile('KKKKKKKK.tif'); iGraphic_First := TTiffGraphic.Create; iGraphic_sec := TTiffGraphic.Create; //ShowMessage(IntToStr(iGraphic_First.Palette.palNumEntries)); //彩色 會為0 黑白 為2 MpsGetBarcode(ISB_BW.Graphic, MpsBarcodeinf); //判斷A3 有用FormID 所以要先辨條碼 For n := 1 To MpsBarcodeinf.Count Do Begin If (MpsBarcodeinf.r180[n] <> 0) and (Length(MpsBarcodeinf.Text[n])=FormIDLength) Then // 依條碼角度轉影像 Begin Rotate(ISB.Graphic, MpsBarcodeinf.r180[n]); //MpsGetBarcode(iGraphic_First, MpsBarcodeinf); Break; End; End; iGraphic_First.Assign(ISB.Graphic); //有必要的話先把影像轉正 再開始切圖 If CheckNeedCrop(iGraphic_First) Then Begin // 先取右邊的影像 iRect.Left := ISB.Graphic.Width Div 2; iRect.Right := ISB.Graphic.Width; iRect.Top := 0; iRect.Bottom := ISB.Graphic.Height; CropImg(iGraphic_First, iRect); iGraphic_sec.Assign(ISB.Graphic); // 再取左邊的影像 iRect.Left := 0; iRect.Right := ISB.Graphic.Width Div 2; iRect.Top := 0; iRect.Bottom := ISB.Graphic.Height; CropImg(iGraphic_sec, iRect); End; ISB.Graphic.Clear; //20220711 Hong 覺得ISB後面沒有到了,先清掉減少記憶體使用 iGraphic := iGraphic_First; While Not iGraphic.IsEmpty Do Begin If (TreeView1.Selected = NewTreeNode) Or (TreeView1.Selected = MyTreeNode1) Then Begin SaveFilename := ''; ISB_BW.Graphic.Assign(iGraphic); //20180104 If iGraphic.ImageFormat <> ifBlackWhite Then //20180104 begin ConvertToBW(ISB_BW.Graphic); end; MpsGetBarcode(ISB_BW.Graphic, MpsBarcodeinf); //ShowMessage(IntToStr(MpsBarcodeinf.Count)); For n := 1 To MpsBarcodeinf.Count Do Begin If (MpsBarcodeinf.r180[n] <> 0) and (Length(MpsBarcodeinf.Text[n])=FormIDLength) Then // 依條碼角度轉影像 Begin Rotate(iGraphic, MpsBarcodeinf.r180[n]); MpsGetBarcode(ISB_BW.Graphic, MpsBarcodeinf); Break; End; End; //ShowMessage('XXX '+IntToStr(MpsBarcodeinf.Count)); FormID := BarCode2FormID; //ShowMessage('FormID='+FormID); // 取出FormID SaveFilename := FormID; If (TreeView1.Selected = NewTreeNode) Then Begin If FindDivFormCode(FormID) Then // 只找分案頁上的案件條碼 Begin imageCount := 0; ClearView(1); ContextList.Clear; CaseID := BarCode2CaseID; If DirectoryExists(ImageSavePath + CaseID + '\') Then Begin _DelTree(ImageSavePath + CaseID + '\'); SetCaseList('D', -1, CaseID); End; End; If CaseID = '' Then Begin CaseID := GetNoNameCase(ImageSavePath); ContextList.Clear; End; End; SavePath := ImageSavePath + CaseID + '\'; Str2Dir(SavePath); DocNo := FormCode2DocNo(FormID); DocDir := FindLastestDocDir(CaseID, DocNo); if (FMode='ESCAN') and (FModeName=_Msg('補件掃描')) then begin DocDir := FindLastestDocDirForPage(CaseID, DocNo,FormID); //ShowMessage('DocDir='+DocDir); end; If DocNoNeedDiv(DocNo) Then // 要分份數 Begin If ((FormCode2Page(FormID) = '01') And (GetDocDir_Page(CaseID, DocDir) > 0)) Or (DocDir = '') Then begin DocDir := DocNo2DocNoDir(ImageSavePath + CaseID + '\', DocNo); end; End Else // 不分份數 Begin If DocNo <> '' Then DocDir := DocNo Else // Attach 附件 DocDir := DocNo2DocNoDir(ImageSavePath + CaseID + '\', DocNo); End; If (Not DirectoryExists(ImageSavePath + CaseID + '\' + DocDir + '\')) And (DocDir <> AttName) Then SetDocNoList('A', -1, CaseID, DocDir, '1'); SavePath := ImageSavePath + CaseID + '\' + DocDir + '\'; Str2Dir(SavePath); ContextList.Clear; If FileExists(SavePath + 'Context.dat') Then ContextList.LoadFromFile(SavePath + 'Context.dat'); WriteCaseIndex(ImageSavePath + CaseID + '\'); // 寫入案件索引 If SaveFilename = '' Then // 附件 SaveFilename := Add_Zoo(ContextList.Count + 1, 3) + ext Else SaveFilename := Add_Zoo(ContextList.Count + 1, 3) + '_' + SaveFilename + ext; For n := 1 To MpsBarcodeinf.Count Do Begin If (MpsBarcodeinf.r180[n] <> 0) and (Length(MpsBarcodeinf.Text[n])=FormIDLength) Then // 依條碼角度轉影像 Begin Rotate(iGraphic, MpsBarcodeinf.r180[n]); MpsGetBarcode(ISB_BW.Graphic, MpsBarcodeinf); Break; End; End; //ShowMessage(IntToStr(iGraphic.Palette.palNumEntries)); if iGraphic.ImageFormat = ifBlackWhite then //20200806 出現無法匯入,是因color256無法壓JPEG,待報會後再開啟 begin SaveFilename := changefileext(SaveFilename,'.tif'); //20240320 Hong 調整黑白存tif iGraphic.Compression:=tcGroup4; end else if iGraphic.ImageFormat= ifColor256 then begin SaveFilename := changefileext(SaveFilename,'.jpg'); //20240320 Hong 調整Color256存jpg ConverttoGray(iGraphic); iGraphic.Compression:=tcJPEG; iGraphic.JpegQuality:=cooom; end else if (iGraphic.ImageFormat = ifTrueColor) or (iGraphic.ImageFormat = ifGray256) then begin SaveFilename := changefileext(SaveFilename,'.jpg'); //20240320 Hong 調整彩色灰階存jpg iGraphic.Compression:=tcJPEG; iGraphic.JpegQuality:=cooom; end else begin iGraphic.Compression:=tcLZW; end; {if (iGraphic.Palette.palNumEntries = 0) or (iGraphic.Palette.palNumEntries = 256) then //20171130 彩色 會為0 黑白 為2 灰階256 //20200806拿掉 begin iGraphic.Compression:=tcJPEG; iGraphic.JpegQuality:=cooom; end;} If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.tif' Then Begin If FileExists(SavePath + SaveFilename) Then SaveStream := TFileStream.Create(SavePath + SaveFilename, fmOpenReadWrite) Else SaveStream := TFileStream.Create(SavePath + SaveFilename, fmCreate); Try SaveStream.Seek(0, soFromBeginning); iGraphic.AppendToStream(SaveStream); Finally SaveStream.Free; End; End Else If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.jpg' Then Begin If FileExists(SavePath + SaveFilename) Then DeleteFile(SavePath + SaveFilename); // SaveStream := TFileStream.Create( PEFileName ,fmCreate ); JpgGr := TJpegGraphic.Create; Try JpgGr.Assign(iGraphic); JpgGr.SaveQuality := 30; // JpgGr.AppendToStream(SaveStream); JpgGr.SaveToFile(SavePath + SaveFilename); Finally JpgGr.Free; // SaveStream.Free; End; End; SetContextList('A', -1, CaseID, DocDir, SaveFilename); If (TreeView1.Selected = NewTreeNode) Then Begin If imageCount = 0 Then Begin SetCaseList('A', -1, CaseID); MyTreeNode1 := TreeView1.Items.AddChild(NewTreeNode, CaseID); MyTreeNode1.ImageIndex := 2; MyTreeNode1.SelectedIndex := 2; Application.ProcessMessages; End; End; inc(imageCount); // DrawDocItem1(MytreeNode1,Doc_Inf_List,CaseID); // DrawDocItem(MyTreeNode1,FORM_INF_List,CaseID); End Else If TreeView1.Selected = MyTreeNode3 Then Begin SavePath := ImageSavePath + CaseID + '\' + NowDocDir + '\'; ContextList.Clear; If FileExists(ImageSavePath + CaseID + '\' + NowDocDir + '\Context.dat') Then ContextList.LoadFromFile(ImageSavePath + CaseID + '\' + NowDocDir + '\Context.dat'); If NowFormCode <> '' Then SaveFilename := Add_Zoo(ContextList.Count + 1, 3) + '_' + NowFormCode + ext Else SaveFilename := Add_Zoo(ContextList.Count + 1, 3) + ext; For n := 1 To MpsBarcodeinf.Count Do Begin If MpsBarcodeinf.r180[n] <> 0 Then // 依條碼角度轉影像 Begin Rotate(iGraphic, MpsBarcodeinf.r180[n]); MpsGetBarcode(iGraphic, MpsBarcodeinf); Break; End; End; if (iGraphic.Palette.palNumEntries = 0) or (iGraphic.Palette.palNumEntries = 256) then //20171130 彩色 會為0 黑白 為2 begin iGraphic.Compression:=tcJPEG; iGraphic.JpegQuality:=cooom; end; If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.tif' Then Begin If FileExists(SavePath + SaveFilename) Then SaveStream := TFileStream.Create(SavePath + SaveFilename, fmOpenReadWrite) Else SaveStream := TFileStream.Create(SavePath + SaveFilename, fmCreate); Try SaveStream.Seek(0, soFromBeginning); iGraphic.AppendToStream(SaveStream); Finally SaveStream.Free; End; End Else Begin If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.jpg' Then Begin If FileExists(SavePath + SaveFilename) Then DeleteFile(SavePath + SaveFilename); // SaveStream := TFileStream.Create( PEFileName ,fmCreate ); JpgGr := TJpegGraphic.Create; Try JpgGr.Assign(iGraphic); JpgGr.SaveQuality := cooom; // JpgGr.AppendToStream(SaveStream); JpgGr.SaveToFile(SavePath + SaveFilename); Finally JpgGr.Free; // SaveStream.Free; End; End; End; // ISB.SaveToFile(SavePath+SaveFilename); ContextList.Add(SaveFilename); ContextList.SaveToFile(SavePath + 'Context.dat'); End; if iGraphic = iGraphic_First then iGraphic := iGraphic_Sec else iGraphic.Assign(nil); End //While 結束 End; ClearErrini(CaseID, MyTreeNode1); // 清掉檢核記錄 If (TreeView1.Selected = MyTreeNode1) Or (TreeView1.Selected = NewTreeNode) Then Begin LoadImgFile; End Else Begin DrawDocItem2(MyTreeNode1, CaseID); // 長出文件名稱的樹並傳回是否有申請書的影像 page := GetCasePage(ImageSavePath, CaseID); // ShowMessage('page='+IntToStr(page)); MyTreeNode1.Text := Format(_Msg('%s-%d頁'), [CaseID, page]); End; // ShowMessage('AAAA'); NewTreeNodeRefresh; Application.ProcessMessages; DataLoading(false, false); finally ISB.Free; iGraphic_First.Free; iGraphic_sec.Free; end; End; End; procedure TCB_IMGPSScanX.PM106Click(Sender: TObject); var i,n,x,v,v1 : Integer; CopyFormID,Copy2Caseno,CopyFileName : String; S : TStringlist; begin ShowText := _Msg('複製文件中,請稍候'); DataLoading(True,True); DocCopyForm := TDocCopyForm.Create(Self); S := TStringlist.Create; try InitialLanguage(DocCopyForm); //載入多國語言 DocCopyForm.CopyFromGB.Caption := NowCaseno+DocCopyForm.CopyFromGB.Caption; IF NewTreenode.Count = 1 Then begin Showmessage(_Msg('沒有其他可複製的文件')); Exit; end; For i := 0 to MyTreeNode1.Count -1 do begin v := Pos('-',MyTreeNode1.Item[i].Text); v1 := pos('{',MyTreeNode1.Item[i].Text); if V1 > 0 then begin CopyFormID := Copy(MyTreeNode1.Item[i].Text,1,v-1); DocCopyForm.CheckListBox1.Items.Add(CopyFormID); end; end; For i := 0 to NewTreenode.Count -1 do begin v := Posend('-',NewTreeNode.Item[i].Text); Copy2Caseno := Copy(NewTreeNode.Item[i].Text,1,v-1); IF Copy2Caseno <> NowCaseno Then begin DocCopyForm.CheckListBox2.Items.Add(Copy2Caseno); end; end; if DocCopyForm.ShowModal = mrok then begin If MessageDlg(_Msg('是否確定要將勾選的文件複製到勾選的編號裡?'),MtConfirmation,[Mbyes,mbcancel],0) = mrCancel Then Exit; ShowText := _Msg('複製中,請稍候'); DataLoading(True,True); For i := 0 to DocCopyForm.CheckListBox2.Count -1 do begin IF DocCopyForm.CheckListBox2.Checked[i] Then begin S.Clear; Copy2Caseno := DocCopyForm.CheckListBox2.Items.Strings[i]; ClearErrini(Copy2Caseno,MyTreeNode1); //清掉檢核記錄 S.LoadFromFile(ImageSavePath + Copy2Caseno +'\Context.dat'); For n := 0 to DocCopyForm.CheckListBox1.Count -1 do //文件 begin If DocCopyForm.CheckListBox1.Checked[n] Then begin //v:= Posend('{',DocCopyForm.CheckContextList.Strings[n]); //v1 := Posend('}',DocCopyForm.CheckContextList.Strings[n]); //CopyFormID := Copy(DocCopyForm.CheckContextList.Strings[n],1,v-1); CopyFormID := DocCopyForm.CheckListBox1.Items.Strings[n]; IF v = 0 Then CopyFormID := ''; For x := 0 to ContextList.Count -1 do begin //Showmessage(CopyFormCode); //IF CopyFormID <> '' then //有文件代號 // begin if FileName2FormCode(ContextList.Strings[x])=CopyFormID then begin //CopyFileName := Add_Zoo(S.Count+1,3)+ Copy(ContextList.Strings[x],4,length(ContextList.Strings[x])-3); CopyFileName := Add_Zoo(S.Count+1,3)+ FileName2NoQuene_Filename(ContextList.Strings[x]); CopyFile(PWideChar(DisplayPath+ContextList.Strings[x]),PWidechar(ImageSavePath + Copy2Caseno+'\'+CopyFileName),False); S.Add(CopyFileName); S.SaveToFile(ImageSavePath + Copy2Caseno +'\Context.dat'); end; // end end; end; end; end; end; DataLoading(False,False); Showmessage(_Msg('複製完成!!')); LoadImgFile; end; finally DocCopyForm.Free; DataLoading(False,False); S.Free; end; end; procedure TCB_IMGPSScanX.PM107Click(Sender: TObject); begin WNoteBtnClick(nil); end; procedure TCB_IMGPSScanX.PM108Click(Sender: TObject); var i : Integer; DocListForm : TDocListForm; OldName,NewName,Ext : String; NewFormID,NewFormName,CustomDocNo : String; begin DocListForm := TDocListForm.Create(self); try LogFile1.LogToFile(logTimeString+'Tree 歸類開始'); InitialLanguage(DocListForm); //載入多國語言 DocListForm.CheckBox1.Visible:=True; for i := 1 to FORM_INF_List.Count - 1 do begin NewFormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); NewFormName := GetSQLData(FORM_INF_List,'T1.FORM_DESC',i); if not FormIDAppear(NewFormID) then Continue; //20170816 先秀全部的 if (NewFormID <> FileName2FormCode(DisplayISB.FileName)) and FormIDExists(NewFormID,False,i) then begin DocListForm.FormIDList.Add(NewFormID+'#@#'+NewFormName); With DocListForm.DocLV.Items.Add do begin Caption := NewFormID; SubItems.Add(GetSQLData(FORM_INF_List,'T1.FORM_DESC',i)); end; end; end; if DocListForm.ShowModal = mrOk then begin if not (DocListForm.DocLV.Selected=nil) then NewFormID := DocListForm.DocLV.Selected.Caption; if DocListForm.CheckBox1.Checked then begin //歸類到自訂文件 NewFormID:=DocListForm.Edit1.Text; if Trim(DocListForm.Edit1.Text)='' then begin Showmessage(_Msg('未輸入文件名稱')); Exit; end; if FindCustomDocName(DisplayPath,NewFormID) then begin Showmessage(Format(_Msg('文件名稱:"%s"己存在'),[NewFormID])); Exit; end; if NowFormCode <> AttName then begin If Messagedlg(Format(_Msg('是否將"%s"的所有影像歸類成"%s"'),[FormCode2FormName(NowCaseNo,NowFormCode),NewFormID]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel Then Exit; end Else begin If Messagedlg(Format(_Msg('是否將"%s"的所有影像歸類成"%s"'),[_Msg('附件')+MyTreeNode3.Text,FormCode2FormName(NowCaseNo,NewFormID)]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel Then Exit; end; CustomDocNo := GetNewCustomDocNo(DisplayPath,NewFormID); //ShowMessage('CustomDocNo='+CustomDocNo); LogFile1.LogToFile(logTimeString+'Tree 歸類到自訂文件 CustomDocNo='+CustomDocNo); ShowText := _Msg('歸類中,請稍侯'); DataLoading(True,True); FormIDReplace(NowCaseNo,NowDocDir,NowFormCode,CustomDocNo+'010101A'); end else begin //歸類到既有文件 if NowFormCode <> AttName then begin If Messagedlg(Format(_Msg('是否將"%s"的所有影像歸類成"%s"'),[FormCode2FormName(NowCaseNo,NowFormCode),FormCode2FormName(NowCaseNo,NewFormID)]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel Then Exit; end Else begin If Messagedlg(Format(_Msg('是否將"%s"的所有影像歸類成"%s"'),[_Msg('附件')+MyTreeNode3.Text,FormCode2FormName(NowCaseNo,NewFormID)]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel Then Exit; end; ShowText := _Msg('歸類中,請稍侯'); DataLoading(True,True); //ShowMessage('NowDocDir='+NowDocDir); LogFile1.LogToFile(logTimeString+'Tree 歸類到既有文件 NewFormID='+NewFormID); FormIDReplace(NowCaseNo,NowDocDir,NowFormCode,NewFormID); end; ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 DrawDocItem2(MytreeNode1,NowCaseno); DataLoading(False,False); TreeView1.Selected := MyTreeNode1; TreeView1Click(self); end; finally DocListForm.Free; end; end; procedure TCB_IMGPSScanX.PM109Click(Sender: TObject); var S : TStringlist; CaseID : String; begin //if TreeView1.Selected = nil then Exit; //if TreeView1.Selected = NewTreeNode then Exit; CaseID := NowCaseno; S := TStringlist.Create; try ClearView(1); ShowText := CaseID+_Msg('檢核中,請稍候'); DataLoading(True,True); ShowText := CaseID+_Msg('檢核中,請稍候'); DataLoading(True,True); If OMRCheckCase(CaseID) then //有成功 begin S.Add('Y'); S.SaveToFile(ImageSavePath+CaseID+'\OMRCheckOk.dat'); end; //MyTreeNode2ReFresh(CaseID); LoadImgFile; TreeView1Click(nil); DataLoading(False,False); finally S.Free; end; Showmessage(_Msg('檢核完成')); end; procedure TCB_IMGPSScanX.PM110Click(Sender: TObject); var CustomDocName : String; CustomDocNo : String; DocDir : String; SavePath : String; ST1:TStringList; begin if InputQuery(_Msg('輸入其他文件名稱'),_Msg('文件名稱'),CustomDocName) then begin if CustomDocName <> '' then begin if FindCustomDocName(DisplayPath,CustomDocName) then begin Showmessage(Format('文件名稱:"%s"己存在',[CustomDocName])); Exit; end; ST1:=TStringList.Create; CustomDocNo := GetNewCustomDocNo(DisplayPath,CustomDocName); DocDir := CustomDocNo; SavePath := ImageSavePath+NowCaseNo+'\'+DocDir+'\'; Str2Dir(SavePath); SetDocNoList('A',-1,NowCaseNo,DocDir,'1'); DrawDocItem2(MytreeNode1,NowCaseno); MyTreeNode1.Expand(True); end; end; end; procedure TCB_IMGPSScanX.PM111Click(Sender: TObject); var oldCopies,NewCopies : Integer; copies : String; begin oldCopies := GetDocDirCopies(NowCaseno,NowDocDir); try NewCopies := Strtoint(inputBox(_Msg('修改份數'),_Msg('請輸入修改後的份數'),inttostr(oldCopies))); except Showmessage(_Msg('輸入錯誤')); Exit; end; if (NewCopies <= 0) and (NewCopies >= 10000) then begin Showmessage(_Msg('輸入範圍錯誤')); Exit; end; if (oldCopies <> NewCopies) and (NewCopies > 0) and (NewCopies < 10000) then begin if DocNoNeedDiv(NowDocNo) and (NewCopies = 1) and (MessageDlg(_Msg('修改至1份後此文件將無法再進行份數修改,是否確定??'),mtConfirmation,[mbyes,mbcancel],0)= mrcancel) then Exit; SetDocDirCopies(NowCaseno,NowDocDir,NewCopies); SetRecordEditedDocDir('A',NowCaseNo,NowDocDir); DrawDocItem2(MytreeNode1,NowCaseno); Showmessage(_Msg('修改完成')); end; end; procedure TCB_IMGPSScanX.PM301Click(Sender: TObject); begin ScanColor := ifBlackWhite; ScanDpi := Def_ScanDpi; Ext := '.tif'; PM301.Checked := True; end; procedure TCB_IMGPSScanX.PM302Click(Sender: TObject); begin ScanColor := ifGray256; Ext := '.jpg'; ScanDpi := 200; //Ext := '.tif'; PM302.Checked := True; end; procedure TCB_IMGPSScanX.PM303Click(Sender: TObject); begin ScanColor := ifTrueColor; Ext := '.jpg'; //20130326 yuu說理賠改存jpg ScanDpi := 200; //Ext := '.tif'; PM303.Checked := True; end; procedure TCB_IMGPSScanX.PM501Click(Sender: TObject); begin DisplayISB.ZoomMode := zmFitWidth; DisplayISB.AntiAliased := True; SetScrollData(DisplayISB,DisplayISB.HorzScrollBar.Position,DisplayISB.VertScrollBar.Position,DisplayISB.ZoomPercent); end; procedure TCB_IMGPSScanX.PM502Click(Sender: TObject); begin DisplayISB.ZoomMode := zmFitHeight; DisplayISB.AntiAliased := True; SetScrollData(DisplayISB,DisplayISB.HorzScrollBar.Position,DisplayISB.VertScrollBar.Position,DisplayISB.ZoomPercent); end; procedure TCB_IMGPSScanX.PM503Click(Sender: TObject); begin DisplayISB.ZoomMode := zmFittoPage; DisplayISB.AntiAliased := True; SetScrollData(DisplayISB,DisplayISB.HorzScrollBar.Position,DisplayISB.VertScrollBar.Position,DisplayISB.ZoomPercent); end; procedure TCB_IMGPSScanX.PM504Click(Sender: TObject); begin DisplayISB.ZoomMode := zmOriginalSize; DisplayISB.AntiAliased := True; SetScrollData(DisplayISB,DisplayISB.HorzScrollBar.Position,DisplayISB.VertScrollBar.Position,DisplayISB.ZoomPercent); end; procedure TCB_IMGPSScanX.PM505Click(Sender: TObject); begin if DisplayISB.FileName = '' then Exit; Panel1.Enabled := False; Panel2.Enabled := False; ScanMode := smReplace; ScanInfo.ImageCount := 0; ScanPath := DisplayPath; ScanCaseno := ''; ScanSaveFilename := ExtractFileName(DisplayISB.FileName); Try StatrTwainScan; Except Panel1.Enabled := True; Panel2.Enabled := True; end; Panel1.Enabled := True; Panel2.Enabled := True; ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 end; procedure TCB_IMGPSScanX.PM507Click(Sender: TObject); var i : Integer; DocListForm : TDocListForm; OldName,NewName,Ext : String; FormID,FormName,DocNo : String; PreNode2Name : String; iFormID : String; begin PreNode2Name := ''; if TreeView1.Selected.Parent = MyTreeNode1 then PreNode2Name:= GetNode2Name(MyTreeNode2); ShowText := _Msg('文件歸類中,請稍候'); DataLoading(True,True); DocListForm := TDocListForm.Create(self); try InitialLanguage(PatchDlg); //載入多國語言 for i := 1 to FORM_INF_List.Count - 1 do begin FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); FormName := GetSQLData(FORM_INF_List,'T1.FORM_DESC',i); DocNo := GetSQLData(FORM_INF_List,'T1.DOC_NO',i)+GetSQLData(FORM_INF_List,'T1.DOC_VERSION',i); //Showmessage(FORM_INF_List.Text); //showmessage(inttostr(FORM_INF_List.Count)+#13+inttostr(self.Doc_Inf_List.Count)); if (FormID <> FileName2FormCode(DisplayISB.FileName)) and FormIDExists(FormID,False,i) then begin DocListForm.FormIDList.Add(FormID+'#@#'+FormName); With DocListForm.DocLV.Items.Add do begin Caption := FormID; SubItems.Add(FormName); end; end; end; if DocListForm.ShowModal = mrOk then begin OldName := ExtractFileName(DisplayISB.FileName); Ext := ExtractFileExt(OldName); //NewName := Copy(OldName,1,3)+'_'+TransRealFormID(DocListForm.DocLV.Selected.Caption)+Ext; NewName := Add_Zoo(FileName2ScanPage(OldName),3)+'_'+DocListForm.DocLV.Selected.Caption+Ext; RenameFile(DisplayPath+OldName,DisplayPath+NewName); ReNameContext(DisplayPath,OldName,NewName); //DrawDocItem1(MytreeNode1,Doc_Inf_List,NowCaseno); //201408280改 DrawDocItem2(MytreeNode1,NowCaseno); //DrawDocItem(MytreeNode1,FORM_INF_List,NowCaseno); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 if PreNode2Name <> '' then // 回到原本點選的文件節點上 begin for i := 0 to MyTreeNode1.Count - 1 do begin if GetNode2Name(MyTreeNode1.Item[i]) = PreNode2Name then begin TreeView1.Selected := MyTreeNode1.Item[i]; Break; end; end; end; TreeView1click(self); //Showmessage(_Msg('歸類完成')); //20101103 User要求拿掉 end; finally DataLoading(False,False); DocListForm.Free; end; end; procedure TCB_IMGPSScanX.PM508Click(Sender: TObject); var P : Integer; inx:Integer; begin if DisplayISB.FileName = '' then Exit; if (ContextList.Count = 1) and ((FMode = 'NSCAN') or (FMode = 'ASCAN') or (FMode = 'DSCAN') or (FMode = 'ISCAN') or (FMode = 'SSCAN') or (FMode = 'MSCAN') or (FMode = 'RI_SCAN')) then begin if Messagedlg(Format(_Msg('刪除後(%s)案件無影像,將刪除此案件,是否確定刪除?'),[NowCaseno]),mtconfirmation,[mbyes,mbcancel],0) = mrCancel then Exit; _DelTree(DisplayPath); SetCaseList('D',NewTreeNode.IndexOf(MyTreeNode1),''); LoadImgFile; end Else begin if Messagedlg(_Msg('是否確定刪除?'),mtconfirmation,[mbyes,mbcancel],0) = mrCancel then Exit; inx := ContextList.IndexOf(ExtractFileName(DisplayISB.FileName)); ContextList.Delete(inx); ContextList.SaveToFile(ImageSavePath + NowCaseno+'\Context.dat'); Context_DocnoList.Delete(inx); Context_DocnoList.SaveToFile(ImageSavePath + NowCaseno+'\Context_DocNo.dat'); DeleteFile(DisplayISB.FileName); ReSortFileName(DisplayPath); ContextList.LoadFromFile(ImageSavePath + NowCaseno+'\Context.dat'); Context_DocnoList.LoadFromFile(ImageSavePath + NowCaseno+'\Context_DocNo.dat'); if FileExists(ImageSavePath + NowCaseno+'\CustomDocNo.dat') then Cust_DocNoList.LoadFromFile(ImageSavePath + NowCaseno+'\CustomDocNo.dat'); //DrawDocItem1(MytreeNode1,Doc_Inf_List,NowCaseno); //201408280改 DrawDocItem2(MytreeNode1,NowCaseno); //DrawDocItem(MytreeNode1,FORM_INF_List,NowCaseno); P := ContextList.Count; MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,p]); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 NewTreeNodeRefresh; TreeView1Click(self); end; //Showmessage(_Msg('刪除完成')); //20101101 User要求拿掉 end; procedure TCB_IMGPSScanX.PM509Click(Sender: TObject); begin PM401Click(nil); end; procedure TCB_IMGPSScanX.PM510Click(Sender: TObject); begin DeskewImg(DisplayISB.Graphic); DisplayISB.SaveToFile(DisplayISB.FileName); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 end; procedure TCB_IMGPSScanX.PopupMenu1Popup(Sender: TObject); begin PM101.Visible := False; //刪除 PM102.Visible := False; //修改案件編號 PM103.Visible := False; //掃瞄器加入影像 PM104.Visible := False; //檔案加入影像 PM106.Visible := False; //複製文件至其他編號 PM107.Visible := False; //寫備註 PM108.Visible := False; //歸類 PM109.Visible := False; //檢核此筆 PM110.Visible := False; //新增自訂文件 PM111.Visible := False; //修改份數 if (FMode = 'SAMPLESCAN') then Exit; if TreeView1.Selected = nil then Exit; if TreeView1.Selected = NewTreeNode then //新掃瞄件 begin if (FMode = 'NSCAN') then begin //ShowMessage('AAAA'); PM101.Visible := True; //刪除 PM103.Visible := True; //掃瞄器加入影像 PM104.Visible := True; //檔案加入影像 end; if FModeName=_Msg('異動件') then begin PM101.Visible := True; end; // if FMode='ESCAN' then // begin // PM101.Visible := True; // end; end Else if TreeView1.Selected = MyTreeNode1 then //案件層 begin PM101.Visible := True; //刪除 if FImgDelete='Y' then begin PM101.Visible:=True; end; if FImgDelete='N' then begin PM101.Visible:=false; end; if FMode='ESCAN' then PM101.Visible:=false; if FModeName=_Msg('異動件') then begin PM101.Visible := True; end; if not CaseDelete_Enable(NowCaseno) then // PM101.Enabled := False else PM101.Enabled := True; PM103.Visible := True; //掃瞄器加入影像 //PM107.Visible := True; //寫備註 //PM109.Visible := True; //檢核此筆 // if FCustDocYN <> 'N' Then // PM110.Visible := True; //新增自訂文件 20170914 先不在tree 中做自訂文件 讓user在縮圖做 PM104.Visible := True; //檔案加入影像 if (FMode = 'NSCAN') then begin PM102.Visible := True; //修改案件編號 end; // if FMode='ESCAN' then // begin // PM101.Visible := True; // end; end Else if TreeView1.Selected = MyTreeNode2 then //文件層 begin PM101.Visible := True; //刪除 //PM107.Visible := True; //寫備註 //PM109.Visible := True; //檢核此筆 // if FCustDocYN <> 'N' Then // PM110.Visible := True; //新增自訂文件 if FImgDelete='Y' then begin PM101.Visible:=True; end; if FImgDelete='N' then begin PM101.Visible:=false; end; if FModeName=_Msg('異動件') then begin PM101.Visible := True; end; if GetUseCase('T',DisplayPath,NowDocDir) <> '' then //沒有被引用走的 PM101.Enabled := False //刪除 Else PM101.Enabled := True; //刪除 if ((GetDocDirCopies(NowCaseno,NowDocDir) > 1) or (not DocNoNeedDiv(NowDocNo)) or (Copy(NowDocNo,1,5)='ZZZZZ')) and (NowDocNo<> 'Attach') and (NowDocNo<> 'S_Attach') then PM111.Visible := True; //修改份數 if (FMode = 'NSCAN') then PM102.Visible := True; //修改案件編號 // if FMode='ESCAN' then // begin // PM101.Visible := True; // end; end Else if TreeView1.Selected = MyTreeNode3 then //表單層 begin PM101.Visible := True; //刪除 PM104.Visible := True; //檔案加入影像 PM108.Visible := True; //歸類 PM103.Visible := True; //掃瞄器加入影像 // if FCustDocYN <> 'N' Then // PM110.Visible := True; //新增自訂文件 if GetFormIDPage(ContextList,NowFormCode) < 1 Then begin PM108.Visible := False; //歸類 end; if FImgDelete='Y' then begin PM101.Visible:=True; end; if FImgDelete='N' then begin PM101.Visible:=false; end; if FModeName=_Msg('異動件') then begin PM101.Visible := True; end; if GetUseCase('T',DisplayPath,NowDocDir) <> '' then //被引用走的 begin PM101.Enabled := False; //刪除 PM104.Enabled := False; //檔案加入影像 PM108.Enabled := False; //歸類 end Else begin PM101.Enabled := True; //刪除 PM104.Enabled := True; //檔案加入影像 PM108.Enabled := True; //歸類 end; if (FMode = 'NSCAN') then begin PM102.Visible := True; //修改案件編號 end; end; end; procedure TCB_IMGPSScanX.PopupMenu4Popup(Sender: TObject); begin PM401.Visible := False; PM402.Visible := False; PM403.Visible := False; PM404.Visible := False; if FMode = 'SAMPLESCAN' then Exit; if (TreeView1.Selected.Level =2) or (TreeView1.Selected.Level =3) then begin PM402.Visible := True; PM403.Visible := True; PM404.Visible := True; end; PM401.Visible := True; if (TreeView1.Selected <> MyTreeNode2) or (FMode = 'RSCAN') then PM401.Visible := False; end; procedure TCB_IMGPSScanX.PopupMenu5Popup(Sender: TObject); begin PM501.Visible := False; PM502.Visible := False; PM503.Visible := False; PM504.Visible := False; PM505.Visible := False; PM506.Visible := False; PM507.Visible := False; PM508.Visible := False; PM509.Visible := False; PM510.Visible := False; if FMode = 'SAMPLESCAN' then Exit; if (DisplayISB.FileName <> '') then begin PM501.Visible := True; PM502.Visible := True; PM503.Visible := True; PM504.Visible := True; //PM505.Visible := True; //PM506.Visible := True; //PM507.Visible := True; //PM508.Visible := True; //PM509.Visible := True; //PM510.Visible := True; end; if (TreeView1.Selected <> MyTreeNode2) or (FMode = 'RSCAN') or (FMode = 'ESCAN') then PM509.Visible := False; end; procedure TCB_IMGPSScanX.PopupMenu6Popup(Sender: TObject); begin PM601.Visible := True; //歸類 PM602.Visible := True; //自行定義文件名稱 PM603.Visible := False; //掃描替換此頁 PM604.Visible := False; //歪斜矯正 PM605.Visible := True; //刪除 // if FMode='ESCAN' then // begin // PM601.Visible := False; //歸類 // PM602.Visible := False; //自行定義文件名稱 // PM603.Visible := False; //掃描替換此頁 // PM604.Visible := False; //歪斜矯正 // PM605.Visible := False; //刪除 // end; if ((NowDocNo = 'Attach') or (NowDocNo = 'S_Attach')) and (FCustDocYN <> 'N') then begin PM602.Visible := True; //自行定義文件名稱 //PM603.Visible := True; //掃描替換此頁 PM604.Visible := True; //歪斜矯正 PM601.Visible := True; //歸類 PM605.Visible := True; //刪除 end; if FModeName<>_Msg('異動件') then begin if (FImgDelete='Y') then begin PM605.Enabled:=True; end; if FImgDelete='N' then begin PM605.Enabled:=false; end; end; if CheckSelectImg_UseCase(DisplayPath,NowCaseNo) then //選擇的影像不可有引用的 begin PM601.Enabled := False; //歸類 PM605.Enabled := False; //刪除 end; end; procedure TCB_IMGPSScanX.PrePageBtnClick(Sender: TObject); var page : Integer; begin {page := ScrollBar1.Position; Case Vmode of 0 : dec(page); 1 : Page := Page - 2; 2 : Page := Page - 4; 3 : Page := Page - 6; 4 : Page := Page - 8; end; IF page >= ScrollBar1.min Then begin ScrollBar1.Position := page; end Else ScrollBar1.Position := 1; } if selectISB = nil then Exit; PriorPage(SelectPage); if (SelectISB.Parent.Top-4) < 0 then scrollBox1.VertScrollBar.Position := scrollBox1.VertScrollBar.Position + SelectISB.Parent.Top-4; //ISBClick(TImageScrollBox(FindComponent(ISBName+'1'))); end; procedure TCB_IMGPSScanX.SampleScanBtnClick(Sender: TObject); var SampleFormID : String; SendData : String; buttonSelected : Integer; begin ScanMode := smSample; ClearView(1); Vmode := 0; //切成單頁 GoViewMode; ScanInfo.ImageCount := 0; ScanPath := SamplePath; ScanCaseno := ''; ContextList.Clear; ShowText := _Msg('範本掃描中,請稍候'); DataLoading(True,True); SampleFormID := UpperCase(InputBox(_Msg('範本檔掃瞄輸入畫面'),_Msg('請輸入文件編號'),'')); if SampleFormIDList.IndexOf(SampleFormID)<>-1 then begin // Show a custom dialog buttonSelected := messagedlg(SampleFormID+_Msg('已有範本,是否取代?'),mtCustom, [mbYes,mbCancel], 0); if buttonSelected = mrCancel then begin DataLoading(false,false); Exit; end; end; if SampleFormID <> '' then begin if FormIDExists(SampleFormID,False,0) then begin ScanSaveFilename := SampleFormID + '.tif'; end Else begin Showmessage(Format(_Msg('FormID:%s尚未註冊'),[SampleFormID])); Panel1.Enabled := True; Panel2.Enabled := True; DataLoading(false,false); Exit; end; SampleAnchorMode := FormID2Anchor(SampleFormID); Panel1.Enabled := False; Panel2.Enabled := False; //ShowMessage('AAAAA'); Try StatrTwainScan; Except Panel1.Enabled := True; Panel2.Enabled := True; end; if (ISB1.FileName <> '') and FileExists(SamplePath+SampleFormID+'.tif') then begin ShowText := _Msg('範本傳送中,請稍候'); DataLoading(True,True); //多存一份jpg ImageScrollBox1.LoadFromFile(SamplePath+SampleFormID+'.tif',1); BWTif2Jpg(ImageScrollBox1.Graphic); ImageScrollBox1.SaveToFile(SamplePath+SampleFormID+'.jpg'); //多存一份jpg NowWork_No := FormCode2WorkNo(SampleFormID); SendData := 'data='+FData+'&verify='+FVerify+'&work_no='+FWork_no+'&file_name='+SampleFormID+'.tif'; if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/sample',SendData,'file',SamplePath+SampleFormID+'.tif',FReWrite,Memo1,False) then begin Showmessage(_Msg('傳送範本檔案時,網路發生錯誤!!')+_MSg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+')'); DataLoading(False,False); Exit; end; if memo1.Lines.Strings[0] = '1' then begin Showmessage(_Msg('傳送範本檔案時,網路發生錯誤!!')+_Msg('錯誤原因:')+memo1.Lines.Strings[1]); DataLoading(False,False); Exit; end Else if Pos('',Memo1.Lines.Text) > 0 then begin Showmessage(_Msg('傳送範本檔案時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入')); DataLoading(False,False); Exit; end; if FileExists(SamplePath+SampleFormID+'.jpg') then //傳送JPG影像 begin SendData := 'data='+FData+'&verify='+FVerify+'&work_no='+FWork_no+'&file_name='+SampleFormID+'.jpg'; if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/sample',SendData,'file',SamplePath+SampleFormID+'.jpg',FReWrite,Memo1,False) then begin Showmessage(_Msg('傳送範本檔案(JPG)時,網路發生錯誤!!')+_MSg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+')'); DataLoading(False,False); Exit; end; if memo1.Lines.Strings[0] = '1' then begin Showmessage(_Msg('傳送範本檔案(JPG)時,網路發生錯誤!!')+_Msg('錯誤原因:')+memo1.Lines.Strings[1]); DataLoading(False,False); Exit; end Else if Pos('',Memo1.Lines.Text) > 0 then begin Showmessage(_Msg('傳送範本檔案(JPG)時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入')); DataLoading(False,False); Exit; end; end; Showmessage(_Msg('傳送完成')); end; end; DataLoading(False,False); end; procedure TCB_IMGPSScanX.ScrollBar1Change(Sender: TObject); begin Exit; If (TreeView1.Selected = MyTreenode1) or (TreeView1.Selected.ImageIndex = 6) Then begin view_image_FormCode(DisplayPath,'ShowAll',ScrollBar1.Position,1); end Else IF (TreeView1.Selected = MyTreenode2) then begin view_image_FormCode(DisplayPath,NowDocNo,ScrollBar1.Position,1); end Else if (TreeView1.Selected = MyTreenode3) then begin view_image_FormCode(DisplayPath,NowFormCode,ScrollBar1.Position,1); end; end; procedure TCB_IMGPSScanX.ScrollBox1MouseEnter(Sender: TObject); begin ScrollBox1.SetFocus; end; procedure TCB_IMGPSScanX.SelectScanBtnClick(Sender: TObject); begin Panel1.Enabled := False; Panel2.Enabled := False; scanner.SelectScanner; Panel1.Enabled := True; Panel2.Enabled := True; end; procedure TCB_IMGPSScanX.StatusBar1DblClick(Sender: TObject); begin Button3.Visible := not Button3.Visible; Button4.Visible := not Button4.Visible; if (GetKeyState(VK_CONTROL) < 0) Then begin ExportBt.Visible := not ExportBt.Visible; ImportBt.Visible := not ImportBt.Visible; end Else begin Memo1.Visible := not Memo1.Visible; Display1.Visible := not Display1.Visible; end; end; procedure TCB_IMGPSScanX.ActiveFormCreate(Sender: TObject); var IScrollBox : TImageScrollBox; i :integer; begin {HotKeyId1 := GlobalAddAtom('MyHotKey1')-$C000; HotKeyId2 := GlobalAddAtom('MyHotKey2')-$C000; HotKeyId3 := GlobalAddAtom('MyHotKey3')-$C000; HotKeyId4 := GlobalAddAtom('MyHotKey4')-$C000; RegisterHotKey(handle,HotKeyId1,0,VK_UP); //printscreen RegisterHotKey(handle,HotKeyId1,0,VK_Down); //printscreen } PostMessage(Handle,WM_ACTIVATE,WA_CLICKACTIVE,0); vmode := 1; DesableImage; For i:= 1 to 8 do begin IScrollBox := TImageScrollBox( FindComponent('ISB'+IntToStr(i))); IScrollBox.MouseMode := mmUser; iScrollBox.ZoomMode := zmFullPage; end; Sleep(500); Timer1.Enabled := True; end; procedure TCB_IMGPSScanX.ActiveFormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Edit1.Focused then begin if selectISB = nil then Exit; if (Key =VK_UP) then begin PriorPage(SelectPage); if (SelectISB.Parent.Top-4) < 0 then scrollBox1.VertScrollBar.Position := scrollBox1.VertScrollBar.Position + SelectISB.Parent.Top-4; //ISBClick(TImageScrollBox(FindComponent(ISBName+'1'))); end; if (Key =VK_Down) then begin NextPage(SelectPage); if SelectISB.Parent.Top+SelectISB.Parent.Height+4 > scrollBox1.Height then ScrollBox1.VertScrollBar.Position := scrollBox1.VertScrollBar.Position + (SelectISB.Parent.Top+SelectISB.Parent.Height-ScrollBox1.Height+8); //scrollBox1.VertScrollBar.ScrollPos := SelectISB.Parent.Top+SelectISB.Parent.Height; //ISBClick(TImageScrollBox(FindComponent(ISBName+'2'))); end; end; end; procedure TCB_IMGPSScanX.AddAttFileLBClick(Sender: TObject); var i : Integer; Addfile : String; begin OpenDialog1.Filter := 'PDF files|*.pdf'; OpenDialog1.Options := [ofAllowMultiSelect]; if OpenDialog1.Execute then begin ShowText :=_Msg('檔案加入中,請稍候'); DataLoading(True,True); for i := 0 to OpenDialog1.Files.Count - 1 do begin AddFile := HTTPEncode(UTF8Encode(ExtractFileName(OpenDialog1.Files.Strings[i]))); if FileExists(ImageSavePath+NowCaseno+'\'+AddFile) then begin if Messagedlg(Format(_Msg('%s己存在,是否覆蓋??'),[Addfile]),mtconfirmation,[mbyes,mbcancel],0) = mrcancel Then Continue; SetAttContextList('D',-1,NowCaseno,AddFile); end; // AttFileGB.Visible := True; //附加電子檔窗 //20120207楊玉說不在這加電子檔先拿掉 // Splitter2.Visible := True; CopyFile(Pchar(OpenDialog1.Files.Strings[i]),Pchar(ImageSavePath+NowCaseno+'\'+AddFile),False); SetAttContextList('A',-1,NowCaseno,AddFile); LoadAttFile(NowCaseno); end; end; DataLoading(False,False); end; procedure TCB_IMGPSScanX.AddCredit1RGClick(Sender: TObject); begin if DisplayPath <> '' then begin Case AddCredit1RG.ItemIndex of -1:Case_loandoc := ''; 0:Case_loandoc := 'Y'; 1:Case_loandoc := 'N'; end; WriteCaseIndex(DisplayPath); end; end; procedure TCB_IMGPSScanX.AddScanBtnClick(Sender: TObject); var P,v : Integer; begin IF not InitialOk Then begin Showmessage(_Msg('資訊尚未下載完成,請稍候或重新進入')); Exit; end; if MyTreeNode1 = nil then begin Showmessage(_Msg('請先選擇案件')); Exit; end; Panel1.Enabled := False; Panel2.Enabled := False; ScanMode := smInsert; ScanInfo.ImageCount := ContextList.Count; ScanPath := DisplayPath; ScanCaseno := NowCaseno; ScanDocDir := NowDocDir; Try StatrTwainScan; Except Panel1.Enabled := True; Panel2.Enabled := True; end; Panel1.Enabled := True; Panel2.Enabled := True; DrawDocItem2(MytreeNode1,NowCaseno); //DrawDocItem(MytreeNode1,FORM_INF_List,NowCaseno); //P := ContextList.Count; GetCase_PageCount(CaseCount,PageCount); v := Pos('-',NewTreeNode.Text); NewTreeNode.Text := Format(_Msg('%s-共%d筆共%d頁'),[Copy(NewTreeNode.Text,1,v-1),CaseCount,PageCount]); MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseno)]); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 SetDocDirtoSelected(MyTreeNode1,FirstDocDir); TreeView1Click(self); end; procedure TCB_IMGPSScanX.AttListBoxClick(Sender: TObject); begin DelAttFileLB.Enabled := False; if AttListBox.ItemIndex >= 0 then DelAttFileLB.Enabled := True; end; procedure TCB_IMGPSScanX.AttListBoxDblClick(Sender: TObject); var AttFile : String; begin if AttListBox.ItemIndex < 0 then Exit; AttFile := HTTPEncode(UTF8Encode(AttListBox.Items.Strings[AttListBox.ItemIndex])); if FileExists(DisplayPath+AttFile) then ShellExecute(Application.Handle,'open',PChar(DisplayPath+AttFile),nil,nil,SW_SHOW) else Showmessage(Format(_Msg('找不到檔案:%s'),[AttFile])); end; procedure TCB_IMGPSScanX.BtnMouseEnter(Sender: TObject); begin AddToolTip(TBitBtn(Sender).Handle,nil,0,Pchar(TBitBtn(Sender).Hint),nil,0,0); end; procedure TCB_IMGPSScanX.Button3Click(Sender: TObject); begin //Showmessage(CreateDocNo_Info(NowCaseNo)+#13+'******'+#13+CreateCustDocNo_Info(NowCaseNo)); //Showmessage(NowSelectFileList.Text); //SetIn_WH_DocNo; //CreateIn_WH(self.NowCaseno); //Create_Cust_DocDir(NowCaseNo); //Showmessage(self.GetDocNoDir(self.DisplayPath,'111')); //Case2upload(NowCaseNo); //mkdir(DisplayPath+'Test\'); //Download2Case(DisplayPath+'Upload\',DisplayPath+'Test\'); //CreateFormID_FormName(DisplayPath); //產生FormID_FormName.dat //CreateDocNo_DocName(DisplayPath); //產生DocNo_Name.dat //Showmessage(CreateDocNo_Info(DisplayPath)); //產生 Docno,份數,頁數;Docno,份數,頁數 的回傳字串 //lb1.Caption:='AAAAAAAAAAA'; //Showmessage(CreateDocnoFrom_Info(NowCaseno)); //Showmessage(self.CreateCustDocNoFrom_Info(NowCaseno)); //ShowMessage('FMaxUploadSize='+FMaxUploadSize); //initkscan; showmessage('FUrl='+FUrl+#10#13+ 'FCaseID='+FCaseID+#10#13+ 'FMode='+FMode+#10#13+ 'FModeName='+FModeName+#10#13+ 'FWork_no='+FWork_no+#10#13+ 'FUserID='+FUserID+#10#13+ 'FUserName='+FUserName+#10#13+ 'FUserUnit='+FUserUnit+#10#13+ 'FData='+FData+#10#13+ 'FVerify='+FVerify+#10#13+ 'FReWrite='+FReWrite+#10#13+ 'FLanguage='+FLanguage+#10#13+ 'FLoanDoc_Value='+FLoanDoc_Value+#10#13+ 'FLoanDoc_Enable='+FLoanDoc_Enable+#10#13+ 'FUseProxy='+FUseProxy+#10#13+ 'FC_DocNoList='+FC_DocNoList+#10#13+ 'FC_DocNameList='+FC_DocNameList+#10#13+ 'FFixFileList='+FFixFileList+#10#13+ 'FIs_In_Wh='+FIs_In_Wh+#10#13+ 'FOldCaseInfo='+FOldCaseInfo+#10#13+ 'FPrintyn='+FPrintyn+#10#13+ 'FIs_OldCase='+FIs_OldCase+#10#13+ 'FCustDocYN='+FCustDocYN); ShowMessage('FImgDPI='+IntToStr(FImgDPI)+#10#13+ 'FScanColor='+ IntToStr(FScanColor)+#10#13+ 'FFileSizeLimit='+ IntToStr(FFileSizeLimit) +#10#13+ 'FCaseNoLength='+ IntToStr(FCaseNoLength) +#10#13+ 'FImgDelete='+ FImgDelete+#10#13+ 'FIsExternal='+ FIsExternal+#10#13+ 'FWH_category='+FWH_category+ 'FCheck_main_form='+ FCheck_main_form+#10#13+ 'FMaxUploadSize='+FMaxUploadSize); //FImgDelete:='Y'; LoadImgFile; { ShowMessage('UpLPoint='+IntToStr(UpLPoint.X)+','+IntToStr(UpLPoint.Y)+#10#13+ 'UpRPoint='+IntToStr(UpRPoint.X)+','+IntToStr(UpRPoint.Y)+#10#13+ 'DownLPoint='+IntToStr(DownLPoint.X)+','+IntToStr(DownLPoint.Y)+#10#13+ 'DownRPoint='+IntToStr(DownRPoint.X)+','+IntToStr(DownRPoint.Y)); } end; procedure TCB_IMGPSScanX.Button4Click(Sender: TObject); var i:integer; str:String; begin //Showmessage(self.Doc_Inf_List.Text); //LoadImgFile; //LoadImgFile1; //ISB1.MouseMode:=mmAmplifier; str:=''; for I := 1 to 11 do // 看 OMRErrInfo 的內容 begin str:=str+BoolToStr(OMRErrInfo[i].Display,true)+',' +BoolToStr(OMRErrInfo[i].Ignore,true)+','+OMRErrInfo[i].Info+',' +OMRErrInfo[i].Mode+#10#13; end; ShowMessage('OMRErrInfo='+str); ShowMessage('Doc_Inf_List='+Doc_Inf_List.Text); ShowMessage('DM_FORM_INF_List='+DM_FORM_INF_List.Text) ; ShowMessage('FORM_INF_List='+FORM_INF_List.Text) ; ShowMessage('CHECK_RULE_INF_List='+CHECK_RULE_INF_List.Text) ; ShowMessage('MEMO_INF_List='+MEMO_INF_List.Text) ; ShowMessage('WORK_INF_List='+WORK_INF_List.Text) ; ShowMessage('LASTEST_FORM_INF_List='+LASTEST_FORM_INF_List.Text) ; ShowMessage('SampleFormIDList='+SampleFormIDList.Text); ShowMessage('ExistImgList='+ExistImgList.Text); ShowMessage('LastInitFormidList='+LastInitFormidList.Text); ShowMessage('IN_WH_DocNoList='+IN_WH_DocNoList.Text); // SampleFormIDList.Add('31A00101011706A'); // SampleFormIDList.Add('31A00101021706A'); // SampleFormIDList.Add('31A00101031706A'); end; procedure TCB_IMGPSScanX.Button5Click(Sender: TObject); begin GetftpInfo(NowCaseno,'upload'); SetFtpInfo; IIS_Ftp.FtpsConnect; IIS_Ftp.FtpsToMain(FFtpExtraPath,NowCaseno+'.pdf','d:\1.pdf',display1); end; procedure TCB_IMGPSScanX.Button6Click(Sender: TObject); begin GetftpInfo(NowCaseno,'download'); SetFtpInfo; IIS_Ftp.FtpsConnect; IIS_Ftp.FtpsCWD(IIS_Ftp.FtpPath); IIS_Ftp.FtpsReceive(NowCaseNo+'.zip','d:\'+NowCaseNo+'.zip'); end; procedure TCB_IMGPSScanX.ExportBtClick(Sender: TObject); var SendData : String; EnCodeDateTime : String; S : TStringlist; SFileName,VFileName : String; begin SFileName := En_DecryptionStr_Base64('E','MPSLIC_SCAN.lic','9338430'); VFileName := En_DecryptionStr_Base64('E','MPSLIC_VIEW.lic','9338430'); IIS_File2Web.S_LicEnName := SFileName; IIS_File2Web.V_LicEnName := VFileName; /////下載MPSLIC_SCAN.lic ////// EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); //SendData := 'checktime='+EnCodeDateTime+'&workno=CW&formid=MPSLIC_SCAN.lic'+'&mode=sample'; //if not dnFile(HTTPSClient,Furl,'servlet/CWC03',SendData,LngPath+SFileName,FReWrite,Memo1,False,DownImgStatus) then SendData:='data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&work_no=PLN&file=MPSLIC_SCAN.lic'; if not dnFile_Get(HTTPSClient,Furl,'service/imgpsc/IMGPSC04/sample',SendData,LngPath+SFileName,FReWrite,Memo1,False,DownImgStatus) then begin Showmessage(_Msg('檢查註冊檔案時,網路發生錯誤!!')+_Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason); Exit; end; /////下載MPSLIC_SCAN.lic ///// /////下載MPSLIC_VIEW.lic ////// EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); //SendData := 'checktime='+EnCodeDateTime+'&workno=CW&formid=MPSLIC_VIEW.lic'+'&mode=sample'; //這裡改成必傳CW 20121212 //if not dnFile(HTTPSClient,Furl,'service/slic/SLIC04/sample',SendData,LngPath+VFileName,FReWrite,Memo1,False,DownImgStatus) then SendData:='data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&work_no=PLN&file=MPSLIC_VIEW.lic'; if not dnFile_Get(HTTPSClient,Furl,'service/imgpsc/IMGPSC04/sample',SendData,LngPath+VFileName,FReWrite,Memo1,False,DownImgStatus) then begin Showmessage(_Msg('檢查註冊檔案時,網路發生錯誤!!')+_Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason); Exit; end; /////下載MPSLIC_VIEW.lic ///// ////壓zip///// S := TStringlist.Create; try S.Add(En_DecryptionStr_Base64('E',GetDate,'9338430')); S.Add(SFileName); S.Add(VFileName); S.SaveToFile(LngPath+'mps.dat'); S.Clear; S.Add(LngPath+'mps.dat'); S.Add(LngPath+SFileName); S.Add(LngPath+VFileName); if FileExists(LngPath+'mps.zip') then DeleteFile(LngPath+'mps.zip'); ExecuteZip_Pwd(LngPath+'mps.zip',LngPath,S,False,False,'9338430'); finally S.Free; DeleteFile(LngPath+SFileName); DeleteFile(LngPath+VFileName); DeleteFile(LngPath+'mps.dat'); end; ////壓zip////// Showmessage(_Msg('匯出完成,匯出檔案:')+LngPath+'mps.zip'); end; procedure TCB_IMGPSScanX.ImportBtClick(Sender: TObject); var SendData : String; EnCodeDateTime : String; S : TStringlist; SFileName,VFileName : String; OpenDialog1 : TOpenDialog; ZipPath : String; ZipFile,ZipName : String; LicName : String; i : Integer; begin OpenDialog1 := TOpenDialog.Create(self); S := TStringlist.Create; try OpenDialog1.Filter := 'Zip files (*.zip)|*.ZIP'; if OpenDialog1.Execute then begin ZipFile:= ExtractFileName(OpenDialog1.FileName); ZipName := Copy(ZipFile,1,length(ZipFile)-length(ExtractFileExt(OpenDialog1.FileName))); ZipPath := LngPath+ZipName+'\'; str2dir(ZipPath); if not ExecuteUnZip_Pwd(OpenDialog1.FileName,ZipPath,False,'9338430') then Showmessage(_Msg('無法解壓縮')); if not FileExists(ZipPath+'mps.dat') then begin Showmessage(_Msg('格式不符,無法匯入')); Exit; end; S.LoadFromFile(ZipPath+'mps.dat'); if (En_DecryptionStr_Base64('D',S.Strings[0],'9338430')<> ServerDate) then begin Showmessage(_Msg('檔案過期,無法匯入')); Exit; end; for i := 1 to S.Count -1 do begin LicName := En_DecryptionStr_Base64('D',S.Strings[i],'9338430'); RenameFile(ZipPath+S.Strings[i],ZipPath+LicName); if (LicName = 'MPSLIC_SCAN.lic') or (LicName = 'MPSLIC_VIEW.lic') then /////上傳MPSLICXXXX.lic //// //if not upFile(HTTPSClient,FUrl,'servlet/CWC04','formid='+LicName+'@workno=CW@mode=sample','file',ZipPath+LicName,FReWrite,Memo1,False) then //begin SendData := 'data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&work_no=PLN&file_name='+LicName; if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/sample',SendData,'file',ZipPath+LicName,FReWrite,Memo1,False) then begin Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_MSg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+')'); DataLoading(False,False); Exit; end; if memo1.Lines.Strings[0] = '1' then begin Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_Msg('錯誤原因:')+memo1.Lines.Strings[1]); DataLoading(False,False); Exit; end Else if Pos('',Memo1.Lines.Text) > 0 then begin Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入')); DataLoading(False,False); Exit; end; /////上傳MPSLICXXXX.lic ///// end; end; Finally OpenDialog1.Free; S.Free; _DelTree(ZipPath); end; Showmessage(_Msg('匯入完成')); end; procedure TCB_IMGPSScanX.HotKeyDown (var Msg : TMessage); begin end; Function TCB_IMGPSScanX.FindISB2View(Vmode:Integer):TImageScrollBox; //找空的ISB來顯示 var i,n : Integer; ISB : TImageScrollBox; begin case Vmode of 0 : n := 1; 1 : n := 2; 2 : n := 4; 3 : n := 6; 4 : n := 8; end; for i := 1 to 8 do begin if i > n then Break; ISB := TImageScrollBox(FindComponent('ISB'+inttostr(i))); if (i = n) and (ISB.FileName <> '') then begin clearView(i); Result := ISB1; end Else if ISB.FileName = '' then Result := ISB; end; end; Procedure TCB_IMGPSScanX.ViewMouseMode(v:Integer); var i : Integer; Md : TMouseMode; ISB : TImageScrollBox; begin //ShowMessage(IntToStr(v)); case v of -1 : Md := TMouseMode(mmUser); 0 : Md := TMouseMode(mmAmplifier); 1 : Md := TMouseMode(mmZoom); 2 : Md := TMouseMode(mmDrag); 3 : Md := TMouseMode(mmR270); 4 : Md := TMouseMode(mmR180); 5 : Md := TMouseMode(mmR90); 6 : Md := TMouseMode(mmDelete); end; for i := 1 to 8 do begin ISB := TImageScrollBox(FindComponent('ISB'+inttostr(i))); ISB.MouseMode := TMouseMode(Md); //Label3.Caption:='v='+IntToStr(v)+' time'+FormatDateTime('yyyy/mm/dd HH:MM:SS', now); end; end; Procedure TCB_IMGPSScanX.GoViewMode; begin case VMode of 0: DisplayMode(VMode,1,1,Panel9); 1: DisplayMode(VMode,1,1,Panel9); 2: DisplayMode(VMode,2,2,Panel9); 3: DisplayMode(VMode,2,3,Panel9); 4: DisplayMode(VMode,2,4,Panel9); end; end; Procedure TCB_IMGPSScanX.SetFormID_DocNo; //將FormID及Docno抽出來另存入list裡 20130403增加 var i : Integer; begin for i := 1 to FORM_INF_List.Count-1 do begin FormID_List.Add(GetSQLData(FORM_INF_List,'T1.FORM_ID',i)); DocNo_List.Add(GetSQLData(FORM_INF_List,'T1.DOC_NO',i)); end; end; Procedure TCB_IMGPSScanX.DeleteFormCodeFile(CaseID,DocDir,FormID:String); //刪除指定FormID文件 var i: Integer; FileList : TStringlist; begin FileList := TStringlist.Create; try FileList.Clear; if FileExists(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat') then FileList.LoadFromFile(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat'); for i := FileList.Count - 1 downto 0 do begin if FileName2FormCode(FileList.Strings[i]) = FormID then begin if (FMode = 'ESCAN') and (FModeName<>_Msg('異動件')) then begin if ISExistImg(ImageSavePath+CaseID+'\'+DocDir+'\'+FileList.Strings[i]) then begin //ShowMessage('有圖為非當次掃瞄,不可刪除'); Break; end; end; //ShowMessage(FileList.Strings[i]); DeleteImageFile(ImageSavePath+CaseID+'\'+DocDir+'\',FileList.Strings[i],CaseID); end; end; finally FileList.Free; end; ReSortFileName(ImageSavePath+CaseID+'\'+DocDir+'\'); {for i := ContextList.Count - 1 downto 0 do begin FName := ContextList.Strings[i]; if FormID = 'Err' then //刪未註冊文件 begin If not FormIDExists(FileName2FormCode(FName),False,0) Then begin DeleteFile(Path+FName); ContextList.Delete(i); end; end Else begin If FormID = FileName2FormCode(FName) then begin DeleteFile(Path+FName); ContextList.Delete(i); end; end; end; ContextList.SaveToFile(Path+'Context.dat'); ReSortFileName(Path); } end; Function TCB_IMGPSScanX.FindFormCodePages(CaseID,FormCode:String):Integer; //計算案件裡FormID的頁數 var i,Count : integer; S : TStringlist; iFormCode : String; begin Count := 0; S := TStringlist.Create; try S.LoadFromFile(ImageSavePath+CaseID+'\upload\Context.dat'); for i := 0 to S.Count - 1 do begin if FWH_category='N' then begin if ISExistImg(ImageSavePath+CaseID+'\upload\'+S.Strings[i]) then begin Continue; end; end; iFormCode := FileName2FormCode(S.Strings[i]); if FormCode = iFormCode then begin Inc(Count); end; end; finally S.Free; end; Result := Count; end; Function TCB_IMGPSScanX.GetDataFormCodePages(FormCode:String):Integer; //取記錄的FormcID的頁數 begin If FindSQLData(FORM_INF_List,'T1.MAX_PAGE','T1.FORM_ID',FormCode,0,FindResult) Then begin IF GetFindResult('T1.MAX_PAGE') = '' Then Result := 9999 Else Result := Strtoint(GetFindResult('T1.MAX_PAGE')); end; end; Procedure TCB_IMGPSScanX.CaseReSize(CaseID:String); //案件的影像縮放 var S : TStringlist; FileName : String; i : Integer; begin {if FileExists(ImageSavePath+CaseID+'\ReSize.dat') then DeleteFile(ImageSavePath+CaseID+'\ReSize.dat');} if FileExists(ImageSavePath+CaseID+'\Upload\AnchorError.dat') then DeleteFile(ImageSavePath+CaseID+'\Upload\AnchorError.dat'); S := TStringlist.Create; try S.LoadFromFile(ImageSavePath+CaseID+'\Upload\Context.dat'); For i := 0 to S.Count -1 do begin FileName := S.Strings[i]; ImageReSize_FormID(CaseID,FileName); //依十字定位點做縮放 end; finally S.Free; end; end; Procedure TCB_IMGPSScanX.ImageReSize_FormID(CaseID,FileName:String); //依十字定位點做縮放 var FormID : String; DH,DW : String; NowW,NowH : Integer; ANCHOR : String; //是否有十字線 SizeStr : String; S : TStringlist; v,v1:Integer; IsRecordMD5:Boolean; begin IsRecordMD5:=False; FormID := FileName2FormCode(FileName); if FormID = '' then Exit; IF FindSQLData(FORM_INF_List,'T1.FORM_HEIGHT,T1.FORM_WIDTH,T1.ANCHOR','T1.FORM_ID',FormID,0,FindResult) then begin DH := GetFindResult('T1.FORM_HEIGHT'); DW := GetFindResult('T1.FORM_WIDTH'); ANCHOR := UpperCase(GetFindResult('T1.ANCHOR')); ANCHOR := Index2Anchor(ANCHOR); Display1.Lines.Add(FormID+','+DH+','+DW); //ShowMessage('AAAAAAAAA'); if ((ANCHOR = 'ANCHOR') or (ANCHOR = 'FRAME')) and (DH <> '') and (DW <> '') then //有十字定位點 begin //ShowMessage('BBBBBBB'); ImageScrollBox1.LoadFromFile(ImageSavePath+CaseID+'\Upload\'+FileName,1); if (FWH_category='N') and ISExistImg(ImageSavePath+CaseID+'\Upload\'+FileName) then begin Exit;//20171103 補件 原有的圖不作resize end; //FindPoint(ImageScrollBox1.Graphic,UpLPoint,UpRPoint,DownLPoint,NowW,NowH); FindPoint(ISB_BW.Graphic,UpLPoint,UpRPoint,DownLPoint,NowW,NowH,ANCHOR); SizeStr := CheckSize(ISB_BW,UpLPoint,UpRPoint,DownLPoint,DW,DH); ImageResize(ImageScrollBox1.Graphic,ISB_BW.Graphic.Width,ISB_BW.Graphic.Height); FindPoint(ISB_BW.Graphic,UpLPoint,UpRPoint,DownLPoint,NowW,NowH,ANCHOR); v := 5; v1 := length(SizeStr); IF (SizeStr <> '') and (Copy(SizeStr,1,v) <> 'ERROR') then begin //ShowMessage('CCCCC'); if (ISExistImg(ImageSavePath+CaseID+'\Upload\'+FileName)) and (reSizeExistImgList.IndexOf(LoadFileGetMD5(ImageSavePath+CaseID+'\Upload\'+FileName))=-1) then begin IsRecordMD5:=True; end; ImageScrollBox1.SaveToFile(ImageSavePath+CaseID+'\Upload\'+FileName); if IsRecordMD5 then begin reSizeExistImgList.add(LoadFileGetMD5(ImageSavePath+CaseID+'\Upload\'+FileName)); end; //showmessage(ImageSavePath+CaseID+'\Upload\'+FileName); S := TStringlist.Create; ///20110422拿掉 換成上傳才做 if FileExists(ImageSavePath+CaseID+'\Upload\ReSize.dat') then S.LoadFromFile(ImageSavePath+CaseID+'\Upload\ReSize.dat'); //S.Add(FormCode2FormName(FormID)+' '+SizeStr); S.Add(FileName+','+SizeStr+#8+DateTimetoStr(Now)); S.SaveToFile(ImageSavePath+CaseID+'\Upload\ReSize.dat'); S.Free; end; if (Copy(SizeStr,1,v) = 'ERROR') then //未找到三個定位點 begin S := TStringlist.Create; if FileExists(ImageSavePath+CaseID+'\Upload\AnchorError.dat') then S.LoadFromFile(ImageSavePath+CaseID+'\Upload\AnchorError.dat'); S.Add(FileName+'-->'+Copy(SizeStr,V+1,V1-v)); S.SaveToFile(ImageSavePath+CaseID+'\Upload\AnchorError.dat'); S.Free; end; ImageScrollBox1.FileName := ''; end; end; end; Procedure TCB_IMGPSScanX.ImageReSize_tmp(FormID,FileName:String); //依十字定位點做縮放(暫存檔) var DH,DW : String; ANCHOR : String; //是否有十字線 SizeStr : String; S : TStringlist; begin IF FindSQLData(FORM_INF_List,'T1.FORM_HEIGHT,T1.FORM_WIDTH,T1.ANCHOR','T1.FORM_ID',FormID,0,FindResult) then begin DH := GetFindResult('T1.FORM_HEIGHT'); DW := GetFindResult('T1.FORM_WIDTH'); ANCHOR := UpperCase(GetFindResult('T1.ANCHOR')); ANCHOR := Index2Anchor(ANCHOR); if ((ANCHOR = 'ANCHOR') or (ANCHOR = 'FRAME')) and (DH <> '') and (DW <> '') then //有十字定位點 begin ImageScrollBox1.LoadFromFile(FileName,1); SizeStr := CheckSize(ImageScrollBox1,UpLPoint,UpRPoint,DownLPoint,DW,DH); IF SizeStr <> '' then begin ImageScrollBox1.SaveToFile(FileName); end; ImageScrollBox1.FileName := ''; end; end; end; procedure TCB_IMGPSScanX.ImageScrollBox1NewGraphic(const Graphic: TDibGraphic); begin IF ImageScrollBox1.Graphic.Empty Then Exit; ISB_BW.Graphic.Assign(ImageScrollBox1.Graphic); If ImageScrollBox1.Graphic.ImageFormat <> ifBlackWhite Then begin ConvertToBW(ISB_BW.Graphic); end; end; Procedure TCB_IMGPSScanX.NewTreeNodeRefresh; var v : Integer; begin //v := Pos('-',NewTreeNode.Text); //NewTreeNode.Text := Copy(NewTreeNode.Text,1,v-1)+'-共'+inttostr(NewTreeNode.Count)+'筆'; GetCase_PageCount(CaseCount,PageCount); v := Pos('-',NewTreeNode.Text); NewTreeNode.Text := Format(_Msg('%s-共%d筆共%d頁'),[Copy(NewTreeNode.Text,1,v-1),CaseCount,PageCount]); end; Procedure TCB_IMGPSScanX.MyTreeNode1Refresh; var v : Integer; begin v := Pos('-',MyTreeNode1.Text); MyTreeNode1.Text := Format(_Msg('%s-%d筆'),[Copy(MyTreeNode1.Text,1,v-1),MyTreeNode1.Count]); end; Procedure TCB_IMGPSScanX.MyTreeNode2ReFresh(CaseID:String); var P : Integer; begin //p:= ContextList.Count; //MytreeNode1.Text := Format(_Msg('%s-%d頁'),[CaseID,p]); DrawDocItem2(MytreeNode1,CaseID); //DrawDocItem(MytreeNode1,FORM_INF_List,CaseID); end; Procedure TCB_IMGPSScanX.MyTreeNode3ReFresh(CaseID:String); begin //DrawDocItem1(MytreeNode1,Doc_Inf_List,CaseID); //201408280改 DrawDocItem2(MytreeNode1,CaseID); //DrawDocItem(MytreeNode1,FORM_INF_List,CaseID); end; Function TCB_IMGPSScanX.Node2DocNo(Node2:TTreeNode):String; //MyTreeNode2取DocNo出來 var v,v1,v2 : Integer; begin v := Posend('{',Node2.Text); v1 := Posend('}',Node2.Text); v2 := Posend('-',Node2.Text); Result := Copy(Node2.Text,v+1,v1-v-1); IF v1 = 0 Then begin Result := ''; end; end; Function TCB_IMGPSScanX.Node3DocNo(Node3:TTreeNode):String; //MyTreeNode3取DocNo出來 var v,v1,v2 : Integer; begin v := Posend('{',Node3.Parent.Text); v1 := Posend('}',Node3.Parent.Text); v2 := Posend('-',Node3.Parent.Text); Result := Copy(Node3.Parent.Text,v+1,v1-v-1); IF v1 = 0 Then begin Result := ''; end; end; Function TCB_IMGPSScanX.Node3FormID(Node3:TTreeNode):String; //MyTreeNode3取FormCode出來 var v,v1,v2 : Integer; begin v := Pos('{',Node3.Text); v1 := Pos('}',Node3.Text); v2 := Posend('-',Node3.Text); Result := Copy(Node3.Text,v+1,v1-v-1); IF v1 = 0 Then begin Result := ''; end; end; Function TCB_IMGPSScanX.GetNode2Name(Node2:TTreeNode):String; //取MyTreeNode2的識別字出來(記之前點選用) var v : Integer; begin v := Posend('-',Node2.Text); Result := Copy(Node2.Text,1,v-1); end; {Function TCB_IMGPSScanX.Down_Replace_Img(SPath,DPath,CaseID:String):Boolean; var EnCodeDateTime : String; DownUrl : String; SC,Main_C : TStringlist; i,n : Integer; FormID,DocNo,Version : String; OldFName,NewMainFName,NewSubFName : String; AttPath : String; begin SC := TStringlist.Create; Main_C := TStringlist.Create; try Result := True; HaveAppDoc := False; EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); DownUrl := FUrl+CaseID+'&checktime='+EnCodeDateTime; if not dnFile(HTTPSClient,DownUrl,'','',DPath+CaseID+'.zip',FReWrite,Memo1,False,DownImgStatus) then begin HttpErrStr := _Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason; Result := False; Exit; end; if Memo1.Lines.Strings[0] = '1' then begin HttpErrStr :=_Msg('錯誤原因:')+memo1.Lines.Strings[1]; Result := False; Exit; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; AttPath := DPath + 'AttFile\'; if FileExists(DPath+CaseID+'.zip') then begin ExecuteUnZip(DPath+CaseID+'.zip',DPath,True); if FileExists(DPath+'img.zip') then begin ExecuteUnZip(DPath+'img.zip',DPath,False); end; if FileExists(DPath+'att.zip') then begin Str2Dir(AttPath); ExecuteUnZip(DPath+'att.zip',AttPath,False); end; end Else begin if ((FMode = 'FSCAN') or (FMode = 'ISCAN')) and (Memo1.Lines.Strings[0] ='NO_FILE') then //FGIS前台匯入件沒有影像是對的 begin SC.Clear; SC.SaveToFile(DPath+'Context.dat'); end Else begin HttpErrStr := _Msg('找不到影像'); Result := False; Exit; end; end; if FileExists(SPath+'Context.dat') then SC.LoadFromFile(SPath+'Context.dat'); for I := 0 to SC.Count - 1 do begin FormID := FileName2FormCode(SC.Strings[i]); DocNo := FormCode2DocNo(FormID); Version := FormCode2Version(FormID); If FindSQLData(Doc_Inf_List,'ADD_SCAN_RULE','DOC_NO,DOC_VERSION',DocNo+','+Version,0,FindResult) Then begin if GetFindResult('ADD_SCAN_RULE') = 'R' then //替換的先刪再加 20101026 User由刪FormCode改刪DocNo begin //DeleteFormCodeFile(DPath,FormID); ContextList.LoadFromFile(DPath+'Context.dat'); DeleteDocNoFile(DPath,DocNo); end; end; end; for I := 0 to SC.Count - 1 do //複製補充進來的影像 begin OldFName := SC.Strings[i]; Main_C.LoadFromFile(DPath+'Context.dat'); //NewMainFName:= Add_Zoo(Main_C.Count+1,3)+Copy(OldFName,4,length(OldFName)-3); NewMainFName:= Add_Zoo(Main_C.Count+1,3)+FileName2NoQuene_Filename(OldFName); FormID := FileName2FormCode(OldFName); DocNo := FormCode2DocNo(FormID); Version := FormCode2Version(FormID); If FindSQLData(Doc_Inf_List,'ADD_SCAN_RULE','DOC_NO,DOC_VERSION',DocNo+','+Version,0,FindResult) Then begin CopyFile(PWideChar(SPath+OldFName),PWideChar(DPath+NewMainFName),False); end; if FormID = '' then //附件 begin CopyFile(PWideChar(SPath+OldFName),PWideChar(DPath+NewMainFName),False); end; Main_C.Add(NewMainFName); Main_C.SaveToFile(DPath+'Context.dat'); end; finally SC.Free; Main_C.Free; end; ///加入的電子檔匯入案件裡 if DirectoryExists(SPath+'AttFile\') then AttFile_Arrange(SPath+'AttFile\',DPath+'AttFile\'); end;} function TCB_IMGPSScanX.checkFormCodeIsCustom(path, formcode: string): boolean; var i:integer; ini : Tmeminifile; str1:String; begin //ShowMessage(path); ini := Tmeminifile.Create(Path+'CustomDocNo.ini'); str1:=ini.ReadString(Copy(formcode,1,8),'FormID',''); //ShowMessage('str1'+str1); if str1 = formcode then begin Result:=True; end else begin Result := False; end; end; Procedure TCB_IMGPSScanX.InitScrollRec; var i : Integer; begin for I := 1 to 8 do begin ScrollRec[i].HScroll := 0; ScrollRec[i].VScroll := 0; end; end; Procedure TCB_IMGPSScanX.GetScrollData(ISB:TImageScrollBox;Var HS,VS:Integer;Var iRate:Single); var index : Integer; begin index := strtoint(copy(ISB.Name,4,1)); HS := ScrollRec[Index].HScroll; VS := ScrollRec[Index].VScroll; iRate := ScrollRec[Index].Rate; end; Procedure TCB_IMGPSScanX.SetScrollData(ISB:TImageScrollBox;HS,VS:Integer;iRate:Single); var index : Integer; begin index := strtoint(copy(ISB.Name,4,1)); ScrollRec[Index].HScroll := HS; ScrollRec[Index].VScroll := VS; ScrollRec[Index].Rate := iRate; end; Procedure TCB_IMGPSScanX.FormIDReplace(CaseID,DocDir,OldFormID,NewFormID:String); //指定FormID更換成新的FormID var i : Integer; OldFileList,NewFileList : TStringlist; NewDocNo,NewDocDir:String; FormID : String; OldFile,NewFile:String; Ext : String; ST1:TStringList; begin ST1:=TStringList.Create; OldFileList := TStringlist.Create; NewFileList := TStringlist.Create; try NewDocNo := FormCode2DocNo(NewFormID); NewDocDir := FindLastestDocDir(CaseID,NewDocNo); /////20190319 Hong 原本的程式判斷怪怪的先Mark在下方,改用這段 if DocNoNeedDiv(NewDocNo) then //要分份數 begin if ((FormCode2Page(NewFormID) = '01') and (GetDocDir_Page(CaseID,NewDocDir)>0)) or (NewDocDir = '') then begin NewDocDir := DocNo2DocNoDir(ImageSavePath + CaseID+'\',NewDocNo); end else begin //20171016 真對補件影響 所加的判斷 ST1.Clear; if FileExists(ImageSavePath + CaseID+'\'+NewDocDir+'\Context.dat') then begin ST1.LoadFromFile(ImageSavePath + CaseID+'\'+NewDocDir+'\Context.dat'); if (ST1.Count > 0) and ISExistImg(ImageSavePath + CaseID+'\'+NewDocDir+'\'+ST1.Strings[0]) then //20181210 多增加判斷ST1>0 否則會有機會出現List out of bound Hong begin NewDocDir := DocNo2DocNoDir(ImageSavePath + CaseID+'\',NewDocNo); end; end; end; end Else //不分份數 begin if NewDocNo <> '' then NewDocDir := NewDocNo else //Attach 附件 NewDocDir := DocNo2DocNoDir(ImageSavePath + CaseID+'\',NewDocNo); end; {if NewDocDir = '' then begin if DocNoNeedDiv(NewDocNo) then begin NewDocDir:=DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',NewDocNo); end else begin NewDocDir := NewDocNo; end; end; //ShowMessage('NewDocDir='+NewDocDir); if DocNoNeedDiv(NewDocNo) and (FormCode2Page(NewFormID)='01') then begin NewDocDir := DocNo2DocNoDir(ImageSavePath+CaseID+'\',NewDocNo); end else begin ST1.Clear; if FileExists(ImageSavePath + NowCaseno+'\'+NewDocDir+'\Context.dat') then begin ST1.LoadFromFile(ImageSavePath + NowCaseno+'\'+NewDocDir+'\Context.dat'); if ISExistImg(ImageSavePath + NowCaseno+'\'+NewDocDir+'\'+ST1.Strings[0]) then begin NewDocDir := DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',NewDocNo); end; end; end; } if Not DirectoryExists(ImageSavePath+CaseID+'\'+NewDocDir) then begin MkDir(ImageSavePath+CaseID+'\'+NewDocDir); SetDocNoList('A',-1,CaseID,NewDocDir,'1'); end; if FileExists(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat') then OldFileList.LoadFromFile(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat'); if FileExists(ImageSavePath+CaseID+'\'+NewDocDir+'\Context.dat') then NewFileList.LoadFromFile(ImageSavePath+CaseID+'\'+NewDocDir+'\Context.dat'); for i := 0 to OldFileList.Count - 1 do begin OldFile := OldFileList.Strings[i]; Ext := ExtractFileExt(OldFile); if FileName2FormCode(OldFile) = OldFormID then begin NewFile := Add_Zoo(NewFileList.Count+1,3)+'_'+NewFormID+Ext; CopyFile(PWideChar(ImageSavePath+CaseID+'\'+DocDir+'\'+OldFile),PWideChar(ImageSavePath+CaseID+'\'+NewDocDir+'\'+NewFile),False); NewFileList.Add(NewFile); SetContextList('A',-1,CaseID,NewDocDir,NewFile); end; end; DeleteFormCodeFile(CaseID,DocDir,OldFormID); {for i := 0 to S.Count - 1 do begin FormID := FileName2FormCode(S.Strings[i]); if FormID = OldFormID then begin OldFile := S.Strings[i]; Ext := ExtractFileExt(OldFile); //NewFile := Copy(S.Strings[i],1,3)+'_'+NewFormID+Ext; NewFile := Add_Zoo(FileName2ScanPage(S.Strings[i]),3)+'_'+NewFormID+Ext; ReNameFile(Path+OldFile,Path+NewFile); S.Strings[i] := NewFile; end; end; S.SaveToFile(Path+'Context.dat'); ContextList.LoadFromFile(Path+'Context.dat'); } finally OldFileList.Free; NewFileList.Free; ST1.Free; end; end; Procedure TCB_IMGPSScanX.PageReplaceFormID(Path,NowFormID,NewFormID:String); //選取頁更換FormID var i,n : Integer; S,S1 : TStringlist; OldFile,NewFile:String; Ext : String; begin S := TStringlist.Create; S1 := TStringlist.Create; try S.LoadFromFile(Path+'Context.dat'); for i := 0 to S.Count - 1 do begin if NowFormID = 'ALL' then S1.Add(S.Strings[i]) Else if NowFormID = 'Err' then begin if not FormIDExists(FileName2FormCode(S.Strings[i]),False,0) then S1.Add(S.Strings[i]) end Else begin if NowFormID = FileName2FormCode(S.Strings[i]) then S1.Add(S.Strings[i]) end; end; for I := 0 to PageLV.Items.Count - 1 do begin if PageLV.Items.Item[i].Selected then begin OldFile := S1.Strings[i]; Ext := ExtractFileExt(OldFile); //NewFile := Copy(S1.Strings[i],1,3)+'_'+NewFormID+Ext; NewFile := Add_Zoo(FileName2ScanPage(S1.Strings[i]),3)+'_'+NewFormID+Ext; ReNameFile(Path+OldFile,Path+NewFile); for n := 0 to S.Count - 1 do begin if OldFile = S.Strings[n] then S.Strings[n] := NewFile; end; end; end; S.SaveToFile(Path+'Context.dat'); ContextList.LoadFromFile(Path+'Context.dat'); finally S.Free; S1.Free; end; end; Function TCB_IMGPSScanX.GetFormIDPage(FileList:TStringlist;FormID:String):Integer; var i,Cnt : Integer; begin Cnt := 0; for i := 0 to FileList.Count - 1 do begin if FormID = FileName2FormCode(FileList.Strings[i]) then begin inc(Cnt); end; end; Result := Cnt; end; Procedure TCB_IMGPSScanX.WriteResize(ImgName,TxtName:String); //產生Resize.dat var TagTxt : String; RecHeight,RecWidth : String; ImgHeight,ImgWidth : String; S : TStringlist; v,v1:Integer; begin ImageScrollBox1.LoadFromFile(ImgName,1); ImgHeight := Inttostr(ImageScrollBox1.Graphic.Height); ImgWidth := Inttostr(ImageScrollBox1.Graphic.Width); Try TagTxt := GetTag(ImgName); Except TagTxt := ''; End; if TagTxt <> '' then begin S := TStringlist.Create; try S.CommaText := TagTxt; if S.Count = 2 then begin v := Pos(':',S.Strings[0]); v1 := length(S.Strings[0]); RecHeight := Copy(S.Strings[0],v+1,v1-v); v := Pos(':',S.Strings[1]); v1 := length(S.Strings[1]); RecWidth := Copy(S.Strings[1],v+1,v1-v); end; S.Clear; if FileExists(TxtName) then S.LoadFromFile(TxtName); if (RecHeight <> '') and (RecWidth <> '') and ((RecHeight<>ImgHeight) or (RecWidth<>ImgWidth)) then S.Add(ExtractfileName(ImgName)+',原長:'+RecHeight+',原寬:'+RecWidth+',長變動:'+ImgHeight+',寬變動:'+ImgWidth); S.SaveToFile(TxtName); finally S.Free; end; end; end; Function TCB_IMGPSScanX.BarCode2FormID : String; //Barcode依規則轉成FormID var i : Integer; FormID : String; begin Result := ''; //沒找到 FormID := ''; for i := 1 to MpsBarcodeinf.Count do begin if (Length(MpsBarcodeinf.Text[i]) = FormIDLength) then begin FormID := MpsBarcodeinf.text[i]; if not FormIDAppear(FormID) then FormID := ''; end; if (FormID <> '') and FormIDExists(FormID,False,0) then //有可用的FormID就離開 begin Result := FormID; Break; end; end; end; Function TCB_IMGPSScanX.CheckFormIDExists(DocNoNode:TTreeNode;FormID:String):Boolean; //檢查FormID是否存在文件裡 var i : Integer; begin Result := False; for i := 0 to DocNoNode.Count - 1 do begin if FormID = Node3FormID(DocNoNode.Item[i]) then begin Result := True; break; end; end; end; Function TCB_IMGPSScanX.FormID2Anchor(FormID:String):String; //用FormID取出十字模式 var Anchor : String; begin Result := 'NONE'; IF FindSQLData(FORM_INF_List,'T1.ANCHOR','T1.FORM_ID',FormID,0,FindResult) then begin ANCHOR := UpperCase(GetFindResult('T1.ANCHOR')); end; Result := Index2Anchor(Anchor); end; procedure TCB_IMGPSScanX.ScanDuplexCBClick(Sender: TObject); begin ScanDuplex := ScanDuplexCB.Checked; //R_W_ScanIni('W'); //user要求改成預設後不能改 end; procedure TCB_IMGPSScanX.ScanGrayCBClick(Sender: TObject); begin if ScanGrayCB.Checked then begin ScanColor:=ifGray256; end else begin if FScanColor = 0 then begin ScanColor := ifBlackWhite; end; if FScanColor = 1 then begin //ScanColor := ifGray256 ; ScanColor := ifBlackWhite; // end; if FScanColor = 2 then begin ScanColor := ifTrueColor ; end; end; end; Function TCB_IMGPSScanX.GetFormatID(CaseID: string):String; Var S : TStringlist; FormatID : String; begin Result := ''; S := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\CaseIndex.dat') then begin S.LoadFromFile(ImageSavePath+CaseID+'\CaseIndex.dat'); //Format_ID := S.Strings[5]; //主鍵值 (報價單號or續保單號or保單號碼or保險證號or原案件受編) //Result := Format_ID; //Handle_No := S.Strings[0]; //經辦代號 //Cen_Uid := S.Strings[1]; //被保人ID //Cen_Cliname := S.Strings[2]; //被保人姓名 //Cen_Platno := S.Strings[3]; //車號 //Case_Priority := S.Strings[4];//案件等級 end; finally S.Free; end; end; procedure TCB_IMGPSScanX.CaseHelpBtnClick(Sender: TObject); var ErrlistForm : TErrlistForm; S : TStringlist; UpFormID : String; Anchor : String; begin ShowText := _Msg('處理檢核失敗中,請稍候'); DataLoading(True,True); LogFile1.LogToFile(logTimeString+'處理檢核失敗中開始'); ErrlistForm := TErrlistForm.Create(Self); RejectCase := False; S := TStringlist.Create; try InitialLanguage(ErrlistForm); Application.ProcessMessages; ErrlistForm.LogFile1.LogFile:=LogFile1.LogFile; ErrlistForm.DeleteBt.Caption := ErrlistForm.DeleteBt.Caption+'(&D)'; ErrlistForm.iniPath := ImageSavePath + NowCaseNo+'\upload\'; OMRErrini2List(NowCaseno,ErrlistForm); ErrlistForm.ErrListLV.ItemIndex := ErrIndex; ErrlistForm.Timer1.Enabled := true; if ErrlistForm.ShowModal = mrok then begin TransPath := ImageSavePath+NowCaseNo+'\upload\'; if FMode = 'ISCAN' then TransPath := ImageSavePath + NowCaseNo+'\DownTemp\'; ShowText := NowCaseNo+_Msg('資料上傳中,請稍候'); DataLoading(True,True); if FMode = 'ISCAN' then begin If Not TransCaseID(TransPath,NowCaseNo,True) Then //傳送案件 begin DataLoading(False,False); Exit; end; end Else begin If Not TransCaseID(TransPath,NowCaseNo,True) Then //傳送案件 begin DataLoading(False,False); Exit; end; end; CaseHelpBtn.Visible := False; LoadImgFile; if (FMode='NSCAN') or (FMode='DSCAN') then begin Showmessage(NowCaseNo+_Msg('影像上傳完成。此案已進入下一流程。')); end; if FMode='ESCAN' then begin Showmessage(NowCaseNo+_Msg('影像已補件完成。')); end; DataLoading(False,False); end Else begin MyTreeNode2ReFresh(NowCaseNo); end; finally ErrlistForm.Free; DataLoading(False,False); S.Free; end; end; procedure TCB_IMGPSScanX.CheckCaseBtnClick(Sender: TObject); Var CaseID : String; i,n,v : Integer; S : TStringlist; begin //if TreeView1.Selected = nil then Exit; //if TreeView1.Selected = NewTreeNode then Exit; Displaypath := ''; //20130327 修正報價單號會錯置的問題 S := TStringlist.Create; try ClearView(1); ShowText := CaseID+_Msg('檢核中,請稍候'); DataLoading(True,True); For i := 0 to NewTreeNode.Count -1 do begin v := posend('-',NewTreenode.Item[i].Text); CaseID := Copy(NewTreenode.Item[i].Text,1,v-1); ShowText := CaseID+_Msg('檢核中,請稍候'); DataLoading(True,True); if (NewTreenode.Item[i].ImageIndex <> 7) and (NewTreenode.Item[i].ImageIndex <> 5) then //檢核完成的不再檢核 begin If OMRCheckCase(CaseID) then //有成功 begin S.Add('Y'); S.SaveToFile(ImageSavePath+CaseID+'\OMRCheckOk.dat'); end; end; //MyTreeNode2ReFresh(CaseID); //原本是OMR單一案件,後改成OMR全部案件 所以這個要mark end; LoadImgFile; TreeView1Click(nil); DataLoading(False,False); finally S.Free; end; Showmessage(_Msg('檢核完成')); end; procedure TCB_IMGPSScanX.ClearView(stkv:Integer); var i:integer; ISB : TImageScrollBox; lb : TLabel; begin For i:= stkv to 8 do begin ISB := TImageScrollBox(FindComponent('ISB'+intToStr(i))); ISB.FileName := ''; Lb := TLabel(FindComponent('Lb'+intToStr(i))); Lb.Caption := ''; end; FreePreViewISB; ISB1Click(ISB1); end; procedure TCB_IMGPSScanX.PrtLbClick(Sender: TObject); var Width : Double; Height : Double; i : Integer; DocDirList,FileList :TStringlist; iDocDir,iDocNo : String; PrtDialog : TPrintDialog; S : String; begin ShowText := _Msg('列印中,請稍候'); DataLoading(True,True); Case2upload(NowCaseNo); //產生原影像結構 //ontextList.LoadFromFile(ImageSavePath+NowCaseNo+'\Upload\Context.dat'); PrintForm := TPrintForm.create(Self); DocDirList := TStringlist.Create; FileList := TStringlist.Create; try FileList.LoadFromFile(ImageSavePath+NowCaseNo+'\Upload\Context.dat'); DocDirList.LoadFromFile(ImageSavePath+NowCaseNo+'\Upload\DocDir.dat'); InitialLanguage(PrintForm); //載入多國語言 PrintForm.CheckListBox1.Items.Clear; For i := 0 to FileList.Count - 1 do begin iDocDir := DocDirList.Strings[i]; iDocno := DocNoDir2DocNo(iDocDir); if not DocNoAppear(iDocNo) then Continue; PrintForm.CheckListBox1.Items.Add(FileList.Strings[i]); if CheckFormID_Prt(FileName2FormCode(FileList.Strings[i])) then PrintForm.CheckListBox1.Checked[i] := True; PrintForm.ListBox1.Items.Add(Add_Zoo(i+1,3)) end; If (PrintForm.ShowModal = mrOK) then begin S := ''; for I := 0 to PrintForm.CheckListBox1.Count -1 do begin if PrintForm.CheckListBox1.Checked[i] then begin if S = '' then S := S+PrintForm.CheckListBox1.Items[i] Else S := S+#13+PrintForm.CheckListBox1.Items[i]; end; end; if S = '' then begin Showmessage(_msg('尚未選擇欲列印文件')); Exit; end Else begin PrintImg(S,FUserID,ServerDate,ImageSavePath+NowCaseNo+'\Upload\'); If not Writelog(NowCaseNo) then begin //Showmessage('false'); end; end; end; finally DataLoading(False,False); PrintForm.Free; end; end; procedure TCB_IMGPSScanX.UseOldCaseLbClick(Sender: TObject); var i,n : Integer; CaseID,Year,BS_No,IS_Old : String; OldCaseInfoForm : TOldCaseInfoForm; OldCaseInfoList,Caseinfolist,FileList,DocNoList,iFileList,iDocNoList,iDocNo_CopiesList : TStringlist; OldDocdir,OldDocNo,OldDocName,NewDocDir,FileName : String; OldPath,NewPath,OldFile,NewFile:String; Oldcopies:Integer; begin OldCaseInfoForm := TOldCaseInfoForm.Create(Self); OldCaseInfoList := TStringlist.Create; Caseinfolist := TStringlist.Create; FileList := TStringlist.Create; DocNoList := TStringlist.Create; iDocNo_CopiesList := TStringlist.Create; iFileList := TStringlist.Create; iDocNoList := TStringlist.Create; OldCaseInfoForm.OldDocDirList := TStringlist.Create; OldCaseInfoForm.OldDocNameList := TStringlist.Create; OldCaseInfoForm.IN_WH_DocNoList := TStringlist.Create; OldCaseInfoForm.OldCopiesList := TStringlist.Create; try InitialLanguage(OldCaseInfoForm); //載入多國語言 OldCaseInfoForm.Notebook1.ActivePage := 'CaseInfo'; OldCaseInfoForm.ImageSavePath := ImageSavePath; OldCaseInfoForm.CaseID := NowCaseNo; OldCaseInfoForm.Furl := Furl; OldCaseInfoForm.Fdata := FData; OldCaseInfoForm.FVerify := FVerify; OldCaseInfoForm.FReWrite := FReWrite; OldCaseInfoForm.FOldCaseInfo := FOldCaseInfo; //OldCaseInfoList 案件編號@#,年度@#,業務別@#,是否舊件@#,文件編號[份數]@#,文件編號[份數] tab 案件編號@#,年度@#,業務別@#,是否舊件@#,文件編號[份數]@#,文件編號[份數] OldCaseInfoList.StrictDelimiter := true; OldCaseInfoList.Delimiter := #9; OldCaseInfoList.DelimitedText := FOldCaseInfo; //Showmessage(FOldCaseInfo); //Showmessage(OldCaseInfoList.Text); OldCaseInfoForm.IN_WH_DocNoList.Assign(IN_WH_DocNoList); OldCaseInfoForm.FIs_In_Wh := FIs_In_Wh; for i := 0 to OldCaseInfoList.Count - 1 do begin Caseinfolist:=SplitString('@#,',OldCaseInfoList.Strings[i]); //Caseinfolist.Delimiter := '_'; //Caseinfolist.DelimitedText := OldCaseInfoList.Strings[i]; CaseID := Caseinfolist.Strings[0]; Year := Caseinfolist.Strings[1]; BS_No := Caseinfolist.Strings[2]; IS_Old := Caseinfolist.Strings[3]; With OldCaseInfoForm.OldCaseLV.Items.Add do begin Caption := CaseID; SubItems.Add(Year); SubItems.Add(BS_No); SubItems.Add(IS_Old); end; end; if OldCaseInfoForm.ShowModal = MrOk then begin OldPath := ImageSavePath+NowCaseNo+'\'+OldCaseInfoForm.UseCaseID+'\'; NewPath := ImageSavePath+NowCaseNo+'\'; iDocNoList.Clear; if FileExists(NewPath+'CaseDocNo.dat') then iDocNoList.LoadFromFile(NewPath+'CaseDocNo.dat'); if FileExists(NewPath+'CaseDocNo_Copies.dat') then iDocNo_CopiesList.LoadFromFile(NewPath+'CaseDocNo_Copies.dat'); for i := 0 to OldCaseInfoForm.OldDocDirList.Count - 1 do begin FileList.LoadFromFile(OldPath+'Context.dat'); DocNoList.LoadFromFile(OldPath+'DocDir.dat'); OldDocName := OldCaseInfoForm.OldDocNameList.Strings[i]; OldDocDir := OldCaseInfoForm.OldDocDirList.Strings[i]; OldDocNo := DocNoDir2DocNo(OldDocDir); if Copy(OldDocNo,1,5)<>'ZZZZZ' then begin if DocNoNeedDiv(OldDocNo) then NewDocDir := DocNo2DocNoDir(NewPath,OldDocNo) else NewDocDir := OldDocNo; end Else begin NewDocDir := GetNewCustomDocNo(NewPath,OldDocName); end; SetRecordEditedDocDir('A',NowCaseNo,NewDocDir); iFileList.Clear; if FileExists(NewPath+NewDocDir+'\Context.dat') then iFileList.LoadFromFile(NewPath+NewDocDir+'\Context.dat'); if Not DirectoryExists(NewPath+NewDocDir) then begin iDocNoList.Add(NewDocDir); Oldcopies := GetDocDirCopies(NowCaseNo+'\'+OldCaseInfoForm.UseCaseID,OldDocDir); //舊案的CaseID 放在新案CaseID目錄裡 if FileExists(ImageSavePath+NowCaseNo+'\'+OldCaseInfoForm.UseCaseID+'\CaseDocNo_Copies.dat') then iDocNo_CopiesList.Add(inttostr(Oldcopies)) else begin OldCopies := GetDocDircopies_Rec(OldPath,OldCaseInfoForm.UseCaseID,OldDocDir); iDocNo_CopiesList.Add(inttostr(Oldcopies)); //iDocNo_CopiesList.Add('1'); end; MkDir(NewPath+NewDocDir); end; SetUseCase('A',NewPath,NewDocDir,OldCaseInfoForm.UseCaseID,''); //NewDocDir 從哪來的 SetUseCase('A',OldPath,OldDocDir,'',NowCaseNo); //OldDocDir 去哪了 StringtoFile('Y',OldPath+'UseCase.dat'); //要上傳 for n := 0 to DocNoList.Count - 1 do begin if OldDocDir = DocNoList.Strings[n] then begin OldFile := FileList.Strings[n]; if Copy(NewDocDir,1,5)<>'ZZZZZ' then NewFile := Add_Zoo(iFileList.Count+1,3)+FileName2NoQuene_Filename(OldFile) Else NewFile := Add_Zoo(iFileList.Count+1,3)+'_'+GetCustomFormID(NewPath,NewDocDir)+ExtractFileExt(OldFile); iFileList.Add(NewFile); CopyFile(PwideChar(OldPath+OldFile),Pwidechar(NewPath+NewDocDir+'\'+NewFile),False); end; end; iFileList.SaveToFile(NewPath+NewDocDir+'\Context.dat'); end; iDocNoList.SaveToFile(NewPath+'CaseDocNo.dat'); iDocNo_CopiesList.SaveToFile(NewPath+'CaseDocNo_Copies.dat'); DrawDocItem2(MyTreeNode1,NowCaseNo); //MyTreeNode1.Text := Format('%s-%d'+_Msg('頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]); MyTreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]); NewTreeNodeRefresh; ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 end; finally OldCaseInfoForm.OldDocDirList.Free; OldCaseInfoForm.OldDocNameList.Free; OldCaseInfoForm.OldCopiesList.Free; OldCaseInfoList.Free; Caseinfolist.Free; FileList.Free; DocNoList.Free; iDocNo_CopiesList.Free; iFileList.Free; iDocNoList.Free; OldCaseInfoForm.Free; end; end; procedure TCB_IMGPSScanX.LastInitFormidListCreate(path: string); var i:integer; ST1:TStringList; str1:string; begin //ShowMessage('path='+path); ST1:=TStringList.Create; ST1.LoadFromFile(path+'FormCode_Name.dat'); for I := 0 to ST1.Count - 1 do begin if (Pos('_',St1.Strings[i])<>1) and (Pos('_',St1.Strings[i])<>-1) then begin str1:=Copy(ST1.Strings[i],1,Pos('_',St1.Strings[i])-1); LastInitFormidList.Add(str1); end; end; ST1.Free; end; Function TCB_IMGPSScanX.FindDivFormCode(FormCode:String):Boolean; //找有沒有分案的條碼 var i : Integer; DelBarCode : String; S : TStringlist; iMode : String; begin Result := False; iMode := FMode; S := TStringlist.Create; try IF FindSQLData(FORM_INF_List,'T1.FORM_ID,T1.DIVISION','T1.FORM_ID',FormCode,0,FindResult) then begin S.CommaText := GetFindResult('T1.DIVISION'); for i := 0 to S.Count - 1 do //可能有多組 begin if S.Strings[i] = iMode then begin Result := True; Break; end; end; end; finally S.Free; end; end; procedure TCB_IMGPSScanX.SmoothCBClick(Sender: TObject); begin if SmoothCB.Checked then begin Image_Smooth(ISB1.Graphic); ISB1.Redraw(True); end; end; Function TCB_IMGPSScanX.GetCustomFormID(Path,DocNo:String):String; //取出自定文件FormID var ini : Tinifile; begin ini := Tinifile.Create(Path+'CustomDocNo.ini'); try Result := ini.ReadString(DocNo,'FormID',''); finally ini.Free; end; end; procedure TCB_IMGPSScanX.DelAttFileLBClick(Sender: TObject); var AttFile : String; SelectCount : Integer; i : Integer; begin SelectCount := 0; for i := 0 to AttListBox.Items.Count - 1 do begin if AttListBox.Selected[i] then inc(SelectCount); end; if SelectCount = 0 then begin Showmessage(_Msg('請選擇要刪除的電子檔')); Exit; end; if SelectCount > 0 then begin if Messagedlg(Format(_Msg('是否刪除這%d筆??'),[SelectCount]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; for i := 0 to AttListBox.Items.Count - 1 do begin if AttListBox.Selected[i] then begin AttFile := HTTPEncode(UTF8Encode(AttListBox.Items.Strings[i])); DeleteFile(ImageSavePath+NowCaseNo+'\'+AttFile); SetAttContextList('D',-1,NowCaseno,AttFile); end; end; end; LoadAttFile(NowCaseNo); Showmessage(_msg('刪除完成')); end; Function TCB_IMGPSScanX.CheckFormID_Prt(FormID:String):Boolean; //傳入的FormID是否預設列印 begin Result := False; If FindSQLData(FORM_INF_List,'T1.IS_PRINT','T1.FORM_ID',FormID,0,FindResult) Then begin if GetFindResult('T1.IS_PRINT') = 'Y' Then Result := True; end; end; Procedure TCB_IMGPSScanX.ErrFormtoCurrentForm(CaseID,EFormID,CFormID:String);//將舊案的錯誤FormID改正確的FormID var DocNoList,FileList :TStringlist; EDocNo,CDocNo,iDocNo,iFormID :String; EDocDir,CDocDir:String; OldFile,NewFile :String; iPath,iiPath : String; i,n : Integer; begin EDocNo := FormCode2DocNo(EFormID); CDocNo := FormCode2DocNo(CFormID); DocNoList :=TStringlist.Create; FileList := TStringlist.Create; try DocNoList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); for i := 0 to DocNoList.Count - 1 do begin EDocDir := DocNoList.Strings[i]; iDocNo := DocNoDir2DocNo(DocNoList.Strings[i]); iPath := ImageSavePath+CaseID+'\'+EDocDir+'\'; if FileExists(iPath+'Context.dat') then //20140909漏加這個判斷造成自訂文件但沒影像會出錯誤訊息 FileList.LoadFromFile(iPath+'Context.dat'); for n := 0 to FileList.Count - 1 do begin iFormID := FileName2FormCode(FileList.Strings[n]); if iFormID = EFormID then begin OldFile := FileList.Strings[n]; NewFile := StringReplace(FileList.Strings[n],iFormID,CFormID,[rfReplaceAll]); FileList.Strings[n] := NewFile; RenameFile(iPath+OldFile,iPath+NewFile); FileList.SaveToFile(iPath+'Context.dat'); end; end; if iDocNo = EDocNo then begin CDocDir := StringReplace(EDocDir,EDocNo,CDocNo,[rfReplaceAll]); iiPath := ImageSavePath+CaseID+'\'+CDocDir+'\'; MoveFile(PWideChar(iPath),PWideChar(iiPath)); DocNoList.Strings[i] := StringReplace(DocNoList.Strings[i],iDocNo,CDocNo,[rfReplaceAll]); DocNoList.SaveToFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); //SetRecordEditedDocDir('A',CaseID,CDocNo); //20140918 yuu說改成不紀錄 end; end; finally DocNoList.Free; FileList.Free; end; end; Procedure TCB_IMGPSScanX.SortDocDir_FormID(CaseID,DocDir:String); //將DocDir裡的文件編號排序 var i,n,v,ln : Integer; Exists:Boolean; FileList,SortFileList,FormIDList : TStringlist; FormID,iFormID:String; OldName,NewName : String; begin FileList := TStringlist.Create; SortFileList := TStringlist.Create; FormIDList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat') then begin FileList.LoadFromFile(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat'); ////取出FormID///// for i := 0 to FileList.Count - 1 do begin FormID := FileName2FormCode(FileList.Strings[i]); if (FormID = 'Attach') or (FormID = 'S_Attach') then Continue; //附件離開 Exists := False; for n := 0 to FormIDList.Count - 1 do //查一下FORMID是否已經存在了 begin if FormID = FormIDList.Strings[n] then begin Exists := True; Break; end; end; if not Exists then FormIDList.Add(FormID); end; FormIDList.Sort; //排序後產要更名的清單 for i := 0 to FormIDList.Count - 1 do begin iFormID := FormIDList.Strings[i]; for n := 0 to FileList.Count - 1 do begin if FileName2FormCode(FileList.Strings[n]) = iFormID then begin SortFileList.Add(FileList.Strings[n]+','+'@'+Add_Zoo(SortFileList.Count+1,3)+'_'+iFormID+ExtractFileExt(FileList.Strings[n])); end; end; end; FileList.Clear; //更名成新順序的檔名 for i := 0 to SortFileList.Count - 1 do begin v := Pos(',',SortFileList.Strings[i]); ln := Length(SortFileList.Strings[i]); OldName := Copy(SortFileList.Strings[i],1,v-1); NewName := Copy(SortFileList.Strings[i],v+1,ln-v); RenameFile(ImageSavePath+CaseID+'\'+DocDir+'\'+OldName,ImageSavePath+CaseID+'\'+DocDir+'\'+NewName); FileList.Add(NewName); end; //去掉@開頭 for i := 0 to FileList.Count - 1 do begin OldName := FileList.Strings[i]; NewName := StringReplace(OldName,'@','',[rfReplaceAll]); ReNameFile(ImageSavePath+CaseID+'\'+DocDir+'\'+OldName,ImageSavePath+CaseID+'\'+DocDir+'\'+NewName); FileList.Strings[i] := NewName; end; FileList.SaveToFile(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat'); end; finally FileList.Free; SortFileList.Free; FormIDList.Free; end; end; Function TCB_IMGPSScanX.FormIDAppear(FormID:String):Boolean; //FormID是否可出現 var iDocNo : String; begin Result := True; iDocNo := FormCode2DocNo(FormID); if (((FIs_In_Wh = 'Y') and (not DocNoIs_In_WH(iDocNo))) or //入庫掃描不看非入庫文件 ((FIs_In_Wh = 'N') and (DocNoIs_In_WH(iDocNo)))) and //非入庫掃描不看入庫文件 ((iDocNo <> 'Attach') and (iDocNo <> 'S_Attach') and (Copy(iDocNo,1,5)<>'ZZZZZ')) then Result := False; if (FIs_In_Wh='Y') and (FWH_category='Y') then //20170816 新加 begin if (((FIs_In_Wh = 'Y') and (not DocNoIs_In_WH(iDocNo))) or //入庫掃描不看非入庫文件 ((FIs_In_Wh = 'N') and (DocNoIs_In_WH(iDocNo)))) and //非入庫掃描不看入庫文件 ((iDocNo <> 'Attach') and (iDocNo <> 'S_Attach') and (Copy(iDocNo,1,5)<>'ZZZZZ')) then Result := False; end; if (FIs_In_Wh='Y') and (FWH_category='N') then //20170816 新加 begin Result:=True; end; end; Function TCB_IMGPSScanX.ISGuideFormID(FormID:String):Boolean; var i : Integer; begin Result := False; for i := 0 to GuideFormIDList.Count - 1 do begin if FormID = GuideFormIDList.Strings[i] then begin Result := True; Break; end; end; end; Function TCB_IMGPSScanX.ISDivPageFormID(FormID:String):Boolean; var i : Integer; begin Result := False; for i := 0 to DivPageFormIDList.Count - 1 do begin if FormID = DivPageFormIDList.Strings[i] then begin Result := True; Break; end; end; end; Procedure TCB_IMGPSScanX.MoveImage_Drag(Path:String;fp,tp:Integer); //拖拉移動頁數 var i,n,inx:Integer; FList,D_Flist:TStringlist; begin FList := TStringlist.Create; D_Flist := TStringlist.Create; try FList.LoadFromFile(Path+'Context.dat'); for i := 0 to FList.Count - 1 do begin Renamefile(Path+Flist.Strings[i],path+'@'+Flist.Strings[i]); Flist.Strings[i]:= '@'+Flist.Strings[i]; end; D_Flist.Add(Flist.Strings[fp-1]); {for i := 0 to ComponentCount -1 do begin if (Components[i] is TShape) and (copy(Components[i].Name,1,2)='SP') then begin inx := strtoint(Copy(TShape(Components[i]).Name,3,length(TShape(Components[i]).Name)-2)); D_Flist.Add(Flist.Strings[inx-1]); //Renamefile(Path+Flist.Strings[inx-1],path+'@'+Flist.Strings[inx-1]); end; end;} //Showmessage('aa'); for i := 0 to D_Flist.Count -1 do begin for n := 0 to FList.Count - 1 do begin //if Flist.Strings[n]=StringReplace(D_Flist.Strings[i],'@','',[rfReplaceAll]) then if Flist.Strings[n]=D_Flist.Strings[i] then begin Flist.Delete(n); Break; end; end; end; //Showmessage('bb'); for i := 0 to D_Flist.Count - 1 do begin Flist.Insert(tp-1+i,D_Flist.Strings[i]); end; Flist.SaveToFile(Path+'Context.dat'); //Showmessage(Flist.Text); //Showmessage('CC'); ReSortFileName(Path); TreeView1click(self); finally FList.Free; D_Flist.Free; end; end; Function TCB_IMGPSScanX.FormCode2FormName(CaseID,FormCode:String):String; //用FormCode轉成文件名稱 var i,v,ln : Integer; DelBarCode : String; CusDocNo,CusDocName : String; begin Result := ''; if (FormCode = '') or (FormCode = 'Attach') or (FormCode = 'S_Attach') then Result := _Msg('未歸類') //showmessage('a'); //stringtofile(FORM_INF_List.Text,'D:\121.txt'); Else If FindSQLData(FORM_INF_List,'T1.FORM_ID,T1.FORM_DESC','T1.FORM_ID',FormCode,0,FindResult) then Result := GetFindResult('T1.FORM_DESC'); ////// 到自訂文件找////// if Result = '' then Result := GetCustomDocName(ImageSavePath+CaseID+'\',FormCode2DocNo(FormCode)); {for i := 0 to Cust_DocNoList.Count - 1 do begin v := Pos('_',Cust_DocNoList.Strings[i]); ln := Length(Cust_DocNoList.Strings[i]); CusDocNo := copy(Cust_DocNoList.Strings[i],1,v-1); CusDocName := Copy(Cust_DocNoList.Strings[i],v+1,ln-v); if CusDocNo = FormCode2DocNo(FormCode) then Result := DocNo2DocName(CusDocNo); end;} {DelBarCode := '**'+FormCode; for I := 0 to FormCodeList.Count - 1 do begin if FindDel then //要找下架的 begin if (FormCode = FormCodeList.Strings[i]) or (DelBarCode = FormCodeList.Strings[i]) then begin Result := FormNameList.Strings[i]; Break; end; end Else begin if (FormCode = FormCodeList.Strings[i]) or (DelBarCode = FormCodeList.Strings[i]) then begin Result := FormNameList.Strings[i]; Break; end; end; end; } end; Function TCB_IMGPSScanX.FormCode2FileName(FormCode:String;List:TStrings):String; //用FormCode找出檔名(第一頁) var i : Integer; v,v1 : Integer; begin Result := ''; for i := 0 to List.Count - 1 do begin V := pos('_',List.Strings[i]); v1 := pos('.',List.Strings[i]); if (FormCode = '') and (V = 0)then //FormCode 為空的則找附件出來 begin Result := List.Strings[i]; Break; end; IF FormCode = Copy(List.Strings[i],v+1,v1-v-1) then begin Result := List.Strings[i]; Break; end; end; end; Function TCB_IMGPSScanX.FileName2FormCode(FileName:String):String; //從檔名取出FormCode var v,v1 : Integer; begin FileName := ExtractFileName(FileName); v := Pos('_',FileName); v1 := Pos('.',FileName); if v > 0 then begin Result := Copy(FileName,v+1,v1-v-1); end Else //附件 begin Result := ''; end; end; Function TCB_IMGPSScanX.FileName2FormName(CaseID,FileName:String):String; //從檔名取出文件名稱 begin Result := FormCode2FormName(CaseID,FileName2FormCode(FileName)); end; Function TCB_IMGPSScanX.FormCode2DocNo(FormCode:String):String; //FormCode轉Docno Var i : Integer; begin Result := ''; for i := 0 to FormID_List.Count-1 do begin if FormID_List.Strings[i] = FormCode then begin Result := DocNo_List.Strings[i]; Break; end; end; if (FormCode <> '') and (Result = '') then //是自訂文件 begin Result := Copy(FormCode,1,8); //20170224 DocNo 固定長度8碼 end; {If FindSQLData(FORM_INF_List,'T1.DOC_NO','T1.FORM_ID',FormCode,0,FindResult) Then //20130403太慢了..換掉 begin Result := GetFindResult('T1.DOC_NO'); end;} end; Function TCB_IMGPSScanX.FormCode2Version(FormCode:String):String; //FormCode轉版本 begin Result := Copy(FormCode,11,5); end; Function TCB_IMGPSScanX.FormCode2Page(FormCode:String):String; //FormCode轉頁數 begin Result := Copy(FormCode,9,2) end; Function TCB_IMGPSScanX.FormCode2WorkNo(FormCode:String):String; //用FormCode取出作業別 begin Result := ''; If FindSQLData(FORM_INF_List,'T1.WORK_NO','T1.FORM_ID',FormCode,0,FindResult) Then begin Result := GetFindResult('T1.WORK_NO'); end; end; Function TCB_IMGPSScanX.CaseNode2Info(Node:TTreeNode;Mode:Char):String; //案件Node取案件編號 Mode: I:Caseno;P:Page var v,ln : Integer; begin //XXXXXX-XX頁 V := Pos('-',Node.Text); ln := Length(Node.Text); case Mode of 'I': Result := Copy(Node.Text,1,v-1); //CaseID 'P': Result := Copy(Node.Text,v+1,ln-v-1); //CasePage end; end; Function TCB_IMGPSScanX.DocNode2Info(Node:TTreeNode;Mode:Char):String; //文件Node取文件代號 Mode: I:Docno;N:Docname;P:Page;G:Group var v,v1,v2,v3,ln :integer; begin //文件名稱@組數{文件代號}-XX頁 V := PosEnd('@',Node.Text); v1 := PosEnd('{',Node.Text); v2 := PosEnd('}',Node.Text); v3 := PosEnd('-',Node.Text); ln := Length(Node.Text); case Mode of 'I': Result := Copy(Node.Text,v1+1,v2-v1-1); //DocNo 'N': Result := Copy(Node.Text,1,v-1); //DocName 'P': Result := Copy(Node.Text,v3+1,ln-v3-1); //DocPage 'G': Result := Copy(Node.Text,v+1,v1-v-1); //DocGroup end; end; Function TCB_IMGPSScanX.FormNode2Info(Node:TTreeNode;Mode:Char):String; //表單Node取表單代號 Mode: I:FormID;N:FormName;P:Page var v,v1,v2,ln :integer; begin //表單代號{表單名稱}-XX頁 v := Pos('{',Node.Text); v1 := PosEnd('}',Node.Text); v2 := PosEnd('-',Node.Text); ln := Length(Node.Text); case Mode of 'I': Result := Copy(Node.Text,1,v-1); //FormID 'N': Result := Copy(Node.Text,v1+1,v2-v1-1); //FormName 'P': Result := Copy(Node.Text,v2+1,ln-v2-1); //Page end; end; Function TCB_IMGPSScanX.DocNoExistsinTree(CaseNode:TTreeNode;DocNo:String):Boolean; //是否己存在樹裡 var i : Integer; begin Result := False; for I := 0 to CaseNode.Count - 1 do begin if DocNo = DocNode2Info(CaseNode.Item[i],'I') Then begin Result := True; Break; end; end; end; Procedure TCB_IMGPSScanX.DistinctFormCode(CaseID:String); //從案件裡的FormCode取出第一頁 var i,n : Integer; LForm,OForm : String; Addok : Boolean; S : TStringlist; begin S := TStringlist.Create; try S.LoadFromFile(ImageSavePath + CaseID+'\upload\Context.dat'); for i := 0 to S.Count - 1 do begin LogFile1.LogToFile(logTimeString+S.Strings[i]+' ISExistImg='+BoolToStr(ISExistImg(ImageSavePath+CaseID+'\upload\'+S.Strings[i]),true)); LogFile1.LogToFile(logTimeString+S.Strings[i]+' reSizeExistImgList='+BoolToStr(reSizeExistImgList.IndexOf(LoadFileGetMD5(ImageSavePath+CaseID+'\upload\'+S.Strings[i]))<>-1,true)); if FWH_category='N' then begin if (ISExistImg(ImageSavePath+CaseID+'\upload\'+S.Strings[i])) or (reSizeExistImgList.IndexOf(LoadFileGetMD5(ImageSavePath+CaseID+'\upload\'+S.Strings[i]))<>-1) then begin Continue; end; end; LForm := FileName2FormCode(S.Strings[i]); AddOk := True; for n := 0 to OMRFileList.Count - 1 do begin OForm := FileName2FormCode(OMRFileList.Strings[n]); if (LForm <> '') and (LForm = OForm) then begin AddOk := False; Break; end; end; if AddOk then begin OMRFileList.Add(S.Strings[i]); end; end; finally S.Free; end; end; procedure TCB_IMGPSScanX.view_image_FormCode(Path,FormCode:String;stpage,stview:integer); //用FormCode來找影像 var i,p:integer; ISB : TImageScrollBox; lb : TLabel; v ,v1 : Integer; page : Integer; List_FormCode,Err_FormCode: String; iFormID : String; begin ShowText := _Msg('影像顯示中,請稍候'); DataLoading(True,True); IF FormCode = 'ShowAll' then //顯示所有的影像 (因為附件會傳空字串,所以用ShowAll) begin ClearView(1); CreatePreViewISB(ContextList.Count); For i := Stpage-1 to ContextList.Count -1 do begin ISB := TImageScrollBox(FindComponent(ISBName+intToStr(stview+i))); ISB.AntiAliased := True; if ISB.ZoomPercent > 100 then ISB.AntiAliased := False; ISB.LoadFromFile(Path+ContextList.Strings[i],1); {GetScrollData(ISB,HS,VS,iRate); if iRate = 0 then ISB.ZoomMode := zmFittoPage Else ISB.ZoomPercent := iRate; ISB.HorzScrollBar.Position := HS; ISB.VertScrollBar.Position := VS; List_FormCode := FileName2FormCode(ContextList.Strings[i]); lb := TLabel(FindComponent('lb'+intToStr(stview))); lb.Caption := Format(_Msg('第%s頁'),[Add_Zoo(i+1,3)]); If List_FormCode = '' Then lb.Caption := lb.Caption+'('+FormCode2FormName(List_FormCode)+')' Else lb.Caption := lb.Caption+'('+FormCode2FormName(List_FormCode)+'-'+List_FormCode+')'; Inc(Stview); If ((VMode = 0) and (Stview>1)) or ((VMode = 1) and ((Stview>2))) or ((VMode = 2) and ((Stview>4))) or ((VMode = 3) and ((Stview>6))) or ((VMode = 4) and ((Stview>8))) Then break; } end; FitPreViewISB; end Else //顯示指定FormCode的影像 begin If (TreeView1.Selected <> nil) Then begin If Stpage = 0 Then Stpage := 1; Page := 0; ClearView(stview); If Stpage > ContextList.Count Then Exit; For i := 0 to ContextList.Count -1 do begin List_FormCode := FileName2FormCode(ContextList.Strings[i]); {iFormID := GetMainFormID(List_FormCode); if iFormID <> '' then List_FormCode := iFormID;} Err_FormCode := 'NoCode'; if (List_Formcode <> '') and (not FormIDExists(List_Formcode,False,0)) then Err_FormCode := 'Err'; IF (List_FormCode = FormCode) or (Err_FormCode=Formcode) or (FormCode2DocNo(List_FormCode) = FormCode) Then begin Inc(Page); IF Page< Stpage Then Continue; ISB := TImageScrollBox(FindComponent('ISB'+intToStr(stview))); ISB.AntiAliased := True; if ISB.ZoomPercent > 100 then ISB.AntiAliased := False; ISB.LoadFromFile(Path+ContextList.Strings[i],1); GetScrollData(ISB,HS,VS,iRate); if iRate = 0 then ISB.ZoomMode := zmFittoPage Else ISB.ZoomPercent := iRate; ISB.HorzScrollBar.Position := HS; ISB.VertScrollBar.Position := VS; {if not SortMode then begin SetScrollData(MPSViewX,MPSViewX.HorzScrollBarPos,MPSViewX.VertScrollBarPos,MPSViewX.ZoomPercent); end;} //MPSViewX.ImageZoomMode := zmFullpage; //MPSViewX.AntiAliased := True; lb := TLabel(FindComponent('lb'+intToStr(stview))); lb.Caption := Format(_Msg('第%s頁'),[Add_Zoo(i+1,3)]); If List_FormCode = '' Then lb.Caption := lb.Caption+'('+FormCode2FormName(NowCaseno,List_FormCode)+')' Else lb.Caption := lb.Caption+'('+FormCode2FormName(NowCaseNo,List_FormCode)+'-'+List_FormCode+')'; Inc(Stview); end; If ((VMode = 0) and (Stview>1)) or ((VMode = 1) and ((Stview>2))) or ((VMode = 2) and ((Stview>4))) or ((VMode = 3) and ((Stview>6))) or ((VMode = 4) and ((Stview>8))) Then break; end; end; end; ISB1Click(ISB1); DataLoading(False,False); end; procedure TCB_IMGPSScanX.view_image_DocNo(Path,DocNo,FormID:String;Pages:integer); //用DocNo來找影像 var i,n,p:integer; ISB : TImageScrollBox; lb : TLabel; v ,v1 : Integer; List_DocNo,Trans_DocNo,List_FormCode,Form_Page: String; iDocNo : String; iGroupNo,page,Ct,int1 : Integer; ST1:TStringList; begin ShowText := _Msg('影像顯示中,請稍候'); DataLoading(True,True); ST1:=TStringList.Create; //Display1.Lines.Clear; IF DocNo = 'ShowAll' then //顯示所有的影像 (因為附件會傳空字串,所以用ShowAll) begin ClearView(1); if GetCasePage(ImageSavePath,NowCaseno) > 30 then begin DataLoading(False,False); Exit; end; CreatePreViewISB(GetCasePage(ImageSavePath,NowCaseno)); //Showmessage(inttostr(GetCasePage(ImageSavePath,NowCaseno))); Ct := 0; For i := 0 to CaseDocNoList.Count-1 do begin if (FWH_category='N') and (FIs_In_Wh='Y') then begin if FileExists(ImageSavePath+NowCaseno+'\EditedDocDir.dat') then begin ST1.LoadFromFile(ImageSavePath+NowCaseno+'\EditedDocDir.dat'); end; end; iDocNo := CaseDocNoList.Strings[i]; //ShowMessage('ST1.Count='+IntToStr(ST1.Count)); if ST1.Count<>0 then begin if ST1.IndexOf(iDocNo)<>-1 then begin end else begin if not DocNoAppear(DocNoDir2DocNo(iDocNo)) then continue; //20170817 這不能被註解 end; end else begin if not DocNoAppear(DocNoDir2DocNo(iDocNo)) then continue; //20170817 這不能被註解 end; ContextList.Clear; if FileExists(Path+iDocNo+'\Context.dat') then ContextList.LoadFromFile(Path+iDocNo+'\Context.dat'); //ShowMessage('ContextList='+ContextList.Text); for n := 0 to ContextList.Count - 1 do begin if (FWH_category='N') and (FIs_In_Wh='Y') then begin if ISExistImg(Path+iDocNo+'\'+ContextList.Strings[n]) then begin if not DocNoIs_In_WH(Copy(iDocNo,1,8)) then begin Continue; end; end; end; inc(Ct); ISB := TImageScrollBox(FindComponent(ISBName+intToStr(Ct))); ISB.AntiAliased := True; if ISB.ZoomPercent > 100 then ISB.AntiAliased := False; ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[n],1); DpiResize(ISB.Graphic,36,False); ISB.Redraw(true); end; end; //if DirectoryExists(Path+'Attach') then if DirectoryExists(Path+AttName) then begin //iDocNo := 'Attach'; iDocNo := AttName; ContextList.Clear; if FileExists(Path+iDocNo+'\Context.dat') then ContextList.LoadFromFile(Path+iDocNo+'\Context.dat'); for n := 0 to ContextList.Count - 1 do begin inc(Ct); ISB := TImageScrollBox(FindComponent(ISBName+intToStr(Ct))); ISB.AntiAliased := True; if ISB.ZoomPercent > 100 then ISB.AntiAliased := False; ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[n],1); end; end; FitPreViewISB; end Else if (DocNo <> '') and (FormID = '') then //顯示指定DocNo+組別的影像 附件傳 Attach begin //顯示 文件層下的影像 iDocNo := DocNo; ContextList.Clear; if FileExists(Path+iDocNo+'\Context.dat') then ContextList.LoadFromFile(Path+iDocNo+'\Context.dat'); //ShowMessage('ContextList.Count='+IntToStr(ContextList.Count)); CreatePreViewISB(ContextList.Count); //ShowMessage(IntToStr(ContextList.Count)); int1:=0; //ShowMessage(BoolToStr(DocNoIs_In_WH(Copy(iDocNo,1,8)),true)); For i := 0 to ContextList.Count -1 do begin if (FWH_category='N') and (FIs_In_Wh='Y') then begin if ISExistImg(Path+iDocNo+'\'+ContextList.Strings[i]) then begin if not DocNoIs_In_WH(Copy(iDocNo,1,8)) and ( iDocNo<>'Attach') then begin inc(int1); Continue; end; end; end; //ShowMessage(Path+iDocNo+'\'+ContextList.Strings[i]); ISB := TImageScrollBox(FindComponent(ISBName+intToStr(i+1-int1))); ISB.AntiAliased := True; if ISB.ZoomPercent > 100 then ISB.AntiAliased := False; ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[i],1); DpiResize(ISB.Graphic,36,False); ISB.Redraw(true); end; FitPreViewISB; end Else if (FormID <> '') {and (FormID <> 'Attach')} then //顯示指定FormID的影像 begin If (TreeView1.Selected <> nil) Then begin iDocNo := DocNo; ContextList.Clear; if FileExists(Path+iDocNo+'\Context.dat') then ContextList.LoadFromFile(Path+iDocNo+'\Context.dat'); iGroupNo := 0; page := 0; Ct := 0; CreatePreViewISB(Pages); //ShowMessage('formID page'+IntToStr(Pages)+', ContextList='+ContextList.Text); For i := 0 to ContextList.Count -1 do begin if FileName2FormCode(ContextList.Strings[i]) = FormID then begin if (FWH_category='N') and (FIs_In_Wh='Y') then begin //ShowMessage(Path+iDocNo+'\'+ContextList.Strings[i]); //ShowMessage(BoolToStr(ISExistImg(Path+iDocNo+'\'+ContextList.Strings[i]),true)); if ISExistImg(Path+iDocNo+'\'+ContextList.Strings[i]) then begin if not DocNoIs_In_WH(FormCode2DocNo(FormID)) then Continue; end; end; inc(Ct); ISB := TImageScrollBox(FindComponent(ISBName+intToStr(Ct))); //ShowMessage(ISB.Name); ISB.AntiAliased := True; if ISB.ZoomPercent > 100 then ISB.AntiAliased := False; ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[i],1); DpiResize(ISB.Graphic,36,False); ISB.Redraw(true); //NowShowFileList.Add(ContextList.Strings[i]); end; end; FitPreViewISB; end; end; if FindComponent(ISBName+'1') <> nil then begin ISBClick(TImageScrollBox(FindComponent(ISBName+'1'))); end; ISB1Click(ISB1); DataLoading(False,False); end; Function TCB_IMGPSScanX.ShapeName2PreViewISBName(SP:TShape):String; //轉出指定PreViewISBName begin Result := ISBName+Copy(SP.Name,3,length(SP.Name)-2); end; procedure TCB_IMGPSScanX.SpeedButton14Click(Sender: TObject); var Count : Integer; begin if not ISB1.Graphic.IsEmpty then begin ISB1.LoadFromFile(ISB1.FileName,1); Rotate(ISB1.Graphic,270); if ISB1.Graphic.ImageFormat <> ifBlackWhite then begin TJpegGraphic(ISB1.Graphic).SaveQuality := 30; TJpegGraphic(ISB1.Graphic).SaveToFile(ISB1.FileName); end Else ISB1.SaveToFile(ISB1.FileName); ISB1.Redraw(True); SelectISB.Graphic.Assign(ISB1.Graphic); SelectISB.Redraw(True); FitPreViewISB; ISBClick(SelectISB); end; end; procedure TCB_IMGPSScanX.SpeedButton15Click(Sender: TObject); begin if not ISB1.Graphic.IsEmpty then begin ISB1.LoadFromFile(ISB1.FileName,1); Rotate(ISB1.Graphic,180); if ISB1.Graphic.ImageFormat <> ifBlackWhite then begin TJpegGraphic(ISB1.Graphic).SaveQuality := 30; TJpegGraphic(ISB1.Graphic).SaveToFile(ISB1.FileName); end Else ISB1.SaveToFile(ISB1.FileName); ISB1.Redraw(True); SelectISB.Graphic.Assign(ISB1.Graphic); SelectISB.Redraw(True); FitPreViewISB; ISBClick(SelectISB); end; end; procedure TCB_IMGPSScanX.SpeedButton16Click(Sender: TObject); begin if not ISB1.Graphic.IsEmpty then begin ISB1.LoadFromFile(ISB1.FileName,1); Rotate(ISB1.Graphic,90); if ISB1.Graphic.ImageFormat <> ifBlackWhite then begin TJpegGraphic(ISB1.Graphic).SaveQuality := 30; TJpegGraphic(ISB1.Graphic).SaveToFile(ISB1.FileName); end Else ISB1.SaveToFile(ISB1.FileName); ISB1.Redraw(True); SelectISB.Graphic.Assign(ISB1.Graphic); SelectISB.Redraw(True); FitPreViewISB; ISBClick(SelectISB); end; end; procedure TCB_IMGPSScanX.SpeedButton17Click(Sender: TObject); begin ISB1.ZoomMode := zmFitHeight; end; procedure TCB_IMGPSScanX.SpeedButton18Click(Sender: TObject); begin ISB1.ZoomMode := zmFitWidth; end; procedure TCB_IMGPSScanX.SpeedButton19Click(Sender: TObject); begin ISB1.ZoomMode := zmOriginalSize; end; procedure TCB_IMGPSScanX.SpeedButton20Click(Sender: TObject); begin ISB1.ZoomMode := zmFittoPage; end; procedure TCB_IMGPSScanX.SpeedButton21Click(Sender: TObject); begin ISB1.ZoomMode := zmPercent; ISB1.ZoomPercent := 50; end; procedure TCB_IMGPSScanX.SpeedButton22Click(Sender: TObject); begin ISB1.ZoomMode := zmPercent; ISB1.ZoomPercent := 25; end; procedure TCB_IMGPSScanX.SpeedButton3Click(Sender: TObject); begin ISB1.ZoomMode := zmFullPage; end; Procedure TCB_IMGPSScanX.CreatePreViewISB(Count:Integer); var ISB : TImageScrollBox; Panel : TPanel; i,W,H : Integer; myDate : TDateTime; begin FreePreViewISB; ScrollBox1.HorzScrollBar.Visible := False; W := 150; H := 250; for I := 1 to Count do begin if FindComponent('M_Pl'+inttostr(i))=nil then begin Panel := TPanel.Create(Self); Panel.Name := 'M_Pl'+inttostr(i);//FormatDateTime('yyyymmddhhnnsszzz', now) Panel.Left := 4; Panel.Top := (i-1)*H+(6*i); Panel.Height := H; Panel.Width := W; Panel.Parent := ScrollBox1; Panel.Caption :=''; if FindComponent(ISBName+inttostr(i))=nil then begin ISB := TImageScrollBox.Create(Self); ISB.Name := ISBName+inttostr(i); ISB.Parent := Panel; ISB.Align := alClient; ISB.ZoomMode := zmFullPage; ISB.DragMode := dmAutomatic; ISB.MouseMode := mmuser; ISB.OnImageClick := ISBClick; ISB.OnImageMouseMove := ISBMouseMove; ISB.PopupMenu := PopupMenu6; ISB.OnImageMouseDown := ISBImageMouseDown; ISB.OnImageMouseUp := ISBImageMouseUp; ISB.OnEndDrag := ISBEndDrag; ISB.OnDragDrop := ISBDragDrop; ISB.OnDragOver := ISBDragOver; end; end; end; end; Procedure TCB_IMGPSScanX.FreePreViewISB; var i : Integer; begin try For i:= ComponentCount -1 downto 0 do begin IF (Components[i] is TImageScrollBox) and (Components[i]<>nil) Then begin IF Pos(ISBName,Components[i].Name) > 0 Then Components[i].Free; end Else If (Components[i] is TPanel) and (Components[i]<>nil) Then begin IF Pos('M_Pl',Components[i].Name) > 0 Then Components[i].Free; end Else If (Components[i] is TShape) and (Components[i]<>nil) Then begin IF Pos('SP',Components[i].Name) > 0 Then Components[i].Free; end; end; Application.ProcessMessages; except on E: Exception do end; //showmessage(inttostr(Count)); end; Procedure TCB_IMGPSScanX.FitPreViewISB; var i : Integer; iISB : TImageScrollBox; iPanel : TPanel; T,H : Integer; begin T := 0; i := 1; while FindComponent(ISBName+inttostr(i)) <> nil do begin iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i))); iISB.Parent.Height := 250; iISB.Parent.Top := T+4; iISB.Parent.Height := iISB.DisplayedGraphic.Height; H := iISB.Parent.Height; T := iISB.Parent.Top+H; inc(i); end; {For i:= 1 to Count do begin if TImageScrollBox(FindComponent(ISBName+inttostr(i))) = nil then Break; iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i))); iISB.Parent.Height := H; iISB.Parent.Top := T+4; iISB.Parent.Height := iISB.DisplayedGraphic.Height; H := iISB.Parent.Height; T := iISB.Parent.Top+H; end;} end; Procedure TCB_IMGPSScanX.PaintShape(FromImg,ToImg:TImageScrollBox); //畫有被選取的影像 var i,F_No,T_No : Integer; SP : TShape; ISB : TImageScrollBox; Function GetImgNo(iISB:TImageScrollBox):Integer; begin Result := strtoint(Copy(iISB.Name,length(ISBName)+1,length(iISB.Name)-length(ISBName))); //'PreViewISB' end; begin IF ToImg = nil Then //只畫單一個 begin ISB := TImageScrollBox(FindComponent(ISBName+inttostr(GetImgNo(FromImg)))); if TShape(FindComponent('SP'+inttostr(GetImgNo(FromImg)))) = nil then begin SP := TShape.Create(self); SP.Pen.Color := clblue; SP.Pen.Width := 3; SP.Parent := ScrollBox1; SP.Name := 'SP'+inttostr(GetImgNo(FromImg)); SP.Left := ISB.Parent.Left-4; SP.Top := ISB.Parent.Top -4; SP.Width := ISB.Parent.Width + 8; SP.Height := ISB.Parent.Height + 8; end; end Else begin FreeShapeobj(nil); IF GetImgNo(FromImg) <= GetImgNo(ToImg) Then begin F_No := GetImgNo(FromImg); T_No := GetImgNo(ToImg); end Else begin F_No := GetImgNo(ToImg); T_No := GetImgNo(FromImg); end; For i := F_No to T_No do begin ISB := TImageScrollBox(FindComponent(ISBName+inttostr(i))); SP := TShape.Create(self); SP.Pen.Color := clblue; SP.Pen.Width := 3; SP.Parent := ScrollBox1; SP.Name := 'SP'+inttostr(i); SP.Left := ISB.Parent.Left-4; SP.Top := ISB.Parent.Top -4; SP.Width := ISB.Parent.Width + 8; SP.Height := ISB.Parent.Height + 8; end; end; end; Procedure TCB_IMGPSScanX.ISBClick(Sender : TObject); var v,ln:Integer; begin if (GetKeyState(VK_SHIFT) < 0) Then begin PaintShape(SelectISB,TImageScrollBox(Sender)); SelectISB := TImageScrollBox(Sender); end Else if (GetKeyState(VK_CONTROL) < 0) Then begin SelectISB := TImageScrollBox(Sender); IF TShape(FindComponent('SP'+Copy(SelectISB.Name,length(ISBName)+1,length(SelectISB.Name)-length(ISBName)))) = nil Then PaintShape(SelectISB,nil) else FreeShapeobj(SelectISB); end Else begin FreeShapeobj(nil); SelectISB := TImageScrollBox(Sender); PaintShape(SelectISB,nil); end; GetSelectImageFile; v := length(ISBName); ln := length(SelectISB.Name); SelectPage := Strtoint(Copy(SelectISB.Name,v+1,ln-v)); ISB1.ZoomMode := zmFittoPage; //ShowMessage('SelectISB.FileName='+SelectISB.FileName); //if SelectISB.FileName='' then exit; ISB1.LoadFromFile(SelectISB.FileName,1); if (ISB1.Graphic.ImageFormat <> ifBlackWhite) and (SmoothCB.Checked)then Image_Smooth(ISB1.Graphic); ISB1.Redraw(True); ISB1Click(ISB1); end; Procedure TCB_IMGPSScanX.ISBMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin //Edit1.SetFocus; if Draging then begin if not (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then begin SelectISB.BeginDrag(False); Draging := False; end; end; end; procedure TCB_IMGPSScanX.ISBImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var v,ln:Integer; begin if Button = TMouseButton(mbLeft) Then begin Draging := True; //if SelectISB <> nil then //if not Draging then //begin end; //end; {if not (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then begin //Showmessage('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name))); if (Button = TMouseButton(mbLeft)) and (GetKeyState(VK_CONTROL) >= 0) then begin if SelectISB <> nil then SelectISB.BeginDrag(False); end; end; //if (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then //begin //else //begin if not Draging then begin if (GetKeyState(VK_SHIFT) < 0) Then begin PaintShape(SelectISB,TImageScrollBox(Sender)); SelectISB := TImageScrollBox(Sender); end Else if (GetKeyState(VK_CONTROL) < 0) Then begin SelectISB := TImageScrollBox(Sender); IF TShape(FindComponent('SP'+Copy(SelectISB.Name,length(ISBName)+1,length(SelectISB.Name)-length(ISBName)))) = nil Then PaintShape(SelectISB,nil) else FreeShapeobj(SelectISB); end Else begin FreeShapeobj(nil); SelectISB := TImageScrollBox(Sender); PaintShape(SelectISB,nil); end; v := length(ISBName); ln := length(SelectISB.Name); SelectPage := Strtoint(Copy(SelectISB.Name,v+1,ln-v)); ISB1.ZoomMode := zmFittoPage; ISB1.LoadFromFile(SelectISB.FileName,1); ISB1Click(ISB1); end; //end; //end //Else //begin //end; } {if (Button = TMouseButton(mbRight)) and (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then begin //ISBClick(Sender); end; if (Button = TMouseButton(mbLeft)) then begin end; } end; procedure TCB_IMGPSScanX.ISBImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Draging := False; end; procedure TCB_IMGPSScanX.ISBEndDrag(Sender, Target: TObject; X, Y: Integer); begin TreeView1Click(self); end; procedure TCB_IMGPSScanX.ISBDragDrop(Sender, Source: TObject; X, Y: Integer); var fp,tp : Integer; begin fp := FileName2ScanPage(TimageScrollBox(Source).FileName); tp := FileName2ScanPage(TimageScrollBox(Sender).FileName); MoveImage_Drag(DisplayPath+NowDocDir+'\',fp,tp ); end; procedure TCB_IMGPSScanX.ISBDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var So : Boolean; begin {if (TObject(Source) is TImageScrollBox) and (TObject(Sender) is TImageScrollBox) then begin Label3.Caption := TImageScrollBox(Source).FileName+#13+TImageScrollBox(Sender).FileName; end; } So := False; if TObject(Source) is TImageScrollBox then So := True; Accept := True; if not So or (TImageScrollBox(Source).FileName = TImageScrollBox(Sender).FileName) or (TreeView1.Selected.Level <> 2) Then Accept := False; end; Function TCB_IMGPSScanX.FindMpsView(Vmode: Integer):TImageScrollBox; var i,n : Integer; ISB : TImageScrollBox; begin case Vmode of 0 : n := 1; 1 : n := 2; 2 : n := 4; 3 : n := 6; 4 : n := 8; end; for i := 1 to 8 do begin if i > n then Break; ISB := TImageScrollBox(FindComponent('ISB'+inttostr(i))); if (i = n) and (ISB.FileName <> '') then begin clearView(i); Result := ISB1; end Else if ISB.FileName = '' then Result := ISB; end; end; Function TCB_IMGPSScanX.GetCaseFormID(Path:String):String; //取案件的主FormID var i,n : Integer; FileFormID : String; begin Result := ''; ContextList.LoadFromFile(Path+'Context.dat'); for I := 0 to ContextList.Count - 1 do begin FileFormID := FileName2FormCode(ContextList.Strings[i]); if DivPageFormIDList.IndexOf(FileFormID)<>-1 then //20170509 跳過分案頁的formid begin Continue; end; if FindDivFormCode(FileFormID) then begin Result := FileFormID; Break; end; end; end; Procedure TCB_IMGPSScanX.CreateFormID_FormName(Path,CaseID:String); //產生FormID_FormName.dat var i : Integer; S : TStringlist; FormID : String; FormName : String; begin S := TStringlist.Create; try for I := 0 to ContextList.Count - 1 do begin FormID := FileName2FormCode(ContextList.Strings[i]); FormName := FormCode2FormName(CaseID,FormID); S.Add(FormID+'_'+FormName); end; S.SaveToFile(Path + 'FormCode_Name.dat',TEnCoding.UTF8); finally S.Free; end; end; Function TCB_IMGPSScanX.FormIDExists(FormCode:String;CheckDate:Boolean;index:Integer):Boolean; //檢查FormID是否存在 var STDate,SPDate : String; Docno,Version : String; begin Result := False; If FormCode = '' then //附件不檢查 begin Result := True; Exit; end; if CheckDate then //要檢查日期 begin STDate := '00000000'; //沒設定 SPDate := '99999999'; //沒設定 IF FindSQLData(FORM_INF_List,'T1.FORM_ID,T1.DOC_NO','T1.FORM_ID',FormCode,index,FindResult) then begin DocNo := GetFindResult('T1.DOC_NO'); Version := FormCode2Version(FormCode); if FindSQLData(Doc_Inf_List,'START_DATE,STOP_DATE','DOC_NO,DOC_VERSION',DocNo+','+Version,0,FindResult) then begin Result := True; STDate := GetFindResult('START_DATE'); SPDate := GetFindResult('STOP_DATE'); if STDate = '' then STDate := '00000000'; //沒設定 if SPDate = '' then SPDate := '99999999'; //沒設定 if (ServerDate < STDate) or (ServerDate > SPDate) then Result := False; end; end; end Else begin Result := FindSQLData(FORM_INF_List,'T1.FORM_ID','T1.FORM_ID',FormCode,index,FindResult); end; end; procedure TCB_IMGPSScanX.CB1Click(Sender: TObject); begin TwainShowUI := CB1.Checked; end; Function TCB_IMGPSScanX.GetKeyinSet : Boolean; //取登打設定 var SendData : String; LastDateTime : String; S : TStringlist; begin Result := True; S := TStringlist.Create; Try if FileExists(SitePath+'KeyinSet.zip') then DeleteFile(SitePath+'KeyinSet.zip'); LastDateTime := '00000000000000'; if FileExists(SitePath+'LastDateTime.dat') then begin S.LoadFromFile(SitePath+'LastDateTime.dat'); LastDateTime := S.Strings[0]; end; SendData := 'settype=2&lastupdate='+LastDateTime; if not dnFile_Get(HTTPSClient,Furl,'service/imgpsc/IMGPSC01/settings',SendData,SitePath+'KeyinSet.zip',FReWrite,Memo1,False,DownImgStatus) then begin HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason; Result := False; Exit; end; if FileExists(SitePath+'KeyinSet.zip') then //有更新 begin ExecuteUnZip(SitePath+'KeyinSet.zip',SitePath,True); S.Clear; S.Add(ServerDate+GetBalance2Time(Balance)); S.SaveToFile(SitePath+'LastDateTime.dat'); end Else begin if (Memo1.Lines.Strings[0] = 'nodata') Then //沒更新 begin Result := True; end Else if (Memo1.Lines.Strings[0] = '1') Then begin HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1]; Result := False; Exit; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; end; Finally S.Free; End; end; procedure TCB_IMGPSScanX.TransBtnClick(Sender: TObject); Var CaseID : String; i,n,v: Integer; ZipFileList : TStringlist; CaseTrans : Integer; //-1:失敗 0:可 1:不行 SuccessCount,ReCasecount,CheckErrCount : Integer; TransMsg : String; AreaStr : String; S : TStringlist; CheckStr : String; uploadMsg:String;//20171122 新增 配合不同mode下要秀不能上傳訊息 begin IF not InitialOk Then begin Showmessage(_msg('資訊尚未下載完成,請稍候或重新進入')); Exit; end; LogFile1.LogToFile(logTimeString+'按下上傳'); ClearView(1); CaseHelpBtn.Visible := False; DisplayPath := ''; ClearCaseIndex; RejectCase := False; uploadMsg:=''; if not CheckCaseID_OK then //檢查是否有未配號的案件 begin Showmessage(_Msg('尚有「無案件編號」之案件,無法上傳')); Exit; end; if not CheckCaseAttach_OK then //20170911檢查是否有未歸類的案件 begin Showmessage(_Msg('尚有未歸類文件,無法上傳')); Exit; end; if NewTreeNode.Count = 0 then begin Showmessage(_Msg('無影像需傳送')); Exit; end; SuccessCount := 0; ReCasecount := 0; CheckErrCount := 0; if (FMode = 'NSCAN') and (not CheckScanDenialTime) then begin if Messagedlg(Format(_Msg('己超過收件時間(%s),預定作業日為下個營業日,是否繼續上傳??'),[ScanDenialTime]),mtConfirmation,[mbyes,mbcancel],0)=mrcancel then Exit; end; ShowText := _Msg('資料上傳中,請稍候'); DataLoading(True,True); For i := 0 to NewTreeNode.Count -1 do begin v := posend('-',NewTreenode.Item[i].Text); CaseID := Copy(NewTreenode.Item[i].Text,1,v-1); ShowText := CaseID+_Msg('資料上傳中,請稍候'); DataLoading(True,True); CreateIn_WH(CaseID); //產生入庫文件文字檔 In_Wh.dat Case2upload(CaseID); //產生原影像結構 TransPath := ImageSavePath+CaseID+'\Upload\'; {if FMode = 'ESCAN' then //20140320 yuu說拿掉此檢查 begin S := TStringlist.Create; try S.LoadFromFile(TransPath + 'Context.dat'); if S.Count = 0 then begin Showmessage(_Msg('無影像檔無法傳送')); DataLoading(False,False); LoadImgFile; Exit; end; finally s.Free; end; end;} if (FMode = 'NSCAN') or (FMode = 'DSCAN') then //20170406 待掃瞄也要問一下 begin /////訊問是否可上傳///// CaseTrans := CaseAsk(CaseID); //Showmessage('記得改回來'); //CaseTrans := 0; /////訊問是否可上傳//// end Else ///不是新件、重掃件、異動件的不查 begin CaseTrans := 0; end; if CaseTrans = -1 then //失敗 begin Showmessage(_Msg('')+HttpErrStr+'.'); DataLoading(False,False); LoadImgFile; Exit; end; if CaseTrans = 1 then begin ////重複處理///// Inc(ReCasecount); ////重複處理///// Continue; end Else if CaseTrans = 0 then //可以傳送 begin ///////檢核////// 20100927 User改為搬至外面做 ///20101019 User又改回上傳要做 //if FMode = 'NSCAN' then //20101019改成讀設定那些模式要做那些檢核 //begin ///依十字定位點縮放//// CaseReSize(CaseID); //所以影像再做一次縮放 ////依十字定位點縮放/////// } if (FMode <> 'FSCAN') then begin if (NewTreenode.Item[i].ImageIndex <> 7) and (NewTreenode.Item[i].ImageIndex <> 5) then //檢核完成的不再檢核 begin ShowText := CaseID+_Msg('檢核中,請稍候'); DataLoading(True,True); If not OMRCheckCase(CaseID) then //進檢核 begin Inc(CheckErrCount); Continue; end; end; if (NewTreenode.Item[i].ImageIndex = 5) then begin Inc(CheckErrCount); Continue; end; end; //end; ///////檢核////// ShowText := CaseID+_Msg('資料上傳中,請稍候'); DataLoading(True,True); //ShowMessage('退出');DataLoading(False,False);Exit; If Not TransCaseID(TransPath,CaseID,True) Then //傳送案件 begin DataLoading(False,False); LoadImgFile; Exit; end; Inc(SuccessCount); end; end; DataLoading(False,False); TransMsg := Format(_Msg('成功件【%d】件'),[SuccessCount]); if ReCasecount > 0 then TransMsg := TransMsg + #13#10 + Format(_Msg('無法上傳件【%d】件'),[ReCasecount]); if CheckErrCount > 0 then begin TransMsg := TransMsg + #13#10 + Format(_Msg('檢核失敗件【%d】件,請先點選「案件編號」,再點選「問號」查看錯誤原因'),[CheckErrCount]); LogFile1.LogToFile(logTimeString+'檢核失敗原因:'+OMRErrini2ListForLog('')); end; if (FMode = 'DSCAN') and (SuccessCount = 1) then begin uploadMsg:=NowCaseNo+_Msg('影像上傳完成。此案已進入下一流程'); end; if (FMode='ESCAN') and (FModeName=_Msg('補件掃描')) and (SuccessCount = 1) then begin uploadMsg:=NowCaseNo+_Msg('影像已補件完成'); end; //ShowMessage('uploadMsg='+uploadMsg); if uploadMsg<>'' then begin ShowMessage(uploadMsg); end else begin Showmessage(_Msg('傳送完成')+#13#10+TransMsg); end; LoadImgFile; if (FMode = 'ESCAN') and (SuccessCount = 1) then begin if FEvents <> nil Then begin FEvents.OnClosePage; end; end; if (FMode = 'DSCAN') and (SuccessCount = 1) then begin if FEvents <> nil Then begin FEvents.OnClosePage; end; end; end; procedure TCB_IMGPSScanX.TreeView1Click(Sender: TObject); Var v,v1,v2,v3,ln : Integer; i,page : Integer; F : TSearchrec; begin ScanMode := smNew; IF TreeView1.Selected = nil Then Exit; Scrollbar1.Position := 1; Scrollbar1.Max := 1; DisplayPath := ''; NowCaseno := ''; NowDocDir := ''; NowDocNo := ''; NowFormCode := ''; NowFormName := ''; NowPage := 0; NowShowFileList.Clear; StatusBar1.Panels[2].Text := ''; ClearCaseIndex; PageLv.Items.Clear; //頁數清單 //Panel18.Enabled:= False; AttListBox.Items.Clear; AddAttFileLB.Enabled := False; DelAttFileLB.Enabled := False; UseOldCaseLb.Visible := False; PM107.Visible := False; //備註功能 CaseHelpBtn.Visible := False; //檢核失敗原因鈕 Panel5.Visible := True; ContextList.Clear; SortMode := false; ISB1.ZoomMode := zmFullPage; IF TreeView1.Selected.Parent <> nil Then begin if TreeView1.Selected.Parent = NewTreenode then //點在案件上 begin //Panel18.Enabled := True; PM107.Visible := True; //備註功能 MyTreeNode1 := TreeView1.Selected; MyTreeNode2 := nil; MyTreeNode3 := nil; v := Posend('-',MyTreenode1.Text); v1 := Length(MyTreenode1.Text); NowCaseNo := Copy(TreeView1.Selected.Text,1,v-1); if (FMode = 'ESCAN') and (FOldCaseInfo <> '') then UseOldCaseLb.Visible := True; ClearView(1); DisplayPath := ImageSavePath+NowCaseNo+'\'; if FLoanDoc_Enable = 'Y' then begin AddCredit1RG.Enabled := True; end; ReadCaseIndex(DisplayPath); If FileExists(DisplayPath+'\upload\Checkerr.ini') and (not FileExists(DisplayPath+'\upload\OMRCheckOk.dat')) Then CaseHelpBtn.Visible := True; IF FileExists(DisplayPath+'CaseDocNo.dat') Then begin CaseDocNoList.LoadFromFile(DisplayPath+'CaseDocNo.dat'); view_image_DocNo(DisplayPath,'ShowAll','',1); end; if FileExists(DisplayPath+'CustomDocNo.dat') then Cust_DocNoList.LoadFromFile(DisplayPath+'CustomDocNo.dat'); Page := ContextList.Count; For i := 1 to page do begin With PageLV.Items.Add do begin Caption := Add_Zoo(i,3); end; end; If Page > 0 then ScrollBar1.Max := page; MyTreeNode1.Expand(True); end Else If TreeView1.Selected.Parent.Parent = NewTreenode Then //點在文件上 begin MyTreeNode1 := TreeView1.Selected.Parent; MyTreeNode2 := TreeView1.Selected; MyTreeNode3 := nil; v := Pos('-',MyTreenode1.Text); NowCaseNo := Copy(MyTreenode1.Text,1,v-1); v := Posend('{',MyTreenode2.Text); v1 := Posend('}',MyTreenode2.Text); v2 := posend('-',MyTreenode2.Text); ln := length(MyTreenode2.Text); NowDocDir := Copy(MyTreeNode2.Text,v+1,v1-v-1); NowDocNo := DocNoDir2DocNo(NowDocDir); page :=Strtoint(Copy(MyTreeNode2.Text,v2+1,ln-v2-1)); if (FMode = 'ESCAN') and (FOldCaseInfo <> '') then UseOldCaseLb.Visible := True; ClearView(1); DisplayPath := ImageSavePath+NowCaseNo+'\'; if GetUseCase('F',DisplayPath,NowDocDir) <> '' then StatusBar1.Panels[2].Text := Format(_Msg('從%s引用'),[GetUseCase('F',DisplayPath,NowDocDir)]); if GetUseCase('T',DisplayPath,NowDocDir) <> '' then StatusBar1.Panels[2].Text := Format(_Msg('被%s引用'),[GetUseCase('T',DisplayPath,NowDocDir)]); if FLoanDoc_Enable = 'Y' then begin AddCredit1RG.Enabled := True; end; ReadCaseIndex(DisplayPath); If FileExists(DisplayPath+'Checkerr.ini') and (not FileExists(DisplayPath+'OMRCheckOk.dat')) Then CaseHelpBtn.Visible := True; If Page > 0 then ScrollBar1.Max := page; For i := 1 to page do begin With PageLV.Items.Add do begin Caption := Add_Zoo(i,3); end; end; If FileExists(DisplayPath+'Checkerr.ini') and (not FileExists(DisplayPath+'OMRCheckOk.dat')) Then CaseHelpBtn.Visible := True; IF FileExists(DisplayPath+NowDocDir+'\Context.dat') Then begin ContextList.LoadFromFile(DisplayPath+NowDocDir+'\Context.dat'); //Context_DocnoList.LoadFromFile(DisplayPath+'Context_Docno.dat'); view_image_DocNo(DisplayPath,NowDocDir,'',Page); end; if FileExists(DisplayPath+'CustomDocNo.dat') then Cust_DocNoList.LoadFromFile(DisplayPath+'CustomDocNo.dat'); MyTreeNode1.Expand(True); end Else If (NewTreenode <> nil) and (TreeView1.Selected.Parent.Parent.Parent = NewTreenode) Then //點在表單上 begin //NoteBtn.Visible := True; //備註功能 //Panel18.Enabled := True; ClearView(1); PM107.Visible := True; //備註功能 MyTreeNode1 := TreeView1.Selected.Parent.Parent; MyTreeNode2 := TreeView1.Selected.Parent; MyTreeNode3 := TreeView1.Selected; v := Posend('-',MyTreenode1.Text); NowCaseNo := Copy(MyTreenode1.Text,1,v-1); if (FMode = 'ESCAN') and (FOldCaseInfo <> '') then UseOldCaseLb.Visible := True; v := Posend('{',MyTreenode2.Text); v1 := Posend('}',MyTreenode2.Text); v2 := posend('-',MyTreenode2.Text); ln := length(MyTreenode2.Text); NowDocDir := Copy(MyTreeNode2.Text,v+1,v1-v-1); NowDocNo := DocNoDir2DocNo(NowDocDir); v := Posend('{',MyTreenode3.Text); v1 := Posend('}',MyTreeNode3.Text); v2 := Posend('-',MyTreeNode3.Text); ln := Length(MyTreeNode3.Text); if v>0 then begin NowFormCode := Copy(MyTreeNode3.Text,v+1,v1-v-1); if (NowFormCode = 'Attach') or (NowFormCode = 'S_Attach') then NowFormCode := ''; NowFormName := Copy(MyTreeNode3.Text,v+1,v1-v-1); page := strtoint(Copy(MyTreeNode3.Text,v2+1,ln-v2-1)); end Else //點在附件的頁數 begin NowFormCode := ''; page := 1; end; DisplayPath := ImageSavePath+NowCaseNo+'\'; if GetUseCase('F',DisplayPath,NowDocDir) <> '' then StatusBar1.Panels[2].Text := Format(_Msg('從%s引用'),[GetUseCase('F',DisplayPath,NowDocDir)]); if GetUseCase('T',DisplayPath,NowDocDir) <> '' then StatusBar1.Panels[2].Text := Format(_Msg('被%s引用'),[GetUseCase('T',DisplayPath,NowDocDir)]); if FLoanDoc_Enable = 'Y' then begin AddCredit1RG.Enabled := True; end; ReadCaseIndex(DisplayPath); If FileExists(DisplayPath+'Checkerr.ini') and (not FileExists(DisplayPath+'OMRCheckOk.dat')) Then CaseHelpBtn.Visible := True; If Page > 0 then ScrollBar1.Max := page; For i := 1 to page do begin With PageLV.Items.Add do begin Caption := Add_Zoo(i,3); end; end; If FileExists(DisplayPath+NowDocDir+'\Context.dat') Then begin ContextList.LoadFromFile(DisplayPath+NowDocDir+'\Context.dat'); view_image_DocNo(DisplayPath,NowDocDir,NowFormCode,Page); //view_image_FormCode(DisplayPath,NowFormCode,1,1); end; if FileExists(DisplayPath+'CustomDocNo.dat') then Cust_DocNoList.LoadFromFile(DisplayPath+'CustomDocNo.dat'); end; MyTreeNode1.Expand(True); AddAttFileLB.Enabled := True; if FileExists(DisplayPath+'ATTContext.dat') then begin LoadAttFile(NowCaseno); end; end Else //點在NewTreenode or MyTreenode1 上 begin ClearView(1); MyTreeNode1 := nil; MyTreeNode2 := nil; MyTreeNode3 := nil; end; TreeView1.Selected.MakeVisible; CaseList.Clear; if FileExists(ImageSavePath + 'CaseList.dat') then CaseList.LoadFromFile(ImageSavePath + 'CaseList.dat'); //CountCaseno; //CountCaseCount; Application.ProcessMessages; end; procedure TCB_IMGPSScanX.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer); var NewCaseno,NewDocNo,NewDocDir,NewFormCode,NewFormName : String; NewPath,NewFileName:String; OldFileName : String; iTreeNode1,iTreeNode2,iTreeNode3: TTreeNode; i,v,v1,v2 : Integer; PreIndex,Precount,NowCount:Integer; GoAtt : Boolean; AttLv : Integer; begin NewCaseno := ''; NewFormCode := ''; NewFormName := ''; Precount := MyTreeNode1.Count; PreIndex := -1; GoAtt := False; if (MytreeNode2 <> nil) and (Pos('Attach',MyTreeNode2.Text)>0) then begin AttLv := TreeView1.Selected.Level; GoAtt := True; end; if TTreeView(Sender).GetNodeAt(X,Y).Level =2 then begin iTreeNode2 := TTreeView(Sender).GetNodeAt(X,Y); iTreeNode1 := iTreeNode2.Parent; v := Pos('-',iTreenode1.Text); v1 := Length(iTreenode1.Text); NewCaseNo := Copy(iTreeNode1.Text,1,v-1); v := Posend('{',iTreeNode2.Text); v1 := Posend('}',iTreeNode2.Text); NewDocNo := Copy(iTreeNode2.Text,v+1,v1-v-1); NewPath := ImagePath+NewCaseNo+'\'; OldFileName := ExtractFileName(DisplayISB.FileName); if Copy(NewDocNo,1,5) = 'ZZZZZ' then //自訂文件 begin NewFileName := Add_Zoo(FileName2ScanPage(OldFileName),3)+'_'+NewDocNo+'0000000'+ExtractFileExt(OldFileName); NewFormCode := NewDocNo+'0000000'; {ReNameFile(DisplayISB.FileName,NewPath+NewFileName); ReNameContext(DisplayPath,OldFileName,NewFileName); MyTreeNode2ReFresh(NowCaseno); TreeView1Click(nil);} end; //NewFileName := Add_Zoo(GetCasePage(ImagePath,NewCaseno)+1,3)+FileName2NoQuene_Filename(OldFileName); end Else if TTreeView(Sender).GetNodeAt(X,Y).Level =3 then begin OldFileName := ExtractFileName(DisplayISB.FileName); iTreeNode1 := TTreeView(Sender).GetNodeAt(X,Y).Parent.Parent; iTreeNode2 := TTreeView(Sender).GetNodeAt(X,Y).Parent; iTreeNode3 := TTreeView(Sender).GetNodeAt(X,Y); v := Pos('-',iTreenode1.Text); v1 := Length(iTreenode1.Text); NewCaseNo := Copy(iTreeNode1.Text,1,v-1); v := Pos('{',iTreeNode2.Text); v1 := Pos('}',iTreeNode2.Text); NewDocDir := Copy(iTreeNode2.Text,v+1,v1-v-1); v := Pos('{',iTreeNode3.Text); v1 := Pos('}',iTreeNode3.Text); NewFormName := Copy(iTreeNode3.Text,1,v-1); NewFormCode := Copy(iTreeNode3.Text,v+1,v1-v-1); IF v = 0 Then begin NewFormCode := ''; v := Posend('-',iTreeNode3.Text); NewFormName := Copy(iTreeNode3.Text,1,v1-1); end; NewPath := ImagePath+NewCaseNo+'\'+NewDocDir+'\'; if NewPath = DisplayPath Then //同案件 begin if NewFormCode <> '' then //NewFileName := Copy(OldFileName,1,3)+'_'+NewFormCode+ExtractFileExt(OldFileName) NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir),3)+'_'+NewFormCode+ExtractFileExt(OldFileName) Else //NewFileName := Copy(OldFileName,1,3)+ExtractFileExt(OldFileName) NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir),3)+ExtractFileExt(OldFileName); end else //不同案件 begin if NewFormCode <> '' then //NewFileName := Copy(OldFileName,1,3)+'_'+NewFormCode+ExtractFileExt(OldFileName) NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir),3)+'_'+NewFormCode+ExtractFileExt(OldFileName) Else //NewFileName := Copy(OldFileName,1,3)+ExtractFileExt(OldFileName) NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir),3)+ExtractFileExt(OldFileName); end; end; //Showmessage('a'); for I := 0 to NowSelectFileList.Count - 1 do begin OldFileName := NowSelectFileList.Strings[i]; if NewFormCode <> '' then //NewFileName := Copy(OldFileName,1,3)+'_'+NewFormCode+ExtractFileExt(OldFileName) NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir)+1,3)+'_'+NewFormCode+ExtractFileExt(OldFileName) Else //NewFileName := Copy(OldFileName,1,3)+ExtractFileExt(OldFileName) NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir)+1,3)+ExtractFileExt(OldFileName); if NewCaseNo = NowCaseNo then //同案件不改順序 begin CopyFile(PWideChar(OldFileName),PwideChar(NewPath+NewFileName),False); SetContextList('A',-1,NewCaseNo,NewDocDir,NewFileName); DeleteImageFile(ExtractFilePath(OldFileName),ExtractFileName(OldFileName),NowCaseNo); TreeView1.Selected := MyTreeNode1; //ReNameFile(DisplayPath + OldFileName,NewPath+NewFileName); //ReNameContext(DisplayPath,OldFileName,NewFileName); //MyTreeNode2ReFresh(NowCaseno); //TreeView1Click(nil); end Else begin //Showmessage(DisplayMpsView.FileName+#13+NewPath+NewFileName); ContextList.LoadFromFile(DisplayPath+'Context.dat'); if (ContextList.Count = 1) and ((FMode = 'NSCAN') or (FMode = 'ASCAN') or (FMode = 'DSCAN') or (FMode = 'SSCAN') or (FMode = 'MSCAN') or (FMode = 'RI_SCAN') or (FMode = 'ISCAN')) then begin if Messagedlg(Format(_Msg('移動後(%s)案件無影像,將刪除此案件,是否確定移動?'),[NowCaseno]),mtconfirmation,[mbyes,mbcancel],0) = mrCancel then Exit; end; CopyFile(PWideChar(DisplayISB.FileName),PWideChar(NewPath+NewFileName),False); ContextList.LoadFromFile(NewPath+'Context.dat'); ContextList.Add(NewFileName); ContextList.SaveToFile(NewPath+'Context.dat'); //Showmessage('1'); iTreeNode2.Text := Format(_Msg('%s-%d頁'),[NewCaseNo,GetCasePage(ImagePath,NewCaseNo)]); //Showmessage('2'); //DrawDocItem(iTreeNode1,FORM_INF_List,NewCaseNo); //DrawDocItem1(MytreeNode1,Doc_Inf_List,NewCaseno); 20140820改 DrawDocItem2(MytreeNode1,NewCaseno); //Showmessage('3'); ClearErrini(NewCaseNo,iTreeNode1); ContextList.LoadFromFile(DisplayPath+'Context.dat'); if (ContextList.Count = 1) and ((FMode = 'NSCAN') or (FMode = 'ASCAN') or (FMode = 'DSCAN') or (FMode = 'SSCAN') or (FMode = 'MSCAN') or (FMode = 'RI_SCAN') or (FMode = 'ISCAN')) then begin _DelTree(DisplayPath); SetCaseList('D',MyTreeNode1.IndexOf(MyTreeNode2),''); LoadImgFile; end Else begin ContextList.Delete(ContextList.IndexOf(ExtractFileName(DisplayISB.FileName))); ContextList.SaveToFile(DisplayPath+'Context.dat'); DeleteFile(DisplayISB.FileName); ReSortFileName(DisplayPath); ClearErrini(NowCaseNo,MyTreeNode1); MyTreeNode2ReFresh(NowCaseno); //MyTreeNode3ReFresh(NowCaseno); ContextList.LoadFromFile(DisplayPath+'Context.dat'); NowCount := MyTreeNode1.Count; if PreCount = NowCount then begin TreeView1.Selected := MyTreeNode1.Item[PreIndex]; TreeView1Click(nil); end Else begin TreeView1.Selected := MyTreeNode1; TreeView1Click(nil); end; end; end; end; for I := 0 to NowSelectFileList.Count - 1 do begin OldFileName := NowSelectFileList.Strings[i]; ReSortFileName(ExtractFilePath(OldFileName)); end; DrawDocItem2(MytreeNode1,NowCaseno); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 if GoAtt then begin GotoAttach(AttLv); end; //TreeView1Click(nil); end; procedure TCB_IMGPSScanX.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var NewNode : TTreeNode; ImgFormCode : String; ImgDocNo : String; So : Boolean; begin ImgFormCode := FileName2FormCode(ExtractFileName(DisplayISB.FileName)); ImgDocNo := Path2DocDir(ExtractFilePath(DisplayISB.FileName),NowCaseno); //ImgDocNo := FileName2NowDcoNo(ExtractFileName(DisplayISB.FileName),ContextList,Context_DocnoList); NewNode := TTreeView(Sender).GetNodeAt(X,Y); //Label3.Caption := format('%d/%s/%s',[NewNode.Level,ImgDocNo,Node2DocNo(NewNode)]); So := False; if TObject(Source) is TImageScrollBox then So := True; Accept := True; if not So or(NewNode=nil) or((NewNode.Level<>3)) or((NewNode.Level =3) and (((ImgFormCode=Node3FormID(NewNode)) and (ImgDocNo = Node3DocNo(NewNode))) or (Node3DocNo(NewNode)=''))) or(Pos(_Msg('Attach'),Newnode.Text)>0) Then Accept := False; {if not So or(NewNode=nil) or((NewNode.Level <>2) and (NewNode.Level<>3)) or((NewNode.Level =2) and ((ImgDocNo = Node2DocNo(NewNode))or(Node2DocNo(NewNode)='')or (copy(Node2DocNo(NewNode),1,5)<>'ZZZZZ'))) or((NewNode.Level =3) and ((ImgFormCode=Node3FormID(NewNode)) or (ImgDocNo = Node3DocNo(NewNode)) or (Node3DocNo(NewNode)=''))) or(Pos(_Msg('未註冊文件'),Newnode.Text)>0) Then Accept := False;} end; procedure TCB_IMGPSScanX.TreeView1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin IF TreeView1.Selected.Parent <> nil Then begin TreeView1Click(nil); end else begin ClearView(1); end; end; procedure TCB_IMGPSScanX.TreeView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF Button = TMouseButton(MbRight) Then begin MDown := True; If TreeView1.GetNodeAt(X,Y) = nil then Exit; TreeView1.Selected := TreeView1.GetNodeAt(X,Y); end; end; procedure TCB_IMGPSScanX.TreeView1MouseEnter(Sender: TObject); begin TreeView1.SetFocus; end; procedure TCB_IMGPSScanX.TreeView1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin //TreeView1.SetFocus; {UnRegisterHotKey(Handle, HotKeyId1); UnRegisterHotKey(Handle, HotKeyId2); } end; procedure TCB_IMGPSScanX.TreeView1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin IF Button = TMouseButton(MbRight) Then begin If TreeView1.GetNodeAt(X,Y) = nil then Exit; if MDown then begin TreeView1Click(self); TreeView1.PopupMenu.Popup(Mouse.CursorPos.X ,Mouse.CursorPos.Y); end; Application.ProcessMessages; //需加這行,不然有些全域變數會沒變到 MDown:= False; end; end; procedure TCB_IMGPSScanX.ViewModeBtnMouseEnter(Sender: TObject); begin AddToolTip(TBitBtn(Sender).Parent.Handle,nil,0,Pchar(TBitBtn(Sender).Hint),nil,0,0); end; function TCB_IMGPSScanX.Get_check_main_form: WideString; begin end; procedure TCB_IMGPSScanX.Set_check_main_form(const Value: WideString); begin FCheck_main_form := Value; end;