function TCB_IMGPSScanX.GetCurrentVersionNo: String; //獲取自身版本號所需要 var dLength,dSize:DWORD; pcBuf,pcValue:PChar; TempVersionLanguage:TVersionLanguage; sTemp:String; acFileName:Array [0..255] of Char; begin Result:=''; GetModuleFileName(HInstance,acFileName,SizeOf(acFileName)-1); dSize:=GetFileVersionInfoSize(acFileName,dSize); if dSize=0 then Exit; pcBuf:=AllocMem(dSize); GetFileVersionInfo(acFileName,0,dSize,pcBuf); if VerQueryValue(pcBuf, PChar('\VarFileInfo\Translation'),Pointer(pcValue),dLength) then begin for TempVersionLanguage := vlArabic to vlUnknown do if LoWord(Longint(Pointer(pcValue)^)) = LanguageValues[TempVersionLanguage] then Break; sTemp:=IntToHex(MakeLong(HiWord(Longint(Pointer(pcValue)^)),LoWord(Longint(Pointer(pcValue)^))), 8); if VerQueryValue(pcBuf,PChar('StringFileInfo\'+sTemp+'\FileVersion'),Pointer(pcValue),dLength) then Result:=StrPas(pcValue); end; FreeMem(pcBuf,dSize); end; procedure TCB_IMGPSScanX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); begin { Define property pages here. Property pages are defined by calling DefinePropertyPage with the class id of the page. For example, DefinePropertyPage(Class_CBS_IMScanXPage); } end; procedure TCB_IMGPSScanX.InitExistImgList(casepath: String); var ST1,ST2,ST3,ST4:TStringList; i,j,k:Integer; begin ST1:=TStringList.Create; ST2:=TStringList.Create; ST3:=TStringList.Create; ExistImgList.Clear; ST1.LoadFromFile(casepath+'Download\Context.dat'); for I := 0 to ST1.Count - 1 do begin LogFile1.LogToFile(logTimeString+casepath+'Download\'+ST1.Strings[i]+',MD5='+LoadFileGetMD5(casepath+'Download\'+ST1.Strings[i])); ExistImgList.Add(LoadFileGetMD5(casepath+'Download\'+ST1.Strings[i])) ; end; LogFile1.LogToFile(logTimeString+'ExistImgList.text'+ExistImgList.CommaText); ST1.Free; ST2.Free; ST3.Free; end; procedure TCB_IMGPSScanX.Initialize; begin inherited Initialize; OnActivate := ActivateEvent; OnClick := ClickEvent; OnCreate := CreateEvent; OnDblClick := DblClickEvent; OnDeactivate := DeactivateEvent; OnDestroy := DestroyEvent; OnKeyPress := KeyPressEvent; OnMouseEnter := MouseEnterEvent; OnMouseLeave := MouseLeaveEvent; OnPaint := PaintEvent; MpsKey := 'fbim'; Seg := 3; //瀏覽窗的邊界 Ext := '.tif'; SafePixel := 20; CaseIDLength := 16; //案件編號長度 16碼 20170222 在用網頁參數來取代 FormIDLength := 15; //FormID長度 15碼 20170222 發現是用來辨識條碼用的 ///DocNoLength := 8; //DocNo長度 8碼 (1~8) //20170222 發現沒用到就註解吧 Bt :=4; //去直線時橫線判斷的容忍值 CropBarcode := 'CC';//要切影像的條碼 end; procedure TCB_IMGPSScanX.ISB1Enter(Sender: TObject); begin ISB1.SetFocus; end; function TCB_IMGPSScanX.Get_Active: WordBool; begin Result := Active; end; function TCB_IMGPSScanX.Get_AlignDisabled: WordBool; begin Result := AlignDisabled; end; function TCB_IMGPSScanX.Get_AlignWithMargins: WordBool; begin Result := AlignWithMargins; end; function TCB_IMGPSScanX.Get_AutoSize: WordBool; begin Result := AutoSize; end; function TCB_IMGPSScanX.Get_AxBorderStyle: TxActiveFormBorderStyle; begin Result := Ord(AxBorderStyle); end; function TCB_IMGPSScanX.Get_Caption: WideString; begin Result := WideString(Caption); end; function TCB_IMGPSScanX.Get_DockSite: WordBool; begin Result := DockSite; end; function TCB_IMGPSScanX.Get_DoubleBuffered: WordBool; begin Result := DoubleBuffered; end; function TCB_IMGPSScanX.Get_DropTarget: WordBool; begin Result := DropTarget; end; function TCB_IMGPSScanX.Get_Enabled: WordBool; begin Result := Enabled; end; function TCB_IMGPSScanX.Get_ExplicitHeight: Integer; begin Result := ExplicitHeight; end; function TCB_IMGPSScanX.Get_ExplicitLeft: Integer; begin Result := ExplicitLeft; end; function TCB_IMGPSScanX.Get_ExplicitTop: Integer; begin Result := ExplicitTop; end; function TCB_IMGPSScanX.Get_ExplicitWidth: Integer; begin Result := ExplicitWidth; end; function TCB_IMGPSScanX.Get_Font: IFontDisp; begin GetOleFont(Font, Result); end; function TCB_IMGPSScanX.Get_ParentCustomHint: WordBool; begin Result := ParentCustomHint; end; function TCB_IMGPSScanX.Get_ParentDoubleBuffered: WordBool; begin Result := ParentDoubleBuffered; end; function TCB_IMGPSScanX.Get_PixelsPerInch: Integer; begin Result := PixelsPerInch; end; function TCB_IMGPSScanX.Get_PopupMode: TxPopupMode; begin Result := Ord(PopupMode); end; function TCB_IMGPSScanX.Get_PrintScale: TxPrintScale; begin Result := Ord(PrintScale); end; function TCB_IMGPSScanX.Get_Scaled: WordBool; begin Result := Scaled; end; function TCB_IMGPSScanX.Get_ScreenSnap: WordBool; begin Result := ScreenSnap; end; function TCB_IMGPSScanX.Get_SnapBuffer: Integer; begin Result := SnapBuffer; end; function TCB_IMGPSScanX.Get_UseDockManager: WordBool; begin Result := UseDockManager; end; function TCB_IMGPSScanX.Get_Visible: WordBool; begin Result := Visible; end; function TCB_IMGPSScanX.Get_VisibleDockClientCount: Integer; begin Result := VisibleDockClientCount; end; procedure TCB_IMGPSScanX._Set_Font(var Value: IFontDisp); begin SetOleFont(Font, Value); end; procedure TCB_IMGPSScanX.Set_AlignWithMargins(Value: WordBool); begin AlignWithMargins := Value; end; procedure TCB_IMGPSScanX.Set_AutoSize(Value: WordBool); begin AutoSize := Value; end; procedure TCB_IMGPSScanX.Set_AxBorderStyle(Value: TxActiveFormBorderStyle); begin AxBorderStyle := TActiveFormBorderStyle(Value); end; procedure TCB_IMGPSScanX.Set_Caption(const Value: WideString); begin Caption := TCaption(Value); end; procedure TCB_IMGPSScanX.Set_DockSite(Value: WordBool); begin DockSite := Value; end; procedure TCB_IMGPSScanX.Set_DoubleBuffered(Value: WordBool); begin DoubleBuffered := Value; end; procedure TCB_IMGPSScanX.Set_DropTarget(Value: WordBool); begin DropTarget := Value; end; procedure TCB_IMGPSScanX.Set_Enabled(Value: WordBool); begin Enabled := Value; end; procedure TCB_IMGPSScanX.Set_Font(const Value: IFontDisp); begin SetOleFont(Font, Value); end; procedure TCB_IMGPSScanX.Set_ParentCustomHint(Value: WordBool); begin ParentCustomHint := Value; end; procedure TCB_IMGPSScanX.Set_ParentDoubleBuffered(Value: WordBool); begin ParentDoubleBuffered := Value; end; procedure TCB_IMGPSScanX.Set_PixelsPerInch(Value: Integer); begin PixelsPerInch := Value; end; procedure TCB_IMGPSScanX.Set_PopupMode(Value: TxPopupMode); begin PopupMode := TPopupMode(Value); end; procedure TCB_IMGPSScanX.Set_PrintScale(Value: TxPrintScale); begin PrintScale := TPrintScale(Value); end; procedure TCB_IMGPSScanX.Set_Scaled(Value: WordBool); begin Scaled := Value; end; procedure TCB_IMGPSScanX.Set_ScreenSnap(Value: WordBool); begin ScreenSnap := Value; end; procedure TCB_IMGPSScanX.Set_SnapBuffer(Value: Integer); begin SnapBuffer := Value; end; procedure TCB_IMGPSScanX.Set_UseDockManager(Value: WordBool); begin UseDockManager := Value; end; procedure TCB_IMGPSScanX.Set_Visible(Value: WordBool); begin Visible := Value; end; procedure TCB_IMGPSScanX.PageDone; Var ISB,NowISB : TImageScrollBox; begin inc(Scaninfo.ImageCount); case ScanMode of smNew: begin if ScanImgShowMode = 0 then //清楚顯示 begin ISB := FindISB2View(VMode); ISB.AntiAliased := True; ISB.ZoomMode := zmFittopage; ISB.LoadFromFile(PEFileName,1); end Else if ScanImgShowMode = 1 then //模糊顯示 begin ISB := FindISB2View(VMode); ISB.AntiAliased := False; ISB.ZoomMode := zmFittopage; ISB.LoadFromFile(PEFileName,1); end Else if ScanImgShowMode = 1 then //不顯示 begin end end; smReplace: begin DisplayISB.LoadFromFile(PEFileName,1); end; smInsert: begin ISB := FindISB2View(VMode); ISB.ZoomMode := zmFittopage; ISB.LoadFromFile(PEFileName,1); end; smSample: begin ISB := FindISB2View(VMode); ISB.ZoomMode := zmFittopage; ISB.LoadFromFile(PEFileName,1); end; smRTS: begin end; end; end; procedure TCB_IMGPSScanX.PageEnd; Var i,n : Integer; SampleFormID : String; DocNo,FormID,FormVersion : String; BarStr : String; begin case ScanMode of smNew: begin ScanSaveFilename := ''; DocNo:=''; FormID:=''; FormVersion:=''; PEFileName := ''; //if not FindNoSaveBarCode then //沒有不儲存影像的條碼 //begin if FormID = '' then begin FormID := BarCode2FormID; //取出FormID end; if (FormID <> '') and ISDivPageFormID(FormID) then begin NowDivPageFormID := FormID; end; if (FormID <> '') and ISGuideFormID(FormID) then begin NowGuideFormID := FormID; end; //ShowMessage('NowGuideFormID='+NowGuideFormID); if (not (FindDivFormCode(FormID))) and (NowGuideFormID <> '') {and (FormID = '')} then FormID := NowGuideFormID; DocNo := FormCode2DocNo(FormID); //ShowMessage('FormID='+FormID); //ShowMessage('ISDivPageFormID(FormID)='+BoolToStr(ISDivPageFormID(FormID),true)); //ShowMessage('FindDivFormCode(FormID)='+BoolToStr(FindDivFormCode(FormID),true)); //ShowMessage('A NowDivPageFormID='+NowDivPageFormID+#10#13+'FormID='+FormID+#10#13+'ScanCaseno='+ScanCaseno); if (FormID <>'') and FindDivFormCode(FormID) and (NowDivPageFormID <> '') Then //只找分案頁上的案件條碼 begin ScanInfo.ImageCount := 0; ClearView(1); ContextList.Clear; Context_DocnoList.Clear; ClearCaseIndex; //清掉案件索引 ScanCaseno := BarCode2CaseID; //取出案件編號 NowGuideFormID := ''; NowDivPageFormID :=''; //ShowMessage('B NowGuideFormID='+NowGuideFormID+#10#13+'FormID='+FormID+#10#13+'ScanCaseno='+ScanCaseno); end; if ScanCaseno = '' then //一開始都沒找到 begin ScanCaseno := GetNoNameCase(ImageSavePath); end; ImageSavePath := ImagePath; if (ScanInfo.ImageCount = 0) then begin if DirectoryExists(ImageSavePath + ScanCaseno+'\') then begin _DelTree(ImageSavePath + ScanCaseno+'\'); SetCaseList('D',-1,ScanCaseno); end; end; ScanPath := ImageSavePath+ScanCaseno+'\'; Str2Dir(ScanPath); ScanDocDir := FindLastestDocDir(ScanCaseno,DocNo); //ShowMessage('AA ScanDocDir='+ScanDocDir); //ShowMessage('BB ScanDocDir='+ScanDocDir); if DocNoNeedDiv(DocNo)then //要分份數 begin //Showmessage(DocNo+#13+FormCode2Page(FormID)+#13+inttostr(GetDocDir_Page(ScanCaseno,ScanDocDir))+#13+ScanDocDir); if ((FormCode2Page(FormID) = '01') and (GetDocDir_Page(ScanCaseno,ScanDocDir)>0)) or (ScanDocDir = '') then begin //ScanInfo.ImageCount := 0; ScanDocDir := DocNo2DocNoDir(ImageSavePath + ScanCaseno+'\',DocNo); end; end Else //不分份數 begin if DocNo <> '' then ScanDocDir := DocNo else //Attach 附件 ScanDocDir := DocNo2DocNoDir(ImageSavePath + ScanCaseno+'\',DocNo); end; //ScanDocDir := GetDocNoDir(ImageSavePath+ScanCaseno+'\',DocNo); if FirstDocDir = '' then FirstDocDir := ScanDocDir; ScanPath := ImageSavePath+ScanCaseno+'\'+ScanDocdir+'\'; //Showmessage(ScanPath); if (not DirectoryExists(ScanPath)) and (ScanDocdir <> AttName) then begin //Showmessage('ADD:'+ScanCaseno+','+ScanDocdir); SetDocNoList('A',-1,ScanCaseno,ScanDocdir,'1'); end; Str2Dir(ScanPath); ScanSaveFilename := FormID; Str2Dir(ScanPath); if ScanSaveFilename = '' then //附件 ScanSaveFilename:= Add_Zoo(GetDocDir_Page(ScanCaseNo,ScanDocDir)+1,3)+ext //ScanSaveFilename:= Add_Zoo(ScanInfo.ImageCount+1,3)+ext Else ScanSaveFilename := Add_Zoo(GetDocDir_Page(ScanCaseNo,ScanDocDir)+1,3)+'_'+ScanSaveFilename+ext; if not FindNoSaveBarCode then //沒有不儲存影像的條碼 begin if ScanInfo.ImageCount = 0 then begin SetCaseList('A',-1,ScanCaseno); WriteCaseIndex(ImageSavePath + ScanCaseno+'\'); //寫入案件索引 MyTreeNode1 := TreeView1.Items.AddChild(NewTreenode,ScanCaseno); MyTreenode1.ImageIndex := 2; MyTreenode1.SelectedIndex := 2; Application.ProcessMessages; end; SetContextList('A',-1,ScanCaseno,ScanDocDir,ScanSaveFilename); //ContextList.Add(ScanSaveFilename); //ContextList.SaveToFile(ScanPath+'Context.dat'); PEFileName := ScanPath+ScanSaveFilename; end; end; smReplace: begin if ScanInfo.ImageCount = 0 then begin DeleteFile(ScanPath+ScanSaveFilename); PEFileName := ScanPath+ScanSaveFilename; end; end; smInsert: begin ScanSaveFilename := ''; FormID := BarCode2FormID; //取出FormID if (FormID <> '') and ISGuideFormID(FormID) then //20170510 註解 因為DSCAN 會全擠在導引頁下 NowGuideFormID := FormID; if (NowGuideFormID <> '') {and (FormID = '')} then //20170510 註解 因為DSCAN 會全擠在導引頁下 FormID := NowGuideFormID; DocNo := FormCode2DocNo(FormID); ScanDocDir := FindLastestDocDir(ScanCaseno,DocNo); if (FMode='ESCAN') and (FModeName=_Msg('補件掃描')) then //20180207 加入的特殊邏輯 begin ScanDocDir := FindLastestDocDirForPage(ScanCaseno, DocNo,FormID); end; if (DocNoNeedDiv(DocNo)) then //要分份數 begin if TreeView1.Selected = MyTreeNode1 then //20170421 掃瞄插頁時選則在案號上才要分份數 選在FormID上就不分份數 begin if ((FormCode2Page(FormID) = '01') and (GetDocDir_Page(ScanCaseno,ScanDocDir)>0)) or (ScanDocDir = '') then begin ScanInfo.ImageCount := 0; ScanDocDir := DocNo2DocNoDir(ImageSavePath + ScanCaseno+'\',DocNo); end; end; end Else //不分份數 begin if DocNo <> '' then ScanDocDir := DocNo else //Attach 附件 ScanDocDir := DocNo2DocNoDir(ImageSavePath + ScanCaseno+'\',DocNo); end; if FirstDocDir = '' Then FirstDocDir := ScanDocDir; ScanPath := ImageSavePath+ScanCaseno+'\'+ScanDocdir+'\'; if (not DirectoryExists(ScanPath)) and (ScanDocdir <> 'Attach') and (ScanDocdir <> 'S_Attach') then SetDocNoList('A',-1,ScanCaseno,ScanDocdir,'1'); ScanSaveFilename := FormID; Str2Dir(ScanPath); if ScanSaveFilename = '' then //附件 ScanSaveFilename:= Add_Zoo(GetDocDir_Page(ScanCaseno,ScanDocdir)+1,3)+ext Else ScanSaveFilename := Add_Zoo(GetDocDir_Page(ScanCaseno,ScanDocdir)+1,3)+'_'+ScanSaveFilename+ext; //ContextList.Add(ScanSaveFilename); //ContextList.SaveToFile(ScanPath+'Context.dat'); SetContextList('A',-1,ScanCaseno,ScanDocDir,ScanSaveFilename); //Showmessage(ScanPath+ScanSaveFilename); //Showmessage('Stop'); PEFileName := ScanPath+ScanSaveFilename; end; smSample: begin if ScanInfo.ImageCount = 0 then begin DeleteFile(ScanPath+ScanSaveFilename); PEFileName := ScanPath+ScanSaveFilename; BarStr := ''; for i := 1 to MpsBarCodeinf.Count do begin BarStr := BarStr + MpsBarCodeinf.Text[i]; end; Showmessage(_Msg('辨識到的BarCode:')+#13+BarStr); end; end; smRTS: begin end; end; Application.ProcessMessages; end; procedure TCB_IMGPSScanX.InitialLanguage(Sender: TObject); var ini : Tmeminifile; i,n : Integer; FormName : String; NowForm : TComponent; begin if Sender is TActiveForm then NowForm := TActiveForm(Sender); if Sender is TForm then NowForm := TForm(Sender); FormName := NowForm.Name; IISUnit.IIS_LngfileName := LngPath+'Language.Lng'; //給IISUnit 轉多國語言字串用 if FLanguage = '' then FLanguage := 'zh_tw'; IISUnit.IIS_NowLng := FLanguage; ini := TMeminifile.Create(LngPath+'Language.Lng'); try IF NowForm is TForm Then TForm(NowForm).Caption := ini.ReadString(FLanguage,FormName+'.FormTitle',''); for i := 0 to NowForm.ComponentCount - 1 do begin //ShowMessage(NowForm.Components[i].Name); if NowForm.Components[i] is TButton then begin TButton(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TButton(NowForm.Components[i]).Name,''); //TBitBtn(NowForm.Components[i]).Caption := ini.ReadString(FormName,TBitBtn(NowForm.Components[i]).Name,''); //TButton(NowForm.Components[i]).OnMouseEnter := BtnMouseEnter; end Else if NowForm.Components[i] is TBitBtn then begin TBitBtn(NowForm.Components[i]).Hint := ini.ReadString(FLanguage,FormName+'.'+TBitBtn(NowForm.Components[i]).Name,''); //TBitBtn(NowForm.Components[i]).Caption := ini.ReadString(FormName,TBitBtn(NowForm.Components[i]).Name,''); TBitBtn(NowForm.Components[i]).OnMouseEnter := BtnMouseEnter; end Else if NowForm.Components[i] is TMenuItem then begin if ini.ValueExists(FLanguage,FormName+'.'+TMenuItem(NowForm.Components[i]).Name) then TMenuItem(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TMenuItem(NowForm.Components[i]).Name,''); end Else if NowForm.Components[i] is TCheckBox then begin TCheckBox(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TCheckBox(NowForm.Components[i]).Name,''); end Else if NowForm.Components[i] is TPJMenuSpeedButton then begin TPJMenuSpeedButton(NowForm.Components[i]).Hint := ini.ReadString(FLanguage,FormName+'.'+TPJMenuSpeedButton(NowForm.Components[i]).Name,''); end Else if NowForm.Components[i] is TLabel then begin TLabel(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TLabel(NowForm.Components[i]).Name,''); end Else if NowForm.Components[i] is TGroupBox then begin TGroupBox(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TGroupBox(NowForm.Components[i]).Name,''); end Else if NowForm.Components[i] is TListView then begin for n := 0 to TListView(NowForm.Components[i]).Columns.Count - 1 do begin TListView(NowForm.Components[i]).Columns.Items[n].Caption := ini.ReadString(FLanguage,FormName+'.'+TListView(NowForm.Components[i]).Name+'_'+inttostr(n),''); end; end Else if NowForm.Components[i] is TRadioGroup then begin TRadioGroup(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TRadioGroup(NowForm.Components[i]).Name,''); for n := 0 to TRadioGroup(NowForm.Components[i]).Items.Count - 1 do begin TRadioGroup(NowForm.Components[i]).Items.Strings[n] := ini.ReadString(FLanguage,FormName+'.'+TRadioGroup(NowForm.Components[i]).Name+'_'+inttostr(n),''); end; end; end; finally ini.Free; end; end; function TCB_IMGPSScanX.GetSiteOMR(FileName,Site:String;bt: Integer): Integer; var OMRRect : TRect; Xdpi,Ydpi : Integer; W,H : Integer; begin Result := 0; //ShowMessage('GetSiteOMR'); IF (ImageScrollBox1.FileName <> FileName) and (FileName <> '') then begin //ShowMessage('11111'+ImageScrollBox1.FileName+#10#13+FileName); ImageScrollBox1.LoadFromFile(FileName,1); { 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)); FindPoint(ImageScrollBox1.Graphic,UpLPoint,UpRPoint,DownLPoint,''); 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)); } ClearLine(ISB_BW.Graphic,bt); ISB_BW.Redraw(True); Application.ProcessMessages; end; If ImageScrollBox1.FileName <> '' Then begin //ShowMessage('22222'+ImageScrollBox1.FileName); Xdpi := ImagescrollBox1.Graphic.XDotsPerInch; Ydpi := ImagescrollBox1.Graphic.YDotsPerInch; H := ImageScrollBox1.Graphic.Height; W := ImageScrollBox1.Graphic.Width; //ShowMessage('Xdpi='+IntToStr(Xdpi)+#10#13+'Ydpi='+IntToStr(Ydpi)+#10#13+'H='+IntToStr(H)+#10#13+'W='+IntToStr(W)+#10#13); //ShowMessage('Site='+Site); OMRRect := CM_Str2Rect(Site,Xdpi,UpLPoint); Display1.Lines.Add('UpLPoint=('+IntToStr(UpLPoint.X)+','+IntToStr(UpLPoint.Y)+');'+Site+';'+IntToStr(OMRRect.Left)+','+IntToStr(OMRRect.top)+','+IntToStr(OMRRect.Right)+','+IntToStr(OMRRect.Bottom)); if OMRRect.Left < 0 then OMRRect.Left := 0; if OMRRect.Top < 0 then OMRRect.Top := 0; if OMRRect.Right > ImageScrollBox1.Graphic.Width then OMRRect.Right := ImageScrollBox1.Graphic.Width; if OMRRect.Bottom > ImageScrollBox1.Graphic.Height then OMRRect.Bottom := ImageScrollBox1.Graphic.Height; result := Get_OMR(ISB_BW.Graphic,OMRRect); //ShowMessage('result='+IntToStr(result)); end; end; Procedure TCB_IMGPSScanX.DisplayMode(index,H_Count,W_Count:Integer;BasePanel:TPanel); Var W,H,T,L:Integer; i,n,Count: Integer; Pl :TPanel; bmp : TBitmap; begin for i := 1 to 8 do begin TPanel(Findcomponent('imgp'+inttostr(i))).Visible := False; end; W := Round((BasePanel.Width - ((W_Count+1) * Seg)) / W_Count); H := Round((BasePanel.Height -((H_Count+1) * Seg)) / H_Count); Count := 1; for i := 1 to H_Count do begin T := i * Seg + H * (i-1); for n := 1 to W_Count do begin L := n * Seg + W * (n-1); Pl := TPanel(Findcomponent('imgp'+inttostr(Count))); Pl.Visible := True; Pl.Left := L; Pl.Top := T; Pl.Width := W; Pl.Height := H; inc(Count); end; end; Shape1.Width := W + (Seg * 2); Shape1.Height := H + (Seg * 2); Shape1.Visible := True; bmp := Tbitmap.Create; try ImageList2.GetBitmap(index,bmp); ViewModeBtn.Glyph.Assign(bmp); finally bmp.Free; end; ISB1Click(ISB1); end; Function TCB_IMGPSScanX.GetSampleInf : Boolean; var str:String; begin Result := False; If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/serversampleforocx','work_no='+FWork_no,FReWrite,Memo1,False) 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 memo1.Lines.Strings[0] = '0' Then begin str := memo1.Lines.Strings[1]; SampleFormIDList.CommaText:=str; Result := True; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; end; function TCB_IMGPSScanX.CheckRequiredColumnValues(workno, caseno:String): Boolean; begin // Result:=False; if (workno='HLN') and (caseno[9]='3') then Result:=True; if (workno='HLN') and (caseno[9]='4') then Result:=True; end; Procedure TCB_IMGPSScanX.CheckRule2OMRErrInfo; //檢核規則填入OMRErrINFo Record var i : Integer; CheckNo : String; begin for I := 1 to 11 do begin CheckNo := Add_Zoo(i,3); if FindSQLData(CHECK_RULE_INF_List,'MESG_SHOW_TYPE,MESG_DISP_TYPE,CHECK_MESG,SCAN_MODE','CHECK_NO',CheckNo,0,FindResult) then begin if GetFindResult('MESG_SHOW_TYPE') = '1' then OMRErrInfo[i].Display := True //顯示 Else if GetFindResult('MESG_SHOW_TYPE') = '2' then OMRErrInfo[i].Display := False; //不顯示 if GetFindResult('MESG_DISP_TYPE') = '1' then OMRErrInfo[i].Ignore := True //可忽略 Else if GetFindResult('MESG_DISP_TYPE') = '2' then OMRErrInfo[i].Ignore := False; //不可忽略 OMRErrInfo[i].Info := GetFindResult('CHECK_MESG'); OMRErrInfo[i].Mode := GetFindResult('SCAN_MODE'); end; end; end; Procedure TCB_IMGPSScanX.ReNameContext(Path,OldName,NewName:String); var i : Integer; begin for i := 0 to ContextList.Count - 1 do begin if OldName = ContextList.Strings[i] then begin ContextList.Strings[i] := NewName; ContextList.SaveToFile(Path+'Context.dat'); Context_DocnoList.Strings[i] := FormCode2DocNo(FileName2FormCode(NewName)); Context_DocnoList.SaveToFile(Path+'Context_DocNo.dat'); Break; end; end; end; Function TCB_IMGPSScanX.Down_Img(Path,CaseID:String):Boolean; var EnCodeDateTime : String; SendData : String; AttPath : String; begin Result := True; EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); ///service/slic/SLIC04/case?data=&verify=&case_no=&file= SendData := 'data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&case_no='+CaseID+'&file='; //ShowMessage(SendData); if not dnFile_Get(HTTPSClient,Furl,'service/imgpsc/IMGPSC04/case',SendData,Path+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; //ShowMessage('替換zip'); AttPath := Path + 'AttFile\'; if FileExists(Path+CaseID+'.zip') then begin ExecuteUnZip(Path+CaseID+'.zip',Path,True); if FileExists(Path+'img.zip') then begin ExecuteUnZip(Path+'img.zip',Path,False); end; if FileExists(Path+'att.zip') then begin Str2Dir(AttPath); ExecuteUnZip(Path+'att.zip',AttPath,False); end; end Else begin HttpErrStr := _Msg('找不到影像'); Result := True; Exit; end; end; Procedure TCB_IMGPSScanX.ClearErrini(CaseID:String;CaseNode:TTreeNode); //清掉檢核檔案 var i : Integer; begin if FileExists(ImageSavePath+CaseID+'\Checkerr.ini') then DeleteFile(ImageSavePath+CaseID+'\Checkerr.ini'); if FileExists(ImageSavePath+CaseID+'\CheckMemo.dat') then DeleteFile(ImageSavePath+CaseID+'\CheckMemo.dat'); {if FileExists(ImageSavePath+CaseID+'\ReSize.dat') then //20110421拿掉 因為記錄會不見 DeleteFile(ImageSavePath+CaseID+'\ReSize.dat');} if FileExists(ImageSavePath+CaseID+'\RemoveMemo.dat') then DeleteFile(ImageSavePath+CaseID+'\RemoveMemo.dat'); if FileExists(ImageSavePath+CaseID+'\OMRCheckOk.dat') then DeleteFile(ImageSavePath+CaseID+'\OMRCheckOk.dat'); CaseHelpBtn.Visible := False; CaseNode.ImageIndex := 2; CaseNode.SelectedIndex := 2; end; Procedure TCB_IMGPSScanX.SetContextList(Mode:Char;Index:Integer;CaseNo,DocDir,FileName:String); //'A:加入,I:插入,D:刪除,E:修改' var i : Integer; //DocNo:String; begin //DocNo := FormCode2DocNo(FileName2FormCode(FileName)); //ShowMessage('FileName='+FileName); if DocDir = '' then DocDir := AttName ; //附件 ContextList.Clear; if FileExists(ImageSavePath+CaseNo+'\'+DocDir+'\Context.dat') then ContextList.LoadFromFile(ImageSavePath+CaseNo+'\'+DocDir+'\Context.dat'); SetRecordEditedDocDir('A',CaseNo,DocDir); //記錄文件有異動 case Mode of 'A':begin ContextList.Add(FileName); end; 'I':begin ContextList.Insert(Index,FileName); end; 'E':begin ContextList.Strings[Index] := FileName; end; 'D':begin if Index <> -1 then begin ContextList.Delete(Index); end Else if (text <> '') then begin for i := 0 to ContextList.Count - 1 do begin if FileName = ContextList.Strings[i] then begin ContextList.Delete(i); Break; end; end; end; if ContextList.Count = 0 then DeleteFile(ImageSavePath+CaseNo+'\'+DocDir+'\Context.dat'); end; end; if ContextList.Count > 0 then begin ContextList.SaveToFile(ImageSavePath+CaseNo+'\'+DocDir+'\Context.dat'); end; end; Procedure TCB_IMGPSScanX.SetAttContextList(Mode:Char;Index:Integer;CaseNo,FileName:String); //'A:加入,I:插入,D:刪除,E:修改' var i : Integer; begin AttContextList.Clear; if FileExists(ImageSavePath+CaseNo+'\AttContext.dat') then AttContextList.LoadFromFile(ImageSavePath+CaseNo+'\AttContext.dat'); case Mode of 'A':begin AttContextList.Add(FileName); end; 'I':begin AttContextList.Insert(Index,FileName); end; 'E':begin AttContextList.Strings[Index] := FileName; end; 'D':begin if Index <> -1 then begin AttContextList.Delete(Index); end Else if (text <> '') then begin for i := 0 to AttContextList.Count - 1 do begin if FileName = AttContextList.Strings[i] then begin AttContextList.Delete(i); Break; end; end; end; if AttContextList.Count = 0 then DeleteFile(ImageSavePath+CaseNo+'\AttContext.dat'); end; end; if AttContextList.Count > 0 then begin AttContextList.SaveToFile(ImageSavePath+CaseNo+'\AttContext.dat'); end; end; Function TCB_IMGPSScanX.ModeNeedCheck(OMRMode,ScanMode:String):Boolean; //掃瞄模式是否要做檢核 begin Result := False; if Pos(ScanMode,OMRMode) > 0 then Result := True; end; Function TCB_IMGPSScanX.FindNoSaveBarCode : Boolean; //找是否有不要儲存影像的條碼 var i,n : Integer; begin Result := False; for i := 1 to MpsBarcodeinf.Count do begin for n := 0 to NoSaveBarCodeList.Count - 1 do begin if MpsBarcodeinf.Text[i] = NoSaveBarCodeList.Strings[n] then begin Result := True; Break; end; end; if Result then Break; end; end; Function TCB_IMGPSScanX.Index2Anchor(Anchor:String):String; //十字模式 0->NONE;1->ANCHOR;2->FRAME begin if Anchor = '0' then Result := 'NONE' else if Anchor = '1' then Result := 'ANCHOR' else if Anchor = '2' then Result := 'FRAME'; end; Function TCB_IMGPSScanX.GetFindResult(Col:String):String; var i,v,v1 : Integer; S,RCol,RValue : String; begin Result := ''; for I := 0 to FindResult.Count - 1 do begin S := FindResult.Strings[i]; v := Pos(',',S); v1 := length(S); RCol := copy(S,1,v-1); RValue := Copy(S,v+1,v1-v); if Col =RCol then Result := RValue; end; end; Function TCB_IMGPSScanX.DrawDocItem2(CaseNode : TTreenode;Caseno:String):Boolean; //畫出文件名稱的Tree Var i,n,m : Integer; DocNode,FormNode : TTreeNode; DocNoPage,FormPage : Integer; DocNoCopies : Integer; DocNo,iDocNo : String; DocVer : String; FileList : TStringlist; FormID,iFormID : String; FormName : String; CaseDocNoList,CaseDocNo_CopiesList,StrList : TStringlist; iiDocNo,iiFormID,iiDocVer : String; ST1:TStringList; begin Result := False; FileList := TStringlist.Create; CaseDocNoList := TStringlist.Create; CaseDocNo_CopiesList := TStringlist.Create; StrList := TStringlist.Create; ST1:=TStringList.Create; LogFile1.LogToFile(logTimeString+'產文件樹開始'); try CaseNode.ImageIndex := 1; CaseNode.SelectedIndex := 1; While CaseNode.Count > 0 do //全刪 begin CaseNode.Item[0].Delete; end; CaseDocNoList.Clear; if FileExists(ImageSavePath+Caseno+'\CaseDocNo.dat') then CaseDocNoList.LoadFromFile(ImageSavePath+Caseno+'\CaseDocNo.dat'); if FileExists(ImageSavePath+Caseno+'\CaseDocNo_Copies.dat') then CaseDocNo_CopiesList.LoadFromFile(ImageSavePath+Caseno+'\CaseDocNo_Copies.dat'); for i := 0 to CaseDocNoList.Count - 1 do begin FileList.Clear; //Showmessage(ImageSavePath+Caseno+'\'+CaseDocNoList.Strings[i]+'\Context.dat'); if FileExists(ImageSavePath+Caseno+'\'+CaseDocNoList.Strings[i]+'\Context.dat') then FileList.LoadFromFile(ImageSavePath+Caseno+'\'+CaseDocNoList.Strings[i]+'\Context.dat'); iDocNo := DocNoDir2DocNo(CaseDocNoList.Strings[i]); ST1.Clear; LogFile1.LogToFile(logTimeString+'FileList.Text='+FileList.CommaText); if (FWH_category='N') and (FIs_In_Wh='Y') then begin for n := 0 to FileList.Count - 1 do begin if ISExistImg(ImageSavePath+Caseno+'\'+CaseDocNoList.Strings[i]+'\'+FileList.Strings[n]) then begin ST1.Add(FileList.Strings[n]); end; end; for n := 0 to ST1.Count - 1 do begin if (FileList.IndexOf(ST1.Strings[n])<>-1) and (not DocNoIs_In_WH(iDocNo)) then begin FileList.Delete(FileList.IndexOf(ST1.Strings[n])); end; end; end Else if not DocNoAppear(iDocNo) then Continue; //20180925 Hong覺得應該加這段 LogFile1.LogToFile(logTimeString+'WH_category='+FWH_category+',Is_In_Wh='+FIs_In_Wh+',FileList.Text='+FileList.CommaText); if FileList.Count=0 then Continue; DocNoCopies := Strtoint(CaseDocNo_CopiesList.Strings[i]); DocNoPage := FileList.Count; iDocNo := DocNoDir2DocNo(CaseDocNoList.Strings[i]); //Showmessage(iDocNo); //Showmessage(DocNo2DocName(Caseno,iDocNo)); //ShowMessage('FileList='+FileList.Text); {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 (Copy(iDocNo,1,5)<>'ZZZZZ')) then //非入庫掃描不看入庫文件 begin Continue; end;} //if not DocNoAppear(iDocNo) then Continue; //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('頁'),[CaseDocNoList.Strings[i],DocNo2DocName(Caseno,iDocNo),DocNoPage])); //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('份'),[CaseDocNoList.Strings[i],DocNo2DocName(Caseno,iDocNo),DocNoCopies])); //ShowMessage('iDocNo='+iDocNo); DocNode := TreeView1.Items.AddChild(CaseNode,Format(_Msg('%s{%s}-%d份'),[DocNo2DocName(Caseno,iDocNo),CaseDocNoList.Strings[i],DocNoCopies])); if GetUseCase('F',ImageSavePath+Caseno+'\',CaseDocNoList.Strings[i]) <> '' Then begin DocNode.ImageIndex := 8; DocNode.SelectedIndex := 8; end Else if GetUseCase('T',ImageSavePath+Caseno+'\',CaseDocNoList.Strings[i]) <> '' Then begin DocNode.ImageIndex := 9; DocNode.SelectedIndex := 9; end Else begin DocNode.ImageIndex := 2; DocNode.SelectedIndex := 2; end; if ((Pos('ZZZZZ',DocNode.Text) = 0) and (Pos('YYYYY',DocNode.Text) = 0)) and (FileList.Count =0) then //制式文件 begin for n := 1 to LASTEST_FORM_INF_List.Count - 1 do begin StrList := SplitString('!@!',LASTEST_FORM_INF_List.Strings[n]); iiFormID := StrList.Strings[0]; iiDocNo := StrList.Strings[1]; if iiDocNo = iDocNo then begin FormID := iiFormID; FormPage := GetFormIDPage(FileList,FormID); FormName := FormCode2FormName(Caseno,FormID); //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁')); FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage])); FormNode.ImageIndex := 4; FormNode.SelectedIndex := 4; DocNode.AlphaSort(True); end; end; end else if (Pos('ZZZZZ',DocNode.Text) > 0) or (Pos('YYYYY',DocNode.Text) > 0) then //自訂文件 begin FormID := GetCustomFormID(ImageSavePath+Caseno+'\',CaseDocNoList.Strings[i]); //showmessage(FileList.Text); FormPage := GetFormIDPage(FileList,FormID); FormName := FormCode2FormName(Caseno,FormID); //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁')); //FormNode := TreeView1.Items.AddChild(DocNode,FormName+'{'+FormID+'}-'+inttostr(FormPage)+_msg('頁')); FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage])); FormNode.ImageIndex := 4; FormNode.SelectedIndex := 4; DocNode.AlphaSort(True); end; SortDocDir_FormID(Caseno,CaseDocNoList.Strings[i]); //檔名依FormID排序 for n := 0 to FileList.Count - 1 do begin FormID := FileName2FormCode(FileList.Strings[n]); DocVer := FormCode2Version(FormID); DocNo := FormCode2DocNo(FormID); if CheckFormIDExists(DocNode,FormID) then Continue; //Showmessage(FormID+#13+DocNo+#13+DocVer); for m := 0 to FormID_List.Count - 1 do begin iiFormID := FormID_List.Strings[m]; iiDocNo := DocNo_List.Strings[m]; iiDocVer := FormCode2Version(iiFormID); if (iiDocNo = DocNo) and (iiDocVer = DocVer) then begin //Showmessage(iiFormID+#13+iiDocNo+#13+iiDocVer); FormID := iiFormID; FormPage := GetFormIDPage(FileList,FormID); FormName := FormCode2FormName(Caseno,FormID); //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁')); //FormNode := TreeView1.Items.AddChild(DocNode,FormName+'{'+FormID+'}-'+inttostr(FormPage)+_msg('頁')); FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage])); FormNode.ImageIndex := 4; FormNode.SelectedIndex := 4; DocNode.AlphaSort(True); end; end; //if not CheckFormIDExists(DocNode,FormID) then //begin // Application.ProcessMessages; // FormPage := GetFormIDPage(FileList,FormID); /// FormName := FormCode2FormName(Caseno,FormID); /// FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁')); // FormNode.ImageIndex := 4; // FormNode.SelectedIndex := 4; //end; end; end; if DirectoryExists(ImageSavePath+Caseno+'\'+AttName) then begin FileList.Clear; if FileExists(ImageSavePath+Caseno+'\'+AttName+'\Context.dat') then FileList.LoadFromFile(ImageSavePath+Caseno+'\'+AttName+'\Context.dat') Else begin Rmdir(ImageSavePath+Caseno+'\'+AttName); Exit; end; DocNoPage := FileList.Count; iDocNo := DocNoDir2DocNo(AttName); //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('份'),[AttName,DocNo2DocName(Caseno,iDocNo),1])); DocNode := TreeView1.Items.AddChild(CaseNode,Format(_Msg('%s{%s}-%d份'),[DocNo2DocName(Caseno,iDocNo),AttName,1])); DocNode.ImageIndex := 2; DocNode.SelectedIndex := 2; for n := 0 to FileList.Count - 1 do begin FormID := FileName2FormCode(FileList.Strings[n]); if not CheckFormIDExists(DocNode,FormID) then begin FormPage := GetFormIDPage(FileList,FormID); FormName := FormCode2FormName(Caseno,FormID); //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁')); //FormNode := TreeView1.Items.AddChild(DocNode,FormName+'{'+FormID+'}-'+inttostr(FormPage)+_msg('頁')); FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage])); FormNode.ImageIndex := 4; FormNode.SelectedIndex := 4; end; end; end; if FModeName='件' then //20170904 先裝死 因為異動 同時存在兩種附件太難寫 begin if DirectoryExists(ImageSavePath+Caseno+'\Attach') then begin FileList.Clear; if FileExists(ImageSavePath+Caseno+'\Attach'+'\Context.dat') then FileList.LoadFromFile(ImageSavePath+Caseno+'\Attach'+'\Context.dat') Else begin Rmdir(ImageSavePath+Caseno+'\Attach'); Exit; end; DocNoPage := FileList.Count; iDocNo := DocNoDir2DocNo(AttName); //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('份'),[AttName,DocNo2DocName(Caseno,iDocNo),1])); //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('份'),[DocNo2DocName(Caseno,iDocNo),'Attach',1])); DocNode := TreeView1.Items.AddChild(CaseNode,Format(_Msg('%s{%s}-%d份'),[DocNo2DocName(Caseno,iDocNo),'Attach',1])); DocNode.ImageIndex := 2; DocNode.SelectedIndex := 2; for n := 0 to FileList.Count - 1 do begin FormID := FileName2FormCode(FileList.Strings[n]); if not CheckFormIDExists(DocNode,FormID) then begin FormPage := GetFormIDPage(FileList,FormID); FormName := FormCode2FormName(Caseno,FormID); //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁')); //FormNode := TreeView1.Items.AddChild(DocNode,FormName+'{'+FormID+'}-'+inttostr(FormPage)+_msg('頁')); FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage])); FormNode.ImageIndex := 4; FormNode.SelectedIndex := 4; end; end; end; end; LogFile1.LogToFile(logTimeString+'產文件樹結束'); Finally FileList.Free; CaseDocNoList.Free; CaseDocNo_CopiesList.Free; StrList.Free; ST1.Free; end; end; procedure TCB_IMGPSScanX.initParameter; begin // if FCaseNoLength=0 then // begin // // end; if FFileSizeLimit = 0 then begin FFileSizeLimit := 5*1024; end; if FImgDPI=0 then begin FImgDPI := 300; ScanDpi := FImgDPI; end else begin //FImgDPI := StrToInt(Value); ScanDpi := FImgDPI; end; if FScanColor = 0 then begin ScanColor := ifBlackWhite; end; if FScanColor = 1 then begin ScanColor := ifGray256 ; ScanGrayCB.Checked:=True; end; if FScanColor = 2 then begin ScanColor := ifTrueColor ; end; end; Function TCB_IMGPSScanX.CheckAvailable:Boolean; //檢查是否可使用元件 var SendData : String; Msg:String; Nowcount,Totalcount,Lic_Idx : Integer; MacID,IPStr,LegalDate :String; begin Result := False; /////下載MPSLIC_SCAN.lic ////// 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+'MPSLIC_SCAN.lic',FReWrite,Memo1,False,DownImgStatus) then begin Showmessage(_Msg('檢查註冊檔案時,網路發生錯誤!!')+_Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason); Exit; end; /////下載MPSLIC_SCAN.lic /// if CheckLicensebyIP_new(LngPath+'MPSLIC_SCAN.lic',MacID,IPStr,LegalDate,Msg,Nowcount,Totalcount,Lic_Idx) then //檢查是否己註冊過 begin if (LegalDate <> '') and (ServerDate>LegalDate) and (Lic_Idx>(Totalcount)) then begin Showmessage(_Msg('已經超過可使用期限及超出授權數請連絡廠商')); Result := False; //Exit; end else Result := True; end Else begin if Msg <> '' then begin Showmessage(Format(_Msg('註冊檔有問題,請連絡廠商 錯誤原因:%s'),[Msg])); Result := false; Exit; end Else begin if (LegalDate <> '') and (ServerDate>LegalDate) and (NowCount =0 ) then begin Lic_Idx := 0; Showmessage(_Msg('已經超過可使用期限請連絡廠商')); Result := False; //Exit; end //else if (LegalDate = '') and (Nowcount >= Totalcount+10) then //超過註冊數量 else if ((LegalDate = '') or ((LegalDate <> '') and (ServerDate>LegalDate)) ) and (Nowcount >= Totalcount) then //超過註冊數量 20150717 yuu說拿掉送的10個 begin Lic_Idx := 0; Showmessage(_Msg('已經超過授權數請連絡廠商')); Result := False; end Else //未超過註冊數量要寫入註冊檔 begin {if Messagedlg(_Msg('您尚未註冊授權是否要進行註冊??'),MtConfirmation,[mbyes,mbcancel],0) = mrcancel then begin Result := False; Exit; end;} ShowText := _Msg('授權中,請稍候'); AddLicense(LngPath+'MPSLIC_SCAN.lic',MacID,IPStr,Msg); Nowcount := Nowcount + 1; DataLoading(True,True); /////上傳MPSLICSCAN.lic //// SendData:='data='+HTTPEncode(UTF8Encode(FData))+'@verify='+FVerify+'@work_no=PLN@file_name=MPSLIC_SCAN.lic'; if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/sample',SendData,'file',LngPath+'MPSLIC_SCAN.lic',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; /////上傳MPSLICSCAN.lic ///// //Sleep(30000); //第一次註冊睡30秒 先不睡 Result := True; end; end; end; if FileExists(LngPath+'MPSLIC_SCAN.lic') then DeleteFile(LngPath+'MPSLIC_SCAN.lic'); if LegalDate = '' then StatusBar1.Panels[4].Text := Format(_Msg('註冊號:%s 剩餘註冊數:%s'),[MacID,inttostr(Totalcount-Nowcount)]); if LegalDate <> '' then StatusBar1.Panels[4].Text := '*'+Format(_Msg('註冊號:%s 剩餘註冊數:%s'),[MacID+'('+inttostr(Lic_Idx)+')',inttostr(Totalcount-Nowcount)]); end; Function TCB_IMGPSScanX.GetCustomDocName(Path,DocNo:String):String; //取出自定文件名稱 var ini : Tinifile; begin ini := Tinifile.Create(Path+'CustomDocNo.ini'); try Result := ini.ReadString(DocNo,'Name',''); finally ini.Free; end; end; Function TCB_IMGPSScanX.FindCustomDocName(Path,DocName:String):Boolean; //尋找自定文件名稱是否存在 var ini : Tinifile; Ct,i:Integer; DocNo,FormID : String; begin Result := False; ini := Tinifile.Create(Path+'CustomDocNo.ini'); try Ct := ini.ReadInteger('CustomCount','Count',0); for I := 1 to Ct do begin DocNo := 'ZZZZZ'+Add_Zoo(i,3); if DocName = ini.ReadString(DocNo,'Name','') then begin Result := True; Break; end; end; finally ini.Free; end; end; procedure TCB_IMGPSScanX.PrintImg(FileName, LoginID, Datetime, Path: WideString); var PrintMode : TEnvisionPrintMode; GraphicPrinter : TDibGraphicPrinter; PrtDialog : TPrintDialog; S : TStringlist; i,Pages,Page : Integer; Prt_String : String; Prt_H : Integer; procedure PrintWithManualPrintJob(LoginID,DateTime:String;Pages,Page:Integer); begin If Page = 1 Then begin { if UsePrintJob is False, Printer.BeginDoc and Printer.EndDoc must be called by the user. This allows printing multiple images in the same job (or page). } GraphicPrinter.UsePrintJob := False; { if UsePrintJob is False, the print job name that appears in the print manager must be specified in using the Title property of the Printer object. Otherwise, if UsePrintJob is True, the Title property of the TDibGraphicPrinter object is used to specify the job name. } Printer.Title := _Msg('影像列印'); end; IF (Page mod 2) = 1 Then Printer.BeginDoc Else Printer.NewPage; ImageScrollBox1.DisplayedGraphic.Canvas.Font.Size := 24; //ImageScrollBox1.DisplayedGraphic.Canvas.TextOut(20,20, _Msg('列印人員:')+LoginID+' '+_Msg('列印分行:')+FUserUnit+' '+_Msg('列印日期:')+DateTime); GraphicPrinter.Print(ImageScrollBox1.DisplayedGraphic); { this shows how to print text on a page. Printer.Canvas.TextOut(10,10, 'Envision Image Library'); } If ((Page mod 2) = 0) or (Page = pages) Then Printer.EndDoc; end; procedure PrintWithAutoPrintJob; begin GraphicPrinter.UsePrintJob := True; GraphicPrinter.Title := _Msg('影像列印'); GraphicPrinter.Print(ImageScrollBox1.Graphic); end; begin S := TStringlist.Create; GraphicPrinter := TDibGraphicPrinter.Create; PrtDialog := TPrintDialog.Create(self); //PrtDialog.Copies:=99; try IF PrtDialog.Execute Then begin S.Text := FileName; Pages := S.Count; for i := 0 to S.Count -1 do begin ImageScrollBox1.LoadFromFile(Path+S.Strings[i],1); watermark2(Image1.Picture.Bitmap,70,'',ImageScrollBox1.DisplayedGraphic); PrintWithManualPrintJob(LoginID,DateTime,Pages,i+1); end; end; Finally PrtDialog.Free; GraphicPrinter.Free; S.Free; end; end; Procedure TCB_IMGPSScanX.GotoAttach(OldLevel:Integer); var i : Integer; begin for i := 0 to MyTreeNode1.Count - 1 do begin if Pos('Attach',MyTreeNode1.Item[i].Text) > 0 then begin if OldLevel = 2 then begin TreeView1.Selected := MyTreeNode1.Item[i]; end else if OldLevel = 3 then begin TreeView1.Selected := MyTreeNode1.Item[i].Item[0]; end; Break; end; end; //TreeView1click(nil); end; Function TCB_IMGPSScanX.GetCustomNameCount(CustomName:String):Integer; //取外傳的名稱數量 var i,ct : Integer; C_DocNameList : TStringlist; begin C_DocNameList := TStringlist.Create; try C_DocNameList.StrictDelimiter := True; C_DocNameList.Delimiter := #9; C_DocNameList.DelimitedText := FC_DocNameList; ct := 0; for i := 0 to C_DocNameList.Count - 1 do begin if C_DocNameList.Strings[i] = CustomName then begin inc(ct); end; end; Result := ct; finally C_DocNameList.Free; end; end; function TCB_IMGPSScanX.ISExistImg(const filename: string): boolean; begin if ExistImgList.IndexOf(LoadFileGetMD5(filename))<>-1 then begin Result:=True; end else begin Result:=False; end; end; Procedure TCB_IMGPSScanX.PriorPage(Page:Integer); //上一頁 var iISB : TImageScrollBox; begin iISB := TImageScrollBox(FindComponent(ISBName+inttostr(Page-1))); if iISB <> nil then begin ISBClick(iISB); end; end; Procedure TCB_IMGPSScanX.NextPage(Page:Integer); //下一頁 var iISB : TImageScrollBox; begin iISB := TImageScrollBox(FindComponent(ISBName+inttostr(Page+1))); if iISB <> nil then begin ISBClick(iISB); end; end; Procedure TCB_IMGPSScanX.OMRErr2ini(CaseID,Reason,FileName,Site,RelaFileName,RelaSite,Anchor,Anchor1:String;Del,Ingnore,Display:Boolean); //OMR檢核失敗寫入ini var ini : Tinifile; Errcount : Integer; S : TStringlist; begin if Display then begin ini := Tinifile.Create(ImageSavePath + CaseID+'\upload\Checkerr.ini'); try Errcount := ini.ReadInteger('OMRCount','Count',0); //透過Errcount來對應 inc(ErrCount); ini.WriteString(inttostr(ErrCount),'Reason',Reason); ini.WriteBool(inttostr(ErrCount),'Ingnore',Ingnore); ini.writeString(inttostr(ErrCount),'FileName',FileName); ini.WriteString(inttostr(ErrCount),'Site',Site); ini.WriteString(inttostr(ErrCount),'RelaFileName',RelaFileName); ini.WriteString(inttostr(ErrCount),'RelaSite',RelaSite); ini.WriteString(inttostr(ErrCount),'Anchor',Anchor); ini.WriteString(inttostr(ErrCount),'RelaAnchor',Anchor1); ini.WriteBool(inttostr(ErrCount),'Del',Del); ini.WriteInteger('OMRCount','Count',ErrCount); finally ini.Free; end; end Else begin S := TStringlist.Create; try if FileExists(ImageSavePath + CaseID+'\CheckMemo.dat') then S.LoadFromFile(ImageSavePath + CaseID+'\CheckMemo.dat'); S.Add(Reason); S.SaveToFile(ImageSavePath + CaseID+'\CheckMemo.dat'); finally S.Free; end; end; end; Procedure TCB_IMGPSScanX.OMRErrini2List(CaseID:String;ErrlistForm:TErrlistForm); //OMR檢核失敗從ini寫入ListView var ini : Tinifile; Errcount : Integer; Del : Boolean; i : Integer; begin ini := Tinifile.Create(ImageSavePath + CaseID+'\upload\Checkerr.ini'); try Errcount := ini.ReadInteger('OMRCount','Count',0); for i := 1 to ErrCount do begin Del := ini.ReadBool(inttostr(i),'Del',False); //是否被移除了 if Not Del then begin With ErrlistForm.ErrListLV.Items.Add do begin Caption := ini.ReadString(inttostr(i),'Reason',''); SubItems.Add(inttostr(i)); end; end; end; if Errlistform.ErrListLV.Items.Count > 0 then Errlistform.ImmediateBt.Enabled := False; finally ini.Free; end; end; Function TCB_IMGPSScanX.DownLanguage:Boolean; //下載多國語言檔 begin Result := True; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime //dnFile(HTTPSClient,FUrl+'Language.Lng','','',LngPath+'Language.Lng',FReWrite.Text,Memo1,False,DownImgStatus) If not dnFile_Get(HTTPSClient,FUrl+'Language.Lng','','',LngPath+'Language.Lng',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; end; Procedure TCB_IMGPSScanX.FreeShapeobj(SelectISB : TImageScrollBox); var i : Integer; begin IF SelectISB = nil then //全Free; begin For i:= ComponentCount -1 downto 0 do begin IF Components[i] is TShape Then begin IF Pos('SP',Components[i].Name) > 0 Then Components[i].Free; end; end; end Else //只Free指定的 begin TShape(FindComponent('SP'+Copy(SelectISB.Name,length(ISBName)+1,length(SelectISB.Name)-length(ISBName)))).Free; end; end; Procedure TCB_IMGPSScanX.CreateIn_WH(CaseID:String); //產生In_WH.dat var i,n : Integer; DocDirList,In_WH_List : TStringlist; iDocNo : String; begin DocDirList := TStringlist.Create; In_WH_List := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then DocDirList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); for i := 0 to DocDirList.Count - 1 do begin iDocNo := DocNoDir2DocNo(DocDirList.Strings[i]); for n := 0 to IN_WH_DocNoList.Count - 1 do begin if (iDocNo = IN_WH_DocNoList.Strings[n]) or (Copy(iDocNo,1,5)='ZZZZZ') then begin In_WH_List.Add(DocDirList.Strings[i]); Break; end; end; end; In_WH_List.SaveToFile(ImageSavePath+CaseID+'\In_Wh.dat'); finally DocDirList.Free; In_WH_List.Free; end; end; Function TCB_IMGPSScanX.CreateAttach_Info(CaseID:String):String; //產生是否有Attach Y:有 N:沒有 begin Result := 'N'; if GetDocDir_Page(CaseID,AttName) > 0 Then Result := 'Y'; end; Function TCB_IMGPSScanX.GetOMRCheckSet : Boolean; //下載OMR檢核XML檔 var SendData : String; LastDateTime : String; S : TStringlist; begin Result := True; S := TStringlist.Create; Try if FileExists(CheckXmlPath+'OMRSet.zip') then DeleteFile(CheckXmlPath+'OMRSet.zip'); LastDateTime := '00000000000000'; if FileExists(CheckXmlPath+'LastDateTime.dat') then begin S.LoadFromFile(CheckXmlPath+'LastDateTime.dat'); LastDateTime := S.Strings[0]; end; SendData := 'settype=3&lastupdate='+LastDateTime; if not dnFile_Get(HTTPSClient,Furl,'service/imgpsc/IMGPSC01/settings',SendData,CheckXmlPath+'OMRSet.zip',FReWrite,Memo1,False,DownImgStatus) then begin HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason; Result := False; Exit; end; if FileExists(CheckXmlPath+'OMRSet.zip') then //有更新 begin ExecuteUnZip(CheckXmlPath+'OMRSet.zip',CheckXmlPath,True); S.Clear; S.Add(ServerDate+GetBalance2Time(Balance)); S.SaveToFile(CheckXmlPath+'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.Timer1Timer(Sender: TObject); var StampDate,StampTime : String; i: Integer; begin Timer1.Enabled := False; //FIs_In_Wh:='Y'; /// test 記得關掉 //FWH_category :='N'; // test 記得關掉 // FImgDelete := 'Y'; //test 記得關掉 //Showmessage('a'); //self.FIs_OldCase := 'Y'; PageLVclear := True; InitialOk := False; FMaxUploadSize:='10'; FJpgCompression:=50; FFtpRootPath := ''; //影像平台沒有給FtpRoot目錄,會直接用FFtpExtraPath切換至指定目錄 //FMode := 'DSCAN' ; //FIs_In_Wh := 'Y'; if FIs_In_Wh = 'Y' then AttName := 'Attach' //入庫附件 else AttName := 'S_Attach'; //Smartlending 附件 //ShowMessage('1111111'); if FMode = 'SAMPLESCAN' then begin NewScanBtn.Visible := False; PJLinkedMenuSpeedButton2.Visible := False; AddScanBtn.Visible := False; CheckCaseBtn.Visible := False; Panel18.Visible := False; TransBtn.Visible := False; FC6.Visible := False; SampleScanBtn.Visible := True; Panel1.Visible := True; Panel6.Visible := True; ScanDuplexCB.Visible := False; //雙面掃描 end Else if (FMode = 'NSCAN') then begin Panel18.Visible := True; Panel1.Visible := True; Panel6.Visible := True; Panel21.Visible := True; Panel23.Visible := True; AttFileGB.Visible := True; Splitter2.Visible := True; ScanDuplexCB.Visible := True; //雙面掃描 end Else if FMode = 'FSCAN' then begin Panel1.Visible := True; //Panel6.Visible := True; end Else begin Panel18.Visible := True; Panel1.Visible := True; Panel6.Visible := True; Panel21.Visible := True; Panel23.Visible := True; AttFileGB.Visible := True; Splitter2.Visible := True; end; DisplayMode(1,1,1,Panel9); Application.ProcessMessages; StatusBar1.Panels[0].Text := 'Ver'+GetCurrentVersionNo; StatusBar1.Panels[1].Text := 'Login User:'+FUserName; {$IFDEF Test} StatusBar1.Panels[0].Text := StatusBar1.Panels[0].Text+'(test)'; {$ENDIF} StatusBar1.Panels[0].Text := StatusBar1.Panels[0].Text; if FPrintyn = 'Y' then PrtLB.Visible := True; initParameter; //20170222 針對新加的parameter 作初始化參數 InitScrollRec; If FUrl = '' then begin Showmessage(_Msg('URL cannot be empty,please contact system administrator')); Exit; end; if FUrl[length(FUrl)]<>'/' then FUrl := FUrl + '/'; //20221028 把語言檔改放至 Local目錄裡,才不會有些文字來不及使用 LngPath := GetLocalAppDir(Handle)+'MPS\CB_IMGPS\'; Str2Dir(LngPath); ////下載語言檔///// 20170218 先拿調以便測試 If not DownLanguage Then begin Showmessage('Language File error!!'+HttpErrStr); DataLoading(False,False); Exit; end; InitialLanguage(Self); //載入多國語言 if FWork_no='' then begin Showmessage(_Msg('業務別不能為空白,請洽詢程式人員')); Exit; end; if CaseIDLength = 0 then begin Showmessage(_Msg('案件編號長度限制不能為空白,請洽詢程式人員')); //Exit; //測試時不退出 end; //********清單區******** Doc_Inf_List := TStringList.Create; //Doc_Inf 清單 Docno + 版本為key DM_FORM_INF_List := TStringList.Create; //DM_FORM_INF 清單 Docno + 版本為key FORM_INF_List := TStringList.Create; //FORM_INF的清單 CHECK_RULE_INF_List := TStringList.Create; //CHECK_RULE_INF 清單 MEMO_INF_List := TStringList.Create; //MEMO_INF 清單 WORK_INF_List := TStringList.Create; //WORK_INF 清單 LASTEST_FORM_INF_List := TStringList.Create; // LASTEST_FORM_INF 清單 FindResult := TStringlist.Create; //找SQLData的結果 OMRFileList := TStringList.Create; //要OMR檢核的文件(只檢查每種Form的第一頁) FormCode_PageSize := TStringList.Create; //文件的預設大小 FormCode_Height_Width DocNo_NeedDoc := TStringList.Create; //有Docno時要相依的文件 DocNo_相依文件_相依文件 DocNo_NoDoc := TStringList.Create; //有Docno時互斥的文件 DocNo_互斥文件_互斥文件 DocNo_VerinCase := TStringList.Create; //案件裡的DocNo+版本的清單 CaseDocNoList := TStringlist.Create; //案件裡的DocNo清單 CaseDocNo_CopiesList := TStringlist.Create; //案件裡的DocNo份數清單 CaseList := TStringList.Create; //記錄掃瞄案件的順序 Context_DocnoList := TStringlist.Create; //案件裡的檔案Docno清單 ContextList := TStringlist.Create; //案件裡的檔案清單 AttContextList := TStringlist.Create; //案件裡的附加檔案清單 NoSaveBarCodeList := TStringlist.Create; //不儲存的條碼清單 FormID_List := TStringlist.Create; //FormID清單 DocNo_List := TStringlist.Create; //DocNo清單 NowShowFileList := TStringlist.Create; //目前顯示的影像清單 NowSelectFileList := TStringlist.Create; //目前被點選的影像清單 Cust_DocNoList := TStringlist.Create; //自行定義的文件名稱 IN_WH_DocNoList := TStringlist.Create; //入庫的文件清單 GuideFormIDList := TStringlist.Create; //要當導引頁表單清單 DivPageFormIDList := TStringList.Create; //要當分案頁表單清單 LastInitFormidList :=TStringList.Create; LastAddFormidList := TStringList.Create; SampleFormIDList := TStringList.Create;//20170627 加入 ExistImgList := TStringList.Create; //20170724 新增 reSizeExistImgList :=TStringList.Create; //20171012 新增 //********清單區******** ShowText := _Msg('資料載入中,請稍候'); DataLoading(True,True); IF not GetServerDate Then begin Showmessage(_Msg('取主機時間時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; if FMode='SAMPLESCAN' then begin IF not GetSampleInf Then //取已存在sample begin Showmessage(_Msg('取存在範本資訊時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; end; //ShowMessage('GetServerDate '+ServerDate+' , '+ServerTime); ////下載系統資訊//// IF not GetSetInf1 Then //取DOC_INF 文件資訊 begin Showmessage(_Msg('取文件資訊時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; //ShowMessage('GetSetInf1'); //showmessage(self.Doc_Inf_List.Text); IF not GetSetInf2 Then //取DM_FORM_INF 相依互斥資訊 begin Showmessage(_Msg('取相依互斥資訊時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; //ShowMessage('GetSetInf2'); //Showmessage(self.Doc_Inf_List.Text); IF not GetSetInf3 Then //取FORM_INF 表單資訊 begin Showmessage(_Msg('取表單資訊時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; //ShowMessage('GetSetInf3'); IF not GetSetInf4 Then //取CHECK_RULE_INF 檢核規則資訊 begin Showmessage(_Msg('取檢核規則資訊時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; //showmessage(self.CHECK_RULE_INF_List.Text); //ShowMessage('GetSetInf4'); IF not GetSetInf5 Then //取MEMO_INF 常用片語資訊 begin Showmessage(_Msg('取常用片語資訊時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; //ShowMessage('GetSetInf5'); //showmessage(self.MEMO_INF_List.Text); IF not GetSetInf6 Then //取WORK_INF 系統參數資訊 begin Showmessage(_Msg('取系統參數資訊時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; //ShowMessage('GetSetInf6'); //showmessage(FORM_INF_List.Text); IF not GetSetInf7 Then //取LASTES_FORM_INF 系統參數資訊 begin Showmessage(_Msg('取最新版FORMID參數資訊時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; //ShowMessage('GetSetInf7'); //Showmessage(LASTEST_FORM_INF_List.Text); SetFormID_DocNo; //將FormID及Docno抽出塞入List裡 20130403增加 SetIn_WH_DocNo; //將要入庫的DocNo抽出來另存入list裡 GetDefScanIni; //取得掃描預設值及相關設定 ////下載系統資訊///// if ImagePath = '' then begin Showmessage(_Msg('本機暫存路徑不得為空白')); DataLoading(False,False); Panel1.Enabled := False; Panel2.Enabled := False; Exit; end; initkscan; if ImagePath[Length(ImagePath)] <> '\' then ImagePath := ImagePath + '\'; //ShowMessage('ImagePath='+ImagePath); //CheckXmlPath := ImagePath+'OMRSITE\'+FWork_No; CheckXmlPath := ImagePath+'OMRSITE\'; // 20200612 發現影像平台是取回所有業務的設定,所以不能有業務別目錄 //ShowMessage('CheckXmlPath='+CheckXmlPath); //SitePath := ImagePath+'Site\'+FWork_No+'\'; SitePath := ImagePath+'Site\'; // 20200612 發現影像平台是取回所有業務的設定,所以不能有業務別目錄 //LngPath := ImagePath; //改放至上面取Local目錄 SamplePath := ImagePath+'Sample\'+FWork_No+'\'; ImagePath := ImagePath + 'Scantemp\'; //ShowMessage('AA ImagePath='+ImagePath); ScaniniPath :=ImagePath+FWork_No+'\'+FUserUnit +'\'; //ShowMessage('ScaniniPath='+ScaniniPath); ImagePath := ImagePath + FWork_No+'\'+FUserUnit+'\'+FMode+'\'; ImagePath := StringReplace(ImagePath, '\\', '\',[rfReplaceAll, rfIgnoreCase]); //ShowMessage('BB ImagePath='+ImagePath); ImageSavePath := ImagePath; str2dir(CheckXmlPath); str2dir(SitePath); str2dir(ImagePath); str2dir(SamplePath); Del_Sub_NothingPath(ImagePath); //清掉案件目錄是空的 LogFile1.LogFile:=LngPath+'IMGPSCheck.log'; ReduceLogFile; LogFile1.LogToFile(logTimeString+'OCX取表data結束'); ShowText := _Msg('資料載入中,請稍候'); DataLoading(True,True); // if not CheckAvailable Then //檢查授權 20170218 說不用了 // begin // DataLoading(False,False); // Panel1.Enabled := False; // Panel2.Enabled := False; // Exit; // end; //Button3Click(Self); //ShowMessage('CheckAvailable'); ShowText := _Msg('資料載入中,請稍候'); DataLoading(True,True); StatusBar1.Panels[1].Text := _Msg('登入人員:')+FUserName; //FCaseID:='20150302180133';//測試用 ////下載語言檔///// //ShowMessage('OOOO'); if (FMode = 'RSCAN') or (FMode = 'DSCAN') or (FMode = 'ESCAN') or (FMode = 'FSCAN') then //重掃件及異動件要只能掃指定編號的件 begin _Deltree(ImagePath); str2dir(ImagePath); ImageSavePath := ImagePath; str2dir(ImageSavePath); MkDir(ImageSavePath+FCaseID); CreateEmptyCase(ImageSavePath,FCaseID); MkDir(ImageSavePath+FCaseID+'\Download'); IF (FMode = 'ESCAN') or (FMode = 'DSCAN') then //異動件先下載影像 begin ShowText := _Msg('案件下載中,請稍候'); DataLoading(True,True); If not DownLoadImage(ImageSavePath+FCaseID+'\Download\',FCaseID) Then begin Showmessage(FCaseID+_msg('載入異動影像時,網路發生錯誤')+DownFileErrStr); DataLoading(False,False); Exit; end; {If not Down_Img(ImageSavePath+FCaseID+'\Download\',FCaseID) then begin Showmessage(FCaseID+_msg('載入異動影像時,網路發生錯誤')+HttpErrStr); DataLoading(False,False); Exit; end;} //Showmessage(ImageSavePath+FCaseID+'\Download\'+#10#13+ImageSavePath+FCaseID+'\'); Download2Case(ImageSavePath+FCaseID+'\Download\',ImageSavePath+FCaseID+'\'); //Showmessage('aaa'); //Download2Case('C:\Users\Hong\Downloads\沒有括號\',ImageSavePath+FCaseID+'\'); if (FIs_OldCase = 'Y') then begin if (FWork_no='HLN') then ErrFormtoCurrentForm(FCaseID,'10000001011112A','11000001011112A'); //換掉錯的FormID //if not FileExists(ImageSavePath+FCaseID+'\CaseDocNo_Copies.dat') then //這個會在Download2Case時一律產生所以不能有這行 20141013 OldCasetoNewCase(FCaseID); //ErrFormtoCurrentForm(FCaseID,'11B00005011312A','11000001011112A'); //換掉錯的FormID //LoadImgFile; end; // if (FIs_OldCase = 'Y') and (FWork_no='HLN') then //77版的 // begin // ErrFormtoCurrentForm(FCaseID,'10000001011112A','11000001011112A'); //換掉錯的FormID // if not FileExists(ImageSavePath+FCaseID+'\CaseDocNo_Copies.dat') then // OldCasetoNewCase(FCaseID); // //ErrFormtoCurrentForm(FCaseID,'11B00005011312A','11000001011112A'); //換掉錯的FormID // //LoadImgFile; // end; Create_Cust_DocDir(FCaseID); //產生外面傳入的文件 if FMode='ESCAN' then LastInitFormidListCreate(ImageSavePath+FCaseID+'\Download\'); end; end; //ShowMessage('GetOMRCheckSet前'); ////下載檢核XML////// IF not GetOMRCheckSet Then begin Showmessage(_Msg('下載檢核定位檔案時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; ////下載檢核XML///// //ShowMessage('GetOMRCheckSet後來'); ////下載登打設定///// IF not GetKeyinSet Then begin Showmessage(_Msg('下載登打定位檔案時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; end; ////下載登打設定///// //ShowMessage('GetKeyinSet'); if ScanDenialHint <> '' then //有設定提示字串就秀在右上角 begin DenialTimeLb.Visible := True; DenialTimeLb.Caption := Format(ScanDenialHint,[ScanDenialTime]); end; //ShowMessage(IntToStr(ScanDpi)); R_W_Scanini('R'); //掃瞄設定的ini //ShowMessage(IntToStr(ScanDpi)); //ShowMessage('停掉DataLoading'); //DataLoading(False,False); ScanDuplexCB.Checked := ScanDuplex; if FMode <> 'SAMPLESCAN' then LoadImgFile; if (FMode = 'RSCAN') or (FMode = 'ESCAN') or (FMode = 'FSCAN') then begin if TreeView1.Items.Count > 0 then begin TreeView1.Selected := NewTreeNode.Item[0]; TreeView1click(self); end; end; InitialOk := True; {AttFileGB.Visible := True; //附加電子檔窗 //20120207楊玉說不在這加電子檔先拿掉 Splitter2.Visible := True; AttFileGB.Visible := False; //附加電子檔窗 Splitter2.Visible := False; } //ShowMessage('ImageSavePath='+ImageSavePath); DataLoading(False,False); LogFile1.LogToFile(logTimeString+'OCX初始化結束'); LogFile1.LogToFile(logTimeString+'FUrl='+FUrl+ ',FCaseID='+FCaseID+ ',FMode='+FMode+ ',FModeName='+FModeName+ ',FWork_no='+FWork_no+ ',FUserID='+FUserID+ ',FUserName='+FUserName+ ',FUserUnit='+FUserUnit+ ',FData='+FData+ ',FVerify='+FVerify+ ',FReWrite='+FReWrite+ ',FLanguage='+FLanguage+ ',FLoanDoc_Value='+FLoanDoc_Value+ ',FLoanDoc_Enable='+FLoanDoc_Enable+ ',FUseProxy='+FUseProxy+ ',FC_DocNoList='+FC_DocNoList+ ',FC_DocNameList='+FC_DocNameList+ ',FFixFileList='+FFixFileList+ ',FIs_In_Wh='+FIs_In_Wh+ ',FOldCaseInfo='+FOldCaseInfo+ ',FPrintyn='+FPrintyn+ ',FIs_OldCase='+FIs_OldCase+ ',FCustDocYN='+FCustDocYN); LogFile1.LogToFile(logTimeString+'FImgDPI='+IntToStr(FImgDPI)+ ',FScanColor='+ IntToStr(FScanColor)+ ',FFileSizeLimit='+ IntToStr(FFileSizeLimit)+ ',FCaseNoLength='+ IntToStr(FCaseNoLength)+ ',FImgDelete='+FImgDelete+ ',FIsExternal='+FIsExternal+ ',FWH_category='+FWH_category+ ',FCheck_main_form='+FCheck_main_form+ ',FMaxUploadSize='+FMaxUploadSize); end; procedure TCB_IMGPSScanX.Timer2Timer(Sender: TObject); begin IF Panel22.Caption = ShowText+'......' Then Panel22.Caption := ShowText Else Panel22.Caption := Panel22.Caption + '.'; Application.ProcessMessages; end; procedure TCB_IMGPSScanX.Set_mode(const Value: WideString); begin FMode := UpperCase(Value); end; procedure TCB_IMGPSScanX.Set_rewrite(const Value: WideString); begin FReWrite := Value; end; procedure TCB_IMGPSScanX.Set_url(const Value: WideString); begin FUrl := Value; end; procedure TCB_IMGPSScanX.Set_userid(const Value: WideString); begin FUserID := Value; end; procedure TCB_IMGPSScanX.Set_username(const Value: WideString); begin FUserName := Value; end; procedure TCB_IMGPSScanX.Set_verify(const Value: WideString); begin FVerify := Value; end; procedure TCB_IMGPSScanX.Set_language(const Value: WideString); begin FLanguage := lowercase(Value); if FLanguage='zh-tw' then begin FLanguage:='zh_tw' end; if FileExists(LngPath+'Language.lng') then begin InitialLanguage(Self); //載入多國語言 end; end; procedure TCB_IMGPSScanX.Set_modename(const Value: WideString); begin FModeName := Value; end; procedure TCB_IMGPSScanX.Set_userunit(const Value: WideString); begin FUserUnit := Value; end; procedure TCB_IMGPSScanX.Set_work_no(const Value: WideString); begin FWork_no := Value; end; procedure TCB_IMGPSScanX.Set_loandoc_enable(const Value: WideString); begin FLoanDoc_Enable := Value; if FLoanDoc_Enable = 'Y' then AddCredit1RG.Enabled := True; if FLoanDoc_Enable = 'I' then begin AddCredit1RG.Visible := False; Panel5.Visible := False; end; end; procedure TCB_IMGPSScanX.Set_loandoc_value(const Value: WideString); begin FLoanDoc_Value := Value; end; procedure TCB_IMGPSScanX.Set_useproxy(const Value: WideString); begin FUseProxy := UpperCase(Value); if FUseProxy = 'Y' then UseProxy := True; //要不要用Proxy end; procedure TCB_IMGPSScanX.Set_c_docnamelist(const Value: WideString); begin FC_DocNameList := Value; end; procedure TCB_IMGPSScanX.Set_is_in_wh(const Value: WideString); begin FIs_In_Wh := UpperCase(Value); end; function TCB_IMGPSScanX.Get_c_docnamelist: WideString; begin end; function TCB_IMGPSScanX.Get_is_in_wh: WideString; begin end; function TCB_IMGPSScanX.Get_language: WideString; begin end; function TCB_IMGPSScanX.Get_loandoc_enable: WideString; begin end; function TCB_IMGPSScanX.Get_loandoc_value: WideString; begin end; function TCB_IMGPSScanX.Get_mode: WideString; begin end; function TCB_IMGPSScanX.Get_modename: WideString; begin end; function TCB_IMGPSScanX.Get_rewrite: WideString; begin end; function TCB_IMGPSScanX.Get_url: WideString; begin end; function TCB_IMGPSScanX.Get_useproxy: WideString; begin end; function TCB_IMGPSScanX.Get_userid: WideString; begin end; function TCB_IMGPSScanX.Get_username: WideString; begin end; function TCB_IMGPSScanX.Get_userunit: WideString; begin end; function TCB_IMGPSScanX.Get_verify: WideString; begin end; function TCB_IMGPSScanX.Get_work_no: WideString; begin end; function TCB_IMGPSScanX.Get_printyn: WideString; begin end; procedure TCB_IMGPSScanX.Set_printyn(const Value: WideString); begin FPrintyn := UpperCase(Value); end; function TCB_IMGPSScanX.Get_custdocyn: WideString; begin end; procedure TCB_IMGPSScanX.Set_custdocyn(const Value: WideString); begin FCustDocYN := UpperCase(Value); end; function TCB_IMGPSScanX.Get_imgdelete: WideString; begin end; procedure TCB_IMGPSScanX.Set_imgdelete(const Value: WideString); begin FImgDelete:=Value; end; function TCB_IMGPSScanX.Get_isExternal: WideString; begin end; procedure TCB_IMGPSScanX.Set_isExternal(const Value: WideString); begin FIsExternal:=Value; end; function TCB_IMGPSScanX.Get_WH_CATEGORY: WideString; begin end; procedure TCB_IMGPSScanX.Set_WH_CATEGORY(const Value: WideString); begin FWH_category:=Value; end;