unit CB_IMGPSScanImp; {$WARN SYMBOL_PLATFORM OFF} interface uses EnScan, { for Scanner } EnDiGrph, { for TDibGraphic } EnMisc, { for MinFloat } EnTifGr, { for TTifGraphic } Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ActiveX, AxCtrls, CB_IMGPSScan_TLB, StdVcl, VCLUnZip, VCLZip, Encryp, ExtCtrls, ComCtrls, Menus, StdCtrls, Gauges, EnImgScr, PJMenuSpeedButtons, Buttons, ImgList, SBSimpleSSL, SBHTTPSClient, SBWinCertStorage, SBX509, SBCustomCertStorage, SBUtils,mpsBarco,BarcodesFinder,HTTPApp,ErrList, Xmltool,inifiles,printers; var Ch_WriteNote : Boolean; RejectCase : Boolean; ErrIndex : Integer; //*****預設區*****// Def_DeviceDelete : Boolean; //空白頁刪除啟動 Def_DeviceDeleteSize : Integer; //空白頁Size Def_ScannerReverse : Boolean; //是否需反相 Def_BoardClear : Boolean; //是否清黑邊 Def_ScanDpi : Integer; //掃瞄DPI Def_ScanDuplex : Boolean; //是否雙面掃瞄 Def_ScanRotate : Integer; //掃瞄時旋轉角度 Def_ScanDeskew : Boolean; //是否傾斜矯正 Def_ScanBright : Integer; //亮度 Def_ScanContrast : Integer; //對比 Def_ScanImgShowMode : Integer; //0:清楚影像 1:不清楚影像 2:不顯示 Def_ScanImgSetUse : Boolean; //是否使用亮度對比設定 //*****預設區*****// Const ISBName = 'PreViewISB'; {獲取自身版本號所需要 } type TVersionLanguage = (vlArabic, vlBulgarian, vlCatalan, vlTraditionalChinese, vlCzech, vlDanish, vlGerman, vlGreek, vlUSEnglish, vlCastilianSpanish, vlFinnish, vlFrench, vlHebrew, vlHungarian, vlIcelandic, vlItalian, vlJapanese, vlKorean, vlDutch, vlNorwegianBokmel, vlPolish, vlBrazilianPortuguese, vlRhaetoRomanic, vlRomanian, vlRussian, vlCroatoSerbian, vlSlovak, vlAlbanian, vlSwedish, vlThai, vlTurkish, vlUrdu, vlBahasa, vlSimplifiedChinese, vlSwissGerman, vlUKEnglish, vlMexicanSpanish, vlBelgianFrench, vlSwissItalian, vlBelgianDutch, vlNorwegianNynorsk, vlPortuguese, vlSerboCroatian, vlCanadianFrench, vlSwissFrench, vlUnknown); const LanguageValues: array[TVersionLanguage] of Word = ($0401, $0402, $0403, $0404, $0405, $0406, $0407, $0408, $0409, $040A, $040B, $040C, $040D, $040E, $040F, $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417, $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F, $0420, $0421, $0804, $0807, $0809, $080A, $080C, $0810, $0813, $0814, $0816, $081A, $0C0C, $100C, $0000); {獲取自身版本號所需要 end} type TScanMode = (smNew, smReplace, smInsert, smSample, smRTS); TpScanInfo = ^TScanInfo; TScanInfo = record MultiPage : Boolean; { supplementary info when MultiPage is True } Graphic : TTiffGraphic; Stream : TFileStream; ImageCount : LongInt; end; TOMRErrInfo = record Display : Boolean; //是否顯示 Ignore : Boolean; //可否刪除 Info : String; Mode : String; end; TScrollRec = Record HScroll : Integer; VScroll : Integer; Rate : Single; end; type TCB_IMGPSScanX = class(TActiveForm, ICB_IMGPSScanX) Panel1: TPanel; TransBtn: TBitBtn; Panel21: TPanel; ViewModeBtn: TPJMenuSpeedButton; Button2: TButton; Button1: TButton; OptionBtn: TBitBtn; SelectScanBtn: TBitBtn; NextPageBtn: TBitBtn; PrePageBtn: TBitBtn; FC6: TBitBtn; FC5: TBitBtn; FC4: TBitBtn; FC3: TBitBtn; FC2: TBitBtn; FC1: TBitBtn; FC0: TBitBtn; Panel23: TPanel; PJLinkedMenuSpeedButton2: TPJLinkedMenuSpeedButton; NewScanBtn: TBitBtn; AddScanBtn: TBitBtn; Panel4: TPanel; Panel2: TPanel; Splitter1: TSplitter; Panel3: TPanel; Label7: TLabel; TreeView1: TTreeView; Panel6: TPanel; CB1: TCheckBox; ScanDuplexCB: TCheckBox; ScanFlatCB: TCheckBox; Panel18: TPanel; Panel12: TPanel; Panel7: TPanel; Panel9: TPanel; Shape1: TShape; ImageScrollBox1: TImageScrollBox; imgp8: TPanel; lb8: TLabel; ISB8: TImageScrollBox; imgp7: TPanel; lb7: TLabel; ISB7: TImageScrollBox; imgp6: TPanel; lb6: TLabel; ISB6: TImageScrollBox; imgp5: TPanel; lb5: TLabel; ISB5: TImageScrollBox; imgp4: TPanel; lb4: TLabel; ISB4: TImageScrollBox; imgp3: TPanel; lb3: TLabel; ISB3: TImageScrollBox; imgp2: TPanel; lb2: TLabel; ISB2: TImageScrollBox; imgp1: TPanel; lb1: TLabel; ISB1: TImageScrollBox; Memo1: TMemo; Display1: TMemo; Panel22: TPanel; Panel8: TPanel; Label2: TLabel; Gauge1: TGauge; ScrollBar1: TScrollBar; Panel10: TPanel; PageLV: TListView; StatusBar1: TStatusBar; ImageList4: TImageList; ImageList3: TImageList; ImageList1: TImageList; PopupMenu2: TPopupMenu; mode1: TMenuItem; mode2: TMenuItem; mode3: TMenuItem; mode4: TMenuItem; N51: TMenuItem; ImageList2: TImageList; OpenDialog1: TOpenDialog; PopupMenu3: TPopupMenu; PM301: TMenuItem; PM302: TMenuItem; PM303: TMenuItem; Timer1: TTimer; TomEncryption1: TTomEncryption; SaveDialog1: TSaveDialog; Timer2: TTimer; VCLZip1: TVCLZip; PopupMenu4: TPopupMenu; PM401: TMenuItem; PM402: TMenuItem; PM403: TMenuItem; PM404: TMenuItem; HTTPSClient: TElHTTPSClient; ElWinCertStorage: TElWinCertStorage; ElMemoryCertStorage: TElMemoryCertStorage; Panel5: TPanel; AddCredit1RG: TRadioGroup; Panel11: TPanel; SampleScanBtn: TBitBtn; WNoteBtn: TBitBtn; Panel13: TPanel; CaseHelpBtn: TBitBtn; PopupMenu1: TPopupMenu; PM101: TMenuItem; N12: TMenuItem; PM102: TMenuItem; MenuItem1: TMenuItem; PM103: TMenuItem; PM104: TMenuItem; N7: TMenuItem; PM106: TMenuItem; PM107: TMenuItem; PM108: TMenuItem; PM109: TMenuItem; PopupMenu5: TPopupMenu; PM501: TMenuItem; PM502: TMenuItem; PM503: TMenuItem; PM504: TMenuItem; N5: TMenuItem; PM505: TMenuItem; PM506: TMenuItem; N29: TMenuItem; PM510: TMenuItem; PM509: TMenuItem; PM507: TMenuItem; N15: TMenuItem; PM508: TMenuItem; ExportBt: TButton; ImportBt: TButton; CheckCaseBtn: TBitBtn; DenialTimeLb: TLabel; Panel14: TPanel; ScrollBox1: TScrollBox; Label1: TLabel; Button3: TButton; Panel15: TPanel; Button4: TButton; PopupMenu6: TPopupMenu; PM602: TMenuItem; PM601: TMenuItem; PM605: TMenuItem; PM603: TMenuItem; PM604: TMenuItem; N8: TMenuItem; Panel16: TPanel; SpeedButton3: TSpeedButton; SpeedButton14: TSpeedButton; SpeedButton15: TSpeedButton; SpeedButton16: TSpeedButton; SpeedButton17: TSpeedButton; SpeedButton18: TSpeedButton; SpeedButton19: TSpeedButton; SpeedButton20: TSpeedButton; SpeedButton21: TSpeedButton; SpeedButton22: TSpeedButton; Edit1: TEdit; PM110: TMenuItem; Image1: TImage; PrtLb: TLabel; UseOldCaseLb: TLabel; PM111: TMenuItem; SmoothCB: TCheckBox; ISB_BW: TImageScrollBox; N1: TMenuItem; N2: TMenuItem; procedure ActiveFormCreate(Sender: TObject); procedure Panel9Resize(Sender: TObject); procedure ISB1Click(Sender: TObject); procedure WNoteBtnClick(Sender: TObject); procedure CaseHelpBtnClick(Sender: TObject); procedure FC0Click(Sender: TObject); procedure FC1Click(Sender: TObject); procedure FC2Click(Sender: TObject); procedure FC3Click(Sender: TObject); procedure FC4Click(Sender: TObject); procedure FC5Click(Sender: TObject); procedure FC6Click(Sender: TObject); procedure PrePageBtnClick(Sender: TObject); procedure NextPageBtnClick(Sender: TObject); procedure OptionBtnClick(Sender: TObject); procedure SelectScanBtnClick(Sender: TObject); procedure mode1Click(Sender: TObject); procedure mode2Click(Sender: TObject); procedure mode3Click(Sender: TObject); procedure mode4Click(Sender: TObject); procedure N51Click(Sender: TObject); procedure ScrollBar1Change(Sender: TObject); procedure ISB1EndScroll(Sender: TObject); procedure ISB1ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ISB1ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ISB1ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PM508Click(Sender: TObject); procedure PM401Click(Sender: TObject); procedure PM402Click(Sender: TObject); procedure PM403Click(Sender: TObject); procedure PM404Click(Sender: TObject); procedure TreeView1Click(Sender: TObject); procedure NewScanBtnClick(Sender: TObject); procedure AddScanBtnClick(Sender: TObject); procedure PageLVClick(Sender: TObject); procedure PageLVKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure PageLVMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure PM101Click(Sender: TObject); procedure PM104Click(Sender: TObject); procedure PM102Click(Sender: TObject); procedure PM103Click(Sender: TObject); procedure PM106Click(Sender: TObject); procedure PM107Click(Sender: TObject); procedure PM108Click(Sender: TObject); procedure PM109Click(Sender: TObject); procedure PM301Click(Sender: TObject); procedure PM302Click(Sender: TObject); procedure PM303Click(Sender: TObject); procedure PM501Click(Sender: TObject); procedure PM502Click(Sender: TObject); procedure PM503Click(Sender: TObject); procedure PM504Click(Sender: TObject); procedure PM505Click(Sender: TObject); procedure PM510Click(Sender: TObject); procedure PM509Click(Sender: TObject); procedure PM507Click(Sender: TObject); procedure PopupMenu1Popup(Sender: TObject); procedure PopupMenu4Popup(Sender: TObject); procedure PopupMenu5Popup(Sender: TObject); procedure SampleScanBtnClick(Sender: TObject); procedure StatusBar1DblClick(Sender: TObject); procedure ExportBtClick(Sender: TObject); procedure ImportBtClick(Sender: TObject); procedure HTTPSClientCertificateValidate(Sender: TObject; X509Certificate: TElX509Certificate; var Validate: Boolean); procedure ScanDuplexCBClick(Sender: TObject); procedure CheckCaseBtnClick(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Timer2Timer(Sender: TObject); procedure TransBtnClick(Sender: TObject); procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure TreeView1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure TreeView1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ViewModeBtnMouseEnter(Sender: TObject); procedure Button3Click(Sender: TObject); procedure AddCredit1RGClick(Sender: TObject); procedure CB1Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure ISB1Enter(Sender: TObject); procedure TreeView1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure PM601Click(Sender: TObject); procedure PopupMenu6Popup(Sender: TObject); procedure PM604Click(Sender: TObject); procedure PM605Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure SpeedButton14Click(Sender: TObject); procedure SpeedButton15Click(Sender: TObject); procedure SpeedButton16Click(Sender: TObject); procedure SpeedButton17Click(Sender: TObject); procedure SpeedButton18Click(Sender: TObject); procedure SpeedButton19Click(Sender: TObject); procedure SpeedButton20Click(Sender: TObject); procedure SpeedButton21Click(Sender: TObject); procedure SpeedButton22Click(Sender: TObject); procedure ActiveFormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure PM110Click(Sender: TObject); procedure PM602Click(Sender: TObject); procedure PrtLbClick(Sender: TObject); procedure Panel1DblClick(Sender: TObject); procedure Panel11DblClick(Sender: TObject); procedure UseOldCaseLbClick(Sender: TObject); procedure PM111Click(Sender: TObject); procedure ImageScrollBox1NewGraphic(const Graphic: TDibGraphic); procedure SmoothCBClick(Sender: TObject); procedure N1Click(Sender: TObject); private { Private declarations } HotKeyId1,HotKeyId2,HotKeyId3,HotKeyId4 :Integer; ////////傳入參數///////// FUrl : String; FCaseID : String; FMode : String; //NSCAN:新件;ESCAN:修改 20170306 DSCAN:被配合待掃瞄清單使用 FModeName : String; FWork_no : String; FUserID : String; FUserName : String; FUserUnit : String; FData : String; FVerify : String; FReWrite : String; FLanguage : String; FLoanDoc_Value : String; //新增授信卷的值 FLoanDoc_Enable : String; //新增授信卷是否可異動 FUseProxy : String; //是否使用Proxy FC_DocNoList : String; //外面傳來要新增的文件編號 FC_DocNameList : String; //外面傳來要新增的自訂文件 FFixFileList : String; //要鎖住的檔名 FIs_In_Wh : String; //是否只顯示入庫文件 (Y:只顯示入庫 N:只顯示非入庫 空白:都顯示) FOldCaseInfo : String; //舊件資訊 CaseID_year[tab]CaseID_year FPrintyn : String; //是否可列印 FIs_OldCase : String; //是否是舊案第一次進入 FCustDocYN : String; //是否可自訂文件 //20170222 新增 FImgDPI:integer;//DPI  依業務別決定 150~~1200  預設300 FScanColor:integer;///掃瞄色彩  依業務別決定   0 :黑白  1：灰階   2：彩色 預設黑白 FFileSizeLimit:integer;//匯入單一檔案大小限  依業務別決定  以KB為單位  預設5*1024kb FCaseNoLength:integer;//案件編號長度檢查  依業務別決定   無預設  一定要傳入 FImgDelete:string; // Y/N 有權限可在補件時刪除影像 FIsExternal:string;//Y/N FCheck_main_form:string; //Y/N ////////傳入參數/////// //********Http參數******** HttpErrStr : String; //錯誤訊息 //********Http參數******** //********ini參數******** DeviceDelete : Boolean; //空白頁刪除啟動 DeviceDeleteSize : Integer; //空白頁Size ScannerReverse : Boolean; //是否需反相 BoardClear : Boolean; //是否清黑邊 ScanDpi : Integer; //掃瞄DPI ScanDuplex : Boolean; //是否雙面掃瞄 ScanRotate : Integer; //掃瞄時旋轉角度 ScanDeskew : Boolean; //是否傾斜矯正 ScanBright : Integer; //亮度 ScanContrast : Integer; //對比 ScanImgShowMode : Integer; //0:清楚影像 1:不清楚影像 2:不顯示 ScanImgSetUse : Boolean; //是否使用亮度對比設定 //********ini參數******** ScanColor : TImageFormat; //********時間******** ServerDate : String; ServerTime : String; Balance : Longint; //local跟server的時間差 ScanDenialTime : String; //停止進件時間 //********時間******** ScanDenialHint : String; //掃描顯示提醒字串 //********路徑******** ScanPath : String; // SpecifyDir\Workid\userunit\mode ImagePath : String; // SpecifyDir\Workid\userunit\mode ImageSavePath : String; // ImagePath\ ScaniniPath : String; // SpecifyDir\Workid\userunit\ LngPath :String; //多國語言檔目錄 CheckXmlPath : String; //檢核用的Xml存放目錄 SitePath : String; //登打位置(切簽名用) SamplePath : String; //範本目錄 TransPath : String; //檔案上傳的路徑(補充件會多一層目錄) //********路徑******** ScanSaveFilename : String; //掃瞄的檔名 ScanCaseno : String; //掃瞄時的案號 ScanDocDir : String; //掃描時的文件代號目錄 //********清單區******** Doc_Inf_List : TStringList; //Doc_Inf 清單 DM_FORM_INF_List :TstringList; //DM_FORM_INF 清單 FORM_INF_List : TStringList; //FORM_INF的清單 CHECK_RULE_INF_List : TStringList; //CHECK_RULE_INF 清單 MEMO_INF_List : TStringList; //MEMO_INF 清單 WORK_INF_List : TStringList; //WORK_INF 清單 LASTEST_FORM_INF_List : TStringList; // LASTEST_FORM_INF 清單 FindResult : TStringList; //找SQLData的結果 CaseList : TStringList; //記錄掃瞄案件的順序 Context_DocnoList : TStringlist; //案件裡的Docno清單 CaseDocNoList : TStringlist; //案件裡的DocNo清單(不重複) CaseDocNo_CopiesList : TStringlist; //案件裡的DocNo份數清單 ContextList : TStringlist; //案件裡的檔案清單 OMRFileList : TStringList; //要OMR檢核的文件(只檢查每種Form的第一頁) Cust_DocNoList : TStringlist; //自行定義文件名稱 IN_WH_DocNoList : TStringlist; //入庫的文件清單 FormCode_PageSize : TStringList; //文件的預設大小 FormCode_Height_Width DocNo_NeedDoc : TStringList; //有Docno時要相依的文件 DocNo_相依文件_相依文件 DocNo_NoDoc : TstringList; //有Docno時互斥的文件 DocNo_互斥文件_互斥文件 DocNo_VerinCase : TStringlist; //案件裡的DocNo+版本的清單 NoSaveBarCodeList : TStringlist; //不儲存的條碼清單 FormID_List : TStringlist; //FormID 清單 20130403 因為原FormCode2Docno會很慢..把FormID抽出來 DocNo_List : TStringlist; //DocNo 清單 20130403 因為原FormCode2Docno會很慢..把DocNo抽出來 NowShowFileList : TStringlist; //目前顯示的影像清單 NowSelectFileList : TStringlist; //目前被點選的影像清單 GuideFormIDList : TStringlist; //要當導引頁表單清單 DivPageFormIDList:TStringlist; //要當分案頁表單清單 LastInitFormidList:TStringList; LastAddFormidList:TstringList; //********清單區******** //********顯示區******** NowCaseno : String; //目前顯示的案件編號 NowDocNo : String; //目前的文件編號 NowDocDir : String; //目前的文件目錄 NowFormCode : String; //目前顯示的表單編號 NowFormName : String; //目前顯示的表單名稱 NowPage : Integer; //目前點選的頁碼 DisplayPath : String; //目前顯示的目錄 //********顯示區******** //******索引資料********* Case_loandoc : String; //是否新增授信卷 //******索引資料********* //********十字定位點資訊******** UpLPoint : Tpoint; //左上方的十字點 UpRPoint : Tpoint; //右上方的十字點 DownLPoint : Tpoint; //左下方的十字點 DownRPoint : Tpoint; //右下方的十字點 Point_Width : String; //十字點的寬 Point_Height : String; //十字點的高 //********十字定位點資訊******** CaseIDLength : Integer; //案件編號長度 FormIDLength : Integer; //FormID長度 DocNoLength : Integer; //Docno長度 PEFileName : String; //掃描時的檔名 ISB : TImageScrollBox; ScanInfo : TScanInfo; TwainShowUI : Boolean; MpsBarcodeinf : TMpsBarcodeinf; ScanMode : TScanMode; Mpskey : String; Seg : Integer; //顯示的邊界值 VMode : Integer; //顯示的index NowClick : Integer; //目前點到的按鈕功能Index ScanIP : String; //掃瞄端的IP DisplayISB : TImageScrollBox; //被點到的影像 SelectISB : TImageScrollBox; //被點到的縮圖 SelectPage : Integer; //被點到的頁數 NewTreeNode,MyTreeNode1,MyTreeNode2,MyTreeNode3 : TTreenode; InitialOk : Boolean; //資訊載入是否完成 ShowText : String; //DataLoading時要秀出的訊息 Ext : String; //附檔名 .tif .jpg SafePixel : Integer; //OMR容忍誤差值點數 OMRErrInfo : Array[1..11] of TOMRErrInfo; //檢核的方式及訊息 ScrollRec : Array[1..8] of TScrollRec; //瀏覽窗的Scroll記錄 RecHozPos,RecVerPos : Integer; //記錄MPSViewX1的ScrollBar位置 ReczoomPercent : Single; SortMode : Boolean; PreMytreeNode2Name:String; HS,VS : Integer; iRate : Single; Bt : Integer; //去直線時橫線判斷的容忍值 BarCodeRotate : Integer; //條碼要轉的角度 HaveAppDoc : Boolean; //補全時是否有補入要保書 PageLVclear : Boolean; CaseCount,PageCount : Integer; //總案件量及總頁數 Item : TMenuItem; SampleAnchorMode : String; //範本掃瞄十字線的模式 NONE:無;ANCHOR:十字;FRAME:邊框 DownImgStatus : String; //下載影像的狀態(NO_DATA:沒資料;NO_FILE:沒影像) TransForm_Field : String; //要用OMR勾選確認是否轉換FORMID的欄位名稱 NowWork_No : String; //現在的作業別 CropBarcode : String; //要切影像的條碼 Has_Authorize :String; //是否有授權書影像 AttName : String; //未歸類目錄名稱 NowGuideFormID : String; NowDivPageFormID:String; FirstDocDir : String; Draging : Boolean; FEvents: ICB_IMGPSScanXEvents; procedure HotKeyDown (var Msg : TMessage);message WM_HOTKEY; Procedure InitialLanguage(Sender: TObject); //畫面載入多國語言 //Function _Msg(S:String):String; //*********SQL相關************ Procedure SetSQLData(ColumeStr:String;FromList,ToList:TStringlist); //把SQL值塞入 Function GetSQLData(TableList:TStringlist;Colname:String;colNo:Integer):String; //依欄位及索引取值 Function FindSQLData(TableList:TStringlist;ColumeStr,KeyColumeStr,KeyStr:String;ColNo:Integer;Var ResultList:TStringlist):Boolean; //找指定的資料 Function GetFindResult(Col:String):String; //*********SQL相關************ //*******轉換區********* Function FindDivFormCode(FormCode:String):Boolean; //找有沒有分案的條碼 Function FormCode2FormName(CaseID,FormCode:String):String; //用FormCode轉成文件名稱 Function FormCode2FileName(FormCode:String;List:TStrings):String; //用FormCode找出檔名(第一頁) Function FileName2FormCode(FileName:String):String; //從檔名取出FormCode Function FileName2FormName(CaseID,FileName:String):String; //從檔名取出文件名稱 Function FileName2ScanPage(FileName:String):Integer; //從檔名取出掃瞄頁數 Function FileName2NoQuene_Filename(FileName:String):String; //取出沒有序號的檔名 Function FileName2Index(FileName:String):Integer; //從檔名取出在ContextList的序號 Function FileName2NowDcoNo(FileName:String;CtList,DNList:TStrings):String; //從檔名取出歸屬的文件代號 Function FormCode2DocNo(FormCode:String):String; //FormCode轉Docno Function FormCode2Version(FormCode:String):String; //FormCode轉版本 Function FormCode2Page(FormCode:String):String; //FormCode轉文件頁數 Function DocNo2DocName(CaseID,DocNo:String):String; //Docno轉Doc名稱 Function DocNo2FileName(DocNo:String;List:TStrings):String; //用DocNo找出檔名(第一頁) Function FormCode2WorkNo(FormCode:String):String; //用FormCode取出作業別 Function DocNo2WorkNo(DocNo:String):String; //用DocNo取出作業別 Function DocNo2DocNoDir(Path,DocNo:String):String; //DocNo轉成DocNo(份數)目錄 Function DocNoDir2DocNo(DocNoDir:String):String; //DocNo(份數)目錄轉成DocNo Function DocNoDir2Index(Path,DocNoDir:String):Integer; //DocNo(份數)目錄轉成index Function DocNoNeedDiv(DocNo:String):Boolean; //是否是需分份數的文件代號 //Function CaseNo2DocNo(CaseNo:String):TStringList; Function CaseNode2Info(Node:TTreeNode;Mode:Char):String; //案件Node取案件編號 Mode: I:Caseno;P:Page Function DocNode2Info(Node:TTreeNode;Mode:Char):String; //文件Node取文件代號 Mode: I:Docno;N:Docname;P:Page;G:Group Function FormNode2Info(Node:TTreeNode;Mode:Char):String; //表單Node取表單代號 Mode: I:FormID;N:FormName;P:Page //*******轉換區********* Procedure PriorPage(Page:Integer); //上一頁 Procedure NextPage(Page:Integer); //下一頁 Function DocNoExistsinTree(CaseNode:TTreeNode;DocNo:String):Boolean; //DocNo是否己存在樹裡 Function DocnoNeedGroup(DocNo:String):Boolean; //傳入的DocNo是否需分組 function GetSiteOMR(FileName, Site: String;bt: Integer): Integer; Function FindISB2View(Vmode:Integer):TImageScrollBox; //找空的ISB來顯示 Procedure R_W_ScanIni(Mode:Char); //'R'讀取;'W'寫入 Procedure GetDefScanIni; //取得掃瞄的預設值 procedure DesableImage; procedure EnableImage(v:integer;Sender : TObject); Procedure ViewMouseMode(v:Integer); Procedure GoViewMode; Procedure DisplayMode(index,H_Count,W_Count:Integer;BasePanel:TPanel); Function GetServerDate : Boolean; //取主機時間 Function GetSetInf1 : Boolean; //取系統設定資訊mode1 DOC_INF Function GetSetInf2 : Boolean; //取系統設定資訊mode2 DM_FORM_INF Function GetSetInf3 : Boolean; //取系統設定資訊mode3 FORM_INF Function GetSetInf4 : Boolean; //取系統設定資訊mode4 CHECK_RULE_INF Function GetSetInf5 : Boolean; //取系統設定資訊mode5 MEMO_INF Function GetSetInf6 : Boolean; //取系統設定資訊mode6 WORK_INF Function GetSetInf7 : Boolean; //取系統設定資訊mode7 LASTESTFORM_INF Procedure SetFormID_DocNo; //將FormID及Docno抽出來另存入list裡 Procedure SetIn_WH_DocNo; //將要入庫的DocNo抽出來另存入list裡 Procedure DataLoading(Loading,UseTimer:Boolean); //資料載入中要停止點選的動作 procedure ClearView(stkv:Integer); //清除瀏覽窗的影像 Function DrawDocItem2(CaseNode : TTreenode;Caseno:String):Boolean; //畫出文件名稱的Tree Procedure initkscan; //檢查掃描器的功能 procedure LoadImgFile; //載入案件 procedure LoadImgFile1; //載入案件 Procedure DistinctFormCode(CaseID:String); //案件裡的FormCode取出第一頁 Function OMRCheckCase(CaseID:String):Boolean; //OMR檢核 Procedure OMRErr2ini(CaseID,Reason,FileName,Site,RelaFileName,RelaSite,Anchor,Anchor1:String;Del,Ingnore,Display:Boolean); //OMR檢核失敗寫入ini Procedure OMRErrini2List(CaseID:String;ErrlistForm : TErrlistForm); //OMR檢核失敗從ini寫入ListView Function DownLanguage:Boolean; //下載多國語言檔 Function FindMpsView(Vmode:Integer):TImageScrollBox; Function CaseAsk(CaseID:String):Integer; //詢問是否可上傳 (-1:失敗;0:可以;1:不行;) Function CaseComplete(Path,CaseID:String;MainCase:Boolean):Boolean; //通知傳送完成 Function GetCaseFormID(Path:String):String; //取案件的FormID Procedure CreateFormID_FormName(Path,CaseID:String); //產生FormID_FormName.dat Procedure CreateDocNo_DocName(Path,CaseID:String); //產生DocNo_DocName.dat Procedure CreateIn_WH(CaseID:String); //產生In_WH.dat Function CreateDocNo_Info(CaseID:String):String; //產生保管袋文件 DocNo[tab]份數[tab]總頁數[tab]是否異動[換行]DocNo[tab]份數[tab]總頁數[tab]是否異動 Function CreateCustDocNo_Info(CaseID:String):String; //產生自訂文件 DocName[tab]份數[tab]總頁數[tab]是否異動[#13#10]DocName[tab]份數[tab]總頁數[tab]是否異動 //Function CreateCustDocNo_Info(path,CaseID:String):String; overload Function CreateAttach_Info(CaseID:String):String; //產生是否有Attach Y:有 N:沒有 Function CreateDocnoFrom_Info(CaseID:String):String; //產生被引進的保管袋文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號 Function CreateCustDocNoFrom_Info(CaseID:String):String; //產生被引進的自定文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號 Function GetDocNoEdit(CaseID,DocNo,DocName:String):String; //取出DocNo是否被異動 (Y/N) Function GetDocNo_Count(Path,DocNo:String):Integer; //取出文件份數 Function GetDocNo_Page(Path,DocNo:String):Integer; //取出文件總頁數 Function FormIDExists(FormCode:String;CheckDate:Boolean;index:Integer):Boolean; //檢查FormID是否存在及是否要檢查啟用停用日期 Function Case_DocNoExists(CaseID,Docno:String):Boolean; //Docno是否存在案件裡 Procedure ReSortFileName_New(Path:String); //檔名重新排序 Procedure ReSortFileName(Path:String); //檔名重新排序 Procedure ReSortFileName2Scanlist(Path:String); //檔名重新排序給Scanlist.dat Function GetOMRCheckSet:Boolean; //下載OMR檢核XML檔 Function GetKeyinSet : Boolean; //取登打設定 Procedure CheckRule2OMRErrInfo; //檢核規則填入OMRErrINFo Record Procedure ReNameContext(Path,OldName,NewName:String); Procedure DeleteImageFile(Path,FileName,CaseID:String); // 刪除檔案 Procedure DeleteFormCodeFile(CaseID,DocDir,FormID:String); //刪除指定FormID文件 Function DeleteDocNoFile(Path,DocNo:String):Boolean; //刪除指定DocNo文件 Procedure DeleteShowFile(Path:String); //刪除顯示中的影像 Function GetDataDocNoPage(MainDocNo,MainVersion:String):Integer; //取記錄的文件_版本頁數 Function CheckCaseDocNoPage(CaseID,DocNo,Version:String;Pages:Integer):Integer; //檢查案件裡的文件_版本頁數 Function FindFormCodePages(CaseID,FormCode:String):Integer; //計算案件裡FormID的頁數 Function GetDataFormCodePages(FormCode:String):Integer; //取記錄的FormcID的頁數 Procedure CaseReSize(CaseID:String); //案件的影像縮放 Procedure ImageReSize(CaseID,FileName:String); //依十字定位點做縮放 Procedure ImageReSize_tmp(FormID,FileName:String); //依十字定位點做縮放(暫存檔) Function TransCaseID(Path,CaseID:String;MainCase:Boolean):Boolean; //傳送案件 Procedure NewTreeNodeRefresh; Procedure MyTreeNode1Refresh; Procedure MyTreeNode2ReFresh(CaseID:String); Procedure MyTreeNode3ReFresh(CaseID:String); Function Node2DocNo(Node2:TTreeNode):String; //MyTreeNode2取DocNo出來 Function Node3DocNo(Node3:TTreeNode):String; //MyTreeNode3取DocNo出來 Function Node3FormID(Node3:TTreeNode):String; //MyTreeNode3取FormCode出來 Function GetNode2Name(Node2:TTreeNode):String; //取MyTreeNode2的識別字出來(記之前點選用) //Function Down_Replace_Img(SPAth,DPath,CaseID:String):Boolean; Function Down_Img(Path,CaseID:String):Boolean; Function GetNoNameCase(Path:string):String; //取未配號XXXX Procedure CaseResort(Path:String); //案件的檔案重新排序(次文件依Docno挑) Procedure CaseResort2Scanlist(Path:String); //案件的檔案重新排序給scanlist(次文件依FormID排) Procedure DistinctDocinCase(Path:String); //列出案件裡的Docno_版本 Procedure DistinctDocNoinCase(Path:String); //列出案件裡的Docno Procedure ClearErrini(CaseID:String;CaseNode:TTreeNode); //清掉檢核檔案 Procedure SetCaseList(Mode:Char;Index:Integer;text:String); //'A:加入,I:插入,D:刪除,E:修改' Procedure SetDocNoList(Mode:Char;Index:Integer;CaseNo,DocDir,Copies:String); //'A:加入,I:插入,D:刪除,E:修改' Procedure SetContextList(Mode:Char;Index:Integer;CaseNo,DocDir,FileName:String); //'A:加入,I:插入,D:刪除,E:修改' Function checkCaseOMRDone:Boolean; //檢查案件是否完成OMR檢核 Function CheckCaseID_OK:Boolean; //檢查是否有未配號的案件 Procedure CreateEmptyCase(Path,CaseID:String); //產生空白案號(重掃件用) Procedure InitScrollRec; //初始化影像Scroll記錄 Procedure GetScrollData(ISB:TImageScrollBox;Var HS,VS:Integer;Var iRate:Single); //取影像Scroll記錄 Procedure SetScrollData(ISB:TImageScrollBox;HS,VS:Integer;iRate:Single); //寫影像Scroll記錄 Procedure FormIDReplace(CaseID,DocDir,OldFormID,NewFormID:String); //指定FormID更換成新的FormID Procedure ShowFileReplace(Path,NewFormID:String);//顯示的影像換成新的FormID Procedure PageReplaceFormID(Path,NowFormID,NewFormID:String); //選取頁更換FormID Function ModeNeedCheck(OMRMode,ScanMode:String):Boolean; //掃瞄模式是否要做檢核 procedure WMMOUSEWHEEL(var message: TWMMouseWheel); message WM_MOUSEWHEEL; Function GetInputMask:String; //取得輸入的保單號碼 Function GetCasePage(Path,CaseID:String):Integer; Function GetFormIDPage(FileList:TStringlist;FormID:String):Integer; Procedure SetFile2Case(CaseID,FileName:String); Procedure WriteResize(ImgName,TxtName:String); //產生Resize.dat Function GetCase_PageCount(var CaseCount,PageCount:Integer):Boolean; //取出案件的數量及頁數 ID為空值時為取所有的 Function BarCode2FormID : String; //Barcode依規則轉成FormID Function BarCode2CaseID : String; //Barcode依規則轉成CaseID Procedure WriteCaseIndex(Path:String); Procedure ReadCaseIndex(Path:String); Procedure ClearCaseIndex; Procedure GetSelectImageFile; Function GetDocNoDir(Path,DocNo:String):String; //取出目前DocNo的份數 Function CheckFormIDExists(DocNoNode:TTreeNode;FormID:String):Boolean; //檢查FormID是否存在文件裡 Procedure ZipMainFile(SoPath,DePath,ZipName:String); //壓縮影像檔 Procedure ZipMaskFile(SoPath,MarkPath,DePath,ZipName:String); //壓縮遮罩影像檔 Procedure ParserPoint(S:String); //解析十字點的字串 Function CheckScanDenialTime:Boolean; Function FormID2Anchor(FormID:String):String; //用FormID取出十字模式 Function Index2Anchor(Anchor:String):String; //十字模式 0->NONE;1->ANCHOR;2->FRAME Function MemoInfoTransfer(Mode,Str:String;ID_S,Name_S:TStringlist):String; //註記代碼註記類別轉換 Mode 'ID':代碼轉名稱;'NAME':名稱轉代碼 Function GetFormatID(CaseID:String):String; //取出案件的FormatID Function FindNoSaveBarCode : Boolean; //找是否有不要儲存影像的條碼 Function CheckAvailable:Boolean; //檢查是否可使用元件 Function Case2Mask(SoPath,DePath:String):Boolean;//產生遮罩影像 Function CheckNeedCrop(Graphic:TDibGraphic):Boolean; //是否是A3要切影像 Function GetNewCustomDocNo(Path,DocName:String):String; //取出未使用的自訂文件代號 Function GetCustomDocName(Path,DocNo:String):String; //取出自定文件名稱 Function GetCustomFormID(Path,DocNo:String):String; //取出自定文件FormID Function GetCustomDocDir(Path,DocName:String):String; //取出自定文件DocDir Function FindCustomDocName(Path,DocName:String):Boolean; //尋找自定文件名稱是否存在 Procedure DeleteCustomDocDir(Path,DocNo:String); //刪除自定文件DocNo Function CheckFormID_Prt(FormID:String):Boolean; //傳入的FormID是否預設列印 procedure PrintImg(FileName, LoginID, Datetime,Path: WideString); Function FindLastestDocDir(CaseID,DocNo:String):String; //找出最新的DocDir Procedure Create_Cust_DocDir(CaseID:String); //產生外面傳入的文件代號及自定文件 Procedure OldCasetoNewCase(CaseID:String); //將舊案份數轉成新規則 Procedure ErrFormtoCurrentForm(CaseID,EFormID,CFormID:String);//將舊案的錯誤FormID改正確的FormID Procedure SetRecordEditedDocDir(Mode:Char;CaseID,DocDir:String); //記錄被異動的文件目錄 'A:加入D:刪掉' Function GetDocDir_Page(CaseID,DocDir:String):Integer; //取得DocDir的頁數 Function Path2DocDir(Path,CaseID:String):String; Function GetDocNo_IS_WH(DocNo:String):Boolean; //DocNo是否為入庫文件 Procedure SortDocDir_FormID(CaseID,DocDir:String); //將DocDir裡的文件編號排序 Procedure GotoAttach(OldLevel:Integer); Function DocNoIs_In_WH(DocNo:String):Boolean; //DocNo是否為入庫文件 Procedure CreateCaseNeedData(Path:String); //先做影像截取會少二個文字檔,產生CaseDocNo.dat及DocDir.dat Procedure SetDocDirtoSelected(CaseNode:TTreeNode;DocDir:String); Function CheckSelectImg_UseCase(Path,CaseID:String):Boolean; //檢查選擇的影像是否有包含被引用的影像 Function TransOldCaseFile(Path:String):Boolean; //上傳引用舊件的記錄檔 Function Writelog(CaseID:String):Boolean; Function FormIDAppear(FormID:String):Boolean; //FormID是否可出現 Function DocNoAppear(DocNo:String):Boolean; //DocNo是否可出現 Function GetDocNoCount(CaseID,DocNo:String):Integer; //取DocNo數量 Function GetDocDirCopies(CaseID,DocDir:String):Integer; //取DocDir份數 Procedure SetDocDirCopies(CaseID,DocDir:String;NewCopies:Integer); //修改DocDir份數 Function GetDocDirCopies_Rec(Path,CaseID,DocDir:String):Integer; //取記錄裡的DocDir份數 Function GetCustomNameCount(CustomName:String):Integer; //取外傳的名稱數量 Function GetCustomDocNoCount(Docno:String):Integer; //取外傳的DocNo數量 Function ISGuideFormID(FormID:String):Boolean; Function CaseDelete_Enable(CaseID:String):Boolean; //案件可否被刪除 Procedure MoveImage(Path:String;mp:Integer); //移動頁數 Procedure MoveImage_Drag(Path:String;fp,tp:Integer); //拖拉移動頁數 Procedure SetUseCase(Mode:Char;Path,DocDir,FormCaseID,ToCaseID:String); //記錄引用其他案件 A:加入 D:刪掉 Function GetUseCase(Mode:Char;Path,DocDir:String):String; //F:取被引用 To:引用 Procedure Case2upload(CaseID:String); Procedure Download2Case(SoDir,DeDir:String); procedure view_image_FormCode(Path,FormCode:String;stpage,stview:integer); //用FormCode來找影像 procedure view_image_DocNo(Path,DocNo,FormID:String;Pages:integer); //用DocNo來找影像 Function ShapeName2PreViewISBName(SP:TShape):String; //轉出指定PreViewISBName Procedure CreatePreViewISB(Count:Integer); Procedure FreePreViewISB; Procedure FitPreViewISB; Procedure PaintShape(FromImg,ToImg:TImageScrollBox); //畫有被選取的影像 Procedure FreeShapeobj(SelectISB : TImageScrollBox); Procedure ISBClick(Sender : TObject); Procedure ISBMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ISBImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ISBImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ISBEndDrag(Sender, Target: TObject; X, Y: Integer); procedure ISBDragDrop(Sender, Source: TObject; X, Y: Integer); procedure ISBDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure BtnMouseEnter(Sender: TObject); procedure PageEnd; //掃描接收完成 Procedure PageDone; //掃描完成後顯示影像 procedure StatrTwainScan; procedure OnAcquire( const DibHandle : THandle; const XDpi : Word; const YDpi : Word; const CallBackData : LongInt ); procedure ActivateEvent(Sender: TObject); procedure ClickEvent(Sender: TObject); procedure CreateEvent(Sender: TObject); procedure DblClickEvent(Sender: TObject); procedure DeactivateEvent(Sender: TObject); procedure DestroyEvent(Sender: TObject); procedure KeyPressEvent(Sender: TObject; var Key: Char); procedure MouseEnterEvent(Sender: TObject); procedure MouseLeaveEvent(Sender: TObject); procedure PaintEvent(Sender: TObject); function GetCurrentVersionNo: String; procedure initParameter; procedure LastInitFormidListCreate(path:string); function checkFormCodeIsCustom(path,formcode:string):boolean; function ISDivPageFormID(FormID: String): Boolean; protected { Protected declarations } procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override; procedure EventSinkChanged(const EventSink: IUnknown); override; function Get_Active: WordBool; safecall; function Get_AlignDisabled: WordBool; safecall; function Get_AlignWithMargins: WordBool; safecall; function Get_AutoScroll: WordBool; safecall; function Get_AutoSize: WordBool; safecall; function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall; function Get_Caption: WideString; safecall; function Get_Color: OLE_COLOR; safecall; function Get_DockSite: WordBool; safecall; function Get_DoubleBuffered: WordBool; safecall; function Get_DropTarget: WordBool; safecall; function Get_Enabled: WordBool; safecall; function Get_ExplicitHeight: Integer; safecall; function Get_ExplicitLeft: Integer; safecall; function Get_ExplicitTop: Integer; safecall; function Get_ExplicitWidth: Integer; safecall; function Get_Font: IFontDisp; safecall; function Get_HelpFile: WideString; safecall; function Get_KeyPreview: WordBool; safecall; function Get_MouseInClient: WordBool; safecall; function Get_ParentCustomHint: WordBool; safecall; function Get_ParentDoubleBuffered: WordBool; safecall; function Get_PixelsPerInch: Integer; safecall; function Get_PopupMode: TxPopupMode; safecall; function Get_PrintScale: TxPrintScale; safecall; function Get_Scaled: WordBool; safecall; function Get_ScreenSnap: WordBool; safecall; function Get_SnapBuffer: Integer; safecall; function Get_UseDockManager: WordBool; safecall; function Get_Visible: WordBool; safecall; function Get_VisibleDockClientCount: Integer; safecall; procedure _Set_Font(var Value: IFontDisp); safecall; procedure Set_AlignWithMargins(Value: WordBool); safecall; procedure Set_AutoScroll(Value: WordBool); safecall; procedure Set_AutoSize(Value: WordBool); safecall; procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall; procedure Set_Caption(const Value: WideString); safecall; procedure Set_Color(Value: OLE_COLOR); safecall; procedure Set_DockSite(Value: WordBool); safecall; procedure Set_DoubleBuffered(Value: WordBool); safecall; procedure Set_DropTarget(Value: WordBool); safecall; procedure Set_Enabled(Value: WordBool); safecall; procedure Set_Font(const Value: IFontDisp); safecall; procedure Set_HelpFile(const Value: WideString); safecall; procedure Set_KeyPreview(Value: WordBool); safecall; procedure Set_ParentCustomHint(Value: WordBool); safecall; procedure Set_ParentDoubleBuffered(Value: WordBool); safecall; procedure Set_PixelsPerInch(Value: Integer); safecall; procedure Set_PopupMode(Value: TxPopupMode); safecall; procedure Set_PrintScale(Value: TxPrintScale); safecall; procedure Set_Scaled(Value: WordBool); safecall; procedure Set_ScreenSnap(Value: WordBool); safecall; procedure Set_SnapBuffer(Value: Integer); safecall; procedure Set_UseDockManager(Value: WordBool); safecall; procedure Set_Visible(Value: WordBool); safecall; procedure Set_caseid(const Value: WideString); safecall; procedure Set_data(const Value: WideString); safecall; procedure Set_mode(const Value: WideString); safecall; procedure Set_rewrite(const Value: WideString); safecall; procedure Set_url(const Value: WideString); safecall; procedure Set_userid(const Value: WideString); safecall; procedure Set_username(const Value: WideString); safecall; procedure Set_verify(const Value: WideString); safecall; procedure Set_language(const Value: WideString); safecall; procedure Set_modename(const Value: WideString); safecall; procedure Set_userunit(const Value: WideString); safecall; procedure Set_work_no(const Value: WideString); safecall; procedure Set_loandoc_enable(const Value: WideString); safecall; procedure Set_loandoc_value(const Value: WideString); safecall; procedure Set_useproxy(const Value: WideString); safecall; procedure Set_c_docnamelist(const Value: WideString); safecall; procedure Set_c_docnolist(const Value: WideString); safecall; procedure Set_fixfilelist(const Value: WideString); safecall; procedure Set_is_in_wh(const Value: WideString); safecall; procedure Set_oldcaseinfo(const Value: WideString); safecall; function Get_c_docnamelist: WideString; safecall; function Get_c_docnolist: WideString; safecall; function Get_caseid: WideString; safecall; function Get_data: WideString; safecall; function Get_fixfilelist: WideString; safecall; function Get_is_in_wh: WideString; safecall; function Get_language: WideString; safecall; function Get_loandoc_enable: WideString; safecall; function Get_loandoc_value: WideString; safecall; function Get_mode: WideString; safecall; function Get_modename: WideString; safecall; function Get_oldcaseinfo: WideString; safecall; function Get_rewrite: WideString; safecall; function Get_url: WideString; safecall; function Get_useproxy: WideString; safecall; function Get_userid: WideString; safecall; function Get_username: WideString; safecall; function Get_userunit: WideString; safecall; function Get_verify: WideString; safecall; function Get_work_no: WideString; safecall; function Get_printyn: WideString; safecall; procedure Set_printyn(const Value: WideString); safecall; function Get_is_oldcase: WideString; safecall; procedure Set_is_oldcase(const Value: WideString); safecall; function Get_custdocyn: WideString; safecall; procedure Set_custdocyn(const Value: WideString); safecall; function Get_casenolength: WideString; safecall; function Get_filesizelimit: WideString; safecall; function Get_imgdpi: WideString; safecall; function Get_scancolor: WideString; safecall; procedure Set_casenolength(const Value: WideString); safecall; procedure Set_filesizelimit(const Value: WideString); safecall; procedure Set_imgdpi(const Value: WideString); safecall; procedure Set_scancolor(const Value: WideString); safecall; function Get_imgdelete: WideString; safecall; procedure Set_imgdelete(const Value: WideString); safecall; function Get_check_main_form: WideString; safecall; function Get_isExternal: WideString; safecall; procedure Set_check_main_form(const Value: WideString); safecall; procedure Set_isExternal(const Value: WideString); safecall; public { Public declarations } procedure Initialize; override; end; implementation uses EnBarcode, EnTransf, { for TImageTransform } Enpnggr, { for PNGGraphic } EnJpgGr, { for JPGGraphic } EnReg, EnBmpGr, { for TBitmapGraphic } EnPrint, { for TEnvisionPrintMode, TDibGraphicPrinter } ComObj, ComServ,IISUnit,IIS_File2Web,IIS_ImageProcess, PatchFom,Doclist,ScanMemo,DocCopy,InputMask,SortMemo,DocPrt,OldCaseInfo; {$R *.DFM} { TCB_IMGPSScanX } 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.WMMOUSEWHEEL(var message: TWMMouseWheel); begin inherited; if (message.WheelDelta = WHEEL_DELTA) Then begin if Edit1.Focused then begin ScrollBox1.VertScrollBar.Increment := 50; ScrollBox1.Perform(WM_VSCROLL, SB_LINEUP, 0); end else if DisplayISB.Focused then begin DisplayISB.VertScrollBar.Increment := 50; DisplayISB.Perform(WM_VSCROLL, SB_LINEUP, 0); end; end else if (message.WheelDelta = -WHEEL_DELTA) then begin if Edit1.Focused then begin ScrollBox1.VertScrollBar.Increment := 50; ScrollBox1.Perform(WM_VSCROLL, SB_LINEDOWN, 0); end else if DisplayISB.Focused then begin DisplayISB.VertScrollBar.Increment := 50; DisplayISB.Perform(WM_VSCROLL, SB_LINEDOWN, 0); 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.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.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.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.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; 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.ISB1Enter(Sender: TObject); begin ISB1.SetFocus; end; procedure TCB_IMGPSScanX.ISB1ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var p : Integer; begin DisplayISB := TImageScrollBox(Sender); 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); 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_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_AutoScroll: WordBool; begin Result := AutoScroll; 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_Color: OLE_COLOR; begin Result := OLE_COLOR(Color); 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_HelpFile: WideString; begin Result := WideString(HelpFile); end; function TCB_IMGPSScanX.Get_KeyPreview: WordBool; begin Result := KeyPreview; end; function TCB_IMGPSScanX.Get_MouseInClient: WordBool; begin Result := MouseInClient; 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.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; //案件裡的檔案清單 NowShowFileList.Free; //目前顯示的影像清單 NowSelectFileList.Free; //目前被點選的影像清單 Cust_DocNoList.Free; //自行定義文件名稱 IN_WH_DocNoList.Free; //入庫的文件清單 GuideFormIDList.Free; //要當導引頁表單清單 DivPageFormIDList.Free; //要當分案頁表單清單 LastInitFormidList.Free; LastAddFormidList.Free; //********清單區******** 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_AlignWithMargins(Value: WordBool); begin AlignWithMargins := Value; end; procedure TCB_IMGPSScanX.Set_AutoScroll(Value: WordBool); begin AutoScroll := 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_Color(Value: OLE_COLOR); begin Color := TColor(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_HelpFile(const Value: WideString); begin HelpFile := string(Value); end; procedure TCB_IMGPSScanX.Set_KeyPreview(Value: WordBool); begin KeyPreview := 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.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; begin PreNode2Name := ''; if TreeView1.Selected.Parent = MyTreeNode1 then PreNode2Name:= GetNode2Name(MyTreeNode2); ShowText := _Msg('文件歸類中,請稍候'); 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); //載入多國語言 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; //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 //Showmessage(Components[i].Name); iISBName := ShapeName2PreViewISBName(TShape(Components[i])); iISB := TImageScrollBox(FindComponent(iISBName)); OldName := ExtractFileName(iISB.FileName); Ext := ExtractFileExt(OldName); FormID := DocListForm.DocLV.Selected.Caption; DocNo := FormCode2DocNo(FormID); if DocNoDir2DocNo(Path2DocDir(ExtractFilePath(iISB.FileName),NowCaseno)) = DocNo then DocDir := Path2DocDir(ExtractFilePath(iISB.FileName),NowCaseNo) Else DocDir := FindLastestDocDir(NowCaseno,DocNo); if DocNoNeedDiv(DocNo) then //要分份數 begin if ((FormCode2Page(FormID) = '01') and (GetDocDir_Page(NowCaseno,DocDir)>0)) or (DocDir = '') then DocDir := DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',DocNo); 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; } 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; 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; 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('輸入其他文件名稱','文件名稱',CustomDocName) then begin if FindCustomDocName(DisplayPath,CustomDocName) then begin Showmessage(Format('文件名稱:"%s"己存在',[CustomDocName])); Exit; end; CustomDocNo := GetNewCustomDocNo(DisplayPath,CustomDocName); end; if CustomDocNo = '' then Exit; DocDir := CustomDocNo; 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('是否確定刪除??',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)); DeleteImageFile(ExtractFilePath(iISB.FileName),ExtractFileName(iISB.FileName),NowCaseNo); end; end; ReSortFileName(ExtractFilePath(iISB.FileName)); DrawDocItem2(MytreeNode1,NowCaseno); MyTreeNode1.Text := Format('%s-%d'+_Msg('頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]); NewTreeNodeRefresh; ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 TreeView1click(self); end; procedure TCB_IMGPSScanX.N1Click(Sender: TObject); var mp:string; begin mp := InputBox('移動頁數','請輸入移入頁碼',''); 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; 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; 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 if TreeView1.Selected = NewTreeNode then //全刪 //新掃描件 begin 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 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; _DelTree(ImageSavePath+NowCaseno+'\'+NowDocDir); SetUseCase('D',ImageSavePath+NowCaseno+'\',NowDocDir,'',''); SetDocNoList('D',-1,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; {if (FMode <>'ESCAN') and (ContextList.Count = NowShowFileList.Count) then begin if Messagedlg(_Msg('刪除後將無影像,案件將刪除,是否確定?'),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; _DelTree(DisplayPath); SetCaseList('D',NewTreeNode.IndexOf(MyTreeNode1),''); if (FMode = 'ESCAN') then begin MkDir(ImageSavePath+FCaseID); CreateEmptyCase(ImageSavePath,FCaseID); end; LoadImgFile; end Else begin DeleteShowFile(DisplayPath); DrawDocItem1(MytreeNode1,Doc_Inf_List,NowCaseno); P := ContextList.Count; MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,p]); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 NewTreeNodeRefresh; end; Showmessage(_Msg('刪除完成')); } //Showmessage(_Msg('刪除完成')); //20101102 User要求拿掉 end Else if TreeView1.Selected = MyTreeNode3 then //FormID層 begin If Messagedlg(Format(_Msg('文件(%s)是否刪除?'),[NowFormName]),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; 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; {if (FMode <>'ESCAN') and (ContextList.Count = NowShowFileList.Count) then begin if Messagedlg(_Msg('刪除後將無影像,案件將刪除,是否確定?'),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit; _DelTree(DisplayPath); SetCaseList('D',NewTreeNode.IndexOf(MyTreeNode1),''); if (FMode = 'ESCAN') then begin MkDir(ImageSavePath+FCaseID); CreateEmptyCase(ImageSavePath,FCaseID); end; LoadImgFile; end Else begin DeleteShowFile(DisplayPath); DrawDocItem1(MytreeNode1,Doc_Inf_List,NowCaseno); P := ContextList.Count; MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,p]); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 NewTreeNodeRefresh; end; Showmessage(_Msg('刪除完成')); //Showmessage(_Msg('刪除完成')); //20101102 User要求拿掉 } end; 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'); NewScanBtnClick(self) end Else begin //ShowMessage('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; begin OpenDialog1.Filter := 'Image files|*.TIF;*.JPG'; if OpenDialog1.Execute then begin ISB := TImageScrollBox.Create(self); try ShowText :=_Msg('檔案加入中,請稍候'); DataLoading(True,True); if TreeView1.Selected = nil then Exit; FName := OpenDialog1.FileName; FindFirst(FName,faAnyfile,FileRec); //ShowMessage(IntToStr(FILEREC.Size)+','+IntToStr(FFileSizeLimit)); if FFileSizeLimit=0 then begin FFileSizeLimit:=5*1024; end; if FILEREC.Size > FFileSizeLimit*1024 then //檢查檔案大小 begin ShowMessage(Format('%.3f',[FILEREC.Size / 1024])+' KB, file size over limit.'); FindClose(FILEREC); DataLoading(false,false); exit; end; FindClose(FILEREC); CaseID := NowCaseno ; imageCount := 0; P := ISB.ImageCountFromFile(OpenDialog1.FileName); for I := 1 to P do begin ShowText :=_Msg('檔案加入中,請稍候('+inttostr(i)+'/'+inttostr(P)+')'); DataLoading(True,True); ISB.LoadFromFile(FName,i); DeskewImg(ISB.Graphic); if (TreeView1.Selected = NewTreeNode) or (TreeView1.Selected = MyTreeNode1) then begin SaveFilename := ''; MpsGetBarcode(ISB.Graphic,MpsBarcodeinf); for n := 1 to MpsBarcodeinf.Count-1 do begin if MpsBarcodeinf.r180[n] <> 0 then //依條碼角度轉影像 begin Rotate(ISB.Graphic,MpsBarcodeinf.r180[n]); MpsGetBarcode(ISB.Graphic,MpsBarcodeinf); Break; end; end; FormID := BarCode2FormID; //取出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 DocNoNeedDiv(DocNo) then //要分份數 begin if ((FormCode2Page(FormID) = '01') and (GetDocDir_Page(CaseID,DocDir)>0)) or (DocDir = '') then DocDir := DocNo2DocNoDir(ImageSavePath + CaseID+'\',DocNo); end Else //不分份數 begin if DocNo <> '' then DocDir := DocNo else //Attach 附件 DocDir := DocNo2DocNoDir(ImageSavePath + CaseID+'\',DocNo); end; {if ((FormCode2Page(FormID) = '01') and DocNoNeedDiv(DocNo)) or (FormID='') then //是表單第一頁且要分份 DocDir := DocNo2DocNoDir(ImageSavePath + CaseID+'\',DocNo) Else if not DocNoNeedDiv(DocNo) then DocDir := DocNo; } 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; ISB.SaveToFile(SavePath+SaveFilename); 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; ISB.SaveToFile(SavePath+SaveFilename); ContextList.Add(SaveFilename); ContextList.SaveToFile(SavePath+'Context.dat'); end; 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); MytreeNode1.Text := Format(_Msg('%s-%d頁'),[CaseID,page]); end; NewTreeNodeRefresh; Application.ProcessMessages; DataLoading(False,False); finally ISB.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 : String; begin DocListForm := TDocListForm.Create(self); try InitialLanguage(PatchDlg); //載入多國語言 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; 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 NewFormID := DocListForm.DocLV.Selected.Caption; 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); //FormIDReplace(DisplayPath,NowFormCode,FormID); //ShowFileReplace(DisplayPath,FormID); FormIDReplace(NowCaseNo,NowDocDir,NowFormCode,NewFormID); ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄 DrawDocItem2(MytreeNode1,NowCaseno); //DrawDocItem(MytreeNode1,FORM_INF_List,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; begin if InputQuery('輸入其他文件名稱','文件名稱',CustomDocName) then begin if CustomDocName <> '' then begin if FindCustomDocName(DisplayPath,CustomDocName) then begin Showmessage(Format('文件名稱:"%s"己存在',[CustomDocName])); Exit; end; 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('修改份數','請輸入修改後的份數',inttostr(oldCopies))); except Showmessage('輸入錯誤'); Exit; end; if (NewCopies <= 0) and (NewCopies >= 10000) then begin Showmessage('輸入範圍錯誤'); Exit; end; if (oldCopies <> NewCopies) and (NewCopies > 0) and (NewCopies < 10000) then begin if DocNoNeedDiv(NowDocNo) and (NewCopies = 1) and (MessageDlg('修改至1份後此文件將無法再進行份數修改,是否確定??',mtConfirmation,[mbyes,mbcancel],0)= mrcancel) then Exit; SetDocDirCopies(NowCaseno,NowDocDir,NewCopies); SetRecordEditedDocDir('A',NowCaseNo,NowDocDir); DrawDocItem2(MytreeNode1,NowCaseno); Showmessage('修改完成'); 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(_Msg('刪除後(%s)案件無影像,將刪除此案件,是否確定刪除?'),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 FMode='ESCAN' then begin PM101.Visible := False; end; end Else if TreeView1.Selected = MyTreeNode1 then //案件層 begin PM101.Visible := True; //刪除 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; //新增自訂文件 PM104.Visible := True; //檔案加入影像 if (FMode = 'NSCAN') then begin PM102.Visible := True; //修改案件編號 end; if FMode='ESCAN' then begin PM101.Visible := False; 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 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 := False; 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 PM108.Visible := False; //歸類 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 PM102.Visible := True; //修改案件編號 //PM103.Visible := True; //掃瞄器加入影像 //PM104.Visible := True; //檔案加入影像 //PM107.Visible := True; //寫備註 //PM109.Visible := True; //檢核此筆 if FMode='ESCAN' then begin PM101.Visible := False; end; end; if FImgDelete='Y' then begin PM101.Visible:=True; 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 := False; //歸類 PM602.Visible := False; //自行定義文件名稱 PM603.Visible := False; //掃描替換此頁 PM604.Visible := False; //歪斜矯正 PM605.Visible := False; //刪除 if ((NowDocNo = 'Attach') or (NowDocNo = 'S_Attach')) and (FCustDocYN <> 'N') then PM602.Visible := True; //自行定義文件名稱 //PM603.Visible := True; //掃描替換此頁 PM604.Visible := True; //歪斜矯正 PM601.Visible := True; //歸類 PM605.Visible := True; //刪除 if CheckSelectImg_UseCase(DisplayPath,NowCaseNo) then //選擇的影像不可有引用的 begin PM601.Enabled := False; //歸類 PM605.Enabled := False; //刪除 end Else begin PM601.Enabled := True; //歸類 PM605.Enabled := True; //刪除 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; 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 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.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.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.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,份數,頁數 的回傳字串 //Showmessage(CreateDocnoFrom_Info(NowCaseno)); //Showmessage(self.CreateCustDocNoFrom_Info(NowCaseno)); 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+ 'FCheck_main_form='+ FCheck_main_form); end; procedure TCB_IMGPSScanX.Button4Click(Sender: TObject); var i:integer; str:String; begin //Showmessage(self.Doc_Inf_List.Text); //LoadImgFile; //LoadImgFile1; 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) ; end; procedure TCB_IMGPSScanX.StatrTwainScan; var ScanInfo : TScanInfo; i : Integer; begin if not Scanner.IsConfigured then begin ShowMessage(_Msg('TWAIN 掃瞄驅動尚未安裝')); Exit; end; FillChar(ScanInfo, SizeOf(ScanInfo), 0); ScanInfo.MultiPage := True; ScanInfo.ImageCount := 0; ScanInfo.Graphic := TTiffGraphic.Create; try ISB := nil; //規零 Scanner.RequestedXDpi := ScanDpi; Scanner.RequestedYDpi := ScanDpi; Scanner.RequestedImageFormat := ScanColor; Scanner.ShowUI := TwainShowUI; Try Scanner.OpenSource; Scanner.Duplex := ScanDuplex; //雙面 //Scanner.FEEDERENABLED := not ScanFlatCB.Checked; // 先拿掉平台 If ScanImgSetUse Then begin Scanner.ScanBrightness := ScanBright; Scanner.ScanContrast := ScanContrast; end; except Showmessage(_Msg('掃瞄器發生錯誤!!')); Scanner.CloseSource; Exit; end; try Try Scanner.AcquireWithSourceOpen( OnAcquire, LongInt(@ScanInfo)); Except Scanner.CloseSource; end; finally Scanner.CloseSource; end; finally Scanner.CloseSource; ScanInfo.Graphic.Free; end; end; procedure TCB_IMGPSScanX.OnAcquire( const DibHandle : THandle; const XDpi : Word; const YDpi : Word; const CallBackData : LongInt ); var pScanInfo : TpScanInfo; SaveFileName : String; SaveStream : TFileStream; strResults : TBarcodeStringResult; DeleteStm : TMemoryStream; isDelete : Boolean; iGraphic,iGraphic_First,iGraphic_sec : TTiffGraphic; iRect : TRect; JpgGr : TJpegGraphic; i : Integer; TagTxt : String; function Deletepage(Graphic:TDibGraphic;BlankSize:Integer):Boolean; begin DeleteStm := TMemoryStream.Create; DeleteStm.Seek(0,soFromBeginning); Graphic.AppendToStream(DeleteStm); //DeleteStm.LoadFromFile(Path+'temp.tif'); //Isb1.Graphic.SaveToStream(DeleteStm); //Isb1.Graphic.AppendToStream(DeleteStm); if DeleteStm.Size < BlankSize Then Result:= True Else Result := False; DeleteStm.Free; //DeleteFile(Path+'temp.tif'); end; begin pScanInfo := TpScanInfo(CallBackData); isDelete := False; if pScanInfo^.MultiPage then begin pScanInfo^.Graphic.AssignFromDibHandle(DibHandle); pScanInfo^.Graphic.XDotsPerInch := XDpi; pScanInfo^.Graphic.YDotsPerInch := YDpi; TagTxt := 'height:'+inttostr(pScanInfo^.Graphic.Height)+',width:'+inttostr(pScanInfo^.Graphic.Width); if pScanInfo^.Graphic.ImageFormat = ifBlackWhite then begin ImageScrollBox1.Graphic.Assign(pScanInfo^.Graphic); ImageScrollBox1NewGraphic(ImageScrollBox1.Graphic); pScanInfo^.Graphic.Compression := tcGroup4; MpsGetBarcode(pScanInfo^.Graphic,MpsBarcodeinf); For i := 1 to MpsBarcodeinf.count do begin If (MpsBarcodeinf.r180[i] <> 0) and (Length(MpsBarcodeinf.Text[i])=FormIDLength) Then begin Rotate(pScanInfo^.Graphic,MpsBarcodeinf.r180[i]); MpsGetBarcode(pScanInfo^.Graphic,MpsBarcodeinf); //旋轉後再重取一次條碼資訊 Break; end; end; //影像反向 IF ScannerReverse then NegativeImg(pScanInfo^.Graphic); //傾斜矯正 IF ScanDeskew Then DeskewImg(pScanInfo^.Graphic); //清黑邊 IF BoardClear then CleanupBorder(pScanInfo^.Graphic); end else if pScanInfo^.Graphic.ImageFormat = ifTrueColor then begin //Ext := '.jpg'; ImageScrollBox1.Graphic.Assign(pScanInfo^.Graphic); //ImageScrollBox1NewGraphic(ImageScrollBox1.Graphic); MpsGetBarcode(ISB_BW.Graphic,MpsBarcodeinf); For i := 1 to MpsBarcodeinf.count do begin If (MpsBarcodeinf.r180[i] <> 0) and (Length(MpsBarcodeinf.Text[i])=FormIDLength) Then begin Rotate(ISB_BW.Graphic,MpsBarcodeinf.r180[i]); MpsGetBarcode(ISB_BW.Graphic,MpsBarcodeinf); //旋轉後再重取一次條碼資訊 Break; end; end; pScanInfo^.Graphic.Compression := tcJpeg; pScanInfo^.Graphic.JpegQuality := 70; end else if pScanInfo^.Graphic.ImageFormat = ifColor256 Then begin //Ext := '.jpg'; ConvertToGray(pScanInfo^.Graphic); pScanInfo^.Graphic.Compression := tcJpeg; pScanInfo^.Graphic.JpegQuality := 70; end else if pScanInfo^.Graphic.ImageFormat = ifGray256 Then begin //Ext := '.jpg'; ImageScrollBox1.Graphic.Assign(pScanInfo^.Graphic); ImageScrollBox1NewGraphic(ImageScrollBox1.Graphic); MpsGetBarcode(ISB_BW.Graphic,MpsBarcodeinf); For i := 1 to MpsBarcodeinf.count do begin If (MpsBarcodeinf.r180[i] <> 0) and (Length(MpsBarcodeinf.Text[i])=FormIDLength) Then begin Rotate(ISB_BW.Graphic,MpsBarcodeinf.r180[i]); MpsGetBarcode(ISB_BW.Graphic,MpsBarcodeinf); //旋轉後再重取一次條碼資訊 Break; end; end; pScanInfo^.Graphic.Compression := tcJpeg; pScanInfo^.Graphic.JpegQuality := 70; end else begin //Ext := '.tif'; pScanInfo^.Graphic.Compression := tcPackBits; end; end; //Application.ProcessMessages; iGraphic_First := TTiffGraphic.Create; iGraphic_sec := TTiffGraphic.Create; //iGraphic := TTiffGraphic.Create; try iGraphic_First.Assign(pScanInfo^.Graphic); //Application.ProcessMessages; if CheckNeedCrop(iGraphic_First) Then begin iRect.Left := pScanInfo^.Graphic.Width div 2; //先取左邊的影像 iRect.Top := 0; iRect.Right := pScanInfo^.Graphic.Width; iRect.Bottom := pScanInfo^.Graphic.Height; CropImg(iGraphic_First,iRect); iGraphic_Sec.Assign(pScanInfo^.Graphic); //再取右邊的影像 iRect.Left := 0; iRect.Top := 0; iRect.Right := pScanInfo^.Graphic.Width div 2; iRect.Bottom := pScanInfo^.Graphic.Height; CropImg(iGraphic_Sec,iRect); end; //iGraphic.Assign(iGraphic_First); iGraphic := iGraphic_First; while not iGraphic.IsEmpty do begin //Application.ProcessMessages; IF (not DeviceDelete) or (not Deletepage(iGraphic,DeviceDeleteSize)) Then begin ImageScrollBox1.Graphic.Assign(iGraphic); ImageScrollBox1NewGraphic(ImageScrollBox1.Graphic); MpsGetBarcode(ISB_BW.Graphic,MpsBarcodeinf); PageEnd; IF PEFileName <> '' Then begin IF LowerCase(ExtractFileExt(PEFileName)) = '.tif' Then begin if FileExists( PEFileName ) then SaveStream := TFileStream.Create( PEFileName ,fmOpenReadWrite) Else SaveStream := TFileStream.Create( PEFileName ,fmCreate ); try SaveStream.Seek(0, soFromBeginning); iGraphic.AppendToStream(SaveStream); finally SaveStream.Free; end; end Else IF LowerCase(ExtractFileExt(PEFileName)) = '.jpg' Then begin if FileExists( PEFileName ) then DeleteFile(PEFileName); //SaveStream := TFileStream.Create( PEFileName ,fmCreate ); JpgGr := TJpegGraphic.Create; try JpgGr.Assign(iGraphic); JpgGr.SaveQuality := 30; //JpgGr.AppendToStream(SaveStream); JpgGr.SaveToFile(PEFileName); finally JpgGr.Free; //SaveStream.Free; end; end; PageDone; end; end; if iGraphic = iGraphic_First then iGraphic := iGraphic_Sec else iGraphic.Assign(nil); //iGraphic.Assign(iGraphic_Sec); end; finally //iGraphic.Free; iGraphic_First.Free; iGraphic_Sec.Free; end; 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); 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('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); 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); //ShowMessage('ScanDocDir='+ScanDocDir); 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.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('匯出完成,匯出檔案:'+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('無法解壓縮'); if not FileExists(ZipPath+'mps.dat') then begin Showmessage('格式不符,無法匯入'); Exit; end; S.LoadFromFile(ZipPath+'mps.dat'); if (En_DecryptionStr_Base64('D',S.Strings[0],'9338430')<> ServerDate) then begin Showmessage('檔案過期,無法匯入'); 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('匯入完成'); end; procedure TCB_IMGPSScanX.HotKeyDown (var Msg : TMessage); begin 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; IF (ImageScrollBox1.FileName <> FileName) and (FileName <> '') then begin ImageScrollBox1.LoadFromFile(FileName,1); FindPoint(ImageScrollBox1.Graphic,UpLPoint,UpRPoint,DownLPoint,'NONE'); ClearLine(ISB_BW.Graphic,bt); ISB_BW.Redraw(True); Application.ProcessMessages; end; If ImageScrollBox1.FileName <> '' Then begin Xdpi := ImagescrollBox1.Graphic.XDotsPerInch; Ydpi := ImagescrollBox1.Graphic.YDotsPerInch; H := ImageScrollBox1.Graphic.Height; W := ImageScrollBox1.Graphic.Width; OMRRect := CM_Str2Rect(Site,Xdpi,UpLPoint); 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); end; 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.R_W_Scanini(Mode:Char); //'R'讀取;'W'寫入 var ini : Tinifile; begin ini := Tinifile.Create(ScaniniPath+'FBScan.ini'); try case Mode of 'R':begin DeviceDelete := ini.ReadBool('DeviceDelete','Mode',Def_DeviceDelete); DeviceDeleteSize := ini.ReadInteger('DeviceDelete','Size_New',Def_DeviceDeleteSize); ScannerReverse := ini.ReadBool('Scanner','Reverse',Def_ScannerReverse); BoardClear := ini.ReadBool('Scanner','BoardClear',Def_BoardClear); ScanDpi := ini.ReadInteger('Scanner','Dpi',Def_ScanDpi); //ScanDuplex := ini.ReadBool('Scanner','Duplex',Def_ScanDuplex); ScanRotate := ini.ReadInteger('Scanner','ScanRotate',Def_ScanRotate); ScanDeskew := ini.ReadBool('Scanner','ScanDeskew',Def_ScanDeskew); ScanBright := ini.ReadInteger('Scanner','ScanBright',Def_ScanBright); ScanContrast := ini.ReadInteger('Scanner','ScanContrast',Def_ScanContrast); ScanImgShowMode := ini.ReadInteger('Scanner','ScanImgShowMode',Def_ScanImgShowMode); ScanImgSetUse := ini.ReadBool('Scanner','ScanImgSetUse',Def_ScanImgSetUse); //20101110 BA說掃瞄器廠商有調設定要新增此選項是否啟動 end; 'W':begin ini.WriteBool('DeviceDelete','Mode',DeviceDelete); ini.WriteInteger('DeviceDelete','Size_New',DeviceDeleteSize); ini.WriteBool('Scanner','Reverse',ScannerReverse); ini.WriteBool('Scanner','BoardClear',BoardClear); ini.ReadInteger('Scanner','Dpi',ScanDpi); //ini.WriteBool('Scanner','Duplex',ScanDuplex); ini.WriteInteger('Scanner','ScanRotate',ScanRotate); ini.WriteBool('Scanner','ScanDeskew',ScanDeskew); ini.WriteInteger('Scanner','ScanBright',ScanBright); ini.WriteInteger('Scanner','ScanContrast',ScanContrast); ini.WriteInteger('Scanner','ScanImgShowMode',ScanImgShowMode); ini.WriteBool('Scanner','ScanImgSetUse',ScanImgSetUse); //20101110 BA說掃瞄器廠商有調設定要新增此選項是否啟動 end; end; finally ini.Free; end; end; Procedure TCB_IMGPSScanX.GetDefScanIni; //取得掃瞄的預設值 var i : Integer; PARA_NO,PARA_CONTENT: String; begin Def_DeviceDelete := True; Def_DeviceDeleteSize := 3072; //20120821 改成3000(出現) Def_ScannerReverse := False; Def_BoardClear := False; Def_ScanDpi := 300; Def_ScanDuplex := False; Def_ScanRotate := 0; Def_ScanDeskew := False; Def_ScanImgSetUse := False; Def_ScanBright := 0; Def_ScanContrast := 0; Def_ScanImgShowMode := 2; for i := 0 to WORK_INF_List.Count - 1 do begin IF GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_BLANKDEL_USE' Then //空白頁啟動 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if UpperCase(PARA_CONTENT) ='Y' then Def_DeviceDelete := True Else Def_DeviceDelete := False; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_BLANKDEL_SIZE' Then //空白頁Size begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if PARA_CONTENT = '' then Def_DeviceDeleteSize := 0 Else Def_DeviceDeleteSize := Strtoint(PARA_CONTENT); end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_REVERSE' Then //是否需反相 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if UpperCase(PARA_CONTENT) ='Y' then Def_ScannerReverse := True Else Def_ScannerReverse := False; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_BOARDCLEAR' Then //是否清黑邊 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if UpperCase(PARA_CONTENT) ='Y' then Def_BoardClear := True Else Def_BoardClear := False; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_DPI' Then //掃瞄DPI begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if PARA_CONTENT = '' then Def_ScanDpi := 300 else Def_ScanDpi := Strtoint(PARA_CONTENT); end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_DUPLEX' Then //是否雙面掃瞄 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if UpperCase(PARA_CONTENT) ='Y' then Def_ScanDuplex := True Else Def_ScanDuplex := False; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_ROTATE_MODE' Then //掃瞄時旋轉角度 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if PARA_CONTENT = '0' then Def_ScanRotate := 0 Else if PARA_CONTENT = '1' then Def_ScanRotate := 270 Else if PARA_CONTENT = '2' then Def_ScanRotate := 180 Else if PARA_CONTENT = '3' then Def_ScanRotate := 90 Else Def_ScanRotate := 0; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_DESKEW' Then //是否傾斜矯正 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if UpperCase(PARA_CONTENT) ='Y' then Def_ScanDeskew := True Else Def_ScanDeskew := False; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_IMGSET_USE' Then //是否使用亮度對比設定 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if UpperCase(PARA_CONTENT) ='Y' then Def_ScanImgSetUse := True else Def_ScanImgSetUse := False; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_BRIGHT' Then //亮度 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if PARA_CONTENT ='' then Def_ScanBright := 0 Else Def_ScanBright := strtoint(PARA_CONTENT); if (Def_ScanBright > 255) or (Def_ScanBright < -255) then Def_ScanBright := 0; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_CONTRAST' Then //對比 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if PARA_CONTENT ='' then Def_ScanContrast := 0 Else Def_ScanContrast := strtoint(PARA_CONTENT); if (Def_ScanContrast > 255) or (Def_ScanContrast < -255) then Def_ScanContrast := 0; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_SHOW_MODE' Then begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); if PARA_CONTENT = '0' then Def_ScanImgShowMode := 0 Else if PARA_CONTENT = '1' then Def_ScanImgShowMode := 1 Else if PARA_CONTENT = '2' then Def_ScanImgShowMode := 2 Else Def_ScanImgShowMode := 0; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'CASE_IN_TIME' Then //取進件截止時間 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); ScanDenialTime := PARA_CONTENT; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'SCAN_HINT' Then //掃描提示字串 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); ScanDenialHint := PARA_CONTENT; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'NO_SAVE_FORM_ID' Then //掃描不存檔之表單代號 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); NoSaveBarCodeList.CommaText := PARA_CONTENT; end Else if GetSQLData(WORK_INF_List,'PARA_NO',i) = 'LOCAL_PATH' Then //本機端路徑 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); ImagePath:= PARA_CONTENT; end Else if UpperCase(GetSQLData(WORK_INF_List,'PARA_NO',i)) = 'GUIDEFORMID' Then //當導引頁的表單 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); GuideFormIDList.CommaText := PARA_CONTENT; end Else if UpperCase(GetSQLData(WORK_INF_List,'PARA_NO',i)) = 'DIVPAGEFORMID' Then //當分案頁的表單 begin PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i); DivPageFormIDList.CommaText := PARA_CONTENT; end; end; ScanDuplex := Def_ScanDuplex; end; procedure TCB_IMGPSScanX.HTTPSClientCertificateValidate(Sender: TObject; X509Certificate: TElX509Certificate; var Validate: Boolean); begin Validate := True; end; procedure TCB_IMGPSScanX.EnableImage(v:integer;Sender : TObject); var bmp : Tbitmap; begin DesableImage; bmp := TBitmap.Create; try ImageList3.GetBitmap(v,bmp); TBitBtn(Sender).Glyph.Assign(bmp); finally bmp.Free; end; ViewMouseMode(v); end; procedure TCB_IMGPSScanX.DesableImage; var bmp : Tbitmap; i : integer; begin NowClick := -1; bmp := Tbitmap.Create; try For i:= 0 to 6 do begin ImageList4.GetBitmap(i,bmp); TBitBtn(FindComponent('FC'+IntToStr(i))).Glyph.Assign(bmp); bmp.Width:=0; bmp.Handle:=0; end; finally bmp.Free; end; ViewMouseMode(NowClick); end; Procedure TCB_IMGPSScanX.ViewMouseMode(v:Integer); var i : Integer; Md : TMouseMode; ISB : TImageScrollBox; begin 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); 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.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.GetServerDate : Boolean; begin Result := False; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/servertimeforocx','',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 ServerDate := memo1.Lines.Strings[1]; ServerTime := Copy(ServerDate,9,6); ServerDate := Copy(ServerDate,1,8); Balance := GetBalance(ServerTime); //Server 跟Local的時間差 Result := True; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; end; Function TCB_IMGPSScanX.GetSetInf1 : Boolean; //取系統設定資訊Mode1 DOC_INF Var ColumeStr : String; S : TStringlist; EnCodeDateTime : String; begin //SELECT %s FROM DOC_INF WHERE WORK_NO = '%s' ORDER BY DOC_TYPE, DOC_NO, DOC_VERSION" Result := False; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); ColumeStr := 'WORK_NO,DOC_NO,DOC_U_DESC,DOC_TYPE,DOC_VERSION,FORM_PAGES,START_DATE,STOP_DATE,IS_DOC_DIV,IS_IN_WH'; //If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC02 ','checktime='+EnCodeDateTime+'&mode=1&col='+Doc_Inf_Colume+'&workno='+FWork_No,FReWrite.Text,Memo1) Then If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/tables','checktime='+EnCodeDateTime+'&mode=1&col='+En_DecryptionStr_Base64('E',ColumeStr,Mpskey)+'&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 S := TStringlist.Create; S.Text := Memo1.Lines.Text; SetSQLData(ColumeStr,S,Doc_Inf_List); S.Free; Result := True; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; end; Function TCB_IMGPSScanX.GetSetInf2 : Boolean; //取系統設定資訊Mode2 DM_FORM_INF var ColumeStr : String; S : TStringlist; EnCodeDateTime : String; begin //SELECT %s FROM DM_FORM_INF Result := False; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); ColumeStr := 'WORK_NO,MAIN_FORM_ID,DOC_VERSION,DEPE_FORM_ID,MUTEX_FORM_ID'; //If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC02 ','checktime='+EnCodeDateTime+'&mode=2&col='+ColumeStr+'&workno='+FWork_No,FReWrite.Text,Memo1) Then If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/tables','checktime='+EnCodeDateTime+'&mode=2&col='+En_DecryptionStr_Base64('E',ColumeStr,Mpskey)+'&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 S := TStringlist.Create; S.Text := Memo1.Lines.Text; SetSQLData(ColumeStr,S,DM_FORM_INF_List); S.Free; Result := True; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; end; Function TCB_IMGPSScanX.GetSetInf3 : Boolean; //取系統設定資訊mode3 FORM_INF var ColumeStr : String; S : TStringlist; EnCodeDateTime : String; begin //SELECT distinct %s FROM FORM_INF T1 LEFT JOIN DOC_INF T2 ON T2.DOC_NO = T1.DOC_NO AND T1.DOC_VERSION = T2.DOC_VERSION AND T1.WORK_NO = T2.WORK_NO WHERE T2.IS_USE = 'Y' AND T2.WORK_NO = %s Result := False; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); //ColumeStr := 'T1.WORK_NO,T1.FORM_ID,T1.DOC_KIND,T1.DOC_NO,T1.DOC_VERSION,T1.FORM_NAME,T1.FORM_DESC,T1.DIVISION,T1.ANCHOR,T1.MAX_PAGE,T1.FORM_HEIGHT,T1.FORM_WIDTH,T1.MERGE_IMAGE,T1.CC_FORM_ID,T1.CC_MERGE_FORMID,T2.DOC_TYPE'; {T1.CC_FORM_ID,T1.CC_MERGE_FORMID,} ColumeStr := 'T1.WORK_NO,T1.FORM_ID,T1.DOC_NO,T1.DOC_VERSION,T1.FORM_NAME,T1.FORM_DESC,T1.DIVISION,T1.ANCHOR,T1.MAX_PAGE,T1.FORM_HEIGHT,T1.FORM_WIDTH,T1.IS_PRINT,T2.DOC_TYPE'; {T1.CC_FORM_ID,T1.CC_MERGE_FORMID,} //If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC02 ','checktime='+EnCodeDateTime+'&mode=3&col='+ColumeStr+'&workno='+FWork_No,FReWrite.Text,Memo1) Then If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/tables','checktime='+EnCodeDateTime+'&mode=3&col='+En_DecryptionStr_Base64('E',ColumeStr,Mpskey)+'&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 S := TStringlist.Create; S.Text := Memo1.Lines.Text; SetSQLData(ColumeStr,S,FORM_INF_List); S.Free; Result := True; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; end; Function TCB_IMGPSScanX.GetSetInf4 : Boolean; //取系統設定資訊mode4 CHECK_RULE_INF var ColumeStr : String; S : TStringlist; EnCodeDateTime : String; begin //SELECT %s FROM CHECK_RULE_INF WHERE CHECK_TYPE = 'S' Result := False; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); ColumeStr := 'WORK_NO,CHECK_NO,CHECK_RULE_DESC,MESG_SHOW_TYPE,MESG_DISP_TYPE,CHECK_MESG,SCAN_MODE'; //If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC02 ','checktime='+EnCodeDateTime+'&mode=4&col='+ColumeStr+'&workno='+FWork_No,FReWrite.Text,Memo1) Then If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/tables','checktime='+EnCodeDateTime+'&mode=4&col='+En_DecryptionStr_Base64('E',ColumeStr,Mpskey)+'&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 S := TStringlist.Create; S.Text := Memo1.Lines.Text; SetSQLData(ColumeStr,S,CHECK_RULE_INF_List); S.Free; Result := True; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; CheckRule2OMRErrInfo; end; Function TCB_IMGPSScanX.GetSetInf5 : Boolean; //取系統設定資訊mode5 MEMO_INF var ColumeStr : String; S : TStringlist; EnCodeDateTime : String; begin //SELECT %s FROM MEMO_INF T1 LEFT JOIN MEMO_TYPE_INF T2 ON T2.MEMO_TYPE_NO = T1.MEMO_TYPE WHERE T1.MEMO_SOURCE = '01' Result := False; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); ColumeStr := 'T1.WORK_NO,T1.MEMO_TYPE,T1.MEMO_CONTENT,T2.MEMO_TYPE_NAME'; //If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC02 ','checktime='+EnCodeDateTime+'&mode=5&col='+ColumeStr+'&workno='+FWork_No,FReWrite.Text,Memo1) Then If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/tables','checktime='+EnCodeDateTime+'&mode=5&col='+En_DecryptionStr_Base64('E',ColumeStr,Mpskey)+'&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 S := TStringlist.Create; S.Text := Memo1.Lines.Text; SetSQLData(ColumeStr,S,MEMO_INF_List); S.Free; Result := True; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; end; Function TCB_IMGPSScanX.GetSetInf6 : Boolean; //取系統設定資訊mode5 WORK_INF var ColumeStr : String; S : TStringlist; EnCodeDateTime : String; begin //SELECT %s FROM WORK_INF Result := False; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); ColumeStr := 'WORK_NO,PARA_NO,PARA_CONTENT'; //If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC02 ','checktime='+EnCodeDateTime+'&mode=5&col='+ColumeStr+'&workno='+FWork_No,FReWrite.Text,Memo1) Then If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/tables','checktime='+EnCodeDateTime+'&mode=6&col='+En_DecryptionStr_Base64('E',ColumeStr,Mpskey)+'&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 S := TStringlist.Create; S.Text := Memo1.Lines.Text; SetSQLData(ColumeStr,S,WORK_INF_List); S.Free; Result := True; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; end; end; Function TCB_IMGPSScanX.GetSetInf7 : Boolean; //取系統設定資訊mode5 LASTEST_FORM_INF var ColumeStr : String; S : TStringlist; EnCodeDateTime : String; begin //SELECT FORM_ID,DOC_NO,DOC_VERSION FROM FORM_INF WHERE (DOC_NO,DOC_VERSION) in (SELECT DOC_NO, MAX(DOC_VERSION) FROM FORM_INF GROUP BY DOC_NO) ORDER BY DOC_NO Result := False; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); ColumeStr := 'FORM_ID,DOC_NO'; //If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC02 ','checktime='+EnCodeDateTime+'&mode=5&col='+ColumeStr+'&workno='+FWork_No,FReWrite.Text,Memo1) Then If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/tables','checktime='+EnCodeDateTime+'&mode=7&col='+En_DecryptionStr_Base64('E',ColumeStr,Mpskey)+'&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 S := TStringlist.Create; S.Text := Memo1.Lines.Text; SetSQLData(ColumeStr,S,LASTEST_FORM_INF_List); S.Free; Result := True; end Else if Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; 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.SetIn_WH_DocNo; //將要入庫的DocNo抽出來另存入list裡 var i : Integer; begin for i := 1 to Doc_Inf_List.Count - 1 do begin if GetSQLData(Doc_Inf_List,'IS_IN_WH',i) = 'Y' then IN_WH_DocNoList.Add(GetSQLData(Doc_Inf_List,'DOC_NO',i)); end; {Showmessage(IN_WH_DocNoList.Text); StringtoFile(IN_WH_DocNoList.Text,'D:\121.txt');} 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; Procedure TCB_IMGPSScanX.DeleteImageFile(Path,FileName,CaseID:String); // 刪除檔案 (無法得到DocDir用) var i : Integer; FileList:TStringlist; DocDir : String; begin DeleteFile(Path+FileName); DocDir := Path2DocDir(Path,CaseID); SetContextList('D',-1,CaseID,DocDir,FileName); {FileList:=TStringlist.Create; try if FileExists(Path+'Context.dat') then FileList.LoadFromFile(Path+'Context.dat'); for i := 0 to FileList.Count - 1 do begin if FileName = FileList.Strings[i] then begin FileList.Delete(i); FileList.SaveToFile(Path+'Context.dat'); Break; end; end; if FileList.Count = 0 then DeleteFile(Path+'Context.dat'); finally FileList.Free; 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 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.DeleteDocNoFile(Path,DocNo:String):Boolean; //刪除指定DocNo文件 var i: Integer; FName : String; begin Result := False; for i := ContextList.Count - 1 downto 0 do begin FName := ContextList.Strings[i]; If DocNo = FormCode2DocNo(FileName2FormCode(FName)) then begin DeleteFile(Path+FName); ContextList.Delete(i); Context_DocnoList.Delete(i); Result := True; //有刪到指定文件 end; end; ContextList.SaveToFile(Path+'Context.dat'); Context_DocnoList.SaveToFile(Path+'Context_DocNo.dat'); ReSortFileName(Path); ContextList.LoadFromFile(Path+'Context.dat'); Context_DocnoList.LoadFromFile(Path+'Context_DocNo.dat'); if FileExists(Path+'CustomDocNo.dat') then Cust_DocNoList.LoadFromFile(Path+'CustomDocNo.dat'); end; Procedure TCB_IMGPSScanX.DeleteShowFile(Path:String); //刪除顯示中的影像 var i : Integer; DelFile : String; begin for i := 0 to NowShowFileList.Count - 1 do begin DelFile := NowShowFileList.Strings[i]; DeleteFile(Path+DelFile); SetContextList('D',-1,NowCaseno,NowDocNo,DelFile); end; end; Function TCB_IMGPSScanX.GetDataDocNoPage(MainDocNo,MainVersion:String):Integer; //取記錄的文件_版本頁數 var P : String; begin Result := 0; If FindSQLData(Doc_Inf_List,'FORM_PAGES','DOC_NO,DOC_VERSION',MainDocNo+','+MainVersion,0,FindResult) Then begin P := GetFindResult('FORM_PAGES'); if P <> '' then Result := strtoint(P) else Result := 0; end; end; Function TCB_IMGPSScanX.CheckCaseDocNoPage(CaseID,DocNo,Version:String;Pages:Integer):Integer; //取案件裡的文件_版本頁數 var i,n,Count : integer; S : TStringlist; FormCode,iPage : String; begin Count := 0; S := TStringlist.Create; try S.LoadFromFile(ImageSavePath+CaseID+'\upload\Context.dat'); for I := 1 to pages do //從0到pages-1 改成 1到pages 20170316 這樣可以修改檢核的頁數問題 begin iPage := Add_Zoo(i,2); for n := 0 to S.Count - 1 do begin FormCode := FileName2FormCode(S.Strings[n]); //Showmessage('1:'+version+','+FormCode2Version(FormCode)+','+DocNo+','+FormCode2DocNo(FormCode)+','+iPage+','+FormCode2Page(FormCode)); if (version = FormCode2Version(FormCode)) and (DocNo = FormCode2DocNo(FormCode)) and (ipage = FormCode2Page(FormCode)) then begin //Showmessage(version+','+DocNo+',iPage='+iPage); //Showmessage(inttostr(Count+1)); Inc(Count); Break; //找到了...離開 end; end; end; finally S.Free; end; Result := Count; 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 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(CaseID,FileName); //依十字定位點做縮放 end; finally S.Free; end; end; Procedure TCB_IMGPSScanX.ImageReSize(CaseID,FileName:String); //依十字定位點做縮放 var FormID : String; DH,DW : String; NowW,NowH : Integer; ANCHOR : String; //是否有十字線 SizeStr : String; S : TStringlist; v,v1:Integer; begin 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); if ((ANCHOR = 'ANCHOR') or (ANCHOR = 'FRAME')) and (DH <> '') and (DW <> '') then //有十字定位點 begin ImageScrollBox1.LoadFromFile(ImageSavePath+CaseID+'\Upload\'+FileName,1); //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); v := 5; v1 := length(SizeStr); IF (SizeStr <> '') and (Copy(SizeStr,1,v) <> 'ERROR') then begin ImageScrollBox1.SaveToFile(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; Function TCB_IMGPSScanX.TransCaseID(Path,CaseID:String;MainCase:Boolean):Boolean; //傳送案件 Var i,n,v: Integer; ZipFileList : TStringlist; UpFormID:String; pages : Integer; TransName : String; MaskPath : String; HaveMask : Boolean; S : String; SendData:String; Doc_Data,Doc_Data1 : String; In_Doc1,In_Doc2 : String; AttachYN : String; //是否有附件 Y:有 N:沒有 ST1,ST2:TStringList; str1,str2:String; must_formidStr :string; last_add_formidstr :string; casepath:String; filesizeInt:integer; case_page:string; begin Result := True; TransName := CaseID; MaskPath := Path+'MaskImg\'; if fileExists(Path+'Context.dat') then begin ContextList.LoadFromFile(Path+'Context.dat'); Context_DocnoList.LoadFromFile(Path+'Context_DocNo.dat'); end; if FileExists(Path+'CustomDocNo.dat') then Cust_DocNoList.LoadFromFile(Path+'CustomDocNo.dat'); Pages := ContextList.Count; case_page:=IntToStr(pages); if (FMode = 'NSCAN') or (FMode = 'ESCAN') or (FMode = 'ASCAN') or (FMode = 'DSCAN') or (FMode = 'SSCAN') or (FMode = 'MSCAN') or (FMode = 'RI_SCAN') or (FMode = 'RSCAN') then begin //Showmessage('1'); UpformID := GetCaseFormID(Path); {if UpformID = '' then //20131213 yuu說不管主form begin Showmessage(_msg('取不到主FormID!!')); Result := False; DataLoading(False,False); Exit; end;} end; CaseResort2Scanlist(Path); //檔名照設定排序產生scanlist.dat //CaseResort(Path); //檔名照設定排序 CreateFormID_FormName(Path,CaseID); //產生FormID_FormName.dat CreateDocNo_DocName(Path,CaseID); //產生DocNo_Name.dat //ShowMessage('EEEEEEEEEE'); Doc_Data := CreateDocNo_Info(CaseID); //產生保管袋文件 Docno,份數,頁數;Docno,份數,頁數 的回傳字串 //ShowMessage('1111111111'); Doc_Data1 := CreateCustDocNo_Info(CaseID); //產生自定文件 Docname,份數,頁數;Docno,份數,頁數 的回傳字串 //ShowMessage('2222222222'); In_Doc1 := CreateDocnoFrom_Info(CaseID); //產生被引進的保管袋文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號 //ShowMessage('333333333333333333'); In_Doc2 := CreateCustDocNoFrom_Info(CaseID); //產生被引進的自定文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號 //ShowMessage('4444444444444'); AttachYN := CreateAttach_Info(CaseID); //是否還有附件 Y:有 N:沒有 //self.ReadCaseIndex() //ShowMessage('555555555555'); ReadCaseIndex(Path); //ShowMessage('DDDDDDDDDD'); //LoanDoc := 'Y'; //產生遮罩影像 // if FWork_No = 'CW' then // HaveMask := Case2Mask(Path,MaskPath); //產生遮罩影像 // S := S +#13+'5-->'+ Timetostr(now); ///////必要formid 20170315 start ////////////////////////////// must_formidStr:=''; last_add_formidstr:=''; ST1:=TStringList.Create; ST1.LoadFromFile(path+'FormCode_Name.dat'); //ShowMessage(ST1.Text); ST2:=TStringList.Create; for I := 0 to ST1.Count - 1 do begin if (Pos('_',St1.Strings[i])<>1) and (Pos('_',St1.Strings[i])<>-11) then begin str1:=Copy(ST1.Strings[i],1,Pos('_',St1.Strings[i])-1); if ST2.IndexOf(str1) = -1 then begin ST2.Add(str1); must_formidStr:= must_formidStr+str1+'@#,'; end; end; end; must_formidStr:=Copy(must_formidStr,1,Length(must_formidStr)-3) ; for I := 0 to LastInitFormidList.Count - 1 do begin if ST2.IndexOf(LastInitFormidList.Strings[i]) <> -1 then begin ST2.Delete(ST2.IndexOf(LastInitFormidList.Strings[i])); end; end; for I := 0 to ST2.Count - 1 do begin if i <> ST2.Count then begin last_add_formidstr:=last_add_formidstr+ST2.Strings[i]+'@#,'; end else begin last_add_formidstr:=last_add_formidstr+ST2.Strings[i] end; end; ST1.Free; ST2.Free; ///////必要formid 20170315 end ////////////////////////// ///保留外部影像 start/////////////////////////////// casepath:= Copy(Path,1,pos('Upload',path)-1); //ShowMessage('casepath='+casepath); //FIsExternal:='Y'; if (FMode='ESCAN') and (FIsExternal='Y') then begin if FileExists(casepath+'Download\FirstImg.zip') then begin CopyFile(PWChar(casepath+'Download\FirstImg.zip'),PWChar(path+'FirstImg.zip'),false); end else begin CopyFile(PWChar(casepath+'Download\'+CaseID+'.zip'),PWChar(path+'FirstImg.zip'),false); end; end; ///保留外部影像 end/////////////////////////////// //file_size 計算 就先不做 20170316 filesizeInt:=0; //////壓檔///// ZipMainFile(Path,Path,'Img.zip'); if HaveMask then ZipMaskFile(Path,MaskPath,Path,'MaskImg.zip'); //有遮罩設定的才產生 /////壓檔//// ////上傳///// SendData:='data='+HTTPEncode(UTF8Encode(FData)) +'&verify='+FVerify +'&form_id='+UpformID +'&loan_doc='+Case_loandoc +'&case_no='+TransName +'&doc_data='+HTTPEncode(UTF8Encode(Doc_Data)) +'&doc_data1='+HTTPEncode(UTF8Encode(Doc_Data1)) +'&attach='+AttachYN +'&case_page='+case_page +'&file_size='+IntToStr(filesizeInt) +'&must_formid='+must_formidStr //擁有的 formid +'&last_add_formid='+last_add_formidstr //當次新加的 formid +'&in_doc1='+HTTPEncode(UTF8Encode(In_Doc1)) +'&in_doc2='+HTTPEncode(UTF8Encode(In_Doc2)); //ShowMessage('SendData='+SendData); //ShowMessage(FData+#10#13+Doc_Data); //exit; if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/caseupload',SendData,'file',Path+'Img.zip',FReWrite,Memo1,False) then begin Showmessage(Format(_Msg('傳送案件編號(%s)檔案時,網路發生錯誤!!'+_Msg('錯誤代碼:')),[CaseID])+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason); Result := False; Exit; end; if memo1.Lines.Strings[0] = '1' then begin Showmessage(Format(_Msg('傳送案件編號(%s)檔案時,網路發生錯誤!!')+_Msg('錯誤原因:'),[CaseID])+memo1.Lines.Strings[1]); Result := False; Exit; end Else if Pos('',Memo1.Lines.Text) > 0 then begin Showmessage(Format(_Msg('傳送案件編號(%s)檔案時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'),[CaseID])); Result := False; Exit; end; ////上傳//// if FMode = 'ESCAN' then //上傳舊件引入檔案 //20140616 原本先搬舊件再搬新件,改為先搬新件再搬舊件 begin if not TransOldCaseFile(ImageSavePath+CaseID+'\') then begin Result := False; Exit; end; end; // 呼叫Server完成 ///// {If not CaseComplete(Path,CaseID,MainCase) Then begin Showmessage(_Msg('通知案件傳送完成時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Result := False; Exit; end; } /// 呼叫Server完成//// ////刪檔//// //_DelTree(Path); //會只刪TransPath //ShowMessage('STOP'); _DelTree(ImageSavePath+CaseID); SetCaseList('D',-1,CaseID); ////刪檔//// 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.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('sssss'); 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; Function TCB_IMGPSScanX.GetNoNameCase(Path:String):String; //取未配號XXXX var i : Integer; begin for i := 1 to 9999 do begin if Not DirectoryExists(Path+_Msg('未配號')+Add_Zoo(i,4)) then begin Result := _Msg('未配號')+Add_Zoo(i,4); Break; end; end; end; Procedure TCB_IMGPSScanX.CaseResort(Path:String); //案件的檔案重新排序(次文件依Docno排) var i,n,v,v1 : Integer; S,S1 : TStringlist; FormID,OldName,NewName,DocNo,Doc_Type:String; x : Integer; begin S := TStringlist.Create; S1 := TStringlist.Create; try S.LoadFromFile(Path+'Context.dat'); X := 0; {for I := 1 to FORM_INF_List.Count - 1 do //在FormID有設定的 //主文件 照SQL排 20101028改 begin FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); if FormCode2FileName(FormID,S) = '' then Continue; Doc_Type := GetSQLData(FORM_INF_List,'T2.DOC_TYPE',i); for n := 0 to S.Count - 1 do begin if (S.Strings[n][1] <> '*') and (FileName2FormCode(S.Strings[n]) = FormID) and (Doc_Type='1') then begin Inc(X); OldName := S.Strings[n]; //NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); //從原有數量加1開始編 NewName := Add_Zoo(S.Count+x,3)+FileName2NoQuene_Filename(OldName); //從原有數量加1開始編 S.Strings[n] := '*'+S.Strings[n]; S1.Add(OldName+','+NewName); end; end; end;} {for I := 0 to FORM_INF_List.Count - 1 do //次文件 照FormID 1~8碼+掃瞄順序排 20110512為了某個文件要先打的原因要求改 begin for n := 0 to S.Count - 1 do begin FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); Doc_Type := GetSQLData(FORM_INF_List,'T2.DOC_TYPE',i); if (S.Strings[n][1] <> '*') and (Copy(FileName2FormCode(S.Strings[n]),1,8) = Copy(FormID,1,8)) and (Doc_Type='2') then begin Inc(X); OldName := S.Strings[n]; NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); //從原有數量加1開始編 S.Strings[n] := '*'+S.Strings[n]; S1.Add(OldName+','+NewName); end; end; end;} for I := 0 to Doc_Inf_List.Count - 1 do //主文件 照文件代碼+掃瞄順序排 20101101改 20110512晚上又說改回來 begin DocNo := GetSQLData(Doc_Inf_List,'DOC_NO',i); if DocNo2FileName(DocNo,S) = '' then Continue; Doc_Type := GetSQLData(Doc_Inf_List,'DOC_TYPE',i); for n := 0 to S.Count - 1 do begin if (S.Strings[n][1] <> '*') and (FormCode2DocNo(FileName2FormCode(S.Strings[n])) = DocNo) and (Doc_Type='1') then begin Inc(X); OldName := S.Strings[n]; //NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); //從原有數量加1開始編 NewName := Add_Zoo(S.Count+x,3)+FileName2NoQuene_Filename(OldName); //從原有數量加1開始編 S.Strings[n] := '*'+S.Strings[n]; S1.Add(OldName+','+NewName); end; end; end; for I := 0 to Doc_Inf_List.Count - 1 do //次文件 照文件代碼+掃瞄順序排 20101101改 20110512晚上又說改回來 begin DocNo := GetSQLData(Doc_Inf_List,'DOC_NO',i); if DocNo2FileName(DocNo,S) = '' then Continue; Doc_Type := GetSQLData(Doc_Inf_List,'DOC_TYPE',i); for n := 0 to S.Count - 1 do begin if (S.Strings[n][1] <> '*') and (FormCode2DocNo(FileName2FormCode(S.Strings[n])) = DocNo) and (Doc_Type='2') then begin Inc(X); OldName := S.Strings[n]; //NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); //從原有數量加1開始編 NewName := Add_Zoo(S.Count+x,3)+FileName2NoQuene_Filename(OldName); //從原有數量加1開始編 S.Strings[n] := '*'+S.Strings[n]; S1.Add(OldName+','+NewName); end; end; end; {for n := 0 to S.Count - 1 do //次文件 照掃瞄順序排 20101028改 begin FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); Doc_Type := GetSQLData(FORM_INF_List,'T2.DOC_TYPE',i); for i := 0 to FORM_INF_List.Count - 1 do begin if (S.Strings[n][1] <> '*') and (FileName2FormCode(S.Strings[n]) = FormID) and (Doc_Type='2') then begin Inc(X); OldName := S.Strings[n]; NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); //從原有數量加1開始編 S.Strings[n] := '*'+S.Strings[n]; S1.Add(OldName+','+NewName); end; end; end;} for i := 0 to S.Count - 1 do //FormID沒設定的或附件 begin if S.Strings[i][1] <> '*' then begin Inc(X); OldName := S.Strings[i]; //NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); NewName := Add_Zoo(S.Count+x,3)+FileName2NoQuene_Filename(OldName); S.Strings[i] := '*'+S.Strings[i]; S1.Add(OldName+','+NewName); end; end; S.Clear; for i := 0 to S1.Count - 1 do //開始轉換檔名 begin v := Pos(',',S1.Strings[i]); v1 := length(S1.Strings[i]); OldName := copy(S1.Strings[i],1,v-1); NewName := copy(S1.Strings[i],v+1,v1-v); if FileExists(Path+OldName) then begin ReNameFile(Path+OldName,Path+NewName); S.Add(NewName); S.SaveToFile(Path+'Context.dat'); end; end; ReSortFileName(Path); finally S.Free; S1.Free; end; end; Procedure TCB_IMGPSScanX.CaseResort2Scanlist(Path:String); //案件的檔案重新排序給scanlist(次文件依FormID排) var i,n,v,v1 : Integer; S,S1 : TStringlist; FormID,OldName,NewName,DocNo,Doc_Type:String; x : Integer; begin S := TStringlist.Create; S1 := TStringlist.Create; try if FileExists(Path+'Context.dat') then S.LoadFromFile(Path+'Context.dat'); X := 0; for I := 1 to FORM_INF_List.Count - 1 do //在FormID有設定的 //主文件 照SQL排 20101028改 begin FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); if FormCode2FileName(FormID,S) = '' then Continue; Doc_Type := GetSQLData(FORM_INF_List,'T2.DOC_TYPE',i); for n := 0 to S.Count - 1 do begin if (S.Strings[n][1] <> '*') and (FileName2FormCode(S.Strings[n]) = FormID) and (Doc_Type='1') then begin Inc(X); OldName := S.Strings[n]; //NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); //從原有數量加1開始編 NewName := Add_Zoo(S.Count+x,3)+FileName2NoQuene_Filename(OldName); //從原有數量加1開始編 S.Strings[n] := '*'+S.Strings[n]; S1.Add(OldName+','+NewName); end; end; end; for I := 0 to FORM_INF_List.Count - 1 do //次文件 照SQL排 20110512為了某個文件要先打的原因要求改 begin FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); if FormCode2FileName(FormID,S) = '' then Continue; Doc_Type := GetSQLData(FORM_INF_List,'T2.DOC_TYPE',i); for n := 0 to S.Count - 1 do begin if (S.Strings[n][1] <> '*') and (FileName2FormCode(S.Strings[n]) = FormID) and (Doc_Type='2') then begin Inc(X); OldName := S.Strings[n]; //NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); //從原有數量加1開始編 NewName := Add_Zoo(S.Count+x,3)+FileName2NoQuene_Filename(OldName); //從原有數量加1開始編 S.Strings[n] := '*'+S.Strings[n]; S1.Add(OldName+','+NewName); end; end; end; {for I := 0 to Doc_Inf_List.Count - 1 do //次文件 照文件代碼+掃瞄順序排 20101101改 20110512晚上又說改回來 begin DocNo := GetSQLData(Doc_Inf_List,'DOC_NO',i); Doc_Type := GetSQLData(Doc_Inf_List,'DOC_TYPE',i); for n := 0 to S.Count - 1 do begin if (S.Strings[n][1] <> '*') and (FormCode2DocNo(FileName2FormCode(S.Strings[n])) = DocNo) and (Doc_Type='2') then begin Inc(X); OldName := S.Strings[n]; NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); //從原有數量加1開始編 S.Strings[n] := '*'+S.Strings[n]; S1.Add(OldName+','+NewName); end; end; end;} {for n := 0 to S.Count - 1 do //次文件 照掃瞄順序排 20101028改 begin for i := 0 to FORM_INF_List.Count - 1 do begin FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i); Doc_Type := GetSQLData(FORM_INF_List,'T2.DOC_TYPE',i); if (S.Strings[n][1] <> '*') and (FileName2FormCode(S.Strings[n]) = FormID) and (Doc_Type='2') then begin Inc(X); OldName := S.Strings[n]; NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); //從原有數量加1開始編 S.Strings[n] := '*'+S.Strings[n]; S1.Add(OldName+','+NewName); end; end; end;} for i := 0 to S.Count - 1 do //FormID沒設定的或附件 begin if S.Strings[i][1] <> '*' then begin Inc(X); OldName := S.Strings[i]; //NewName := Add_Zoo(S.Count+x,3)+Copy(OldName,4,length(OldName)-3); NewName := Add_Zoo(S.Count+x,3)+FileName2NoQuene_Filename(OldName); S.Strings[i] := '*'+S.Strings[i]; S1.Add(OldName+','+NewName); end; end; S.Clear; for i := 0 to S1.Count - 1 do //開始轉換檔名 begin v := Pos(',',S1.Strings[i]); v1 := length(S1.Strings[i]); OldName := copy(S1.Strings[i],1,v-1); NewName := copy(S1.Strings[i],v+1,v1-v); //if FileExists(Path+OldName) then //begin //ReNameFile(Path+OldName,Path+NewName); S.Add(NewName); S.SaveToFile(Path+'scanlist.dat'); //end; end; ReSortFileName2Scanlist(Path); finally S.Free; S1.Free; end; end; Procedure TCB_IMGPSScanX.DistinctDocinCase(Path:String); //列出案件裡的Docno_版本 var i,n,v : Integer; S : TStringlist; FormCode,DocNo,Ver : String; Doc_Ver : String; Exists : Boolean; begin S := TSTringlist.Create; try DocNo_VerinCase.Clear; S.LoadFromFile(Path+'Context.dat'); for I := 0 to S.Count - 1 do begin FormCode := FileName2FormCode(S.Strings[i]); DocNo := FormCode2DocNo(FormCode); Ver := FormCode2Version(FormCode); if (Docno <> '') and (Ver <> '') then begin Doc_Ver := DocNo+'_'+Ver; Exists := False; for n := 0 to DocNo_VerinCase.Count-1 do begin if Doc_Ver = DocNo_VerinCase.Strings[n] then begin Exists := True; Break; end; end; if not Exists then DocNo_VerinCase.Add(Doc_Ver); end; end; finally S.Free; end; end; Procedure TCB_IMGPSScanX.DistinctDocNoinCase(Path:String); //列出案件裡的Docno var i,n,v : Integer; S : TStringlist; FormCode,DocNo,Ver : String; Exists : Boolean; begin S := TSTringlist.Create; try CaseDocNoList.Clear; S.LoadFromFile(Path+'Context.dat'); for I := 0 to S.Count - 1 do begin FormCode := FileName2FormCode(S.Strings[i]); DocNo := FormCode2DocNo(FormCode); if (Docno <> '') then begin Exists := False; for n := 0 to CaseDocNoList.Count-1 do begin if DocNo = CaseDocNoList.Strings[n] then begin Exists := True; Break; end; end; if not Exists then CaseDocNoList.Add(DocNo); end; end; finally S.Free; 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.SetCaseList(Mode:Char;Index:Integer;text:String); //'A:加入,I:插入,D:刪除,E:修改' var i : Integer; begin CaseList.Clear; if FileExists(ImageSavePath + 'CaseList.dat') then CaseList.LoadFromFile(ImageSavePath + 'CaseList.dat'); case Mode of 'A':begin CaseList.Add(Text); end; 'I':begin CaseList.Insert(Index,Text); end; 'E':begin CaseList.Strings[Index] := Text; end; 'D':begin if Index <> -1 then CaseList.Delete(Index) Else if (text <> '') then begin for i := 0 to CaseList.Count - 1 do begin if Text = CaseList.Strings[i] then begin CaseList.Delete(i); Break; end; end; end; if CaseList.Count = 0 then DeleteFile(ImageSavePath + 'CaseList.dat'); end; end; if CaseList.Count > 0 then CaseList.SaveToFile(ImageSavePath+'CaseList.dat'); end; Procedure TCB_IMGPSScanX.SetDocNoList(Mode:Char;Index:Integer;CaseNo,DocDir,Copies:String); //'A:加入,I:插入,D:刪除,E:修改' var i : Integer; CaseDocNoList : TStringlist; CaseDocNo_copiesList : TStringlist; begin CaseDocNoList := TStringlist.Create; CaseDocNo_CopiesList := TStringlist.Create; try 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'); case Mode of 'A':begin CaseDocNoList.Add(DocDir); CaseDocNo_CopiesList.Add(Copies); SetRecordEditedDocDir('A',CaseNo,DocDir); end; 'I':begin CaseDocNoList.Insert(Index,DocDir); CaseDocNo_CopiesList.Insert(Index,Copies); end; 'E':begin CaseDocNoList.Strings[Index] := DocDir; CaseDocNo_CopiesList.Strings[Index] := Copies; end; 'D':begin if Index <> -1 then begin //SetRecordEditedDocDir('D',CaseNo,CaseDocNoList.Strings[Index]); //20140624 修改刪除文件時也記一筆異動,刪掉會無法通知前端網頁有異動 SetRecordEditedDocDir('A',CaseNo,CaseDocNoList.Strings[Index]); CaseDocNoList.Delete(Index); CaseDocNo_CopiesList.Delete(Index); end Else if (DocDir <> '') then begin for i := 0 to CaseDocNoList.Count - 1 do begin if DocDir = CaseDocNoList.Strings[i] then begin //SetRecordEditedDocDir('D',CaseNo,CaseDocNoList.Strings[i]); //20140624 修改刪除文件時也記一筆異動,刪掉會無法通知前端網頁有異動 SetRecordEditedDocDir('A',CaseNo,CaseDocNoList.Strings[i]); CaseDocNoList.Delete(i); CaseDocNo_CopiesList.Delete(i); Break; end; end; end; if ContextList.Count = 0 then begin DeleteFile(ImageSavePath+CaseNo+'\CaseDocNo.dat'); end; end; end; //Showmessage('abc'+#13+ImageSavePath+CaseNo+'\CaseDocNo.dat'+#13+inttostr(CaseDocNoList.Count)+#13+CaseDocNoList.Text); if CaseDocNoList.Count > 0 then begin CaseDocNoList.SaveToFile(ImageSavePath+CaseNo+'\CaseDocNo.dat'); CaseDocNo_CopiesList.SaveToFile(ImageSavePath+CaseNo+'\CaseDocNo_Copies.dat'); //Showmessage('存了'); end; finally CaseDocNoList.Free; CaseDocNo_CopiesList.Free; end; 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)); 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; Function TCB_IMGPSScanX.checkCaseOMRDone:Boolean; //檢查案件是否完成OMR檢核 var i : Integer; begin Result := True; for I := 0 to NewTreeNode.Count - 1 do begin if NewTreeNode.Item[i].ImageIndex <> 7 then begin Result := False; Break; end; end; 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; Function TCB_IMGPSScanX.CheckCaseID_OK:Boolean; //檢查是否有未配號的案件 var i,n : Integer; begin Result := True; for i := 0 to NewTreeNode.Count - 1 do begin if Pos(_msg('未配號'),NewTreeNode.Item[i].Text) > 0 then begin Result := False; Break; end; end; end; Procedure TCB_IMGPSScanX.CreateEmptyCase(Path,CaseID:String); //產生空白案號(重掃件用) var S : TStringlist; begin S := TStringlist.Create; try S.SaveToFile(Path+CaseID+'\Context.dat'); S.Add(FCaseID); S.SaveToFile(Path+'CaseList.dat') finally S.Free; 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; begin OldFileList := TStringlist.Create; NewFileList := TStringlist.Create; try NewDocNo := FormCode2DocNo(NewFormID); NewDocDir := FindLastestDocDir(CaseID,NewDocNo); if NewDocDir = '' then NewDocDir := NewDocNo; if DocNoNeedDiv(NewDocNo) and (FormCode2Page(NewFormID)='01') then NewDocDir := DocNo2DocNoDir(ImageSavePath+CaseID+'\',NewDocNo); 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; end; end; Procedure TCB_IMGPSScanX.ShowFileReplace(Path,NewFormID:String);//顯示的影像換成新的FormID var i,n : Integer; OldFile,NewFile:String; Ext : String; begin for i := 0 to NowShowFileList.Count - 1 do begin OldFile := NowShowFileList.Strings[i]; Ext := ExtractFileExt(OldFile); NewFile := Add_Zoo(FileName2ScanPage(OldFile),3)+'_'+NewFormID+Ext; ReNameFile(Path+OldFile,Path+NewFile); SetContextList('E',FileName2Index(OldFile),NowCaseno,NowDocNo,NewFile); 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.ModeNeedCheck(OMRMode,ScanMode:String):Boolean; //掃瞄模式是否要做檢核 begin Result := False; if Pos(ScanMode,OMRMode) > 0 then Result := True; end; Function TCB_IMGPSScanX.GetInputMask:String; //取得輸入的保單號碼 var InputMaskForm: TInputMaskForm; begin Result := ''; ShowText := _msg('輸入保單號碼中'); DataLoading(True,True); InputMaskForm := TInputMaskForm.Create(self); try InputMaskForm.MaskEdit1.ClearSelection; if InputMaskForm.ShowModal = mrOk then begin Result := Trim(InputMaskForm.MaskEdit1.Text)+Trim(InputMaskForm.MaskEdit2.Text)+Trim(InputMaskForm.MaskEdit3.Text); end; finally InputMaskForm.Free; DataLoading(False,False); end; end; Function TCB_IMGPSScanX.GetCasePage(Path,CaseID:String):Integer; var DocDirList,FileList :TStringlist; iDocDir,iDocNo : String; i,Count : Integer; begin Count := 0; DocDirList := TStringlist.Create; FileList := TStringlist.Create; try if FileExists(Path+CaseID+'\CaseDocNo.dat') then DocDirList.LoadFromFile(Path+CaseID+'\CaseDocNo.dat'); //Showmessage(DocDirList.Text); for i := 0 to DocDirList.Count - 1 do begin iDocDir := DocDirList.Strings[i]; iDocno := DocNoDir2DocNo(iDocDir); {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; FileList.Clear; if FileExists(Path+CaseID+'\'+iDocDir+'\Context.dat') then FileList.LoadFromFile(Path+CaseID+'\'+iDocDir+'\Context.dat'); Count := Count+ FileList.Count; end; if FileExists(Path+CaseID+'\'+AttName+'\Context.dat') then begin FileList.LoadFromFile(Path+CaseID+'\'+AttName+'\Context.dat'); Count := Count+ FileList.Count; end; Result := Count; finally DocDirList.Free; FileList.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.SetFile2Case(CaseID,FileName:String); var S :TStringlist; begin S := TStringlist.Create; try S.LoadFromFile(ImageSavePath+CaseID+'\Context.dat'); S.Add(FileName); S.SaveToFile(ImageSavePath+CaseID+'\Context.dat'); finally S.Free; end; 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.GetCase_PageCount(var CaseCount,PageCount:Integer):Boolean; //取出案件的數量及頁數 var i,n: Integer; CaseList,DocList,FileList : TStringlist; begin Result := False; CaseCount := 0; PageCount := 0; CaseList := TStringlist.Create; DocList := TStringlist.Create; FileList := TStringlist.Create; try ImageSavePath := ImagePath; CaseList.Clear; if FileExists(ImageSavePath + 'CaseList.dat') then CaseList.LoadFromFile(ImageSavePath + 'CaseList.dat'); CaseCount := CaseCount+CaseList.Count; for i := 0 to CaseList.Count - 1 do begin DocList.Clear; If FileExists(ImageSavePath+CaseList.Strings[i]+'\CaseDocNo.dat') Then DocList.LoadFromFile(ImageSavePath+CaseList.Strings[i]+'\CaseDocNo.dat'); for n := 0 to DocList.Count - 1 do begin if not DocNoAppear(DocNoDir2DocNo(DocList.Strings[n])) then Continue; FileList.Clear; If FileExists(ImageSavePath+CaseList.Strings[i]+'\'+DocList.Strings[n]+'\Context.dat') Then FileList.LoadFromFile(ImageSavePath+CaseList.Strings[i]+'\'+DocList.Strings[n]+'\Context.dat'); PageCount := PageCount+FileList.Count; end; //Showmessage(inttostr(PageCount)); FileList.Clear; If FileExists(ImageSavePath+CaseList.Strings[i]+'\'+Attname+'\Context.dat') Then FileList.LoadFromFile(ImageSavePath+CaseList.Strings[i]+'\'+Attname+'\Context.dat'); //Showmessage(ImageSavePath+CaseList.Strings[i]+'\'+Attname+'\Context.dat'); //Showmessage(FileList.Text); PageCount := PageCount+FileList.Count; //Showmessage(inttostr(PageCount)); end; Finally CaseList.Free; DocList.Free; FileList.Free; end; 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.BarCode2CaseID : String; //Barcode依規則轉成CaseID var i : Integer; iCaseID : String; begin Result := ''; //沒找到 iCaseID := ''; for i := 1 to MpsBarcodeinf.Count-1 do begin if (Length(MpsBarcodeinf.text[i]) = CaseIDLength) then begin iCaseID := MpsBarcodeinf.text[i]; Result := iCaseID; Break; 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; Procedure TCB_IMGPSScanX.WriteCaseIndex(Path:String); Var S : TStringlist; begin if Path = '' then Exit; S := TStringlist.Create; try S.Add(Case_loandoc); S.SaveToFile(Path+'CaseIndex.dat'); finally S.Free; end; end; Procedure TCB_IMGPSScanX.ReadCaseIndex(Path:String); Var S : TStringlist; begin AddCredit1RG.ItemIndex := -1; S := TStringlist.Create; try if FileExists(Path+'CaseIndex.dat') then begin S.LoadFromFile(Path+'CaseIndex.dat'); Case_loandoc := S.Strings[0]; end; if (Case_loandoc = '') and (FLoanDoc_Value <> '') then begin Case_loandoc := FLoanDoc_Value; WriteCaseIndex(Path); end; if Case_loandoc = 'Y' then AddCredit1RG.ItemIndex := 0 Else if Case_loandoc = 'N' then AddCredit1RG.ItemIndex := 1; finally S.Free; end; end; Procedure TCB_IMGPSScanX.ClearCaseIndex; begin AddCredit1RG.Enabled := False; AddCredit1RG.ItemIndex := -1; end; Procedure TCB_IMGPSScanX.GetSelectImageFile; var i : Integer; FormID,FormName,DocNo : String; PreNode2Name : String; iFormID : String; iISBName : String; iISB : TImageScrollBox; begin NowSelectFileList.Clear; 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)); NowSelectFileList.Add(iISB.FileName); end; end; end; Function TCB_IMGPSScanX.GetDocNoDir(Path,DocNo:String):String; //取出目前DocNo的份數 var i : Integer; iDocNo : String; begin if (DocNo <> '') then begin i := 0; Repeat begin inc(i); iDocNo := Format('%s_%d',[DocNo,i]); end; until not DirectoryExists(Path+iDocNo); Result := iDocNo; end Else begin Result := AttName; 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.DocNo2DocNoDir(Path,DocNo:String):String; //DocNo轉成DocNo(份數)目錄 var i : Integer; iDocNo : String; begin if (DocNo <> '') then begin i := 0; Repeat begin inc(i); iDocNo := Format('%s(%d)',[DocNo,i]); end; until not DirectoryExists(Path+iDocNo); Result := iDocNo; end Else begin Result := AttName; end; end; Function TCB_IMGPSScanX.DocNoDir2DocNo(DocNoDir:String):String; //DocNo(份數)目錄轉成DocNo var v,ln : Integer; begin if (DocNoDir <> 'Attach') and (DocNoDir <> 'S_Attach') then begin v := Pos('(',DocNoDir); if v > 0 then Result := Copy(DocNoDir,1,v-1) else Result := DocNoDir; end Else Result := DocNoDir end; Function TCB_IMGPSScanX.DocNoDir2Index(Path,DocNoDir:String):Integer; //DocNo(份數)目錄轉成index var i : Integer; CaseNo_List : TStringlist; begin Result := -1; CaseNo_List := TStringlist.Create; try CaseNo_List.LoadFromFile(Path+'CaseDocNo.dat'); for i := 0 to CaseNo_List.Count - 1 do begin if DocNoDir = CaseNo_List.Strings[i] then begin Result := i; Break; end; end; finally CaseNo_List.Free; end; end; Procedure TCB_IMGPSScanX.ZipMainFile(SoPath,DePath,ZipName:String); var ZipFileList : TStringlist; n : Integer; begin ZipFileList := TStringlist.Create; try if fileExists(DePath+ZipName) then DeleteFile(DePath+ZipName); {if FileExists(SoPath+'ReSize.dat') then DeleteFile(SoPath+'ReSize.dat');} //Showmessage(SoPath+#13+ContextList.Text); for n := 0 to ContextList.Count - 1 do begin {WriteResize(SoPath+ContextList.Strings[n],SoPath+'ReSize.dat');} ZipFileList.Add(SoPath+ContextList.Strings[n]); if FileExists(SoPath+'@'+ContextList.Strings[n]) then ZipFileList.Add(SoPath+'@'+ContextList.Strings[n]); end; if FileExists(SoPath+'Context.dat') then ZipFileList.Add(SoPath+'Context.dat'); if FileExists(SoPath+'Context_DocNo.dat') then ZipFileList.Add(SoPath+'Context_DocNo.dat'); if FileExists(SoPath+'scanlist.dat') then ZipFileList.Add(SoPath+'scanlist.dat'); if FileExists(SoPath+'FormCode_Name.dat') then ZipfileList.Add(SoPath+'FormCode_Name.dat'); if FileExists(SoPath+'DocNo_Name.dat') then ZipfileList.Add(SoPath+'DocNo_Name.dat'); if FileExists(SoPath+'ReSize.dat') then ZipfileList.Add(SoPath+'ReSize.dat'); if FileExists(SoPath+'FormIDReplace.dat') then ZipfileList.Add(SoPath+'FormIDReplace.dat'); if FileExists(SoPath+'AnchorError.dat') then ZipfileList.Add(SoPath+'AnchorError.dat'); if FileExists(SoPath+'CaseDocNo.dat') then ZipfileList.Add(SoPath+'CaseDocNo.dat'); if FileExists(SoPath+'CaseDocNo_Copies.dat') then ZipfileList.Add(SoPath+'CaseDocNo_Copies.dat'); if FileExists(SoPath+'CustomDocNo.ini') then ZipfileList.Add(SoPath+'CustomDocNo.ini'); if FileExists(SoPath+'DocDir.dat') then ZipfileList.Add(SoPath+'DocDir.dat'); if FileExists(SoPath+'In_Wh.dat') then ZipfileList.Add(SoPath+'In_Wh.dat'); if FileExists(SoPath+'UseCase.ini') then ZipfileList.Add(SoPath+'UseCase.ini'); if FileExists(SoPath+'FirstImg.zip') then//20170315 加的 begin ZipfileList.Add(SoPath+'FirstImg.zip'); end; ExeCuteZip(DePath+ZipName,SoPath,ZipFileList,False,False); //Showmessage('111'); finally ZipFileList.Free; end; end; Procedure TCB_IMGPSScanX.ZipMaskFile(SoPath,MarkPath,DePath,ZipName:String); //壓縮遮罩影像檔 var ZipFileList : TStringlist; n : Integer; begin ZipFileList := TStringlist.Create; try if fileExists(DePath+ZipName) then DeleteFile(DePath+ZipName); for n := 0 to ContextList.Count - 1 do begin ZipFileList.Add(MarkPath+ContextList.Strings[n]); end; if FileExists(SoPath+'Context.dat') then ZipFileList.Add(SoPath+'Context.dat'); if FileExists(SoPath+'scanlist.dat') then ZipFileList.Add(SoPath+'scanlist.dat'); if FileExists(SoPath+'FormCode_Name.dat') then ZipfileList.Add(SoPath+'FormCode_Name.dat'); if FileExists(SoPath+'DocNo_Name.dat') then ZipfileList.Add(SoPath+'DocNo_Name.dat'); if FileExists(SoPath+'ReSize.dat') then ZipfileList.Add(SoPath+'ReSize.dat'); if FileExists(SoPath+'Err.jpg') then ZipfileList.Add(SoPath+'Err.jpg'); if FileExists(SoPath+'auth.jpg') then ZipfileList.Add(SoPath+'auth.jpg'); ExeCuteZip(DePath+ZipName,SoPath,ZipFileList,False,False); finally ZipFileList.Free; end; end; Procedure TCB_IMGPSScanX.ParserPoint(S:String); //解析十字點的字串 var PointList : TStringlist; Rect : TRect; begin PointList := TStringlist.Create; try PointList.Text := S; IF PointList.Count <> 6 Then begin UpLPoint := Str2Point('0,0'); UpRPoint := Str2Point('0,0'); DownLPoint := Str2Point('0,0'); DownRPoint := Str2Point('0,0'); Point_Width := '0'; Point_Height := '0'; end Else begin UpLPoint := Str2Point(PointList[0]); DownLPoint := Str2Point(PointList[1]); UpRPoint := Str2Point(PointList[2]); DownRPoint := Str2Point(PointList[3]); Point_Width := PointList[4]; Point_Height := PointList[5]; end; finally PointList.Free; end; end; Function TCB_IMGPSScanX.CheckScanDenialTime:Boolean; Var NowTime : String; begin NowTime := GetBalance2Time(Balance); NowTime := Copy(NowTime,1,2)+':'+Copy(NowTime,3,2)+':'+Copy(NowTime,5,2); Result := True; if ScanDenialTime <> '' then begin if StrtoTime(NowTime) >= StrtoTime(ScanDenialTime) then Result := False; 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; 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; procedure TCB_IMGPSScanX.ScanDuplexCBClick(Sender: TObject); begin ScanDuplex := ScanDuplexCB.Checked; //R_W_ScanIni('W'); //user要求改成預設後不能改 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; Function TCB_IMGPSScanX.MemoInfoTransfer(Mode,Str:String;ID_S,Name_S:TStringlist):String; //註記代碼註記類別轉換 Mode 'ID':代碼轉名稱;'NAME':名稱轉代碼 var i : Integer; begin if Mode = 'ID' then begin Result := '自行輸入'; for i := 0 to ID_S.Count - 1 do begin if Str = ID_S.Strings[i] then begin Result := Name_S.Strings[i]; Break; end; end; end else if Mode = 'NAME' then begin Result := '00'; for i := 0 to Name_S.Count - 1 do begin if Str = Name_S.Strings[i] then begin Result := ID_S.Strings[i]; Break; end; end; end; end; Procedure TCB_IMGPSScanX.SetSQLData(ColumeStr:String;FromList,ToList:TStringlist); //把SQL值塞入 var i : Integer; begin ToList.Clear; ToList.Add(ColumeStr); For i := 1 to FromList.Count -1 do begin ToList.Add(FromList.Strings[i]); end; end; Function TCB_IMGPSScanX.GetSQLData(TableList:TStringlist;Colname:String;colNo:Integer):String; //依欄位及索引取值 var i,col,v,v1 : Integer; ColStr,DataStr: TStringList; TmpStr : String; P1,p2 : Integer; begin Result := ''; ColStr := TStringList.Create; DataStr := TSTringList.Create; ColStr.CommaText := TableList.Strings[0]; TmpStr := TableList.Strings[ColNo]; //DataStr.Text:=StringReplace(TmpStr,'!@!',#13,[rfReplaceAll]); While Length(Tmpstr) > 0 do begin v:= Pos('!@!',TmpStr); v1 := Length(TmpStr); If v > 0 Then begin DataStr.Add(Copy(TmpStr,1,v-1)); TmpStr := Copy(TmpStr,v+3,V1-(V-2)); end Else begin DataStr.Add(TmpStr); TmpStr := ''; end; end; For i := 0 to ColStr.Count-1 do begin IF ColStr.Strings[i] = ColName Then begin Result := ''; If (DataStr.Count > 0) and (i<=DataStr.Count-1) Then Result := DataStr.Strings[i]; //If (DataStr.Count > 0) and (i<=DataStr.Count-1) Then //begin {if i = 0 then begin P1 := 1; p2 := PosN('!@!',TmpStr,1)-1; end else begin P1 := PosN('!@!',TmpStr,i)+3; p2 := PosN('!@!',TmpStr,i+1)-p1; end; Result :=Copy(tmpstr,p1,p2);} //end; //Result := DataStr.Strings[i]; Break; end; end; ColStr.Free; DataStr.Free; end; Function TCB_IMGPSScanX.FindSQLData(TableList:TStringlist;ColumeStr,KeyColumeStr,KeyStr:String;ColNo:Integer;Var ResultList:TStringlist):Boolean; //找指定的資料 Var i,n,Findindex : Integer; ColList,KeyColList,KeyList : TStringlist; Cols,Keycols,keys :String; Find:Boolean; begin ResultList.Clear; if (KeyStr = '') or (TableList.Count <= 1) then begin Result := False; Exit; end; ColList := TStringlist.Create; KeyColList := TStringlist.Create; KeyList := TStringlist.Create; try ColList.CommaText := ColumeStr; KeyColList.CommaText := KeyColumeStr; KeyList.CommaText := KeyStr; if ColNo = 0 then begin for i := 1 to TableList.Count -1 do //找key對不對 begin Findindex := i; for n := 0 to KeyColList.Count - 1 do begin Find := True; Keycols := KeyColList.Strings[n]; keys := KeyList.Strings[n]; //Showmessage(keys); //Showmessage(TableList.Strings[i]); if GetSQLData(TableList,Keycols,i) = keys then //對.繼續 //if Pos('!@!'+keys+'!@!','!@!'+TableList.Strings[i]+'!@!') >0 then //在資料列前後加!@! 用pos的方式來改善速度 //20130521發現找資料會有問題 Continue Else //不對.離開 begin Find := False; Break; end; end; if Find then Break; // 找到了離開 end; end Else begin i := ColNo; Findindex := i; for n := 0 to KeyColList.Count - 1 do begin Find := True; Keycols := KeyColList.Strings[n]; keys := KeyList.Strings[n]; //if GetSQLData(TableList,Keycols,i) = keys then //對.繼續 if Pos('!@!'+keys+'!@!','!@!'+TableList.Strings[i]+'!@!') >0 then //在資料列前後加!@! 用pos的方式來改善速度 Continue Else //不對.離開 begin Find := False; Break; end; end; end; if Find then //有找到key begin for n := 0 to ColList.Count -1 do begin Cols := ColList.Strings[n]; ResultList.Add(Cols+','+GetSQLData(TableList,Cols,Findindex)); end; end; finally Result := Find; ColList.Free; KeyColList.Free; KeyList.Free; end; 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; Procedure TCB_IMGPSScanX.DataLoading(Loading:Boolean;UseTimer:Boolean); //資料載入中要停止點選的動作 begin If Loading Then begin Screen.Cursor := -11; if UseTimer then begin Panel22.Caption := ShowText; Panel22.Left := (Panel9.Width div 2) - (Panel22.Width div 2); Panel22.Top := (Panel9.Height div 2) - (Panel22.Height div 2); Panel22.Visible := True; Timer2.Enabled := True; end Else begin Panel8.Left := (Panel9.Width div 2) - (Panel8.Width div 2); Panel8.Top := (Panel9.Height div 2) - (Panel8.Height div 2); Panel8.Visible := True; end; Application.ProcessMessages; Panel1.Enabled := False; Panel2.Enabled := False; end Else begin Panel22.Visible := False; Panel8.Visible := False; Timer2.Enabled := False; Panel1.Enabled := True; Panel2.Enabled := True; Screen.Cursor := 0; end; end; procedure TCB_IMGPSScanX.CaseHelpBtnClick(Sender: TObject); var ErrlistForm : TErrlistForm; S : TStringlist; UpFormID : String; begin ShowText := _Msg('處理檢核失敗中,請稍候'); DataLoading(True,True); ErrlistForm := TErrlistForm.Create(Self); RejectCase := False; S := TStringlist.Create; try InitialLanguage(ErrlistForm); Application.ProcessMessages; 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+'\'; 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; Showmessage(NowCaseNo+_Msg('傳送完成')); 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; 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; begin Result := False; FileList := TStringlist.Create; CaseDocNoList := TStringlist.Create; CaseDocNo_CopiesList := TStringlist.Create; StrList := TStringlist.Create; 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'); //Showmessage('aaa '+FileList.Text); DocNoCopies := Strtoint(CaseDocNo_CopiesList.Strings[i]); DocNoPage := FileList.Count; iDocNo := DocNoDir2DocNo(CaseDocNoList.Strings[i]); //Showmessage(iDocNo); //Showmessage(DocNo2DocName(Caseno,iDocNo)); {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])); DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('份'),[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,FormName+'{'+FormID+'}-'+inttostr(FormPage)+_msg('頁')); 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.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.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('%s{%s}-%d'+_msg('份'),[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.ImageIndex := 4; FormNode.SelectedIndex := 4; end; end; end; Finally FileList.Free; CaseDocNoList.Free; CaseDocNo_CopiesList.Free; StrList.Free; end; end; procedure TCB_IMGPSScanX.initkscan; begin ScanDuplexCB.Enabled := False; if Scanner.IsConfigured then begin try Scanner.OpenSource; IF Scanner.DuplexCap > 0 Then begin ScanDuplexCB.Enabled := True; end; {IF Scanner.FEEDERCAP Then ScanFlatCB.Enabled := True; } Except DataLoading(False,True); Exit; end; Scanner.CloseSource; 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 ; end; if FScanColor = 2 then begin ScanColor := ifTrueColor ; end; 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 := '列印中,請稍候'; 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+FileList.Strings[i] Else S := S+#13+FileList.Strings[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 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.ListView1.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)]); 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])<>-11) then begin str1:=Copy(ST1.Strings[i],1,Pos('_',St1.Strings[i])-1); if LastInitFormidList.IndexOf(str1) = -1 then begin LastInitFormidList.Add(str1); end; end; end; ST1.Free; end; procedure TCB_IMGPSScanX.LoadImgFile; //載入新件及替換件 Var i,v,v1,m : Integer; CasePage : integer; TempName : String; BarName : String; DocName : String; //S : String; begin ClearView(1); PageLV.Clear; DisplayPath := ''; ClearCaseIndex; CaseHelpBtn.Visible := False; //Del_Sub_NothingPath(ImageSavePath); //清掉案件目錄是空的 TreeView1.Items.Clear; NewTreeNode := nil; MyTreenode1 := nil; MyTreenode2 := nil; MyTreenode3 := nil; NewTreeNode := TreeView1.Items.Add(nil,Format(_Msg('%s-共%d筆共%d頁'),[FModeName,0,0])); NewTreenode.ImageIndex := 0; NewTreenode.SelectedIndex := 0; Del_Sub_NothingPath(ImageSavePath); //清掉案件目錄是空的 GetCase_PageCount(CaseCount,PageCount); CaseList.Clear; if FileExists(ImageSavePath + 'CaseList.dat') then CaseList.LoadFromFile(ImageSavePath + 'CaseList.dat'); for i := 0 to CaseList.Count - 1 do begin CaseDocNoList.Clear; if FileExists(ImageSavePath+CaseList.Strings[i]+'\CaseDocNo.dat') then CaseDocNoList.LoadFromFile(ImageSavePath+CaseList.Strings[i]+'\CaseDocNo.dat'); if not FileExists(ImageSavePath+CaseList.Strings[i]+'\CaseDocNo_Copies.dat') then begin CaseDocNo_CopiesList.Clear; for m := 0 to CaseDocNoList.Count - 1 do begin CaseDocNo_CopiesList.Add('1'); CaseDocNo_CopiesList.SaveToFile(ImageSavePath+CaseList.Strings[i]+'\CaseDocNo_Copies.dat'); end; end; CasePage := GetCasePage(ImageSavePath,CaseList.Strings[i]); MytreeNode1 := TreeView1.Items.AddChild(NewTreeNode,Format(_Msg('%s-%d頁'),[CaseList.Strings[i],CasePage])); MytreeNode1.ImageIndex := 1; MytreeNode1.SelectedIndex := 1; DrawDocItem2(MytreeNode1,CaseList.Strings[i]); //長出文件名稱的樹並傳回是否有申請書的影像 if Pos(_Msg('未配號'),CaseList.Strings[i]) > 0 then begin MytreeNode1.ImageIndex := 5; MytreeNode1.SelectedIndex := 5; end; If FileExists(ImageSavePath+CaseList.Strings[i]+'\OMRCheckOk.dat') Then begin MytreeNode1.ImageIndex := 7; MytreeNode1.SelectedIndex := 7; CaseHelpBtn.Visible := False; end Else IF FileExists(ImageSavePath+CaseList.Strings[i]+'\Checkerr.ini') Then begin MyTreenode1.ImageIndex := 5; MyTreenode1.SelectedIndex := 5; //AllEnforceLb.Visible := True; //全部強迫送件 end; end; MyTreenode1 := nil; MyTreenode2 := nil; If NewTreeNode <> nil Then begin TreeView1.Selected := NewTreeNode; NewTreeNode.Expand(False); end; IF (NewTreeNode <> nil) and (NewTreeNode.Count > 0) Then begin GetCase_PageCount(CaseCount,PageCount); v := Pos('-',NewTreeNode.Text); NewTreeNode.Text := Format(_Msg('%s-共%d筆共%d頁'),[Copy(NewTreeNode.Text,1,v-1),CaseCount,PageCount]); end; end; procedure TCB_IMGPSScanX.LoadImgFile1; //載入新件及替換件 Var i,n,v,v1,m : Integer; p : integer; iCaseNo,iDocNo : String; TempName : String; BarName : String; DocName : String; //S : String; begin ClearView(1); PageLV.Clear; DisplayPath := ''; ClearCaseIndex; CaseHelpBtn.Visible := False; //Del_Sub_NothingPath(ImageSavePath); //清掉案件目錄是空的 TreeView1.Items.Clear; NewTreeNode := nil; MyTreenode1 := nil; MyTreenode2 := nil; MyTreenode3 := nil; NewTreeNode := TreeView1.Items.Add(nil,Format(_Msg('%s-共%d筆共%d頁'),[FModeName,0,0])); NewTreenode.ImageIndex := 0; NewTreenode.SelectedIndex := 0; Del_Sub_NothingPath(ImageSavePath); //清掉案件目錄是空的 GetCase_PageCount(CaseCount,PageCount); CaseList.Clear; if FileExists(ImageSavePath + 'CaseList.dat') then CaseList.LoadFromFile(ImageSavePath + 'CaseList.dat'); for n := 0 to CaseList.Count - 1 do begin iCaseNo := CaseList.Strings[n]; CaseDocNoList.Clear; if FileExists(ImageSavePath+CaseList.Strings[n]+'\DocNoList.dat') then CaseDocNoList.LoadFromFile(ImageSavePath+CaseList.Strings[n]+'\DocNoList.dat'); for m := 0 to CaseDocNoList.Count - 1 do begin iDocNo := CaseDocNoList.Strings[i]; MytreeNode1 := TreeView1.Items.AddChild(NewTreeNode,Format(_Msg('%s-%d頁'),[CaseList.Strings[n],p])); MytreeNode1.ImageIndex := 1; MytreeNode1.SelectedIndex := 1; end; ContextList.Clear; Context_DocnoList.Clear; If FileExists(ImageSavePath+CaseList.Strings[n]+'\Context.dat') Then begin ContextList.LoadFromFile(ImageSavePath+CaseList.Strings[n]+'\Context.dat'); if FileExists(ImageSavePath+CaseList.Strings[n]+'\Context_DocNo.dat') then Context_DocnoList.LoadFromFile(ImageSavePath+CaseList.Strings[n]+'\Context_DocNo.dat') else begin for m := 0 to ContextList.Count - 1 do begin Context_DocnoList.Add(FormCode2DocNo(FileName2FormCode(ContextList.Strings[m]))); end; Context_DocnoList.SaveToFile(ImageSavePath+CaseList.Strings[n]+'\Context_DocNo.dat'); end; Cust_DocNoList.Clear; if FileExists(ImageSavePath+CaseList.Strings[n]+'\CustomDocNo.dat') then Cust_DocNoList.LoadFromFile(ImageSavePath+CaseList.Strings[n]+'\CustomDocNo.dat'); P := ContextList.Count; MytreeNode1 := TreeView1.Items.AddChild(NewTreeNode,Format(_Msg('%s-%d頁'),[CaseList.Strings[n],p])); MytreeNode1.ImageIndex := 1; MytreeNode1.SelectedIndex := 1; //DrawDocItem1(MytreeNode1,Doc_Inf_List,CaseList.Strings[n]); //長出文件名稱的樹並傳回是否有申請書的影像 DrawDocItem2(MytreeNode1,CaseList.Strings[n]); //長出文件名稱的樹並傳回是否有申請書的影像 20140820改 if Pos(_Msg('未配號'),CaseList.Strings[n]) > 0 then begin MytreeNode1.ImageIndex := 5; MytreeNode1.SelectedIndex := 5; end; If FileExists(ImageSavePath+CaseList.Strings[n]+'\OMRCheckOk.dat') Then begin MytreeNode1.ImageIndex := 7; MytreeNode1.SelectedIndex := 7; CaseHelpBtn.Visible := False; end Else IF FileExists(ImageSavePath+CaseList.Strings[n]+'\Checkerr.ini') Then begin MyTreenode1.ImageIndex := 5; MyTreenode1.SelectedIndex := 5; //AllEnforceLb.Visible := True; //全部強迫送件 end; end; end; MyTreenode1 := nil; MyTreenode2 := nil; If NewTreeNode <> nil Then begin TreeView1.Selected := NewTreeNode; NewTreeNode.Expand(False); end; ContextList.Clear; IF (NewTreeNode <> nil) and (NewTreeNode.Count > 0) Then begin GetCase_PageCount(CaseCount,PageCount); v := Pos('-',NewTreeNode.Text); NewTreeNode.Text := Format(_Msg('%s-共%d筆共%d頁'),[Copy(NewTreeNode.Text,1,v-1),CaseCount,PageCount]); end; 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; 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 := '註冊號:'+MacID+' 剩餘註冊數:'+inttostr(Totalcount-Nowcount); if LegalDate <> '' then StatusBar1.Panels[4].Text := '*註冊號:'+MacID+'('+inttostr(Lic_Idx)+')'+' 剩餘註冊數:'+inttostr(Totalcount-Nowcount); 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.Case2Mask(SoPath,DePath:String):Boolean;//產生遮罩影像 var XT : TXMLTool; i : Integer; S : TStringlist; SiteList : TStringlist; FormID : String; ColEName : String; FileName : String; nodename : String; Site : String; Anchor : String; begin Result := False; if DirectoryExists(DePath) then _DelTree(DePath); Str2Dir(DePath); DeleteFile(SoPath+'MaskImg.zip'); SiteList := TStringlist.Create; S := TStringlist.Create; XT := TXMLTool.Create; try S.LoadFromFile(SoPath+'Context.dat'); for I := 0 to S.Count - 1 do begin SiteList.Clear; ImageScrollBox1.LoadFromFile(SoPath+S.Strings[i],1); FormID := FileName2FormCode(S.Strings[i]); Anchor := FormID2Anchor(FormID); //ParserPoint(CropMpsV.FindPoint(Anchor)); FindPoint(ImageScrollBox1.Graphic,UpLPoint,UpRPoint,DownLPoint,Anchor); if FileExists(CheckXmlPath+FormID+'.xml') then //沒有Xml就不用遮罩 begin XT.LoadFromFile(CheckXmlPath+FormID+'.xml'); if XT.SubNodes['/form/settype10/'].First then Repeat ColEName := XT.SubNodes['/form/settype10/'].NodeName; if XT.SubNodes['/form/settype10/'+ColEName+'/'].First then Repeat nodename := XT.SubNodes['/form/settype10/'+ColEName+'/'].NodeName; If nodename <> '@coldesc' then begin Site := XT.Node['/form/settype10/'+ColEName+'/'+nodename+'/'].Attributes['colxy']; SiteList.Add(Site); Result := True; //有設定 end Else begin //ColCName := XT['/form/settype1/'+ColEName+'/'+nodename+'/']; end; Until not XT.SubNodes['/form/settype10/'+ColEName+'/'].Next; Until not XT.SubNodes['/form/settype10/'].Next ; FieldMask(ImageScrollBox1,SiteList.Text,'Mask',UpLPoint); end; SaveAnnotation(ImageScrollBox1,DePath+S.Strings[i]); end; finally SiteList.Free; S.Free; XT.Free; end; end; Function TCB_IMGPSScanX.CheckNeedCrop(Graphic:TDibGraphic):Boolean; //是否是A3要切影像 Var i,FormIDCount : Integer; begin Result := False; FormIDCount := 0; if (Graphic.Width > (4 * Graphic.XDotsPerInch)) {or (Graphic.Height > (15 * Graphic.YDotsPerInch))} then //if (Graphic.Width > (6 * Graphic.XDotsPerInch)) then begin for I := 1 to MpsBarcodeinf.Count do begin if (Length(MpsBarcodeinf.Text[i])=FormIDLength) and FormIDExists(MpsBarcodeinf.Text[i],False,0) then begin inc(FormIDCount); end; end; end; if FormIDCount = 2 then begin Result := True; end; end; Function TCB_IMGPSScanX.GetNewCustomDocNo(Path,DocName:String):String; //取出未使用的自訂文件代號 var ini : Tinifile; Ct:Integer; DocNo,FormID : String; {i,n,v,ln : Integer; C_No,C_Name : String; CNo : Integer; S : TStringlist; NewDocNo : String;} begin ini := Tinifile.Create(Path+'CustomDocNo.ini'); try Ct := ini.ReadInteger('CustomCount','Count',0); inc(Ct); DocNo := 'ZZZZZ'+Add_Zoo(Ct,3); if FIs_In_Wh <> 'Y' then //不是入庫文件 DocNo := 'YYYYY'+Add_Zoo(Ct,3); FormID := DocNo+'010101A'; ini.WriteInteger('CustomCount','Count',Ct); ini.WriteString(DocNo,'FormID',FormID); ini.WriteString(DocNo,'Name',DocName); Result := DocNo; finally ini.Free; end; {S := TStringlist.Create; try NewDocNo :='ZZZZZ001'; if FileExists(Path+'CustomDocNo.dat') then begin /// ZZZZZ001_自定文件名稱 001_自定文件名稱 S.LoadFromFile(Path+'CustomDocNo.dat'); for i := 0 to S.Count - 1 do begin v := Pos('_',S.Strings[i]); ln := Length(S.Strings[i]); C_No := Copy(S.Strings[i],1,v-1); C_Name := Copy(S.Strings[i],v+1,ln-v); if DocName = C_Name then begin Showmessage('文件名稱已存在'); Result := ''; Exit; end; end; CNo := strtoint(Copy(C_No,6,3))+1; NewDocNo := 'ZZZZZ'+Add_Zoo(CNo,3); end; S.Add(NewDocNo+'_'+DocName); S.SaveToFile(Path+'CustomDocNo.dat'); Result := NewDocNo; finally S.Free; end; } 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.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; Function TCB_IMGPSScanX.GetCustomDocDir(Path,DocName:String):String; //取出自定文件DocDir var i,ct:integer; ini : Tinifile; begin Result := ''; ini := Tinifile.Create(Path+'CustomDocNo.ini'); try ct := ini.ReadInteger('CustomCount','Count',0); for i := 1 to ct do begin if ini.ReadString('ZZZZZ'+Add_Zoo(i,3),'Name','') = DocName then begin Result := 'ZZZZZ'+Add_Zoo(i,3); Break; end; if ini.ReadString('YYYYY'+Add_Zoo(i,3),'Name','') = DocName then begin Result := 'YYYYY'+Add_Zoo(i,3); Break; end; end; 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.DeleteCustomDocDir(Path,DocNo:String); //刪除自定文件DocNo var ini : Tinifile; begin ini := Tinifile.Create(Path+'CustomDocNo.ini'); try ini.EraseSection(DocNo); finally ini.Free; end; 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.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 := '影像列印'; 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 := '影像列印'; GraphicPrinter.Print(ImageScrollBox1.Graphic); end; begin S := TStringlist.Create; GraphicPrinter := TDibGraphicPrinter.Create; PrtDialog := TPrintDialog.Create(self); 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; Function TCB_IMGPSScanX.FindLastestDocDir(CaseID,DocNo:String):String; //找出最新的DocDir var i : Integer; DocNoList,FileList : TStringlist; begin Result := ''; DocNoList := TStringlist.Create; FileList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then DocNoList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); for i := DocNoList.Count-1 downto 0 do begin if Copy(DocNoList.Strings[i],1,length(DocNo)) = DocNo then begin Result := DocNoList.Strings[i]; Break; end; end; finally DocNoList.Free; FileList.Free; end; end; Procedure TCB_IMGPSScanX.Create_Cust_DocDir(CaseID:String); //產生外面傳入的文件代號及自定文件 var i,n : Integer; C_DocNoList,C_DocNameList : TStringlist; DocNo,DocName,DocDir : String; DocNo_Ct,NowDocNo_Ct :integer; DocName_Ct : Integer; inx : Integer; begin C_DocNoList := TStringlist.Create; C_DocNameList := TStringlist.Create; try if FC_DocNoList <> '' then begin C_DocNoList.StrictDelimiter := True; C_DocNoList.Delimiter := #9; C_DocNoList.DelimitedText := FC_DocNoList; //Showmessage(C_DocNoList.Text); for i := 0 to C_DocNoList.Count - 1 do begin DocNo := C_DocNoList.Strings[i]; //舊件不長出錯誤的文件出來 if (FIs_OldCase = 'Y') and (FWork_no='HLN') and (DocNo = FormCode2DocNo('10000001011112A')) then Continue; NowDocNo_Ct := GetDocNoCount(CaseID,DocNo); if DocNoNeedDiv(DocNo) then begin DocNo_Ct := 0; for n := 0 to i do begin if C_DocNoList.Strings[n] = DocNo then inc(DocNo_Ct); end; if DocNo_CT <= NowDocNo_Ct then Continue; if DirectoryExists(ImageSavePath+CaseID+'\'+DocNo+'('+inttostr(DocNo_Ct)+')') then //存在了 Continue; if (DocNo_Ct = 1) and DirectoryExists(ImageSavePath+CaseID+'\'+DocNo) then //存在了 20140327加 Continue; DocDir := DocNo2DocNoDir(ImageSavePath+CaseID+'\',DocNo) end else begin DocDir := DocNo; end; if not DirectoryExists(ImageSavePath+CaseID+'\'+DocDir) then begin MkDir(ImageSavePath+CaseID+'\'+DocDir); SetDocNoList('A',-1,CaseID,DocDir,'1'); end; if not DocNoNeedDiv(DocNo) then //不分份的秀數 SetDocDirCopies(CaseID,DocNo,GetCustomDocNoCount(DocNo)); end; end; if FC_DocNameList <> '' then begin C_DocNameList.StrictDelimiter := True; C_DocNameList.Delimiter := #9; C_DocNameList.DelimitedText := FC_DocNameList; //Showmessage(C_DocNameList.Text); for i := 0 to C_DocNameList.Count - 1 do begin DocName := C_DocNameList.Strings[i]; DocName_Ct := GetCustomNameCount(DocName); if not FindCustomDocName(ImageSavePath+CaseID+'\',DocName) then begin DocDir := GetNewCustomDocNo(ImageSavePath+CaseID+'\',DocName); if not DirectoryExists(ImageSavePath+CaseID+'\'+DocDir) then begin MkDir(ImageSavePath+CaseID+'\'+DocDir); SetDocNoList('A',-1,CaseID,DocDir,inttostr(DocName_Ct)); end; end Else begin DocDir := GetCustomDocDir(ImageSavePath+CaseID+'\',DocName); //inx := DocNoDir2Index(ImageSavePath+CaseID+'\',DocDir); SetDocDirCopies(CaseID,DocDir,DocName_Ct); end; end; end; finally C_DocNoList.Free; C_DocNameList.Free; end; end; Procedure TCB_IMGPSScanX.OldCasetoNewCase(CaseID:String); //將舊案份數轉成新規則 var i,n : Integer; C_DocNoList,C_DocNameList : TStringlist; DocNoList,DocNo_CopiesList : TStringlist; DocNo,DocName,DocDir : String; DocNo_Ct :integer; begin C_DocNoList := TStringlist.Create; C_DocNameList := TStringlist.Create; DocNoList := TStringlist.Create; DocNo_CopiesList := TStringlist.Create; try DocNoList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); for i := 0 to DocNoList.Count - 1 do begin DocNo_CopiesList.Add('0'); end; //Showmessage(FC_DocNoList); if FC_DocNoList <> '' then begin C_DocNoList.StrictDelimiter := True; C_DocNoList.Delimiter := #9; C_DocNoList.DelimitedText := FC_DocNoList; //showmessage(C_DocNoList.Text+#13+#13+DocNoList.Text); for i := 0 to DocNoList.Count - 1 do begin //DocNo := DocNoList.Strings[i]; DocNo := DocNoDir2DocNo(DocNoList.Strings[i]); //20140812 因轉舊案錯誤件會出現DocnoDir DocNo_Ct := 0; for n := 0 to C_DocNoList.Count - 1 do begin if DocNo = C_DocNoList.Strings[n] then inc(DocNo_Ct); end; if DocNo_CT > 0 Then DocNo_CopiesList.Strings[i] := inttostr(DocNo_CT); end; DocNo_CopiesList.SaveToFile(ImageSavePath+CaseID+'\CaseDocNo_Copies.dat'); end; if FC_DocNameList <> '' then begin C_DocNameList.StrictDelimiter := True; C_DocNameList.Delimiter := #9; C_DocNameList.DelimitedText := FC_DocNameList; for i := 0 to DocNoList.Count - 1 do begin DocNo := DocNoList.Strings[i]; DocNo_Ct := 0; for n := 0 to C_DocNameList.Count - 1 do begin if GetCustomDocName(ImageSavePath+CaseID+'\',DocNo) = C_DocNameList.Strings[n] then inc(DocNo_Ct); end; if DocNo_CT > 0 Then DocNo_CopiesList.Strings[i] :=inttostr(DocNo_CT); end; end; DocNo_CopiesList.SaveToFile(ImageSavePath+CaseID+'\CaseDocNo_Copies.dat'); finally C_DocNoList.Free; C_DocNameList.Free; DocNoList.Free; DocNo_CopiesList.Free; 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.SetRecordEditedDocDir(Mode:Char;CaseID,DocDir:String); //記錄被異動的文件目錄 'A:加入D:刪掉' var i : Integer; Exists : Boolean; EditedDocDirList : TStringlist; begin EditedDocDirList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\EditedDocDir.dat') then EditedDocDirList.LoadFromFile(ImageSavePath+CaseID+'\EditedDocDir.dat'); case Mode of 'A':begin Exists := False; for i := 0 to EditedDocDirList.Count - 1 do begin if EditedDocDirList.Strings[i]=DocDir then begin Exists := True; Break; end; end; if not Exists then begin EditedDocDirList.Add(DocDir); EditedDocDirList.SaveToFile(ImageSavePath+CaseID+'\EditedDocDir.dat'); end; end; 'D':begin for i := 0 to EditedDocDirList.Count - 1 do begin if EditedDocDirList.Strings[i] = DocDir then begin EditedDocDirList.Delete(i); if EditedDocDirList.Count > 0 then EditedDocDirList.SaveToFile(ImageSavePath+CaseID+'\EditedDocDir.dat') else DeleteFile(ImageSavePath+CaseID+'\EditedDocDir.dat'); Break; end; end; end; end; finally EditedDocDirList.Free; end; end; Function TCB_IMGPSScanX.GetDocDir_Page(CaseID,DocDir:String):Integer; var FileList : TStringlist; begin Result := 0; FileList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat') then begin FileList.LoadFromFile(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat'); Result := FileList.Count; end; finally FileList.Free; end; end; Function TCB_IMGPSScanX.Path2DocDir(Path,CaseID:String):String; var i : Integer; DocnoList : TStringlist; begin Result := ''; DocNoList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then DocNoList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); if Path[length(Path)]<>'\' then path := path+'\'; for i := 0 to DocNoList.Count - 1 do begin if (path=ImageSavePath+CaseID+'\'+DocNoList.Strings[i]+'\') then begin Result := DocNoList.Strings[i]; Break; end; end; finally DocNoList.Free; end; end; Function TCB_IMGPSScanX.GetDocNo_IS_WH(DocNo:String):Boolean; //DocNo是否為入庫文件 var i :Integer; begin Result := False; for i := 0 to IN_WH_DocNoList.Count - 1 do begin if DocNo = IN_WH_DocNoList.Strings[i] then begin Result := True; Break; end; 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; 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.DocNoIs_In_WH(DocNo:String):Boolean; //DocNo是否為入庫文件 var i : Integer; begin Result := False; if (Copy(DocNo,1,5)='ZZZZZ') then //20140728 yuu 說自訂文件也是入庫文件 begin Result := True; Exit; end; for i := 0 to IN_WH_DocNoList.Count -1 do begin if DocNo = IN_WH_DocNoList.Strings[i] then begin Result := True; Break; end; end; end; Procedure TCB_IMGPSScanX.CreateCaseNeedData(Path:String); var FileList,DocNoList,CaseDocNoList,CaseDocNo_CopiesList : TStringlist; i,n : Integer; Docno : String; Exists : Boolean; begin FileList := TStringlist.Create; DocNoList := TStringlist.Create; CaseDocNoList := TStringlist.Create; CaseDocNo_CopiesList := TStringlist.Create; try if FileExists(Path+'Context.dat') then begin FileList.LoadFromFile(Path+'Context.dat'); for i := 0 to FileList.Count - 1 do begin Docno := FormCode2DocNo(FileName2FormCode(FileList.Strings[i])); //ShowMessage('Docno='+Docno); DocNoList.Add(DocNo); Exists := False; for n := 0 to CaseDocNoList.Count - 1 do begin if Docno = CaseDocNoList.Strings[n] then Exists := True; end; if not Exists then begin CaseDocNoList.Add(DocNo); CaseDocNo_CopiesList.Add('1'); end; end; //ShowMessage('CreateCaseNeedData DocNoList='+DocNoList.Text); DocNoList.SaveToFile(Path+'DocDir.dat'); CaseDocNoList.SaveToFile(Path+'CaseDocNo.dat'); CaseDocNo_CopiesList.SaveToFile(Path+'CaseDocNo_Copies.dat') end; finally FileList.Free; DocNoList.Free; CaseDocNoList.Free; CaseDocNo_CopiesList.Free; end; end; Procedure TCB_IMGPSScanX.SetDocDirtoSelected(CaseNode:TTreeNode;DocDir:String); var i : Integer; begin for i := 0 to CaseNode.Count - 1 do begin if Pos(DocDir+'{',CaseNode.Item[i].Text) > 0 then begin TreeView1.Selected := CaseNode.Item[i]; end; end; end; Function TCB_IMGPSScanX.CheckSelectImg_UseCase(Path,CaseID:String):Boolean; //檢查選擇的影像是否有包含被引用的影像 var i : Integer; iISBName : String; iISB : TImageScrollBox; ImgPath,DocDir : String; begin Result := False; 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)); ImgPath := ExtractFilePath(iISB.FileName); DocDir := Path2DocDir(ImgPath,CaseID); if GetUseCase('T',Path,DocDir) <> '' then Result := True; end; end; end; Function TCB_IMGPSScanX.TransOldCaseFile(Path:String):Boolean; var i : Integer; OldCaseID,Year,Data,Verify:String; SendData : String; OldCaseInfoList,Caseinfolist : TStringlist; OldCasePath : String; begin Result := True; OldCaseInfoList := TStringlist.Create; Caseinfolist := TStringlist.Create; try OldCaseInfoList.StrictDelimiter := True; OldCaseInfoList.Delimiter := #9; OldCaseInfoList.DelimitedText := FOldCaseInfo; for i := 0 to OldCaseInfoList.Count - 1 do begin Caseinfolist := SplitString('@#,',OldCaseInfoList.Strings[i]); //Caseinfolist.Delimiter := '_'; //Caseinfolist.DelimitedText := OldCaseInfoList.Strings[i]; OldCaseID := Caseinfolist.Strings[0]; Year := Caseinfolist.Strings[1]; Data := Caseinfolist.Strings[4]; Verify := Caseinfolist.Strings[5]; OldCasePath := Path+OldCaseID+'\'; if FileExists(OldCasePath+'UseCase.dat') and FileExists(OldCasePath+'UseCase.ini') then begin //////壓檔///// //ZipMainFile(Path,Path,'Img.zip'); ////上傳///// SendData:='data='+HTTPEncode(UTF8Encode(Data))+'&verify='+Verify+'&other_case_no='+OldCaseID; //Showmessage(FUrl+'service/slic/SLIC02/useOther?'+senddata); if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/useOther',SendData,'file',OldCasePath+'UseCase.ini',FReWrite,Memo1,False) then begin Showmessage(Format(_Msg('傳送舊件編號(%s)檔案時,網路發生錯誤!!'+_Msg('錯誤代碼:')),[OldCaseID])+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason); Result := False; Exit; end; if memo1.Lines.Strings[0] = '1' then begin Showmessage(Format(_Msg('傳送舊件編號(%s)檔案時,網路發生錯誤!!')+_Msg('錯誤原因:'),[OldCaseID])+memo1.Lines.Strings[1]); Result := False; Exit; end Else if Pos('',Memo1.Lines.Text) > 0 then begin Showmessage(Format(_Msg('傳送舊件編號(%s)檔案時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'),[OldCaseID])); Result := False; Exit; end; end; ////上傳//// end; finally OldCaseInfoList.Free; Caseinfolist.Free; end; end; Function TCB_IMGPSScanX.Writelog(CaseID : String):Boolean; var SendData : String; begin Result := True; SendData:='data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&case_no='+CaseID; If not ProcessServlet(HTTPSClient,FURL+'service/imgpsc/IMGPSC06/printlog',SendData,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 Pos('',Memo1.Lines.Text) > 0 then begin HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'); Result := False; Exit; 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; end; Function TCB_IMGPSScanX.DocNoAppear(DocNo:String):Boolean; //DocNo是否可出現 begin Result := True; if (((FIs_In_Wh = 'Y') and (not DocNoIs_In_WH(DocNo)) or (DocNo ='S_Attach')) or //入庫掃描不看非入庫文件 ((FIs_In_Wh = 'N') and (DocNoIs_In_WH(DocNo)) or (DocNo ='Attach') )) {and //非入庫掃描不看入庫文件 (Copy(DocNo,1,5)<>'ZZZZZ')} then Result := False; end; Function TCB_IMGPSScanX.GetDocNoCount(CaseID,DocNo:String):Integer; //取DocNo數量 var i : Integer; Doc_Ct:Integer; iDocNo : String; DocNoList,DocNo_CopiesList : TStringlist; begin DocNoList := TStringlist.Create; DocNo_CopiesList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then begin DocNoList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); DocNo_CopiesList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo_Copies.dat'); end; Doc_Ct := 0; for i := 0 to DocNoList.Count - 1 do begin iDocNo := DocNoDir2DocNo(DocNoList.Strings[i]); if iDocNo = DocNo then Doc_Ct := Doc_Ct + strtoint(DocNo_CopiesList.Strings[i]); end; Result := Doc_Ct; // Showmessage(DocNo+#13+inttostr(Doc_Ct)); finally DocNoList.Free; DocNo_CopiesList.Free; end; end; Function TCB_IMGPSScanX.GetDocDirCopies(CaseID,DocDir:String):Integer; //取DocDir數量 var i : Integer; DocNoList,DocNo_CopiesList : TStringlist; begin Result := 1; //預設回傳1 //20140521 由0改成1 DocNoList := TStringlist.Create; DocNo_CopiesList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then DocNoList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); if FileExists(ImageSavePath+CaseID+'\CaseDocNo_Copies.dat') then begin DocNo_CopiesList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo_Copies.dat'); for i := 0 to DocNoList.Count - 1 do begin if (DocDir = DocNoList.Strings[i]) and (i <= DocNo_CopiesList.Count-1) then begin Result := strtoint(DocNo_CopiesList.Strings[i]); Break; end; end; end; finally DocNoList.Free; DocNo_CopiesList.Free; end; end; Procedure TCB_IMGPSScanX.SetDocDirCopies(CaseID,DocDir:String;NewCopies:Integer); //修改DocDir份數 var i : Integer; DocNoList,DocNo_CopiesList : TStringlist; begin DocNoList := TStringlist.Create; DocNo_CopiesList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then begin DocNoList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); DocNo_CopiesList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo_Copies.dat'); end; for i := 0 to DocNoList.Count - 1 do begin if DocDir = DocNoList.Strings[i] then begin DocNo_CopiesList.Strings[i] := inttostr(NewCopies); DocNo_CopiesList.SaveToFile(ImageSavePath+CaseID+'\CaseDocNo_Copies.dat'); Break; end; end; finally DocNoList.Free; DocNo_CopiesList.Free; end; end; Function TCB_IMGPSScanX.GetDocDirCopies_Rec(Path,CaseID,DocDir:String):Integer; //取記錄裡的DocDir份數 var i,n,v,v1 : Integer; OldCaseInfoList,Caseinfolist : TStringlist; iCaseID,Year,iBS_No,iIS_Old,iDocNo,iCopies:String; begin Result := 1; OldCaseInfoList := TStringlist.Create; Caseinfolist := TStringlist.Create; try //OldCaseInfoList 案件編號@#,年度@#,業務別@#,是否舊件@#,Data@#,Verify@#,文件編號[份數]@#,文件編號[份數] tab 案件編號@#,年度@#,業務別@#,是否舊件@#,Data@#,Verify@#,文件編號[份數]@#,文件編號[份數] OldCaseInfoList.StrictDelimiter := true; OldCaseInfoList.Delimiter := #9; OldCaseInfoList.DelimitedText := FOldCaseInfo; for i := 0 to OldCaseInfoList.Count - 1 do begin Caseinfolist:=SplitString('@#,',OldCaseInfoList.Strings[i]); //Caseinfolist.Delimiter := '_'; //Caseinfolist.DelimitedText := OldCaseInfoList.Strings[i]; iCaseID := Caseinfolist.Strings[0]; Year := Caseinfolist.Strings[1]; iBS_No := Caseinfolist.Strings[2]; iIS_Old := Caseinfolist.Strings[3]; if CaseID = iCaseID then begin for n := 6 to Caseinfolist.Count - 1 do begin v := Pos('[',Caseinfolist.Strings[n]); v1 := Pos(']',Caseinfolist.Strings[n]); iDocNo := Copy(Caseinfolist.Strings[n],1,v-1); iCopies := Copy(Caseinfolist.Strings[n],v+1,v1-v-1); if Copy(DocDir,1,5) = 'ZZZZZ' then begin if iDocNo = GetCustomDocName(Path,DocDir) then Result := strtoint(iCopies); end else begin if iDocNo = DocNoDir2DocNo(DocDir) then Result := strtoint(iCopies); end; end; end; end; finally OldCaseInfoList.Free; Caseinfolist.Free; end; 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.GetCustomDocNoCount(Docno:String):Integer; //取外傳的DocNo數量 var i,ct : Integer; C_DocNoList : TStringlist; begin C_DocNoList := TStringlist.Create; try C_DocNoList.StrictDelimiter := True; C_DocNoList.Delimiter := #9; C_DocNoList.DelimitedText := FC_DocNoList; ct := 0; for i := 0 to C_DocNoList.Count - 1 do begin if C_DocNoList.Strings[i] = Docno then begin inc(ct); end; end; Result := ct; finally C_DocNoList.Free; 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; Function TCB_IMGPSScanX.CaseDelete_Enable(CaseID:String):Boolean; //案件可否被刪除 var i : Integer; CaseDocNoList : TStringlist; begin Result := True; CaseDocNoList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then CaseDocNoList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); for i := 0 to CaseDocNoList.Count - 1 do begin if GetUseCase('T',DisplayPath,CaseDocNoList.Strings[i]) <> '' then //有被引用走的 Result := False; end; finally CaseDocNoList.Free; end; end; Procedure TCB_IMGPSScanX.MoveImage(Path:String;mp:Integer); //移動頁數 var i,n,inx:Integer; FList,D_Flist:TStringlist; begin FList := TStringlist.Create; D_Flist := TStringlist.Create; try FList.LoadFromFile(Path+'Context.dat'); //Showmessage(Path); //Showmessage(Flist.Text); 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; 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(mp-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; 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; Procedure TCB_IMGPSScanX.SetUseCase(Mode:Char;Path,DocDir,FormCaseID,ToCaseID:String); //記錄引用其他案件 A:加入 D:刪掉 var ini : Tinifile; begin ini := Tinifile.Create(Path+'UseCase.ini'); try case Mode of 'A':begin ini.WriteString(DocDir,'FROM_CASEID',FormCaseID); ini.WriteString(DocDir,'TO_CASEID',ToCaseID); end; 'D':begin ini.EraseSection(DocDir); end; end; finally ini.Free; end; end; Function TCB_IMGPSScanX.GetUseCase(Mode:Char;Path,DocDir:String):String; //F:取被引用 To:引用 var ini : Tinifile; begin ini := Tinifile.Create(Path+'UseCase.ini'); try case Mode of 'F':begin Result := ini.ReadString(DocDir,'FROM_CASEID',''); end; 'T':begin Result := ini.ReadString(DocDir,'TO_CASEID',''); end; end; finally ini.Free; end; end; Procedure TCB_IMGPSScanX.Case2upload(CaseID:String); var i,n:Integer; OldPath,NewPath,DocDir : String; OldFile,NewFile : String; DocNoList,FileList:TStringlist; iFileList,iFile_DocNoList :TStringlist; iDocDirList : TStringlist; begin DocNoList := TStringlist.Create; FileList := TStringlist.Create; iFileList := TStringlist.Create; iFile_DocNoList := TStringlist.Create; iDocDirList := TStringlist.Create; try OldPath := ImageSavePath+CaseID+'\'; NewPath := ImageSavePath+CaseID+'\Upload\'; if DirectoryExists(NewPath) then _DelTree(NewPath); str2dir(NewPath); CopyFile(PWideChar(OldPath+'CaseDocNo.dat'),PWideChar(NewPath+'CaseDocNo.dat'),False); CopyFile(PWideChar(OldPath+'CaseDocNo_Copies.dat'),PWideChar(NewPath+'CaseDocNo_Copies.dat'),False); CopyFile(PWideChar(OldPath+'CustomDocNo.ini'),PWideChar(NewPath+'CustomDocNo.ini'),False); CopyFile(PWideChar(OldPath+'CaseIndex.dat'),PWideChar(NewPath+'CaseIndex.dat'),False); CopyFile(PWideChar(OldPath+'In_Wh.dat'),PWideChar(NewPath+'In_Wh.dat'),False); CopyFile(PWideChar(OldPath+'UseCase.ini'),PWideChar(NewPath+'UseCase.ini'),False); if FileExists(OldPath+'CaseDocNo.dat') then begin DocNoList.LoadFromFile(OldPath+'CaseDocNo.dat'); end else begin DocNoList.SaveToFile(OldPath+'CaseDocNo.dat'); CopyFile(PWideChar(OldPath+'CaseDocNo.dat'),PWideChar(NewPath+'CaseDocNo.dat'),False); end; for i := 0 to DocNoList.Count-1 do begin DocDir := DocNoList.Strings[i]; OldPath := ImageSavePath+CaseID+'\'+ DocDir+'\'; FileList.Clear; if FileExists(OldPath+'Context.dat') then begin FileList.LoadFromFile(OldPath+'Context.dat'); for n := 0 to FileList.Count - 1 do begin OldFile := FileList.Strings[n]; NewFile := Add_Zoo(iFileList.Count+1,3)+FileName2NoQuene_Filename(OldFile); CopyFile(PWideChar(OldPath+OldFile),PWideChar(NewPath+NewFile),False); iFileList.Add(NewFile); iFile_DocNoList.Add(DocNoDir2DocNo(DocDir)); iDocDirList.Add(DocDir); end; end; end; if DirectoryExists(ImageSavePath+CaseID+'\Attach') then begin DocDir := 'Attach'; OldPath := ImageSavePath+CaseID+'\'+ DocDir+'\'; FileList.Clear; if FileExists(OldPath+'Context.dat') then begin FileList.LoadFromFile(OldPath+'Context.dat'); for n := 0 to FileList.Count - 1 do begin OldFile := FileList.Strings[n]; NewFile := Add_Zoo(iFileList.Count+1,3)+FileName2NoQuene_Filename(OldFile); CopyFile(PWideChar(OldPath+OldFile),PWideChar(NewPath+NewFile),False); iFileList.Add(NewFile); iFile_DocNoList.Add(DocNoDir2DocNo(DocDir)); iDocDirList.Add(DocDir); end; end; end; if DirectoryExists(ImageSavePath+CaseID+'\S_Attach') then begin DocDir := 'S_Attach'; OldPath := ImageSavePath+CaseID+'\'+ DocDir+'\'; FileList.Clear; if FileExists(OldPath+'Context.dat') then begin FileList.LoadFromFile(OldPath+'Context.dat'); for n := 0 to FileList.Count - 1 do begin OldFile := FileList.Strings[n]; NewFile := Add_Zoo(iFileList.Count+1,3)+FileName2NoQuene_Filename(OldFile); CopyFile(PWideChar(OldPath+OldFile),PWideChar(NewPath+NewFile),False); iFileList.Add(NewFile); iFile_DocNoList.Add(DocNoDir2DocNo(DocDir)); iDocDirList.Add(DocDir); end; end; end; iFileList.SaveToFile(NewPath+'Context.dat'); iFile_DocNoList.SaveToFile(NewPath+'Context_DocNo.dat'); iDocDirList.SaveToFile(NewPath+'DocDir.dat'); finally iFileList.Free; iFile_DocNoList.Free; DocNoList.Free; FileList.Free; end; end; Procedure TCB_IMGPSScanX.Download2Case(SoDir,DeDir:String); var i,n : Integer; DocDir:String; OldFile,NewFile:String; DocNoList,FileList : TStringlist; iFileList,iFile_DocDirList :TStringlist; AA,AA2,AA3,AA4:Boolean; begin if (not FileExists(SoDir+'CaseDocNo.dat')) or (not FileExists(SoDir+'DocDir.dat')) then //截畫面會沒這些檔 begin //ShowMessage('產生必要的文字檔'); CreateCaseNeedData(SoDir); //產生必要的文字檔 end; AA:=CopyFile(PWideChar(SoDir+'CaseDocNo.dat'),PWideChar(DeDir+'CaseDocNo.dat'),False); AA2:=CopyFile(PWideChar(SoDir+'CaseDocNo_Copies.dat'),PWideChar(DeDir+'CaseDocNo_Copies.dat'),False); AA3:=CopyFile(PWideChar(SoDir+'CustomDocNo.ini'),PWideChar(DeDir+'CustomDocNo.ini'),False); AA4:=CopyFile(PWideChar(SoDir+'UseCase.ini'),PWideChar(DeDir+'UseCase.ini'),False); //ShowMessage(BoolToStr(AA)+#10#13+BoolToStr(AA2)+#10#13+BoolToStr(AA3)+#10#13+BoolToStr(AA4)); if FileExists(SoDir+'DocDir.dat') then //20170222 新加 begin CopyFile(PWideChar(SoDir+'DocDir.dat'),PWideChar(DeDir+'DocDir.dat'),False); end; DocNoList := TStringlist.Create; FileList := TStringlist.Create; iFileList := TStringlist.Create; iFile_DocDirList := TStringlist.Create; try //if Not FileExists(SoDir+'Context.dat') then Exit; //iFileList.LoadFromFile(SoDir+'Context.dat'); //if iFileList.Count = 0 then Exit; if FileExists(SoDir+'Context.dat') then iFileList.LoadFromFile(SoDir+'Context.dat'); if FileExists(SoDir+'DocDir.dat') then iFile_DocDirList.LoadFromFile(SoDir+'DocDir.dat'); if iFileList.Count <> iFile_DocDirList.Count then begin for i := 0 to iFileList.Count - 1 do begin if i > iFile_DocDirList.Count -1 then begin iFile_DocDirList.Add(FormCode2DocNo(FileName2FormCode(iFileList.Strings[i]))); end; end; end; if FileExists(SoDir+'CaseDocNo.dat') then DocNoList.LoadFromFile(SoDir+'CaseDocNo.dat'); if FileExists(DeDir+'CaseDocNo_Copies.dat') then CaseDocNo_CopiesList.LoadFromFile(DeDir+'CaseDocNo_Copies.dat'); {for i := 0 to DocNoList.Count - 1 do begin DocDir := DocNoList.Strings[i]; MkDir(DeDir+DocDir); end;} //ShowMessage('DocNoList='+DocNoList.Text); for i := DocNoList.Count - 1 downto 0 do begin DocDir := DocNoList.Strings[i]; if not DirectoryExists(DeDir+DocDir) then begin MkDir(DeDir+DocDir); if not FileExists(DeDir+DocDir+'\Context.dat') then StringtoFile('',DeDir+DocDir+'\Context.dat'); end else begin //ShowMessage('GGG'); DocNoList.Delete(i); DocNoList.SaveToFile(DeDir+'CaseDocNo.dat'); if i <= CaseDocNo_CopiesList.Count-1 then begin //ShowMessage('KKKK'); CaseDocNo_CopiesList.Delete(i); CaseDocNo_CopiesList.SaveToFile(DeDir+'CaseDocNo_Copies.dat'); end; end; end; //20170221 先註解起來 因為他在補充掃瞄時好像會有顯示的問題 for i := 0 to iFileList.Count - 1 do begin OldFile := iFileList.Strings[i]; DocDir := iFile_DocDirList.Strings[i]; if (DocDir = 'Attach') or (DocDir = 'S_Attach') then begin if not DirectoryExists(DeDir+DocDir) then MkDir(DeDir+DocDir); end; FileList.Clear; if FileExists(DeDir+DocDir+'\Context.dat') then begin FileList.LoadFromFile(DeDir+DocDir+'\Context.dat'); end; NewFile := Add_Zoo(FileList.Count+1,3)+FileName2NoQuene_Filename(OldFile); CopyFile(PWideChar(SoDir+OldFile),PWideChar(DeDir+DocDir+'\'+NewFile),False); FileList.Add(NewFile); FileList.SaveToFile(DeDir+DocDir+'\Context.dat'); end; for i := DocNoList.Count -1 downto 0 do begin if (DocNoList.Strings[i] = 'Attach') or (DocNoList.Strings[i] = 'S_Attach') then begin DocNoList.Delete(i); DocNoList.SaveToFile(DeDir+'CaseDocNo.dat'); end; end; {if (DocNoList.Count > 0) and ((DocNoList.Strings[DocNoList.Count-1] = 'Attach') or (DocNoList.Strings[DocNoList.Count-1] = 'S_Attach')) then begin DocNoList.Delete(DocNoList.Count-1); DocNoList.SaveToFile(DeDir+'CaseDocNo.dat'); end; } CaseDocNo_CopiesList.Clear; if FileExists(DeDir+'CaseDocNo_Copies.dat') then CaseDocNo_CopiesList.LoadFromFile(DeDir+'CaseDocNo_Copies.dat'); if DocNoList.Count > CaseDocNo_CopiesList.Count then begin for i := 0 to DocNoList.Count - 1 do begin if i > CaseDocNo_CopiesList.Count-1 then begin CaseDocNo_CopiesList.Add('1'); //CaseDocNo_CopiesList.SaveToFile(DeDir+'CaseDocNo_Copies.dat'); end; end; end; CaseDocNo_CopiesList.SaveToFile(DeDir+'CaseDocNo_Copies.dat'); {if (not FileExists(DeDir+'CaseDocNo_Copies.dat') then begin CaseDocNo_CopiesList.Free; for i := 0 to DocNoList.Count - 1 do begin CaseDocNo_CopiesList.Add('1'); CaseDocNo_CopiesList.SaveToFile(DeDir+'CaseDocNo_Copies.dat'); end; end;} finally iFileList.Free; FileList.Free; DocNoList.Free; iFile_DocDirList.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.FileName2ScanPage(FileName:String):Integer; //從檔名轉出掃瞄頁數 Var v : Integer; FName : String; begin FName := ExtractFileName(FileName); v := Pos('_',FName); if v = 0 then //附件 v := pos('.',FName); Result := Strtoint(Copy(FName,1,v-1)); end; Function TCB_IMGPSScanX.FileName2NoQuene_Filename(FileName:String):String; //取出沒有序號的檔名 var v,v1 : Integer; FName : String; begin FName := ExtractFileName(FileName); v := Pos('_',FName); if v = 0 then //附件 v := pos('.',FName); v1 := length(FName); Result := Copy(FName,v,v1-v+1); end; Function TCB_IMGPSScanX.FileName2Index(FileName:String):Integer; //從檔名取出在ContextList的序號 var i : Integer; begin for i := 0 to ContextList.Count - 1 do begin if FileName = ContextList.Strings[i] then begin Result := i; Break; end; end; end; Function TCB_IMGPSScanX.FileName2NowDcoNo(FileName:String;CtList,DNList:TStrings):String; //從檔名取出歸屬的文件代號 var i : Integer; begin for I := 0 to CTList.Count -1 do begin if FileName = CTList.Strings[i] then begin Result := DNList.Strings[i]; break; end; end; 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.DocNo2DocName(CaseID,DocNo:String):String; //Docno轉Doc名稱 var i,v,ln : Integer; CusDocNo,CusDocName : String; begin Result := ''; if DocNo = AttName then begin Result := _Msg('未歸類'); end Else begin If FindSQLData(Doc_Inf_List,'DOC_U_DESC','DOC_NO',DocNo,0,FindResult) Then begin Result := GetFindResult('DOC_U_DESC'); end; end; if Result = '' then //去自訂文件裡找 begin Result := GetCustomDocName(ImageSavePath+CaseID+'\',DocNo); {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 DocNo = CusDocNo then begin Result := CusDocName; Break; end; end;} end; end; Function TCB_IMGPSScanX.DocNo2FileName(DocNo:String;List:TStrings):String; //用DocNo找出檔名(第一頁) var i : Integer; begin Result := ''; for i := 0 to List.Count - 1 do begin IF DocNo = FormCode2DocNo(FileName2FormCode(List.Strings[i])) then begin Result := List.Strings[i]; Break; end; end; 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.DocNo2WorkNo(DocNo:String):String; //用DocNo取出作業別 begin Result := ''; If FindSQLData(Doc_Inf_List,'WORK_NO','DOC_NO',DocNo,0,FindResult) Then begin Result := GetFindResult('WORK_NO'); end; end; Function TCB_IMGPSScanX.DocNoNeedDiv(DocNo:String):Boolean; //是否是需分份數的文件代號 var NeedDiv : String; begin Result := False; If FindSQLData(Doc_Inf_List,'IS_DOC_DIV','DOC_NO',DocNo,0,FindResult) Then begin NeedDiv := GetFindResult('IS_DOC_DIV'); if NeedDiv = 'Y' then Result := True; 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; 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; 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; Function TCB_IMGPSScanX.DocnoNeedGroup(DocNo:String):Boolean; //傳入的DocNo是否需分組 begin Result := False; If FindSQLData(Doc_Inf_List,'IS_DOC_DIV','DOC_NO',DocNo,0,FindResult) Then begin if GetFindResult('IS_DOC_DIV') = 'Y' Then Result := True; 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 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; Function TCB_IMGPSScanX.OMRCheckCase(CaseID:String):Boolean; //OMR檢核 var i,n,m,v,v1 : Integer; XT,RelaXT,ValueXT : TXmltool; OMRFormCode,OMRFile,OMRFormName,ColEName,ColCName,Site : String; Pixel : Integer; RelaFormCode,RelaFile,RelaFormName,RelaColEName,RelaColCName,RelaSite : String; RelaDocNo,RelaDocName : string; RelaPixel : Integer; s : String; nodename : String; OMROK : Boolean; CaseOk : Boolean; ErrStr : String; SiteRec,RelaSiteRec : String; //多組位置記錄 OMRValue : String; MainFormID,MainDocNo,MainVersion : String; //主FormID MainFormPage,CaseFormPage : Integer; //主要文件需要的頁數 NeedDocNoStr,NoDocNoStr : String; //相依 互斥文件字串 List : TStringlist; FormCode : String; FormDataPages : Integer; NoSite : Boolean; //未定位 Anchor,Anchor1 : String; OMROkCount : Integer; //Casecheck : Boolean; //是否要做檢核 //AllCheck : Boolean; //是否要做完整檢核 begin ///OMRErrInfo 1: 必要文件 2:相依文件 3:互斥文件 4:必填 5:欄位有值附文件 6:欄位有值不附文件 /// 7: 欄位有值相關欄位也要有值 8:欄位有值要寫備註 9:停用日期 10:最大頁數 //Casecheck := True; //Allcheck := True; //if (FMode = 'ISCAN') then //Allcheck := False; CaseOk := True; //if Casecheck then //begin DeleteFile(ImageSavePath+CaseID+'\upload\Checkerr.ini'); DeleteFile(ImageSavePath+CaseID+'\upload\CheckMemo.dat'); //DeleteFile(ImageSavePath+CaseID+'\upload\ReSize.dat'); DeleteFile(ImageSavePath+CaseID+'\upload\RemoveMemo.dat'); DeleteFile(ImageSavePath+CaseID+'\upload\OMRCheckOk.dat'); Memo1.Lines.Clear; OMRFileList.Clear; MainFormID := GetCaseFormID(ImageSavePath+CaseID+'\upload\'); List := TStringlist.Create; try //if AllCheck then //begin if GetCasePage(ImageSavePath,CaseID) =0 then begin end; //ShowMessage('MainFormID='+MainFormID); if MainFormID = ''then begin //20131203 yuu說不檢查這個,先拿掉 20170315 楷琳說未歸類要擋 if FCheck_main_form='Y' then begin if (FMode <> 'SSCAN') then //簽署章件會換主FormID,先跳過 begin ErrStr:=_Msg('找不到分案文件'); //找不到主文件 OMRErr2ini(CaseID,ErrStr,'','','','','','',False,False,True); CaseOk := false; end; end; end Else begin //////主要非主要文件////// DistinctDocinCase(ImageSavePath+CaseID+'\upload\'); if ModeNeedCheck(OMRErrInfo[1].Mode,FMode) then //是否要檢核 begin for i := 0 to DocNo_VerinCase.Count - 1 do begin v := Pos('_', DocNo_VerinCase.Strings[i]); v1 := length(DocNo_VerinCase.Strings[i]); MainDocNo := Copy(DocNo_VerinCase.Strings[i],1,v-1); //FormCode2DocNo(MainFormID); MainVersion :=Copy(DocNo_VerinCase.Strings[i],v+1,v1-v); //FormCode2Version(MainFormID); MainFormPage := GetDataDocNoPage(MainDocNo,MainVersion); //資料庫記錄主文件頁數 CaseFormPage := CheckCaseDocNoPage(CaseID,MainDocNo,MainVersion,MainFormPage); //案件主文件的頁數 IF (MainFormPage > 0) and (MainFormPage <> CaseFormPage) then begin ErrStr:=MainDocNo+Format(OMRErrInfo[1].Info,[Inttostr(MainFormPage),Inttostr(CaseFormPage)]); //主要文件需有XX頁僅附XX頁 OMRErr2ini(CaseID,ErrStr,'','','','','','',False,OMRErrInfo[1].Ignore,OMRErrInfo[1].Display); if OMRErrInfo[1].Display then CaseOk := false; end; end; end; //////主要非主要文件///// //showmessage(MainFormID); MainDocNo := FormCode2DocNo(MainFormID); MainVersion := FormCode2Version(MainFormID); if FindSQLData(DM_FORM_INF_List,'DEPE_FORM_ID,MUTEX_FORM_ID','MAIN_FORM_ID,DOC_VERSION',MainDocNo+','+MainVersion,0,FindResult) then begin NeedDocNoStr := GetFindResult('DEPE_FORM_ID'); NoDocNoStr := GetFindResult('MUTEX_FORM_ID'); end Else if FindSQLData(DM_FORM_INF_List,'DEPE_FORM_ID,MUTEX_FORM_ID','MAIN_FORM_ID,DOC_VERSION',MainDocNo+','+MainVersion,0,FindResult) then begin NeedDocNoStr := GetFindResult('DEPE_FORM_ID'); NoDocNoStr := GetFindResult('MUTEX_FORM_ID'); end; //////相依文件///// if ModeNeedCheck(OMRErrInfo[2].Mode,FMode) then //是否要檢核 begin List.CommaText := NeedDocNoStr; for I := 0 to List.Count - 1 do begin if not Case_DocNoExists(CaseID,List.Strings[i]) then //沒附相依文件 begin ErrStr:=Format(OMRErrInfo[2].Info,[DocNo2DocName(CaseID,List.Strings[i])]); //沒附相依文件 OMRErr2ini(CaseID,ErrStr,'','','','','','',False,OMRErrInfo[2].Ignore,OMRErrInfo[2].Display); if OMRErrInfo[2].Display then CaseOk := false; end; end; end; //////相依文件///// //////互斥文件///// if ModeNeedCheck(OMRErrInfo[3].Mode,FMode) then //是否要檢核 begin List.CommaText := NoDocNoStr; for I := 0 to List.Count - 1 do begin if Case_DocNoExists(CaseID,List.Strings[i]) then //附了互斥文件 begin ErrStr:=Format(OMRErrInfo[3].Info,[DocNo2DocName(CaseID,List.Strings[i])]); //有附互斥文件 OMRErr2ini(CaseID,ErrStr,'','','','','','',False,OMRErrInfo[3].Ignore,OMRErrInfo[3].Display); if OMRErrInfo[3].Display then CaseOk := false; end; end; end; //////互斥文件///// end; //end; List.LoadFromFile(ImageSavePath + CaseID+'\upload\Context.dat'); for i := 0 to List.Count - 1 do begin FormCode := FileName2FormCode(List.Strings[i]); /////未歸類/// {IF FormCode = 'Attach' Then //20140211 yuu說不檢查了 begin ErrStr:=_Msg('尚有文件未歸類'); OMRErr2ini(CaseID,ErrStr,'','','','','','',False,False,True); CaseOk := false; end; } /////未歸類////// /////未註冊文件///// {IF not FormIDExists(FormCode,False) then //未註冊文件 begin ErrStr:=FormCode+_Msg('不為此業務的表單代碼'); OMRErr2ini(CaseID,ErrStr,'','','','',False,False,True); CaseOk := false; end } /////未註冊文件///// //////停用文件// {Else} IF ModeNeedCheck(OMRErrInfo[9].Mode,FMode) and (not FormIDExists(FormCode,True,0)) and (not checkFormCodeIsCustom(ImageSavePath + CaseID+'\upload\',FormCode)) then //有停用的文件 begin //ShowMessage('AAAA'); ErrStr:=Format(OMRErrInfo[9].Info,[FormCode2FormName(CaseID,FormCode)]); //有停用文件 OMRErr2ini(CaseID,ErrStr,'','','','','','',False,OMRErrInfo[9].Ignore,OMRErrInfo[9].Display); //ShowMessage('ErrStr='+ErrStr); if OMRErrInfo[9].Display then CaseOk := false; end; //////停用文件//// end; finally List.Free; end; //if AllCheck then //begin //////最大頁數///// DistinctFormCode(CaseID); if ModeNeedCheck(OMRErrInfo[10].Mode,FMode) then //是否要檢核 begin For i := 0 to OMRFileList.Count - 1 do begin FormCode := FileName2FormCode(OMRFileList.Strings[i]); FormDataPages := GetDataFormCodePages(FormCode); IF (FormCode <> '') and (FormDataPages > 0) and (FindFormCodePages(CaseID,FormCode) > FormDataPages) then //有超過最大頁數的文件 begin ErrStr:=Format(OMRErrInfo[10].Info,[FormCode2FormName(CaseID,FormCode),inttostr(FormDataPages)]); //有超過最大頁數文件 OMRErr2ini(CaseID,ErrStr,'','','','','','',False,OMRErrInfo[10].Ignore,OMRErrInfo[10].Display); if OMRErrInfo[10].Display then CaseOk := false; end; end; end; /////最大頁數///// //end; ImageScrollBox1.FileName := ''; //if FWork_No = 'CW' then //理賠就不做下面的檢核了 //begin //////OMR檢核/////// ContextList.LoadFromFile(ImageSavePath+CaseID+'\upload\Context.dat'); DistinctFormCode(CaseID); ValueXT := TXmltool.Create; Try For i := 0 to OMRFileList.Count - 1 do begin OMRFile := OMRFileList.Strings[i]; OMRFormCode := FileName2FormCode(OMRFileList.Strings[i]); OMRFormName := FormCode2FormName(CaseID,OMRFormCode); Anchor := FormID2Anchor(OMRFormCode); ///依十字定位點縮放//// ImageReSize(CaseID,OMRFile); ////依十字定位點縮放//// if not FileExists(CheckXmlPath+OMRFormCode+'.xml') then //沒有Xml就不用檢核 Continue; XT := TXmltool.Create(CheckXmlPath+OMRFormCode+'.xml'); RelaXT := TXmltool.Create; try //*******必填******** if ModeNeedCheck(OMRErrInfo[4].Mode,FMode) then //是否要檢核 begin if XT.SubNodes['/form/settype1/'].First then Repeat OMROK := False; SiteRec := ''; //清掉 ColEName := XT.SubNodes['/form/settype1/'].NodeName; ColCName := XT.Node['/form/settype1/'+ColEName+'/'].Attributes['coldesc']; ColCName := Copy(ColCName,1,length(ColCName)-6); if XT.SubNodes['/form/settype1/'+ColEName+'/'].First then Repeat nodename := XT.SubNodes['/form/settype1/'+ColEName+'/'].NodeName; If nodename <> '@coldesc' then begin Pixel := Strtoint(XT.Node['/form/settype1/'+ColEName+'/'+nodename+'/'].Attributes['pixel']); Site := XT.Node['/form/settype1/'+ColEName+'/'+nodename+'/'].Attributes['colxy']; if SiteRec= '' then //記錄位置 SiteRec := Site else SiteRec := SiteRec+'@'+Site; //有填就ok //Showmessage(ColCName +','+ inttostr(OMRMpsV1.GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site))+','+inttostr(Pixel + SafePixel)); if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt) > (Pixel + SafePixel) then begin //Showmessage('oh'); OMROK := True; Break; end; end Else begin //ColCName := XT['/form/settype1/'+ColEName+'/'+nodename+'/']; end; Until not XT.SubNodes['/form/settype1/'+ColEName+'/'].Next; if not OMROk then begin ErrStr:=Format(OMRErrInfo[4].Info,[ColCName]); //XX欄位未填寫 OMRErr2ini(CaseID,ErrStr,ImageSavePath+CaseID+'\upload\'+OMRFile,SiteRec,'','',Anchor,Anchor1,False,OMRErrInfo[4].Ignore,OMRErrInfo[4].Display); if OMRErrInfo[4].Display then CaseOk := false; end; Until not XT.SubNodes['/form/settype1/'].Next ; end; //*******必填******** //if AllCheck then //begin //*******有值相關文件的欄位也要有值******* if ModeNeedCheck(OMRErrInfo[7].Mode,FMode) then //是否要檢核 begin if XT.SubNodes['/form/settype3/'].First then Repeat SiteRec := ''; RelaSiteRec := ''; ColEName := XT.SubNodes['/form/settype3/'].NodeName; ColCName := XT.Node['/form/settype3/'+ColEName+'/'].Attributes['coldesc']; ColCName := Copy(ColCName,1,length(ColCName)-6); Site := XT.Node['/form/settype3/'+ColEName+'/'].Attributes['colxy']; if SiteRec= '' then //記錄位置 SiteRec := Site else SiteRec := SiteRec+'@'+Site; Pixel := XT.Node['/form/settype3/'+ColEName+'/'].Attributes['pixel']; if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt) > (Pixel + SafePixel) then begin ////有填寫//// if XT.SubNodes['/form/settype3/'+ColEName+'/'].First then Repeat RelaSiteRec := ''; nodename := XT.SubNodes['/form/settype3/'+ColEName+'/'].NodeName; If (nodename <> '@coldesc') and (not XT.SubNodes['/form/settype3/'+ColEName+'/'].NodeIsAttr) then begin RelaFormCode := XT.node['/form/settype3/'+ColEName+'/'+nodename+'/'].Attributes['relaformid']; RelaColEName := XT.node['/form/settype3/'+ColEName+'/'+nodename+'/'].Attributes['rela_col_name']; RelaColCName := XT.node['/form/settype3/'+ColEName+'/'+nodename+'/'].Attributes['relacoldesc']; RelaColCName := Copy(RelaColCName,1,length(RelaColCName)-6); RelaFile := FormCode2FileName(RelaFormCode,ContextList); RelaFormName := FormCode2FormName(CaseID,RelaFormCode); Anchor1 := FormID2Anchor(RelaFormCode); RelaXT.LoadFromFile(CheckXmlPath+RelaFormCode+'.xml'); OMROK := False; //OMROK := False; //if RelaXT.SubNodes['/form/settype2/'].First then //Repeat NoSite := True; if RelaXT.SubNodes['/form/settype2/'+RelaColEName+'/'].Count >0 then NoSite := False; if RelaXT.SubNodes['/form/settype2/'+RelaColEName+'/'].First then Repeat nodename := RelaXT.SubNodes['/form/settype2/'+RelaColEName+'/'].NodeName; If nodename <> '@coldesc' then begin RelaPixel := Strtoint(RelaXT.Node['/form/settype2/'+RelaColEName+'/'+nodename+'/'].Attributes['pixel']); RelaSite := RelaXT.Node['/form/settype2/'+RelaColEName+'/'+nodename+'/'].Attributes['colxy']; if RelaSiteRec= '' then //記錄位置 RelaSiteRec := RelaSite else RelaSiteRec := RelaSiteRec+'@'+RelaSite; if FileExists(ImageSavePath+CaseID+'\upload\'+RelaFile) then begin if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+RelaFile,RelaSite,Bt) > (RelaPixel + SafePixel) then begin OMROK := True; Break; end; end; end; //Else //begin //ColCName := XT['/form/settype1/'+ColEName+'/'+nodename+'/']; //end; Until not RelaXT.SubNodes['/form/settype2/'+RelaColEName+'/'].Next; if not OMROk then begin if not FileExists(ImageSavePath+CaseID+'\upload\'+RelaFile) then ErrStr:=Format(OMRErrInfo[7].Info,[ColCName,RelaColCName])+'('+_msg('未附')+RelaFormName+')' //XX欄位填寫時,XX欄位未填寫 Else if NoSite then ErrStr:=Format(OMRErrInfo[7].Info,[ColCName,RelaColCName])+'('+_msg('未定位')+')' Else ErrStr:=Format(OMRErrInfo[7].Info,[ColCName,RelaColCName]); //XX欄位填寫時,XX欄位未填寫 OMRErr2ini(CaseID,ErrStr,ImageSavePath+CaseID+'\upload\'+OMRFile,SiteRec,ImageSavePath+CaseID+'\upload\'+RelaFile,RelaSiteRec,Anchor,Anchor1,False,OMRErrInfo[7].Ignore,OMRErrInfo[7].Display); if OMRErrInfo[7].Display then CaseOk := false; end; //Until not RelaXT.SubNodes['/form/settype2/'].Next ; end; Until not XT.SubNodes['/form/settype3/'+ColEName+'/'].Next; end; Until not XT.SubNodes['/form/settype3/'].Next ; end; //*******有值相關文件的欄位也要有值******* //*******有值相關文件的欄位不能有值******* if ModeNeedCheck(OMRErrInfo[11].Mode,FMode) then //是否要檢核 begin if XT.SubNodes['/form/settype8/'].First then Repeat SiteRec := ''; RelaSiteRec := ''; OMROkCount := 0; ColEName := XT.SubNodes['/form/settype8/'].NodeName; ColCName := XT.Node['/form/settype8/'+ColEName+'/'].Attributes['coldesc']; ColCName := Copy(ColCName,1,length(ColCName)-6); Site := XT.Node['/form/settype8/'+ColEName+'/'].Attributes['colxy']; if SiteRec= '' then //記錄位置 SiteRec := Site else SiteRec := SiteRec+'@'+Site; Pixel := XT.Node['/form/settype8/'+ColEName+'/'].Attributes['pixel']; if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt) > (Pixel + SafePixel) then begin ////有填寫// // inc(OMROkCount); end; if XT.SubNodes['/form/settype8/'+ColEName+'/'].First then Repeat RelaSiteRec := ''; nodename := XT.SubNodes['/form/settype8/'+ColEName+'/'].NodeName; If (nodename <> '@coldesc') and (not XT.SubNodes['/form/settype8/'+ColEName+'/'].NodeIsAttr) then begin RelaFormCode := XT.node['/form/settype8/'+ColEName+'/'+nodename+'/'].Attributes['relaformid']; RelaColEName := XT.node['/form/settype8/'+ColEName+'/'+nodename+'/'].Attributes['rela_col_name']; RelaColCName := XT.node['/form/settype8/'+ColEName+'/'+nodename+'/'].Attributes['relacoldesc']; RelaColCName := Copy(RelaColCName,1,length(RelaColCName)-6); RelaFile := FormCode2FileName(RelaFormCode,ContextList); RelaFormName := FormCode2FormName(CaseID,RelaFormCode); Anchor1 := FormID2Anchor(RelaFormCode); RelaXT.LoadFromFile(CheckXmlPath+RelaFormCode+'.xml'); OMROK := False; //OMROK := False; //if RelaXT.SubNodes['/form/settype2/'].First then //Repeat NoSite := True; if RelaXT.SubNodes['/form/settype2/'+RelaColEName+'/'].Count >0 then NoSite := False; if RelaXT.SubNodes['/form/settype2/'+RelaColEName+'/'].First then Repeat nodename := RelaXT.SubNodes['/form/settype2/'+RelaColEName+'/'].NodeName; If nodename <> '@coldesc' then begin RelaPixel := Strtoint(RelaXT.Node['/form/settype2/'+RelaColEName+'/'+nodename+'/'].Attributes['pixel']); RelaSite := RelaXT.Node['/form/settype2/'+RelaColEName+'/'+nodename+'/'].Attributes['colxy']; if RelaSiteRec= '' then //記錄位置 RelaSiteRec := RelaSite else RelaSiteRec := RelaSiteRec+'@'+RelaSite; if FileExists(ImageSavePath+CaseID+'\upload\'+RelaFile) then begin if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+RelaFile,RelaSite,Bt) > (RelaPixel + SafePixel) then begin inc(OMROkCount); //OMROK := True; //Break; end; end; end; //Else //begin //ColCName := XT['/form/settype1/'+ColEName+'/'+nodename+'/']; //end; Until not RelaXT.SubNodes['/form/settype2/'+RelaColEName+'/'].Next; if OMROkCount > 1 then begin if not FileExists(ImageSavePath+CaseID+'\upload\'+RelaFile) then ErrStr:=Format(OMRErrInfo[11].Info,[ColCName,RelaColCName])+'('+_msg('未附')+RelaFormName+')' //XX欄位填寫時,XX欄位也填寫 Else if NoSite then ErrStr:=Format(OMRErrInfo[11].Info,[ColCName,RelaColCName])+'('+_msg('未定位')+')' Else ErrStr:=Format(OMRErrInfo[11].Info,[ColCName,RelaColCName]); //XX欄位填寫時,XX欄位也填寫 OMRErr2ini(CaseID,ErrStr,ImageSavePath+CaseID+'\upload\'+OMRFile,SiteRec,ImageSavePath+CaseID+'\upload\'+RelaFile,RelaSiteRec,Anchor,Anchor1,False,OMRErrInfo[7].Ignore,OMRErrInfo[7].Display); if OMRErrInfo[11].Display then CaseOk := false; end; //Until not RelaXT.SubNodes['/form/settype2/'].Next ; end; Until not XT.SubNodes['/form/settype8/'+ColEName+'/'].Next; Until not XT.SubNodes['/form/settype8/'].Next ; end; //*******有值相關文件的欄位不能有值******* //*******有值相依文件******* if ModeNeedCheck(OMRErrInfo[5].Mode,FMode) then //是否要檢核 begin if XT.SubNodes['/form/settype4/'].First then Repeat SiteRec := ''; RelaSiteRec := ''; ColEName := XT.SubNodes['/form/settype4/'].NodeName; ColCName := XT.Node['/form/settype4/'+ColEName+'/'].Attributes['coldesc']; ColCName := Copy(ColCName,1,length(ColCName)-6); Site := XT.Node['/form/settype4/'+ColEName+'/'].Attributes['colxy']; if SiteRec= '' then //記錄位置 SiteRec := Site else SiteRec := SiteRec+'@'+Site; Pixel := XT.Node['/form/settype4/'+ColEName+'/'].Attributes['pixel']; if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt) > (Pixel + SafePixel) then begin ////有填寫//// if XT.SubNodes['/form/settype4/'+ColEName+'/'].First then Repeat nodename := XT.SubNodes['/form/settype4/'+ColEName+'/'].NodeName; If (nodename <> 'coldesc') and (not XT.SubNodes['/form/settype4/'+ColEName+'/'].NodeIsAttr) then begin {RelaFormCode := XT.Node['/form/settype4/'+ColEName+'/'+nodename+'/'].Attributes['relaformid']; RelaFile := FormCode2FileName(RelaFormCode); RelaFormName := FormCode2FormName(RelaFormCode); } RelaDocNo := XT.Node['/form/settype4/'+ColEName+'/'+nodename+'/'].Attributes['relaformid']; RelaFile := DocNo2FileName(RelaDocNo,ContextList); RelaDocName := XT.Node['/form/settype4/'+ColEName+'/'+nodename+'/'].Attributes['relaformname']; if RelaFile='' then begin ErrStr:=Format(OMRErrInfo[5].Info,[ColCName,RelaDocName]); //XX文件XX欄位填寫時,需附XX文件 OMRErr2ini(CaseID,ErrStr,ImageSavePath+CaseID+'\upload\'+OMRFile,SiteRec,'','',Anchor,Anchor1,False,OMRErrInfo[5].Ignore,OMRErrInfo[5].Display); if OMRErrInfo[5].Display then CaseOk := false; end; end; Until not XT.SubNodes['/form/settype4/'+ColEName+'/'].Next; end; Until not XT.SubNodes['/form/settype4/'].Next ; end; //*******有值相依文件******* //*******有值互斥文件******* if ModeNeedCheck(OMRErrInfo[6].Mode,FMode) then //是否要檢核 begin if XT.SubNodes['/form/settype5/'].First then Repeat SiteRec := ''; RelaSiteRec := ''; ColEName := XT.SubNodes['/form/settype5/'].NodeName; ColCName := XT.Node['/form/settype5/'+ColEName+'/'].Attributes['coldesc']; ColCName := Copy(ColCName,1,length(ColCName)-6); Site := XT.Node['/form/settype5/'+ColEName+'/'].Attributes['colxy']; if SiteRec= '' then //記錄位置 SiteRec := Site else SiteRec := SiteRec+'@'+Site; Pixel := XT.Node['/form/settype5/'+ColEName+'/'].Attributes['pixel']; if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt) > (Pixel + SafePixel) then begin ////有填寫//// if XT.SubNodes['/form/settype5/'+ColEName+'/'].First then Repeat nodename := XT.SubNodes['/form/settype5/'+ColEName+'/'].NodeName; If (nodename <> 'coldesc') and (not XT.SubNodes['/form/settype5/'+ColEName+'/'].NodeIsAttr) then begin {RelaFormCode := XT.Node['/form/settype5/'+ColEName+'/'+nodename+'/'].Attributes['relaformid']; RelaFile := FormCode2FileName(RelaFormCode); RelaFormName := FormCode2FormName(RelaFormCode);} RelaDocNo := XT.Node['/form/settype5/'+ColEName+'/'+nodename+'/'].Attributes['relaformid']; RelaFile := DocNo2FileName(RelaDocNo,ContextList); RelaDocName := XT.Node['/form/settype5/'+ColEName+'/'+nodename+'/'].Attributes['relaformname']; if RelaFile<>'' then //有附 20130604看到(='')改的(未測) begin ErrStr:=Format(OMRErrInfo[6].Info,[ColCName,RelaDocName]); //XX文件XX欄位填寫時,不能附XX文件 OMRErr2ini(CaseID,ErrStr,ImageSavePath+CaseID+'\upload\'+OMRFile,SiteRec,'','',Anchor,Anchor1,False,OMRErrInfo[6].Ignore,OMRErrInfo[6].Display); if OMRErrInfo[6].Display then CaseOk := false; end; end; Until not XT.SubNodes['/form/settype5/'+ColEName+'/'].Next; end; Until not XT.SubNodes['/form/settype5/'].Next ; end; //*******有值互斥文件******* //*******有值寫備註******* if ModeNeedCheck(OMRErrInfo[8].Mode,FMode) then //是否要檢核 begin if XT.SubNodes['/form/settype6/'].First then Repeat SiteRec := ''; ColEName := XT.SubNodes['/form/settype6/'].NodeName; ColCName := XT.Node['/form/settype6/'+ColEName+'/'].Attributes['coldesc']; ColCName := Copy(ColCName,1,length(ColCName)-6); Site := XT.Node['/form/settype6/'+ColEName+'/'].Attributes['colxy']; Pixel := XT.Node['/form/settype6/'+ColEName+'/'].Attributes['pixel']; if SiteRec= '' then //記錄位置 SiteRec := Site else SiteRec := SiteRec+'@'+Site; if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt) > (Pixel + SafePixel) then begin ////有填寫//// if not FileExists(ImageSavePath+CaseID+'ScanMemo.dat') then begin ErrStr:=Format(OMRErrInfo[8].Info,[ColCName]); //XX文件XX欄位填寫時,需寫備註 OMRErr2ini(CaseID,ErrStr,ImageSavePath+CaseID+'\upload\'+OMRFile,SiteRec,'','',Anchor,Anchor1,False,OMRErrInfo[8].Ignore,OMRErrInfo[8].Display); if OMRErrInfo[8].Display then CaseOk := false; end; end; Until not XT.SubNodes['/form/settype6/'].Next ; end; //*******有值寫備註******* //*******OMR帶值******** if XT.SubNodes['/form/settype7/'].First then Repeat ColEName := XT.SubNodes['/form/settype7/'].NodeName; ValueXT['/content/'+ColEName+'/@savevalue'] := ''; //先給預設空白 if XT.SubNodes['/form/settype7/'+ColEName+'/'].First then Repeat nodename := XT.SubNodes['/form/settype7/'+ColEName+'/'].NodeName; If nodename <> '@coldesc' then begin Pixel := Strtoint(XT.Node['/form/settype7/'+ColEName+'/'+nodename+'/'].Attributes['pixel']); Site := XT.Node['/form/settype7/'+ColEName+'/'+nodename+'/'].Attributes['colxy']; OMRValue := XT.Node['/form/settype7/'+ColEName+'/'+nodename+'/'].Attributes['getvalue']; //有填就ok if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt) > (Pixel + SafePixel) then begin ValueXT['/content/'+ColEName+'/@savevalue'] := OMRValue; //有填就換成設定的值 Break; end; end; Until not XT.SubNodes['/form/settype7/'+ColEName+'/'].Next; Until not XT.SubNodes['/form/settype7/'].Next ; //*******OMR帶值******** //end; Finally if (OMRValue <> '') then ValueXT.SaveToFile(ImageSavePath+CaseID+'/GetValue.xml'); XT.Free; RelaXT.Free; end; end; Finally ValueXT.Free; end; //end; //end; Result := CaseOk; 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,'') 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.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 := '影像顯示中,請稍候'; 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 : Integer; begin ShowText := '影像顯示中,請稍候'; DataLoading(True,True); 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 {iDocno := DocNoDir2DocNo(CaseDocNoList.Strings[i]); 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; } iDocNo := CaseDocNoList.Strings[i]; if not DocNoAppear(DocNoDir2DocNo(iDocNo)) then continue; 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 := False; if ISB.ZoomPercent > 100 then ISB.AntiAliased := False; ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[n],1); DpiResize(ISB.Graphic,36); 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'); CreatePreViewISB(ContextList.Count); For i := 0 to ContextList.Count -1 do begin ISB := TImageScrollBox(FindComponent(ISBName+intToStr(i+1))); ISB.AntiAliased := True; if ISB.ZoomPercent > 100 then ISB.AntiAliased := False; ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[i],1); DpiResize(ISB.Graphic,36); 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); For i := 0 to ContextList.Count -1 do begin if FileName2FormCode(ContextList.Strings[i]) = FormID then 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[i],1); DpiResize(ISB.Graphic,36); ISB.Redraw(true); //NowShowFileList.Add(ContextList.Strings[i]); end; end; FitPreViewISB; end; end; {Else if (DocNo = 'Attach') and (FormID = 'Attach') then //附件傳 Attach begin If (TreeView1.Selected <> nil) Then begin iGroupNo := 0; page := 0; CreatePreViewISB(Pages); For i := 0 to ContextList.Count -1 do begin List_FormCode := FileName2FormCode(ContextList.Strings[i]); Form_Page := FormCode2Page(List_FormCode); List_DocNo := FormCode2DocNo(List_FormCode); Trans_DocNo := Context_DocnoList.Strings[i]; if (Trans_DocNo = DocNo) then begin if List_FormCode = FormID then begin inc(Page); if Page = GroupNo+1 then begin ISB := TImageScrollBox(FindComponent(ISBName+intToStr(1))); ISB.AntiAliased := True; if ISB.ZoomPercent > 100 then ISB.AntiAliased := False; ISB.LoadFromFile(Path+ContextList.Strings[i],1); NowShowFileList.Add(ContextList.Strings[i]); end; end; end; end; FitPreViewISB; end; end;} if FindComponent(ISBName+'1') <> nil then ISBClick(TImageScrollBox(FindComponent(ISBName+'1'))); 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; begin FreePreViewISB; ScrollBox1.HorzScrollBar.Visible := False; W := 150; H := 250; for I := 1 to Count do begin Panel := TPanel.Create(Self); Panel.Name := 'M_Pl'+inttostr(i); Panel.Left := 4; Panel.Top := (i-1)*H+(6*i); Panel.Height := H; Panel.Width := W; Panel.Parent := ScrollBox1; Panel.Caption :=''; 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.OnStartDrag := ISBStartDrag; ISB.OnEndDrag := ISBEndDrag; // ISB.OnImageDragDrop := ISBDragDrop; // ISB.OnImageDragOver := ISBDragOver; ISB.OnDragDrop := ISBDragDrop; ISB.OnDragOver := ISBDragOver; end; end; Procedure TCB_IMGPSScanX.FreePreViewISB; var i : Integer; begin For i:= ComponentCount -1 downto 0 do begin IF Components[i] is TImageScrollBox Then begin IF Pos(ISBName,Components[i].Name) > 0 Then Components[i].Free; end Else If Components[i] is TPanel Then begin IF Pos('M_Pl',Components[i].Name) > 0 Then Components[i].Free; end Else If Components[i] is TShape Then begin IF Pos('SP',Components[i].Name) > 0 Then Components[i].Free; end; end; Application.ProcessMessages; //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.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.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; 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; Procedure TCB_IMGPSScanX.CreateDocNo_DocName(Path,CaseID:String); //產生DocNo_DocName.dat var i : Integer; S : TStringlist; Doc_Name : String; begin S := TStringlist.Create; try DistinctDocNoinCase(Path); for i := 0 to CaseDocNoList.Count - 1 do begin Doc_Name := CaseDocNoList.Strings[i]+'_'+DocNo2DocName(CaseID,CaseDocNoList.Strings[i]); if not DocnoNeedGroup(CaseDocNoList.Strings[i]) Then //不用分組的加*號給智豪 Doc_Name := '*'+Doc_Name; S.Add(Doc_Name); end; S.SaveToFile(Path+'DocNo_Name.dat',TEnCoding.UTF8); finally S.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.CreateDocNo_Info(CaseID:String):String; //產生 DocNo[tab]份數[tab]總頁數[tab]是否異動[換行]DocNo[tab]份數[tab]總頁數[tab]是否異動 var i,n : Integer; DocDirList,DocDir_CopiesList,FileList,C_DocNoList : TStringlist; DocNo,iDocDir,iDocNo,iEdit:String; icopys,ipages : integer; S,S1 : TStringlist; Str : String; begin DocDirList := TStringlist.Create; DocDir_CopiesList := TStringlist.Create; FileList := TStringlist.Create; C_DocNoList := TStringlist.Create; try Str := ''; if Not FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then Exit; DocDirList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); if DocDirList.Count =0 then exit;//20170222 新加 DocDir_CopiesList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo_Copies.dat'); while DocDirList.Count > 0 do begin iDocDir := DocDirList.Strings[0]; DocNo := DocNoDir2DocNo(iDocDir); if Copy(iDocDir,1,5) <> 'ZZZZZ' then //不為自定文件 begin //icopys := 1; icopys := GetDocNoCount(CaseID,DocNo); ipages := GetDocDir_Page(CaseID,iDocDir); iEdit := GetDocNoEdit(CaseID,DocNo,''); for i := DocDirList.Count - 1 downto 1 do begin iDocDir := DocDirList.Strings[i]; iDocNo := DocNoDir2DocNo(iDocDir); if iDocNo = DocNo then begin //inc(icopys); ipages := ipages + GetDocDir_Page(CaseID,iDocDir); DocDirList.Delete(i); end; end; if str = '' then Str := Format('%s'+#9+'%d'+#9+'%d'+#9+'%s',[DocNo,iCopys,iPages,iEdit]) else Str := Str+#13#10+ Format('%s'+#9+'%d'+#9+'%d'+#9+'%s',[DocNo,iCopys,iPages,iEdit]); end; DocDirList.Delete(0); end; finally DocDirList.Free; DocDir_CopiesList.Free; FileList.Free; C_DocNoList.Free; end; Result := Str; {S := TStringlist.Create; S1 := TStringlist.Create; try S.LoadFromFile(Path+'Context.dat'); S1.LoadFromFile(Path+'Context_DocNo.dat'); for i := 0 to CaseDocNoList.Count - 1 do begin iDocNo := CaseDocNoList.Strings[i]; iCopys := GetDocNo_Count(Path,iDocNo); iPages := GetDocNo_Page(Path,iDocNo); if str = '' then Str := Format('%s,%d,%d',[iDocNo,iCopys,iPages]) else Str := Str+';'+ Format('%s,%d,%d',[iDocNo,iCopys,iPages]); end; Result := Str; finally S.Free; S1.Free; end; } end; Function TCB_IMGPSScanX.CreateCustDocNo_Info(CaseID:String):String; //產生自訂文件 DocName[tab]份數[tab]總頁數[tab]是否異動[#13#10]DocName[tab]份數[tab]總頁數[tab]是否異動 var i,n : Integer; DocDirList,FileList : TStringlist; DocNo,DocName,iDocDir,iDocNo,iEdit:String; icopys,ipages : integer; S,S1 : TStringlist; Str : String; begin DocDirList := TStringlist.Create; FileList := TStringlist.Create; try Str := ''; if Not FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then Exit; DocDirList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); //ShowMessage(DocDirList.Text); while DocDirList.Count > 0 do begin iDocDir := DocDirList.Strings[0]; DocNo := DocNoDir2DocNo(iDocDir); if Copy(iDocDir,1,5) = 'ZZZZZ' then //是自定文件 begin //icopys := 1; DocName := GetCustomDocName(ImageSavePath+CaseID+'\',DocNo); icopys := GetDocNoCount(CaseID,DocNo); ipages := GetDocDir_Page(CaseID,iDocDir); iEdit := GetDocNoEdit(CaseID,DocNo,DocName); for i := DocDirList.Count - 1 downto 1 do begin iDocDir := DocDirList.Strings[i]; iDocNo := DocNoDir2DocNo(iDocDir); if iDocNo = DocNo then begin //inc(icopys); ipages := ipages + GetDocDir_Page(CaseID,iDocDir); DocDirList.Delete(i); end; end; DocName := GetCustomDocName(ImageSavePath+CaseID+'\',DocNo); if str = '' then Str := Format('%s'+#9+'%d'+#9+'%d'+#9+'%s',[DocName,iCopys,iPages,iEdit]) else Str := Str+#13#10+ Format('%s'+#9+'%d'+#9+'%d'+#9+'%s',[DocName,iCopys,iPages,iEdit]); end; DocDirList.Delete(0); end; finally DocDirList.Free; FileList.Free; end; Result := Str; end; Function TCB_IMGPSScanX.CreateDocnoFrom_Info(CaseID:String):String; //產生被引進的保管袋文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號 var i,n : Integer; DocDirList,DocDir_CopiesList,FileList : TStringlist; DocNo,iDocDir,iDocNo,iEdit:String; FromCaseID : string; icopys,ipages : integer; S,S1 : TStringlist; Str : String; begin DocDirList := TStringlist.Create; DocDir_CopiesList := TStringlist.Create; FileList := TStringlist.Create; try Str := ''; if Not FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then Exit; DocDirList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); if DocDirList.Count=0 then exit;//20170222 新加 DocDir_CopiesList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo_Copies.dat'); while DocDirList.Count > 0 do begin iDocDir := DocDirList.Strings[0]; DocNo := DocNoDir2DocNo(iDocDir); if (Copy(iDocDir,1,5) <> 'ZZZZZ') then //不為自定文件 begin //icopys := 1; //icopys := GetDocNoCount(CaseID,DocNo); icopys := GetDocDirCopies(CaseID,iDocDir); ipages := GetDocDir_Page(CaseID,iDocDir); iEdit := GetDocNoEdit(CaseID,DocNo,''); FromCaseID := GetUseCase('F',ImageSavePath+CaseID+'\',iDocDir); if FromCaseID <> '' then begin for i := DocDirList.Count - 1 downto 1 do begin iDocDir := DocDirList.Strings[i]; iDocNo := DocNoDir2DocNo(iDocDir); if (iDocNo = DocNo) and (GetUseCase('F',ImageSavePath+CaseID+'\',iDocDir)<>'') then begin FromCaseID := GetUseCase('F',ImageSavePath+CaseID+'\',iDocDir); //inc(icopys); icopys := icopys + GetDocDirCopies(CaseID,iDocDir); ipages := ipages + GetDocDir_Page(CaseID,iDocDir); DocDirList.Delete(i); end; end; if str = '' then Str := Format('%s'+#9+'%d'+#9+'%s',[DocNo,iCopys,FromCaseID]) else Str := Str+#13#10+ Format('%s'+#9+'%d'+#9+'%s',[DocNo,iCopys,FromCaseID]); end; end; DocDirList.Delete(0); end; finally DocDirList.Free; DocDir_CopiesList.Free; FileList.Free; end; Result := Str; end; Function TCB_IMGPSScanX.CreateCustDocNoFrom_Info(CaseID:String):String; //產生被引進的自定文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號 var i,n : Integer; DocDirList,FileList : TStringlist; DocNo,DocName,iDocDir,iDocNo,iEdit:String; FromCaseID : string; icopys,ipages : integer; S,S1 : TStringlist; Str : String; begin DocDirList := TStringlist.Create; FileList := TStringlist.Create; try Str := ''; if Not FileExists(ImageSavePath+CaseID+'\CaseDocNo.dat') then Exit; DocDirList.LoadFromFile(ImageSavePath+CaseID+'\CaseDocNo.dat'); while DocDirList.Count > 0 do begin iDocDir := DocDirList.Strings[0]; DocNo := DocNoDir2DocNo(iDocDir); if Copy(iDocDir,1,5) = 'ZZZZZ' then //是自定文件 begin //icopys := 1; //icopys := GetDocNoCount(CaseID,DocNo); icopys := GetDocDirCopies(CaseID,iDocDir); ipages := GetDocDir_Page(CaseID,iDocDir); iEdit := GetDocNoEdit(CaseID,DocNo,DocName); FromCaseID := GetUseCase('F',ImageSavePath+CaseID+'\',iDocDir); if FromCaseID <> '' then begin for i := DocDirList.Count - 1 downto 1 do begin iDocDir := DocDirList.Strings[i]; iDocNo := DocNoDir2DocNo(iDocDir); if (iDocNo = DocNo) and (GetUseCase('F',ImageSavePath+CaseID+'\',iDocDir)<>'') then begin FromCaseID := GetUseCase('F',DisplayPath,iDocDir); //inc(icopys); ipages := ipages + GetDocDir_Page(CaseID,iDocDir); DocDirList.Delete(i); end; end; DocName := GetCustomDocName(ImageSavePath+CaseID+'\',DocNo); if str = '' then Str := Format('%s'+#9+'%d'+#9+'%s',[DocName,iCopys,FromCaseID]) else Str := Str+#13#10+ Format('%s'+#9+'%d'+#9+'%s',[DocName,iCopys,FromCaseID]); end; end; DocDirList.Delete(0); end; finally DocDirList.Free; FileList.Free; end; Result := Str; 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.GetDocNoEdit(CaseID,DocNo,DocName:String):String; //取出DocNo是否被異動 (Y/N) var i : Integer; EditedDocDirList : TStringlist; C_DocNoList,C_DocNameList : TStringlist; begin Result := 'N'; EditedDocDirList := TStringlist.Create; C_DocNoList := TStringlist.Create; C_DocNameList := TStringlist.Create; try if FileExists(ImageSavePath+CaseID+'\EditedDocDir.dat') then EditedDocDirList.LoadFromFile(ImageSavePath+CaseID+'\EditedDocDir.dat'); C_DocNoList.StrictDelimiter := True; C_DocNoList.Delimiter := #9; C_DocNoList.DelimitedText := FC_DocNoList; C_DocNameList.StrictDelimiter := True; C_DocNameList.Delimiter := #9; C_DocNameList.DelimitedText := FC_DocNameList; //Showmessage(C_DocNoList.Text); if (DocName = '') and (C_DocNoList.IndexOf(DocNo)=-1 ) then Result := 'Y'; if (DocName <> '') and (C_DocNameList.IndexOf(DocName)=-1) then Result := 'Y'; for i := 0 to EditedDocDirList.Count - 1 do begin if (DocNo = DocNoDir2DocNo(EditedDocDirList.Strings[i])) then begin Result := 'Y'; Break; end; end; finally EditedDocDirList.Free; C_DocNoList.Free; C_DocNameList.Free; end; end; Function TCB_IMGPSScanX.GetDocNo_Count(Path,DocNo:String):Integer; //取出文件份數 var i : Integer; iCopys : integer; S,S1 : TStringlist; iFormID : String; DocFirst : Boolean; begin Result := 0; if not DocnoNeedGroup(DocNo) then begin Result := 1; Exit; end; S := TStringlist.Create; S1 := TStringlist.Create; try S.LoadFromFile(Path+'Context.dat'); S1.LoadFromFile(Path+'Context_DocNo.dat'); iCopys := 0; for i := 0 to S.Count - 1 do begin iFormID := FileName2FormCode(S.Strings[i]); DocFirst := False; if FormCode2Page(iFormID) = '01' then DocFirst := True; if ((iCopys = 0) or DocFirst) and (Docno = S1.Strings[i]) then begin inc(iCopys); end; end; Result := iCopys; finally S.Free; S1.Free; end; end; Function TCB_IMGPSScanX.GetDocNo_Page(Path,DocNo:String):Integer; //取出文件總頁數 var i : Integer; ipages : integer; S,S1 : TStringlist; begin Result := 0; S := TStringlist.Create; S1 := TStringlist.Create; try S.LoadFromFile(Path+'Context.dat'); S1.LoadFromFile(Path+'Context_DocNo.dat'); iPages := 0; for i := 0 to S.Count - 1 do begin if Docno = S1.Strings[i] then begin inc(iPages); end; end; Result := ipages; finally S.Free; S1.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; Function TCB_IMGPSScanX.Case_DocNoExists(CaseID,Docno:String):Boolean; //Docno是否存在案件裡 var i : Integer; S : TStringlist; iDocNo : String; begin Result := False; S := TStringlist.Create; try S.LoadFromFile(ImageSavePath + CaseID+'\Context.dat'); for i := 0 to S.Count - 1 do begin iDocNo := FormCode2DocNo(FileName2FormCode(S.Strings[i])); if Docno = iDocNo then begin Result := True; Break; end; end; finally S.Free; end; end; procedure TCB_IMGPSScanX.CB1Click(Sender: TObject); begin TwainShowUI := CB1.Checked; end; Procedure TCB_IMGPSScanX.ReSortFileName(Path:String); //檔名重新排序 var i : Integer; OldName,NewName : String; Filelist : TStringlist; begin Filelist := TStringlist.Create; try if FileExists(Path+'Context.dat') then begin Filelist.LoadFromFile(Path+'Context.dat'); for i := 0 to Filelist.Count - 1 do begin OldName := Filelist.Strings[i]; //NewName := Add_Zoo(i+1,3)+Copy(OldName,4,length(OldName)-3); NewName := Add_Zoo(i+1,3)+FileName2NoQuene_Filename(OldName); ReNameFile(Path+OldName,Path+NewName); Filelist.Strings[i] := NewName; end; Filelist.SaveToFile(Path+'Context.dat'); ContextList.LoadFromFile(Path+'Context.dat'); end; finally Filelist.Free; end; end; Procedure TCB_IMGPSScanX.ReSortFileName_New(Path:String); //檔名重新排序 var i : Integer; OldName,NewName : String; Filelist : TStringlist; begin Filelist := TStringlist.Create; try if FileExists(Path+'Context.dat') then begin Filelist.LoadFromFile(Path+'Context.dat'); for i := Filelist.Count - 1 downto 0 do begin OldName := Filelist.Strings[i]; //NewName := Add_Zoo(i+1,3)+Copy(OldName,4,length(OldName)-3); NewName := Add_Zoo(i+1,3)+FileName2NoQuene_Filename(OldName); ReNameFile(Path+OldName,Path+NewName); Filelist.Strings[i] := NewName; end; Filelist.SaveToFile(Path+'Context.dat'); ContextList.LoadFromFile(Path+'Context.dat'); end; finally Filelist.Free; end; end; Procedure TCB_IMGPSScanX.ReSortFileName2Scanlist(Path:String); //檔名重新排序給Scanlist.dat var i : Integer; OldName,NewName : String; S : TStringlist; begin S := TStringlist.Create; try if FileExists(Path+'scanlist.dat') then S.LoadFromFile(Path+'scanlist.dat'); for i := 0 to S.Count - 1 do begin OldName := S.Strings[i]; //NewName := Add_Zoo(i+1,3)+Copy(OldName,4,length(OldName)-3); NewName := Add_Zoo(i+1,3)+FileName2NoQuene_Filename(OldName); //ReNameFile(Path+OldName,Path+NewName); S.Strings[i] := NewName; end; S.SaveToFile(Path+'scanlist.dat'); finally S.Free; end; 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,False); 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; 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,False); 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; Function TCB_IMGPSScanX.CaseAsk(CaseID: string):Integer; var SendData : String; begin //Memo1.Clear; SendData := 'data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&case_no='+CaseID+'&work_no='+FWork_no; if (FMode = 'NSCAN') or (FMode = 'DSCAN') then begin //ShowMessage('JJJJJ'); If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC05/isnew',SendData,FReWrite,Memo1,False) Then begin HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason; Result := -1; Exit; end; end; //ShowMessage(SendData); //ShowMessage(Memo1.Lines.Text); IF memo1.Lines.Strings[0] <> '0' Then begin HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1]; Result := -1; Exit; end Else begin if (memo1.Lines.Count < 2) then begin HttpErrStr := _Msg('錯誤原因:')+'OCX:Index Count error'; Result := -1; Exit; end Else begin if memo1.Lines.Strings[1] = '0' then begin Result := 0; end Else if memo1.Lines.Strings[1] = '1' then Result := 1 Else begin HttpErrStr := _Msg('錯誤原因:')+'OCX:Value error'; Result := -1; Exit; end; end; end; end; Function TCB_IMGPSScanX.CaseComplete(Path,CaseID:String;MainCase:Boolean):Boolean; //通知傳送完成 var OMRValue,Batchnum,Usermemo,Checkmemo,UpformID,ReMoveMemo: String; Case_type,Handle_no,Format_id,Cen_Uid,Cen_Cliname,Cen_Platno,Cen_Apolyno,Case_priority : String; Pages : Integer; EnCodeDateTime : String; SendData : String; S : TStringlist; i,v,v1 : Integer; UpSortID : String; begin Result := True; S := TStringlist.Create; try EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey); UpformID := GetCaseFormID(Path); Case_type := '0'; if FileExists(Path+'Context.dat') then //掃描頁數 begin S.LoadFromFile(Path+'Context.dat'); Pages := S.Count; end; if not FileExists(ImageSavePath+CaseID+'\CaseIndex.dat') then //如果沒這個檔就重產生預設值 begin ClearCaseIndex; WriteCaseIndex(ImageSavePath+CaseID+'\'); end; {if FileExists(ImageSavePath+CaseID+'\CaseIndex.dat') then begin S.LoadFromFile(ImageSavePath+CaseID+'\CaseIndex.dat'); 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];//案件等級 if FMode = 'SSCAN' then //簽署章件的時候一律傳Format_ID begin Format_ID := S.Strings[5]; //主鍵值 (報價單號or續保單號or保單號碼or保險證號) end Else begin if (Length(UpformID) = 12) and (UpformID[2] = '-') then Format_ID := S.Strings[5] //主鍵值 (報價單號or續保單號or保單號碼or保險證號) else Cen_Apolyno := S.Strings[5]; //強制證號 end; if (FMode = 'MSCAN') and (length(Format_ID) = 16) and (Copy(Format_ID,1,2) = '05') then begin Format_ID := Copy(Format_ID,3,14); //20130606 yuu說監理站件的主鍵值為16碼且開開為05的要去掉 end; end; } if FileExists(ImageSavePath+CaseID+'\GetValue.xml') then //掃描帶值 begin S.LoadFromFile(ImageSavePath+CaseID+'\GetValue.xml'); OMRValue := Trim(S.Text); end; if MainCase then //雙主約的主要案件 begin if FileExists(ImageSavePath+CaseID+'\Batchnum.dat') then begin S.LoadFromFile(ImageSavePath+CaseID+'\Batchnum.dat'); Batchnum := Trim(S.Text); end; end Else //雙主約的第二案件 begin if FileExists(ImageSavePath+CaseID+'\SecBatchnum.dat') then begin S.LoadFromFile(ImageSavePath+CaseID+'\SecBatchnum.dat'); Batchnum := Trim(S.Text); end; end; if FileExists(ImageSavePath+CaseID+'\Scan_Memo.dat') then begin S.LoadFromFile(ImageSavePath+CaseID+'\Scan_Memo.dat'); Usermemo := Trim(S.Text); end; if FileExists(ImageSavePath+CaseID+'\CheckMemo.dat') then begin S.LoadFromFile(ImageSavePath+CaseID+'\CheckMemo.dat'); Checkmemo := Trim(S.Text); end; if FileExists(ImageSavePath+CaseID+'\RemoveMemo.dat') then begin S.LoadFromFile(ImageSavePath+CaseID+'\RemoveMemo.dat'); ReMoveMemo := Trim(S.Text); end; finally S.Free; end; case_priority:='0'; if (FMode = 'NSCAN') or (FMode = 'ASCAN') or (FMode = 'DSCAN') or (FMode = 'SSCAN') or (FMode = 'MSCAN') or (FMode = 'RI_SCAN') then begin SendData := 'checktime='+EnCodeDateTime +'&work_no='+FWork_No //作業別 +'&case_id='+CaseID //受理編號 +'&form_id='+UpformID //表單代號 +'&scan_page='+inttostr(pages) //掃描頁數 +'&scan_get_value='+HTTPEncode(UTF8Encode(OMRValue)) //掃描帶值 +'&case_priority='+case_priority //案件等級 +'&batch_no='+batchnum //車隊批號 +'&user_memo='+HTTPEncode(UTF8Encode(usermemo)) //使用者註記 +'&check_memo='+HTTPEncode(UTF8Encode(checkmemo)) //檢核註記 +'&remove_memo='+HTTPEncode(UTF8Encode(ReMoveMemo)) //檢核移除註記 +'&case_type='+Case_type //進件種類 進件0 歸檔1 +'&handle_no='+Handle_no //經辦代號 +'&format_id='+Format_id //案件主鍵值 +'&cen_uid='+Cen_Uid //被保人ID +'&cen_cliname='+HTTPEncode(UTF8Encode(Cen_Cliname)) //被保人姓名 +'&cen_platno='+Cen_Platno //車牌 +'&cen_apolyno='+Cen_Apolyno //強制證號 +'&has_authorize='+Has_Authorize; //是否有授權書影像 Showmessage(SendData); if not RejectCase then begin If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC05',SendData,FReWrite,Memo1,False) Then begin HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason; Result := False; Exit; end; end Else begin If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC06',SendData,FReWrite,Memo1,False) Then begin HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason; Result := False; Exit; end; end; end Else if FMode = 'ISCAN' then begin SendData := 'checktime='+EnCodeDateTime +'&work_no='+FWork_No +'&case_id='+CaseID +'&form_id='+UpformID +'&format_id='+Format_id +'&scan_page='+inttostr(pages) +'&user_memo='+HTTPEncode(UTF8Encode(usermemo)) +'&check_memo='+HTTPEncode(UTF8Encode(checkmemo)) +'&remove_memo='+HTTPEncode(UTF8Encode(ReMoveMemo)) +'&has_authorize='+Has_Authorize; //是否有授權書影像 //Showmessage(SendData); If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC08',SendData,FReWrite,Memo1,False) Then begin HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason; Result := False; Exit; end; end Else if FMode = 'FSCAN' then begin SendData := 'checktime='+EnCodeDateTime +'&work_no='+FWork_No +'&case_id='+CaseID +'&scan_page='+inttostr(pages) +'&user_memo='+HTTPEncode(UTF8Encode(usermemo)) +'&check_memo='+HTTPEncode(UTF8Encode(checkmemo)) +'&remove_memo='+HTTPEncode(UTF8Encode(ReMoveMemo)) +'&has_authorize='+Has_Authorize; //是否有授權書影像 If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC09',SendData,FReWrite,Memo1,False) Then begin HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason; Result := False; Exit; end; end Else if FMode = 'RSCAN' then begin SendData := 'checktime='+EnCodeDateTime +'&act=rescan' +'&workno='+FWork_No +'&caseid='+CaseID +'&formid='+UpformID +'&scanpage='+inttostr(pages) // +'&areano='+FUserArea +'&scangetvalue='+HTTPEncode(UTF8Encode(OMRValue)) +'&usermemo='+HTTPEncode(UTF8Encode(usermemo)) +'&checkmemo='+HTTPEncode(UTF8Encode(checkmemo)) +'&removememo='+HTTPEncode(UTF8Encode(ReMoveMemo)) +'&has_authorize='+Has_Authorize; //是否有授權書影像 If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC01',SendData,FReWrite,Memo1,False) Then begin HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason; Result := False; Exit; end; end Else if FMode = 'ESCAN' then begin SendData := 'checktime='+EnCodeDateTime +'&act=escan' +'&workno='+FWork_No +'&caseid='+CaseID +'&formid='+UpformID +'&scanpage='+inttostr(pages) +'&batchnum='+batchnum +'&usermemo='+HTTPEncode(UTF8Encode(usermemo)) +'&checkmemo='+HTTPEncode(UTF8Encode(checkmemo)) +'&removememo='+HTTPEncode(UTF8Encode(ReMoveMemo)) +'&has_authorize='+Has_Authorize; //是否有授權書影像 If not ProcessServlet(HTTPSClient,FURL+'servlet/CWC01',SendData,FReWrite,Memo1,False) Then begin HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason; Result := False; Exit; end; end; if Memo1.Lines.Strings[0] <> '0'then begin HttpErrStr := _Msg('錯誤原因:')+Memo1.Lines.Strings[1]; Result := False; Exit; end; end; procedure TCB_IMGPSScanX.Timer1Timer(Sender: TObject); var StampDate,StampTime : String; i: Integer; begin Timer1.Enabled := False; //Showmessage('a'); //self.FIs_OldCase := 'Y'; PageLVclear := True; InitialOk := False; //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; 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; end; DisplayMode(1,1,1,Panel9); Application.ProcessMessages; StatusBar1.Panels[0].Text := 'Ver'+GetCurrentVersionNo; StatusBar1.Panels[1].Text := _Msg('登入人員:')+FUserName; if FPrintyn = 'Y' then PrtLB.Visible := True; initParameter; //20170222 針對新加的parameter 作初始化參數 InitScrollRec; If FUrl = '' then begin Showmessage(_Msg('URL不能為空白,請洽詢程式人員')); Exit; end; if FUrl[length(FUrl)]<>'/' then FUrl := FUrl + '/'; 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; //案件裡的檔案清單 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; //********清單區******** ShowText := _Msg('資料載入中,請稍候'); DataLoading(True,True); IF not GetServerDate Then begin Showmessage(_Msg('取主機時間時,網路發生錯誤!!')+HttpErrStr); DataLoading(False,False); Exit; 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 + '\'; CheckXmlPath := ImagePath+'OMRSITE\'+FWork_No; SitePath := ImagePath+'Site\'+FWork_No+'\'; LngPath := ImagePath; SamplePath := ImagePath+'Sample\'+FWork_No+'\'; ImagePath := ImagePath + 'Scantemp\'; ScaniniPath :=ImagePath+FWork_No+'\'+FUserUnit +'\'; ImagePath := ImagePath + FWork_No+'\'+FUserUnit+'\'+FMode+'\'; //ShowMessage('ImagePath='+ImagePath); ImageSavePath := ImagePath; str2dir(CheckXmlPath); str2dir(SitePath); str2dir(ImagePath); str2dir(SamplePath); Del_Sub_NothingPath(ImagePath); //清掉案件目錄是空的 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); ////下載語言檔///// 20170218 先拿調以便測試 If not DownLanguage Then begin Showmessage('Language File error!!'+HttpErrStr); DataLoading(False,False); Exit; end; InitialLanguage(Self); //載入多國語言 //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') then //異動件先下載影像 begin ShowText := _Msg('案件下載中,請稍候'); DataLoading(True,True); 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); //產生外面傳入的文件 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; R_W_Scanini('R'); //掃瞄設定的ini 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; } DataLoading(False,False); //ShowMessage('初始話執行完成'); //ShowMessage('GuideFormIDList='+GuideFormIDList.Text); //ShowMessage('DivPageFormIDList='+DivPageFormIDList.Text); 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.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; begin IF not InitialOk Then begin Showmessage(_msg('資訊尚未下載完成,請稍候或重新進入')); Exit; end; ClearView(1); CaseHelpBtn.Visible := False; DisplayPath := ''; ClearCaseIndex; RejectCase := False; if not CheckCaseID_OK then //檢查是否有未配號的案件 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); /////訊問是否可上傳//// 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('NNNNN'); 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 TransMsg := TransMsg + #13#10 + Format(_Msg('檢核失敗件%d件'),[CheckErrCount]); Showmessage(_Msg('傳送完成')+#13#10+TransMsg); 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; 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('從%s引用',[GetUseCase('F',DisplayPath,NowDocDir)]); if GetUseCase('T',DisplayPath,NowDocDir) <> '' then StatusBar1.Panels[2].Text := Format('被%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('從%s引用',[GetUseCase('F',DisplayPath,NowDocDir)]); if GetUseCase('T',DisplayPath,NowDocDir) <> '' then StatusBar1.Panels[2].Text := Format('被%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); 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 TreeView1Click(nil); 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; TreeView1.Selected := TreeView1.GetNodeAt(X,Y); TreeView1Click(self); TreeView1.PopupMenu.Popup(Mouse.CursorPos.X ,Mouse.CursorPos.Y); end; end; procedure TCB_IMGPSScanX.ViewModeBtnMouseEnter(Sender: TObject); begin AddToolTip(TBitBtn(Sender).Parent.Handle,nil,0,Pchar(TBitBtn(Sender).Hint),nil,0,0); end; procedure TCB_IMGPSScanX.Set_caseid(const Value: WideString); begin FCaseID := Value; end; procedure TCB_IMGPSScanX.Set_data(const Value: WideString); begin FData := Value; 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_c_docnolist(const Value: WideString); begin FC_DocNoList := Value; end; procedure TCB_IMGPSScanX.Set_fixfilelist(const Value: WideString); begin FFixFileList := Value; end; procedure TCB_IMGPSScanX.Set_is_in_wh(const Value: WideString); begin FIs_In_Wh := UpperCase(Value); end; procedure TCB_IMGPSScanX.Set_oldcaseinfo(const Value: WideString); begin FOldCaseInfo := Value; end; function TCB_IMGPSScanX.Get_c_docnamelist: WideString; begin end; function TCB_IMGPSScanX.Get_c_docnolist: WideString; begin end; function TCB_IMGPSScanX.Get_caseid: WideString; begin end; function TCB_IMGPSScanX.Get_data: WideString; begin end; function TCB_IMGPSScanX.Get_fixfilelist: 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_oldcaseinfo: 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_is_oldcase: WideString; begin end; procedure TCB_IMGPSScanX.Set_is_oldcase(const Value: WideString); begin FIs_OldCase := 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_casenolength: WideString; begin end; function TCB_IMGPSScanX.Get_filesizelimit: WideString; begin end; function TCB_IMGPSScanX.Get_imgdpi: WideString; begin end; function TCB_IMGPSScanX.Get_scancolor: WideString; begin end; procedure TCB_IMGPSScanX.Set_casenolength(const Value: WideString); begin if Value ='' then begin FCaseNoLength := 0 ; CaseIDLength := FCaseNoLength; end else begin FCaseNoLength := StrToInt(Value) ; CaseIDLength := FCaseNoLength; end; end; procedure TCB_IMGPSScanX.Set_filesizelimit(const Value: WideString); begin //ShowMessage(Value); if Value ='' then begin FFileSizeLimit := 5*1024; end else begin FFileSizeLimit := StrToInt(Value); end; end; procedure TCB_IMGPSScanX.Set_imgdpi(const Value: WideString); begin if Value ='' then begin FImgDPI := 300; ScanDpi := FImgDPI; end else begin FImgDPI := StrToInt(Value); ScanDpi := FImgDPI; Def_ScanDpi := FImgDPI; end; end; procedure TCB_IMGPSScanX.Set_scancolor(const Value: WideString); begin if value='' then begin FScanColor := 0; ScanColor := ifBlackWhite; end else begin FScanColor := StrToInt(Value); ScanColor := ifBlackWhite; end; if FScanColor = 1 then begin ScanColor := ifGray256 ; end; if FScanColor = 2 then begin ScanColor := ifTrueColor ; end; 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_check_main_form: WideString; begin end; function TCB_IMGPSScanX.Get_isExternal: WideString; begin end; procedure TCB_IMGPSScanX.Set_check_main_form(const Value: WideString); begin FCheck_main_form := Value; end; procedure TCB_IMGPSScanX.Set_isExternal(const Value: WideString); begin FIsExternal:=Value; end; initialization TActiveFormFactory.Create( ComServer, TActiveFormControl, TCB_IMGPSScanX, Class_CB_IMGPSScanX, 1, '', OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL, tmApartment); SetLicenseKey('5B4451E676A1D2976FBB0F3BB18341336AF114C80B5ABAE7F6926B1CAF671F44' + 'BD2F098CCEDA922F6389BFAE398DA6AEE67F97EEA0C17234C20D75C12173DBDA' + '594924D56DD8E342F454389C836AD880BB4352CA3BE62C4933B1BA3828E7462C' + '60514F2ECDAD322E6128D841F12D24DA00B623106D3F08EBCAA917D8A97CAA34' + '3D65F2DA567316457395BF9123EE53DF235D181F191A5712DBB27735284AA92D' + '5DFA0C8308308505F384707E900C6063F53F1BFF4C6972607955D1AE517B19D0' + '82CDD16301885403AD229D57BAEF98C056F31430861E5F68F339D658D72E1F92' + '63899412EC2D07891FE3AFD35F3E4A4390B2F0A8A1BF1B7D6160E5F1CC009B17'); SetLicenseKey('A6A94A8D91B08A9D58F300C0573EA9EF1B9DB0BF69B90E13B958DB4CB6B44F5A' + '4EE9CB22C9A68C2D07ED52ED4D13C755D890E4074996755361E6CDE2A6F1B563' + '5DDC8999AC4D71FB092EA9F1F87BFA25694FBF0D6D250087D2B39629713FCCB0' + 'D0A83135BC14FC63A4E8331CFF9E24C45C2D9CFD837EB70BAFDB79A75B7B97D5' + 'E9EB271685118C29D90A7C85E7793908989E295DA50021C795A448366026E975' + 'F49EA75B721B80427B99E5CF24A225FB498C07946ED7B806B483654C00D85C66' + 'E34215CA3EDEF1D4C3F5896090E97E1E2C9752BA2D5B49EE58CF19A0D374077F' + '6D13B90B6FED22D9EBC3AD6CDC76E595E08725BF2E12B8EF30A524A2E00504DF'); end.