From 62c5adb8641e8626a056abc773b72449152d8ae9 Mon Sep 17 00:00:00 2001
From: curtis <curtis@i-mps.com>
Date: 星期一, 30 三月 2026 14:08:25 +0800
Subject: [PATCH] fix: 1) 更新內部引用方法參照 2) mermaid 滙出
---
CB_IMGPSScanImp.pas | 15203 -----------------------------------------------------------
1 files changed, 63 insertions(+), 15,140 deletions(-)
diff --git a/CB_IMGPSScanImp.pas b/CB_IMGPSScanImp.pas
index beb5aaf..f90fcff 100644
--- a/CB_IMGPSScanImp.pas
+++ b/CB_IMGPSScanImp.pas
@@ -1,5 +1,5 @@
-unit CB_IMGPSScanImp;
-
+unit CB_IMGPSScanImp;
+//TEST
{$WARN SYMBOL_PLATFORM OFF}
interface
@@ -9,13 +9,22 @@
EnDiGrph, { for TDibGraphic }
EnMisc, { for MinFloat }
EnTifGr, { for TTifGraphic }
+ {$IFDEF Production}
+ CB_IMGPSScan_TLB,
+ {$ENDIF}
+ {$IFDEF Test}
+ CB_IMGPSScan_test_TLB,
+ {$ENDIF}
+
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- ActiveX, AxCtrls, CB_IMGPSScan_TLB, StdVcl, VCLUnZip, VCLZip, Encryp,
+ ActiveX, AxCtrls, 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,IdHashMessageDigest, idHash, LogFile,ShellApi,
- SBSocket;
+ SBSocket,IIS_Ftp, SBSimpleFTPS;
+Type
+ TTransMode =(tsHttp,tsFtp,tsNone);
var
Ch_WriteNote : Boolean;
@@ -266,6 +275,9 @@
PrtLb: TLabel;
CaseHelpBtn: TBitBtn;
HTTPSClient: TElHTTPSClient;
+ Button5: TButton;
+ FTPSClient1: TElSimpleFTPSClient;
+ Button6: TButton;
procedure ActiveFormCreate(Sender: TObject);
procedure Panel9Resize(Sender: TObject);
procedure ISB1Click(Sender: TObject);
@@ -392,6 +404,8 @@
Shift: TShiftState; X, Y: Integer);
procedure HTTPSClientRedirection(Sender: TObject; const OldURL: string;
var NewURL: string; var AllowRedirection: Boolean);
+ procedure Button5Click(Sender: TObject);
+ procedure Button6Click(Sender: TObject);
private
{ Private declarations }
HotKeyId1,HotKeyId2,HotKeyId3,HotKeyId4 :Integer;
@@ -431,9 +445,20 @@
FWH_category:string; //Y/N Y是歸類時有區分入庫非入庫文件 N 是不區分
////////傳入參數///////
+ TransMode : TTransMode; //用何種方式上傳檔案
//********Http參數********
HttpErrStr : String; //錯誤訊息
//********Http參數********
+
+ //********Ftp參數*********
+ FFtpIP : String;
+ FFtpID : String;
+ FFtpPwd : String;
+ FFtpRootPath : String;
+ FFtpExtraPath : String;
+ FFtpPort : Integer;
+ FFtpProtocol : TFtpProtocol;
+ //********Ftp參數*********
//********ini參數********
DeviceDelete : Boolean; //空白頁刪除啟動
@@ -541,6 +566,7 @@
DocNoLength : Integer; //Docno長度
PEFileName : String; //掃描時的檔名
+ DownFileErrStr : String; //下載影像時發生的錯誤
ISB : TImageScrollBox;
ScanInfo : TScanInfo;
@@ -604,6 +630,11 @@
Function GetFindResult(Col:String):String;
//*********SQL相關************
+ //*********FTP相關************
+ Function GetFtpinfo(CaseID,Action:String):Boolean;
+ Procedure SetFtpInfo; //餵入FTP資訊
+ Function FtpCaseComplete(SendData:String):Boolean;
+ //*********FTP相關************
//*******轉換區*********
Function FindDivFormCode(FormCode:String):Boolean; //找有沒有分案的條碼
@@ -720,6 +751,7 @@
Function Node3FormID(Node3:TTreeNode):String; //MyTreeNode3取FormCode出來
Function GetNode2Name(Node2:TTreeNode):String; //取MyTreeNode2的識別字出來(記之前點選用)
//Function Down_Replace_Img(SPAth,DPath,CaseID:String):Boolean;
+ Function DownLoadImage(Path,CaseID:String):Boolean;
Function Down_Img(Path,CaseID:String):Boolean;
Function GetNoNameCase(Path:string):String; //取未配號XXXX
Procedure CaseResort(Path:String); //案件的檔案重新排序(次文件依Docno挑)
@@ -1017,15139 +1049,30 @@
{ 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);
-var
- I: Integer;
- iISB : TImageScrollBox;
-begin
- inherited;
- //lb1.Caption:=IntToStr(message.Keys);
- if (message.WheelDelta = WHEEL_DELTA) Then
- begin
-
- if ScrollBox1.Focused then
- begin
- ScrollBox1.VertScrollBar.Increment := 50;
- ScrollBox1.Perform(WM_VSCROLL,SB_Lineup,0);
- end;
- if DisplayISB <> nil then
- begin
- if (DisplayISB.Focused) and (message.Keys=0) then
- begin
- DisplayISB.VertScrollBar.Increment := 50;
- DisplayISB.Perform(WM_VSCROLL,SB_Lineup,0);
- end;
-
- if (DisplayISB.Focused) and (message.Keys=50) then
- begin
- DisplayISB.ZoomMode := zmPercent;
- if DisplayISB.ZoomPercent < 90 then
- DisplayISB.ZoomPercent := DisplayISB.ZoomPercent+10;
- end;
-
- end;
- i:=0;
- while FindComponent(ISBName+inttostr(i)) <> nil do
- begin
- iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i)));
- if iISB.Focused then
- begin
- ScrollBox1.VertScrollBar.Increment := 50;
- ScrollBox1.Perform(WM_VSCROLL,SB_Lineup,0);
- end;
- inc(i);
- end;
-
- end
- else if (message.WheelDelta = -WHEEL_DELTA) then
- begin
-
- if ScrollBox1.Focused then
- begin
- ScrollBox1.VertScrollBar.Increment := 50;
- ScrollBox1.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
- end;
- if DisplayISB <> nil then
- begin
- if (DisplayISB.Focused) and (message.Keys=0) then
- begin
- DisplayISB.VertScrollBar.Increment := 50;
- DisplayISB.Perform(WM_VSCROLL,SB_LINEDOWN,0);
- end;
- if (DisplayISB.Focused) and (message.Keys=50) then
- begin
- DisplayISB.ZoomMode := zmPercent;
- if DisplayISB.ZoomPercent > 10 then
- DisplayISB.ZoomPercent := DisplayISB.ZoomPercent-10;
- end;
-
-
- end;
-
- i:=0;
- while FindComponent(ISBName+inttostr(i)) <> nil do
- begin
- iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i)));
- if iISB.Focused then
- begin
- ScrollBox1.VertScrollBar.Increment := 50;
- ScrollBox1.Perform(WM_VSCROLL,SB_Lineup,0);
- end;
- inc(i);
- end;
-
- end;
-
-
-end;
-
-procedure TCB_IMGPSScanX.WNoteBtnClick(Sender: TObject);
-var
- i,n,v,v1:Integer;
- SortMemoForm : TSortMemoForm;
- M_Content,M_ID,M_Name : String;
- S : TStringlist;
-begin
- ShowText := _Msg('備註輸入中,請稍候');
- DataLoading(True,True);
- SortMemoForm := TSortMemoForm.Create(Self);
- S := TStringlist.Create;
- try
- InitialLanguage(SortMemoForm); //載入多國語言
-
- SortMemoForm.ContentList := TStringlist.Create; //註記內容
- SortMemoForm.MemoIDList := TStringlist.Create; //註記代號
- SortMemoForm.MemoNameList := TStringlist.Create; //註記名稱
-
- for i := 1 to MEMO_INF_List.Count - 1 do
- begin
- M_Content := GetSQLData(MEMO_INF_List,'T1.MEMO_CONTENT',i);
- M_ID := GetSQLData(MEMO_INF_List,'T1.MEMO_TYPE',i);
- M_Name := GetSQLData(MEMO_INF_List,'T2.MEMO_TYPE_NAME',i);
- SortMemoForm.ComboBox1.Items.Add(M_Name+'-->'+M_Content);
- SortMemoForm.ContentList.Add(M_Content); //註記內容
- SortMemoForm.MemoIDList.Add(M_ID); //註記代號
- SortMemoForm.MemoNameList.Add(M_Name); //註記名稱
- end;
- if FileExists(DisplayPath+'Scan_Memo.dat') then
- begin
- S.LoadFromFile(DisplayPath+'Scan_Memo.dat');
- for I := 0 to S.Count - 1 do
- begin
- v := Pos(',',S.Strings[i]);
- v1 := length(S.Strings[i]);
- M_ID := copy(S.Strings[i],1,v-1);
- M_Name := MemoInfoTransfer('ID',M_ID,SortMemoForm.MemoIDList,SortMemoForm.MemoNameList);
- M_Content := copy(S.Strings[i],v+1,v1-v);
- SortMemoForm.ResoureMemo.Add(M_Name+'-->'+M_Content);
- With SortMemoForm.MemoLV.Items.Add do
- begin
- Caption := M_Content;
- SubItems.Add(M_Name);
- end;
- end;
- end;
-
- if SortMemoForm.ShowModal = mrOk then
- begin
- S.Clear;
- for I := 0 to SortMemoForm.MemoLV.Items.Count - 1 do
- begin
- M_Content := SortMemoForm.MemoLV.Items.Item[i].Caption;
- M_Name := SortMemoForm.MemoLV.Items.Item[i].SubItems.Strings[0];
- M_ID := MemoInfoTransfer('NAME',M_Name,SortMemoForm.MemoIDList,SortMemoForm.MemoNameList);
- S.Add(M_ID+','+M_Content);
- end;
- S.SaveToFile(DisplayPath+'Scan_Memo.dat');
- end;
- SortMemoForm.ContentList.Free; //註記內容
- SortMemoForm.MemoIDList.Free; //註記代號
- SortMemoForm.MemoNameList.Free; //註記名稱
- finally
- SortMemoForm.Free;
- S.Free;
- DataLoading(False,False);
- if Ch_WriteNote then
- begin
- Ch_WriteNote := False;
- CaseHelpBtnClick(self);
- ErrIndex := 0;
- end;
- end;
-end;
-
-procedure TCB_IMGPSScanX.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.InitExistImgList(casepath: String);
-var
- ST1,ST2,ST3,ST4:TStringList;
- i,j,k:Integer;
-begin
-
- ST1:=TStringList.Create;
- ST2:=TStringList.Create;
- ST3:=TStringList.Create;
-
- ExistImgList.Clear;
- ST1.LoadFromFile(casepath+'Download\Context.dat');
- for I := 0 to ST1.Count - 1 do
- begin
-LogFile1.LogToFile(logTimeString+casepath+'Download\'+ST1.Strings[i]+',MD5='+LoadFileGetMD5(casepath+'Download\'+ST1.Strings[i]));
- ExistImgList.Add(LoadFileGetMD5(casepath+'Download\'+ST1.Strings[i])) ;
- end;
-LogFile1.LogToFile(logTimeString+'ExistImgList.text'+ExistImgList.CommaText);
-
- ST1.Free;
- ST2.Free;
- ST3.Free;
-
-end;
-
-procedure TCB_IMGPSScanX.Initialize;
-begin
- inherited Initialize;
- OnActivate := ActivateEvent;
- OnClick := ClickEvent;
- OnCreate := CreateEvent;
- OnDblClick := DblClickEvent;
- OnDeactivate := DeactivateEvent;
- OnDestroy := DestroyEvent;
- OnKeyPress := KeyPressEvent;
- OnMouseEnter := MouseEnterEvent;
- OnMouseLeave := MouseLeaveEvent;
- OnPaint := PaintEvent;
- MpsKey := 'fbim';
- Seg := 3; //瀏覽窗的邊界
- Ext := '.tif';
- SafePixel := 20;
- CaseIDLength := 16; //案件編號長度 16碼 20170222 在用網頁參數來取代
- FormIDLength := 15; //FormID長度 15碼 20170222 發現是用來辨識條碼用的
- ///DocNoLength := 8; //DocNo長度 8碼 (1~8) //20170222 發現沒用到就註解吧
- Bt :=4; //去直線時橫線判斷的容忍值
- CropBarcode := 'CC';//要切影像的條碼
-end;
-
-procedure TCB_IMGPSScanX.ISB1Click(Sender: TObject);
-var
- p : Integer;
-begin
- DisplayISB := TImageScrollBox(Sender);
- Shape1.Left := TPanel(TImageScrollBox(Sender).Parent).Left - Seg;
- Shape1.Top := TPanel(TImageScrollBox(Sender).Parent).Top - Seg;
- P := strtoint(copy(DisplayISB.Name,4,1)) + ScrollBar1.Position-2;
- if P <= PageLV.Items.Count-1 then
- begin
- if PageLVclear then
- begin
- PageLV.ClearSelection;
- end;
- NowPage := p+1;
- PageLV.ItemIndex := P;
- end;
- //DisplayISB.SetFocus;
-end;
-
-procedure TCB_IMGPSScanX.ISB1EndScroll(Sender: TObject);
-var
- ISB : TImageScrollBox;
-begin
- ISB := TImageScrollBox(Sender);
-
- SetScrollData(ISB,ISB.HorzScrollBar.Position,ISB.VertScrollBar.Position,ISB.ZoomPercent);
- {if (TImageScrollBox(Sender) = MpsViewX1) and SortMode then
- begin
- ReczoomPercent := MpsViewX1.ZoomPercent;
- RecHozPos := MpsViewX1.HorzScrollBarPos;
- RecVerPos := MpsViewX1.VertScrollBarPos;
- end;}
-end;
-
-procedure TCB_IMGPSScanX.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);
- if NowClick<>0 then
- DisplayISB.SetFocus;
- Shape1.Left := TPanel(TImageScrollBox(Sender).Parent).Left - Seg;
- Shape1.Top := TPanel(TImageScrollBox(Sender).Parent).Top - Seg;
- P := strtoint(copy(DisplayISB.Name,4,1)) + ScrollBar1.Position-2;
- if P <= PageLV.Items.Count-1 then
- begin
- NowPage := p+1;
- PageLV.ClearSelection;
- PageLV.ItemIndex := P;
-
- //PageLV.Selected := PageLV.Items.Item[PageLV.ItemIndex];
-
- end;
- if (NowClick = -1) and (Button=TMouseButton(mbLeft)) and (DisplayISB.FileName <> '') then
- begin
- {for P := 1 to 8 do
- begin
- TImageScrollBox(FindComponent('ISB'+inttostr(p))).Enabled := False;
- end; }
- DisplayISB.BeginDrag(True);
- end;
- case TImageScrollBox(Sender).MouseMode of
- mmR90,mmR180,mmR270:
- begin
- TImageScrollBox(Sender).LoadFromFile(TImageScrollBox(Sender).FileName,1);
- end;
- end;
-
-end;
-
-procedure TCB_IMGPSScanX.ISB1ImageMouseMove(Sender: TObject; Shift: TShiftState;
- X, Y: Integer);
-begin
- //Edit1.SetFocus;
- //TImageScrollBox(Sender).SetFocus;
-
- if TImageScrollBox(Sender).FileName = '' then
- TImageScrollBox(Sender).MouseMode := mmUser
- Else
- ViewMouseMode(NowClick);
-
- ISB1.AlwaysShowAnnotations := False;
-
-// if TImageScrollBox(Sender).FileName = '' then
-// begin
-////ShowMessage('AAA');
-//Label3.Caption:='FileName='+TImageScrollBox(Sender).FileName+' time='+FormatDateTime('yyyy/mm/dd HH:MM:SS', now);
-// TImageScrollBox(Sender).MouseMode := mmUser
-// end
-// Else
-// begin
-//Label3.Caption:='FileName='+TImageScrollBox(Sender).FileName;
-// ViewMouseMode(NowClick);
-// end;
-end;
-
-procedure TCB_IMGPSScanX.ISB1ImageMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-Var
- p : Integer;
- ISB : TImageScrollBox;
-begin
- case TImageScrollBox(Sender).MouseMode of
- mmDelete:
- begin
- PM508Click(Self);
- end;
- mmR90,mmR180,mmR270:
- begin
- if TImageScrollBox(Sender).Graphic.ImageFormat <> ifBlackWhite then
- begin
- TJpegGraphic(TImageScrollBox(Sender).Graphic).SaveQuality := 30;
- TJpegGraphic(TImageScrollBox(Sender).Graphic).SaveToFile(TImageScrollBox(Sender).FileName);
- end
- Else
- TImageScrollBox(Sender).SaveToFile(TImageScrollBox(Sender).FileName);
-
- SelectISB.Graphic.Assign(TImageScrollBox(Sender).Graphic);
- SelectISB.Redraw(True);
- FitPreViewISB;
- ISBClick(SelectISB);
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- end;
- end;
-
- ISB := TImageScrollBox(Sender);
- if (ISB.MouseMode = mmZoom) or (ISB.MouseMode = mmDrag) then
- SetScrollData(ISB,ISB.HorzScrollBar.Position,ISB.VertScrollBar.Position,ISB.ZoomPercent);
-
-end;
-
-function TCB_IMGPSScanX.Get_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; //案件裡的檔案清單
- AttContextList.Free; //案件裡的附加檔案清單
- NowShowFileList.Free; //目前顯示的影像清單
- NowSelectFileList.Free; //目前被點選的影像清單
- Cust_DocNoList.Free; //自行定義文件名稱
- IN_WH_DocNoList.Free; //入庫的文件清單
- GuideFormIDList.Free; //要當導引頁表單清單
- DivPageFormIDList.Free; //要當分案頁表單清單
- LastInitFormidList.Free;
- LastAddFormidList.Free;
- SampleFormIDList.Free;
- ExistImgList.Free;
- reSizeExistImgList.Free;
- //********清單區********
- if (FMode = 'DSCAN') or (FMode = 'ESCAN') then //重掃件及異動件要只能掃指定編號的件
- begin
- if ImagePath<>'' then
- _Deltree(ImagePath);
- end;
-
- if FEvents <> nil then FEvents.OnDestroy;
-end;
-
-procedure TCB_IMGPSScanX.KeyPressEvent(Sender: TObject; var Key: Char);
-var
- TempKey: Smallint;
-begin
- TempKey := Smallint(Key);
- if FEvents <> nil then FEvents.OnKeyPress(TempKey);
- Key := Char(TempKey);
-end;
-
-procedure TCB_IMGPSScanX.mode1Click(Sender: TObject);
-begin
- VMode := 0;
- GoViewMode;
- //ScrollBar1Change(Self);
- Panel14.Visible := False;
-end;
-
-procedure TCB_IMGPSScanX.mode2Click(Sender: TObject);
-begin
- VMode := 1;
- GoViewMode;
- //ScrollBar1Change(Self);
- Panel14.Visible := True;
-end;
-
-procedure TCB_IMGPSScanX.mode3Click(Sender: TObject);
-begin
- VMode := 2;
- GoViewMode;
- ScrollBar1Change(Self);
-end;
-
-procedure TCB_IMGPSScanX.mode4Click(Sender: TObject);
-begin
- VMode := 3;
- GoViewMode;
- ScrollBar1Change(Self);
-end;
-
-procedure TCB_IMGPSScanX.MouseEnterEvent(Sender: TObject);
-begin
- if FEvents <> nil then FEvents.OnMouseEnter;
-end;
-
-procedure TCB_IMGPSScanX.MouseLeaveEvent(Sender: TObject);
-begin
- if FEvents <> nil then FEvents.OnMouseLeave;
-end;
-
-procedure TCB_IMGPSScanX.PaintEvent(Sender: TObject);
-begin
- if FEvents <> nil then FEvents.OnPaint;
-end;
-
-procedure TCB_IMGPSScanX.Set_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;
- ST1 :TStringList;
-begin
- PreNode2Name := '';
- ST1:=TStringList.Create;
- if TreeView1.Selected.Parent = MyTreeNode1 then
- PreNode2Name:= GetNode2Name(MyTreeNode2);
- ShowText := _Msg('文件歸類中,請稍候');
-LogFile1.LogToFile(logTimeString+'縮圖 歸類開始');
- DataLoading(True,True);
- GoAtt := False;
- if (MytreeNode2 <> nil) and (Pos('Attach',MyTreeNode2.Text)>0) then
- begin
- AttLv := TreeView1.Selected.Level;
- GoAtt := True;
- end;
- DocListForm := TDocListForm.Create(self);
- try
- InitialLanguage(DocListForm); //載入多國語言
- //InitialLanguage(PatchDlg); //載入多國語言
- DocListForm.CheckBox1.Visible:=False;
- for i := 1 to FORM_INF_List.Count - 1 do
- begin
- FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i);
- FormName := GetSQLData(FORM_INF_List,'T1.FORM_DESC',i);
- DocNo := GetSQLData(FORM_INF_List,'T1.DOC_NO',i)+GetSQLData(FORM_INF_List,'T1.DOC_VERSION',i);
- if not FormIDAppear(FormID) then Continue; //20170816 先秀全部
-
- //Showmessage(FORM_INF_List.Text);
- //showmessage(inttostr(FORM_INF_List.Count)+#13+inttostr(self.Doc_Inf_List.Count));
- if (FormID <> FileName2FormCode(DisplayISB.FileName)) and FormIDExists(FormID,False,i) then
- begin
- DocListForm.FormIDList.Add(FormID+'#@#'+FormName);
- With DocListForm.DocLV.Items.Add do
- begin
- Caption := FormID;
- SubItems.Add(FormName);
- end;
- end;
- end;
- if DocListForm.ShowModal = mrOk then
- begin
- for i := 0 to ComponentCount -1 do
- begin
- if (Components[i] is TShape) and (copy(Components[i].Name,1,2)='SP') then
- begin
- iISBName := ShapeName2PreViewISBName(TShape(Components[i]));
- iISB := TImageScrollBox(FindComponent(iISBName));
- OldName := ExtractFileName(iISB.FileName);
- Ext := ExtractFileExt(OldName);
-
- if DocListForm.CheckBox1.Checked then
- begin
- FormID := DocListForm.Edit1.Text;
- DocNo := GetNewCustomDocNo(DisplayPath,FormID);
- end
- else
- begin
- FormID := DocListForm.DocLV.Selected.Caption;
- DocNo := FormCode2DocNo(FormID);
- end;
-
-
- if DocNoDir2DocNo(Path2DocDir(ExtractFilePath(iISB.FileName),NowCaseno)) = DocNo then
- DocDir := Path2DocDir(ExtractFilePath(iISB.FileName),NowCaseNo)
- Else
- DocDir := FindLastestDocDir(NowCaseno,DocNo);
-
-//ShowMessage('DocNoNeedDiv(DocNo)='+BoolToStr(DocNoNeedDiv(DocNo),true));
-//ShowMessage('DocDir='+DocDir);
-
- if DocNoNeedDiv(DocNo) then //要分份數
- begin
- if ((FormCode2Page(FormID) = '01') and (GetDocDir_Page(NowCaseno,DocDir)>0)) or (DocDir = '') then
- begin
- DocDir := DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',DocNo);
- end
- else
- begin //20171016 真對補件影響 所加的判斷
- ST1.Clear;
- if FileExists(ImageSavePath + NowCaseno+'\'+DocDir+'\Context.dat') then
- begin
- ST1.LoadFromFile(ImageSavePath + NowCaseno+'\'+DocDir+'\Context.dat');
- if (ST1.Count > 0) and ISExistImg(ImageSavePath + NowCaseno+'\'+DocDir+'\'+ST1.Strings[0]) then //20181210 多增加判斷ST1>0 否則會有機會出現List out of bound Hong
- begin
- DocDir := DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',DocNo);
- end;
- end;
- end;
- end
- Else //不分份數
- begin
- if DocNo <> '' then
- DocDir := DocNo
- else //Attach 附件
- DocDir := DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',DocNo);
- end;
- if (not DirectoryExists(ImageSavePath + NowCaseno+'\'+DocDir+'\')) and (DocDir <> AttName) then
- SetDocNoList('A',-1,NowCaseno,DocDir,'1');
-
- {if DocDir = '' then
- begin
- DocDir := DocNo;
- if DocNoNeedDiv(DocNo) then
- DocDir:=DocNo2DocNoDir(ImageSavePath+NowCaseno+'\',DocNo);
- SetDocNoList('A',-1,NowCaseno,DocDir);
- end; }
-LogFile1.LogToFile(logTimeString+'縮圖 FormID='+FormID);
- if Not DirectoryExists(ImageSavePath+NowCaseno+'\'+DocDir) then
- Mkdir(ImageSavePath+NowCaseno+'\'+DocDir);
- ContextList.Clear;
- if FileExists(ImageSavePath+NowCaseno+'\'+DocDir+'\Context.dat') then
- ContextList.LoadFromFile(ImageSavePath+NowCaseno+'\'+DocDir+'\Context.dat');
- NewName := Add_Zoo(ContextList.Count+1,3)+'_'+FormID+Ext;
- CopyFile(PWideChar(iISB.FileName),PwideChar(ImageSavePath+NowCaseno+'\'+DocDir+'\'+NewName),False);
- {ContextList.Add(NewName);
- ContextList.SaveToFile(ImageSavePath+NowCaseno+'\'+DocDir+'\Context.dat'); }
- SetContextList('A',-1,NowCaseNo,DocDir,NewName);
- DeleteImageFile(ExtractFilePath(iISB.FileName),ExtractFileName(iISB.FileName),NowCaseNo);
- //RenameFile(iISB.FileName,ImageSavePath+NowCaseno+'\'+DocDir+'\'+NewName);
- //ReNameContext(iISB.FileName,OldName,NewName);
- end;
- end;
-//ShowMessage('KKKK');
- ReSortFileName(ExtractFilePath(iISB.FileName));
- DrawDocItem2(MytreeNode1,NowCaseno);
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
-
- if GoAtt then
- begin
- GotoAttach(AttLv);
- end;
- TreeView1click(self);
-
- end;
- finally
- DataLoading(False,False);
- DocListForm.Free;
- ST1.Free;
- end;
-
-end;
-
-procedure TCB_IMGPSScanX.PM602Click(Sender: TObject);
-var
- FileList:TStringlist;
- SavePath : String;
- DocDir : String;
- CustomDocName : String;
- CustomDocNo : String;
- i : Integer;
- OldName,NewName,Ext : String;
- FormID,FormName,DocNo : String;
- PreNode2Name : String;
- iFormID : String;
- iISBName : String;
- iISB : TImageScrollBox;
- GoAtt : Boolean;
- AttLv : Integer;
-begin
- GoAtt := False;
- if (MytreeNode2 <> nil) and (Pos('Attach',MyTreeNode2.Text)>0) then
- begin
- AttLv := TreeView1.Selected.Level;
- GoAtt := True;
- end;
-
- if InputQuery(_Msg('輸入其他文件名稱'),_Msg('文件名稱'),CustomDocName) then
- begin
- if FindCustomDocName(DisplayPath,CustomDocName) then
- begin
- Showmessage(Format(_Msg('文件名稱:"%s"己存在'),[CustomDocName]));
- Exit;
- end;
- CustomDocNo := GetNewCustomDocNo(DisplayPath,CustomDocName);
- end;
- if CustomDocNo = '' then Exit;
- DocDir := CustomDocNo;
-LogFile1.LogToFile(logTimeString+'縮圖 歸類自訂文件 DocDir='+DocDir);
- SavePath := ImageSavePath+NowCaseNo+'\'+DocDir+'\';
- Str2Dir(SavePath);
- SetDocNoList('A',-1,NowCaseNo,DocDir,'1');
- FileList := TStringlist.Create;
- try
- FileList.Clear;
- if FileExists(SavePath+'Context.dat') then
- FileList.LoadFromFile(SavePath+'Context.dat');
-
- for i := 0 to ComponentCount -1 do
- begin
- if (Components[i] is TShape) and (copy(Components[i].Name,1,2)='SP') then
- begin
- iISBName := ShapeName2PreViewISBName(TShape(Components[i]));
- iISB := TImageScrollBox(FindComponent(iISBName));
- OldName := ExtractFileName(iISB.FileName);
- Ext := ExtractFileExt(OldName);
- NewName := Add_Zoo(FileList.Count+1,3)+'_'+GetCustomFormID(ImageSavePath+NowCaseNo+'\',CustomDocNo)+ext;
-
- //Showmessage(iISB.FileName+#13+ImageSavePath+NowCaseno+'\'+DocDir+'\'+NewName);
- CopyFile(PWideChar(iISB.FileName),PwideChar(ImageSavePath+NowCaseno+'\'+DocDir+'\'+NewName),False);
- SetContextList('A',-1,NowCaseno,DocDir,NewName);
- FileList.Add(NewName);
- {FileList.Add(NewName);
- FileList.SaveToFile(ImageSavePath+NowCaseno+'\'+DocDir+'\Context.dat');}
- DeleteImageFile(ExtractFilePath(iISB.FileName),ExtractFileName(iISB.FileName),NowCaseNo);
- end;
- end;
- finally
- FileList.Free;
- end;
- ReSortFileName(ExtractFilePath(iISB.FileName));
- DrawDocItem2(MytreeNode1,NowCaseno);
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
-
- if GoAtt then
- begin
- GotoAttach(AttLv);
- end;
- TreeView1click(self);
- MyTreeNode1.Expand(True);
-end;
-
-procedure TCB_IMGPSScanX.PM604Click(Sender: TObject);
-var
- i : Integer;
- iISBName : String;
- iISB : TImageScrollBox;
-begin
- //Showmessage(inttostr(ComponentCount));
- for i := 0 to ComponentCount -1 do
- begin
- if (Components[i] is TShape) and (copy(Components[i].Name,1,2)='SP') then
- begin
- //Showmessage(Components[i].Name);
- iISBName := ShapeName2PreViewISBName(TShape(Components[i]));
- iISB := TImageScrollBox(FindComponent(iISBName));
- DeskewImg(iISB.Graphic);
- iISB.Redraw(True);
- iISB.SaveToFile(iISB.FileName);
- DisplayISB.LoadFromFile(DisplayISB.FileName,1);
- end;
- end;
- //TreeView1Click(nil);
-end;
-
-procedure TCB_IMGPSScanX.PM605Click(Sender: TObject);
-var
- i : Integer;
- iISBName,OldName : String;
- iISB : TImageScrollBox;
-begin
- if MessageDlg(_Msg('是否確定刪除??'),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit;
-
- for i := 0 to ComponentCount -1 do
- begin
- if (Components[i] is TShape) and (copy(Components[i].Name,1,2)='SP') then
- begin
- //Showmessage(Components[i].Name);
- iISBName := ShapeName2PreViewISBName(TShape(Components[i]));
- iISB := TImageScrollBox(FindComponent(iISBName));
-//ShowMessage('iISB.FileName='+iISB.FileName);
-//ShowMessage(ExtractFilePath(iISB.FileName)+','+ExtractFileName(iISB.FileName)+','+NowCaseNo);
-// if (FMode = 'ESCAN') and (FModeName<>'異動件') then
-// begin
-// if ISExistImg(iISB.FileName) then
-// begin
-// ShowMessage(_Msg('此圖為非當次掃瞄，不可刪除'));
-// Exit;
-// end;
-// end;
-LogFile1.LogToFile(logTimeString+'縮圖刪除 iISB.FileName='+iISB.FileName);
- DeleteImageFile(ExtractFilePath(iISB.FileName),ExtractFileName(iISB.FileName),NowCaseNo);
- end;
- end;
-//ShowMessage('iISB.FileName='+iISB.FileName);
- ReSortFileName(ExtractFilePath(iISB.FileName));
- DrawDocItem2(MytreeNode1,NowCaseno);
- MyTreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]);
- NewTreeNodeRefresh;
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- TreeView1click(self);
-end;
-
-procedure TCB_IMGPSScanX.N1Click(Sender: TObject);
-var
- mp:string;
-begin
- mp := InputBox(_Msg('移動頁數'),_Msg('請輸入移入頁碼'),'');
- if (mp <> '') then
- begin
- MoveImage(DisplayPath+NowDocDir+'\',strtoint(mp));
- end;
-end;
-
-procedure TCB_IMGPSScanX.N51Click(Sender: TObject);
-begin
- VMode := 4;
- GoViewMode;
- ScrollBar1Change(Self);
-end;
-
-procedure TCB_IMGPSScanX.NewScanBtnClick(Sender: TObject);
-begin
- IF not InitialOk Then
- begin
- Showmessage(_msg('資訊尚未下載完成,請稍候或重新進入'));
- Exit;
- end;
-LogFile1.LogToFile(logTimeString+'掃瞄開始');
- if (FMode = 'RSCAN') or (FMode = 'ESCAN') or (FMode = 'DSCAN') then
- begin
- if NewTreeNode.Count > 0 then
- begin
- TreeView1.Selected := NewTreeNode.Item[0];
- TreeView1click(nil);
- FirstDocDir := '';
- NowGuideFormID := '';
- NowDivPageFormID :='';
- AddScanBtnclick(nil);
- end;
- end
- Else
- begin
- TreeView1.Selected := NewTreeNode;
- NewTreeNode.Expand(False);
- TreeView1Click(self);
- Panel1.Enabled := False;
- Panel2.Enabled := False;
- ScanMode := smNew;
- ScanInfo.ImageCount := 0;
- ScanPath := '';
- ScanCaseno := '';
- NowGuideFormID := '';
- NowDivPageFormID :='';
- ClearView(1);
- ContextList.Clear;
- Try
- StatrTwainScan;
-LogFile1.LogToFile(logTimeString+'掃瞄結束');
- Except
- Panel1.Enabled := True;
- Panel2.Enabled := True;
- end;
- Panel1.Enabled := True;
- Panel2.Enabled := True;
- LoadImgFile;
- end;
-end;
-
-procedure TCB_IMGPSScanX.NextPageBtnClick(Sender: TObject);
-var
- page : Integer;
-begin
- {page := ScrollBar1.Position;
- Case Vmode of
- 0 : Inc(page);
- 1 : Page := Page + 2;
- 2 : Page := Page + 4;
- 3 : Page := Page + 6;
- 4 : Page := Page + 8;
- end;
- IF page <= ScrollBar1.Max Then
- begin
- ScrollBar1.Position := page;
- end;}
- if selectISB = nil then Exit;
- NextPage(SelectPage);
- if SelectISB.Parent.Top+SelectISB.Parent.Height+4 > scrollBox1.Height then
- ScrollBox1.VertScrollBar.Position := scrollBox1.VertScrollBar.Position + (SelectISB.Parent.Top+SelectISB.Parent.Height-ScrollBox1.Height+8);
-
-end;
-
-procedure TCB_IMGPSScanX.OptionBtnClick(Sender: TObject);
-var
- PatchDlg : TPatchDlg;
- i : Integer;
-begin
- IF not InitialOk Then
- begin
- Showmessage(_msg('資訊尚未下載完成,請稍候或重新進入'));
- Exit;
- end;
- ShowText := _Msg('掃瞄參數設定中,請稍候');
- DataLoading(True,True);
-
- PatchDlg := TPatchDlg.Create(self);
- try
- InitialLanguage(PatchDlg); //載入多國語言
- PatchDlg.BlankuseCB.Checked := DeviceDelete;
- if PatchDlg.BlankuseCB.Checked then
- PatchDlg.SpinEdit5.Enabled := True
- else
- PatchDlg.SpinEdit5.Enabled := False;
- PatchDlg.SpinEdit5.Value := DeviceDeleteSize;
- For i := 0 to PatchDlg.ComboBox1.Items.Count -1 do
- begin
- If inttostr(ScanDpi) = PatchDlg.ComboBox1.Items.Strings[i] Then
- PatchDlg.ComboBox1.ItemIndex := i;
- end;
- PatchDlg.DuplexCB.Checked := ScanDuplex;
- PatchDlg.ReverseCB.Checked := ScannerReverse;
- PatchDlg.BorderCB.Checked := BoardClear;
- PatchDlg.DeskewCB.Checked := ScanDeskew;
- PatchDlg.ImgSetUseCB.Checked := ScanImgSetUse;
- PatchDlg.SpinEdit1.Value := ScanBright;
- PatchDlg.SpinEdit2.Value := ScanContrast;
- case ScanRotate of
- 0 : PatchDlg.ScanRotateRG.ItemIndex := 0;
- 270 : PatchDlg.ScanRotateRG.ItemIndex := 1;
- 180 : PatchDlg.ScanRotateRG.ItemIndex := 2;
- 90 : PatchDlg.ScanRotateRG.ItemIndex := 3;
- end;
- Case ScanImgShowMode of
- 0 : PatchDlg.ScanShowRG.ItemIndex := 0;
- 1 : PatchDlg.ScanShowRG.ItemIndex := 1;
- 2 : PatchDlg.ScanShowRG.ItemIndex := 2;
- end;
- If PatchDlg.ShowModal = mrOk then
- begin
- DeviceDelete := PatchDlg.BlankuseCB.Checked;
- DeviceDeleteSize := PatchDlg.SpinEdit5.Value;
- ScanDpi := Strtoint(PatchDlg.ComboBox1.Text);
- ScannerReverse := PatchDlg.ReverseCB.Checked;
- BoardClear := PatchDlg.BorderCB.Checked;
- ScanDeskew := PatchDlg.DeskewCB.Checked;
- ScanDuplex := PatchDlg.DuplexCB.Checked;
- ScanImgSetUse := PatchDlg.ImgSetUseCB.Checked;
- ScanBright := PatchDlg.SpinEdit1.Value;
- ScanContrast := PatchDlg.SpinEdit2.Value;
- Case PatchDlg.ScanRotateRG.ItemIndex of
- 0:ScanRotate := 0;
- 1:ScanRotate := 270;
- 2:ScanRotate := 180;
- 3:ScanRotate := 90;
- end;
- Case PatchDlg.ScanShowRG.ItemIndex of
- 0:ScanImgShowMode := 0;
- 1:ScanImgShowMode := 1;
- 2:ScanImgShowMode := 2;
- end;
- R_W_ScanIni('W');
- ScanDuplexCB.Checked := ScanDuplex;
- end;
- finally
- PatchDlg.Free;
- DataLoading(False,False);
- end;
-end;
-
-procedure TCB_IMGPSScanX.PageLVClick(Sender: TObject);
-begin
- IF PageLV.Selected = nil Then Exit;
- PageLVclear := False;
- ScrollBar1.Position := PageLV.Selected.Index+1;
- PageLVclear := True;
-end;
-
-procedure TCB_IMGPSScanX.PageLVKeyUp(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-begin
- IF PageLV.Selected = nil Then Exit;
- ScrollBar1.Position := PageLV.Selected.Index+1;
-end;
-
-procedure TCB_IMGPSScanX.PageLVMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-begin
- IF Button = TMouseButton(MbRight) Then
- begin
- If PageLV.GetItemAt(X,Y) = nil then Exit;
- PageLV.Selected := PageLV.GetItemAt(X,Y);
- PageLVClick(self);
- PageLV.PopupMenu.Popup(Mouse.CursorPos.X ,Mouse.CursorPos.Y);
- end;
-end;
-
-procedure TCB_IMGPSScanX.Panel11DblClick(Sender: TObject);
-begin
- // Button3.Visible := not Button3.Visible;
- //Button4.Visible := not Button4.Visible;
- //self.FCustDocYN := 'N';
-end;
-
-procedure TCB_IMGPSScanX.Panel1DblClick(Sender: TObject);
-begin
- Button1.Visible := not Button1.Visible;
- Button2.Visible := not Button2.Visible;
-end;
-
-procedure TCB_IMGPSScanX.Panel9Resize(Sender: TObject);
-begin
- GoViewMode;
-end;
-
-procedure TCB_IMGPSScanX.PM101Click(Sender: TObject);
-var
- P,v,v1,v2,ln,i : Integer;
- iDocDir,iDocNo : String;
-begin
-LogFile1.LogToFile(logTimeString+'Tree 按下刪除');
- if TreeView1.Selected = NewTreeNode then //全刪 //新掃描件
- begin
-LogFile1.LogToFile(logTimeString+'Tree 全部刪除');
- If Messagedlg(_Msg('是否刪除所有案件?'),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit;
- clearView(1);
- Application.ProcessMessages;
- _DelTree(ImageSavePath);
- if (FMode = 'ESCAN') then
- begin
- MkDir(ImageSavePath+FCaseID);
- CreateEmptyCase(ImageSavePath,FCaseID);
- end;
- LoadImgFile;
- Showmessage(_Msg('刪除完成'));
- end
- Else if TreeView1.Selected = MyTreeNode1 then //案件編號
- begin
-LogFile1.LogToFile(logTimeString+'Tree 案件編號刪除 NowCaseno='+NowCaseno);
- If Messagedlg(Format(_Msg('編號(%s)是否刪除?'),[NowCaseno]),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit;
- clearView(1);
- Application.ProcessMessages;
- if (FMode = 'ESCAN') then
- begin
- for i := 0 to MyTreeNode1.Count - 1 do
- begin
- MyTreenode2 := MyTreeNode1.Item[i];
- v := Posend('{',MyTreenode2.Text);
- v1 := Posend('}',MyTreenode2.Text);
- v2 := posend('-',MyTreenode2.Text);
- ln := length(MyTreenode2.Text);
- iDocDir := Copy(MyTreeNode2.Text,v+1,v1-v-1);
- iDocNo := DocNoDir2DocNo(iDocDir);
- _DelTree(ImageSavePath+NowCaseno+'\'+iDocDir);
- SetUseCase('D',ImageSavePath+NowCaseno+'\',iDocDir,'','');
- SetDocNoList('D',-1,NowCaseNo,iDocDir,'');
- if (Copy(iDocNo,1,5)='ZZZZZ') then //20140703 刪除自定文件時要刪ini檔資料
- DeleteCustomDocDir(ImageSavePath+NowCaseno+'\',iDocDir);
-
- end
- end
- Else
- begin
- _DelTree(DisplayPath);
- SetCaseList('D',NewTreeNode.IndexOf(MyTreeNode1),'');
- end;
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
-
- if (FMode = 'ESCAN') then
- begin
- if not DirectoryExists(ImageSavePath+FCaseID) then
- begin
- MkDir(ImageSavePath+FCaseID);
- CreateEmptyCase(ImageSavePath,FCaseID);
- end;
- end;
- LoadImgFile;
- end
- Else if TreeView1.Selected = MyTreeNode2 then //文件層
- begin
- If Messagedlg(Format(_Msg('文件(%s)是否刪除?'),[DocNo2DocName(NowCaseno,NowDocNo)]),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit;
- ClearView(1);
- Application.ProcessMessages;
-//ShowMessage(NowDocDir);
-LogFile1.LogToFile(logTimeString+'Tree 文件層號刪除 NowDocDir='+NowDocDir);
- if (Length(NowDocDir)=8) or (NowDocDir=AttName) then
- begin
-//ShowMessage('DeleteDocNoFileForESCAN');
- DeleteDocNoFileForESCAN(ImageSavePath+NowCaseno+'\'+NowDocDir,NowDocDir);
- end
- else
- begin
- _DelTree(ImageSavePath+NowCaseno+'\'+NowDocDir);
- SetDocNoList('D',-1,NowCaseNo,NowDocDir,'');
- end;
- SetUseCase('D',ImageSavePath+NowCaseno+'\',NowDocDir,'','');
-
- if (Copy(NowDocNo,1,5)='ZZZZZ') then //20140703 刪除自定文件時要刪ini檔資料
- DeleteCustomDocDir(ImageSavePath+NowCaseno+'\',NowDocDir);
-
- DrawDocItem2(MytreeNode1,NowCaseno);
- MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]);
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- NewTreeNodeRefresh;
-
- end
- Else if TreeView1.Selected = MyTreeNode3 then //FormID層
- begin
- If Messagedlg(Format(_Msg('文件(%s)是否刪除?'),[NowFormName]),mtconfirmation,[mbyes,mbcancel],0) = mrcancel then Exit;
-LogFile1.LogToFile(logTimeString+'Tree FormID層號刪除 NowFormCode='+NowFormCode);
- DeleteFormCodeFile(NowCaseNo,NowDocDir,NowFormCode);
- SetRecordEditedDocDir('A',NowCaseNo,NowDocDir);
- DrawDocItem2(MytreeNode1,NowCaseno);
- MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]);
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- NewTreeNodeRefresh;
-
- end;
-end;
-
-function TCB_IMGPSScanX.DocNoIsExistImg(DocNopath:String):boolean;
-var
- i:integer;
- ST:TStringList;
-begin
- Result:=False;
- ST:=TStringList.Create;
- if FileExists(DocNopath+'\Context.dat') then /////20190319 Hong 當有空的Docno目錄時會掛掉,增加這行
- ST.loadFromfile(DocNopath+'\Context.dat');
- for I := 0 to ST.Count - 1 do
- begin
- if ISExistImg(DocNopath+ST.Strings[i]) then
- begin
-
- Result:=False;
- Exit;
- Break;
- end;
- end;
- Result:=True;
-
-
-end;
-
-procedure TCB_IMGPSScanX._DelTreeForExistImg(ASourceDir:String);
-var
- i:integer;
- ST:TStringList;
-begin
-
-end;
-
-procedure TCB_IMGPSScanX.PM102Click(Sender: TObject);
-var
- NewCaseID,ShowNewCaseID,ShowNowCaseID : String;
- i,P,v : Integer;
- InputOk : Boolean;
-begin
- VMode := 0;
- GoViewMode;
- ISB1.ZoomMode := zmFitWidth;
-
- NewCaseID := InputBox(_Msg('修改案件編號'),_Msg('新案件編號'),'');
- ShowNewCaseID := NewCaseID;
- ShowNowCaseID := NowCaseno;
-
- if NewCaseID = '' then Exit;
-
- IF Length(NewCaseID)<>CaseIDLength Then
- begin
- Showmessage(_Msg('輸入格式錯誤'));
- Exit;
- end;
-
- if DirectoryExists(ImageSavePath+NewCaseID) then
- begin
- Showmessage(NewCaseID+_Msg('己存在,無法修改'));
- Exit;
- end;
-
- if Messagedlg(Format(_Msg('是否將%s改為%s'),[ShowNowCaseID,ShowNewCaseID]),Mtconfirmation,[mbyes,mbcancel],0) = mrcancel then
- Exit;
- ClearView(1);
- RenameFile(ImageSavePath+NowCaseno,ImageSavePath+NewCaseID);
- SetCaseList('E',NewTreeNode.IndexOf(MyTreeNode1),NewCaseID);
-
- //P := ContextList.Count;
- MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NewCaseID,GetCasePage(ImageSavePath,NewCaseID)]);
- //DrawDocItem(MyTreeNode1,FORM_INF_List,NewCaseID);
- DrawDocItem2(MytreeNode1,NewCaseID);
- Showmessage(_Msg('修改完成'));
-end;
-
-procedure TCB_IMGPSScanX.PM103Click(Sender: TObject);
-begin
- if TreeView1.Selected = nil then Exit;
-
- {if Treeview1.Selected = NewTreeNode then
- begin
- ShowMessage('AAAAA');
- end;
- if Treeview1.Selected = MyTreeNode1 then
- begin
- ShowMessage('BBBBB');
- end;
-
- if Treeview1.Selected = MyTreeNode2 then
- begin
- ShowMessage('CCCCC');
- end;
-
- if Treeview1.Selected = MyTreeNode3 then
- begin
- ShowMessage('DDDDD');
- end;
- }
- if (Treeview1.Selected = NewTreeNode) {or (Treeview1.Selected = MyTreeNode1)} then
- begin
-//ShowMessage('NewScanBtnClick');
-LogFile1.LogToFile(logTimeString+'Tree NewScanBtnClick');
- NewScanBtnClick(self)
- end
- Else
- begin
-//ShowMessage('AddScanBtnclick');
-LogFile1.LogToFile(logTimeString+'Tree AddScanBtnclick');
- AddScanBtnclick(self);
- end;
-end;
-
-
-Procedure TCB_IMGPSScanX.PM104Click(Sender: TObject);
-Var
- i, n, m, ii, P, v, v1, page, imageCount: Integer;
- FName: String;
- CaseID, DocNo, FormID: String;
- DocDir: String;
- SavePath, SaveFilename: String;
- ISB: TImageScrollBox;
- FileRec: TSearchrec;
-
- iGraphic, iGraphic_First, iGraphic_sec: TTiffGraphic;
- iRect : TRect;
- JpgGr : TJpegGraphic;
- SaveStream : TFileStream;
- SaveStreamA:TFileStream;
- SaveStreamB:TFileStream;
- cooom:integer;
-Begin
- OpenDialog1.Filter := 'Image files|*.TIF;*.JPG';
- If OpenDialog1.Execute Then
- Begin
- ISB := TImageScrollBox.Create(self);
-try
- ShowText := _Msg('檔案加入中,請稍候');
-LogFile1.LogToFile(logTimeString+'檔案加入中開始');
- DataLoading(True, True);
- If TreeView1.Selected = Nil Then
- Exit;
- FName := OpenDialog1.FileName;
-
- FindFirst(FName, faAnyfile, FileRec);
-
- If FFileSizeLimit = 0 Then
- Begin
- FFileSizeLimit := 5 * 1024;
- End;
-//FFileSizeLimit:=20*5*1024;
-//ShowMessage(IntToStr(FileRec.Size)+','+IntToStr(FFileSizeLimit * 1024));
- If FileRec.Size > FFileSizeLimit * 1024 Then // 檢查檔案大小
- Begin
- ShowMessage(Format(_Msg('目前檔案大小為 %.3f MB,已超過單一檔案匯入限制%1.f MB'),[FileRec.Size / (1024*1024),FFileSizeLimit/1024]));
- {ShowMessage(Format('目前檔案大小為 %.3f MB', [FileRec.Size / (1024*1024)]) +
- '，已超過單一檔案匯入限制'+Format('%.1f',[FFileSizeLimit/1024])+'MB');}
- FindClose(FileRec);
- DataLoading(false, false);
- Exit;
- End;
- //MessageDlg()
- //cooom:=StrToInt(InputBox('輸入百分比','輸入百分比',''));
- cooom:=FJpgCompression;//20171211彩色tif採jpg壓縮的比例
-
- FindClose(FileRec);
- CaseID := NowCaseno;
- imageCount := 0;
- P := ISB.ImageCountFromFile(OpenDialog1.FileName);
- For i := 1 To P Do
- Begin
- ShowText := Format(_Msg('檔案加入中,請稍候(%d/%d)'),[i,p]);
- //ShowText := _Msg('檔案加入中,請稍候')+'(' + inttostr(i) + '/' + inttostr(P) + ')';
- DataLoading(True, True);
- ISB.LoadFromFile(FName, i);
- DeskewImg(ISB.Graphic);
-
-
- ISB_BW.Graphic.Assign(ISB.Graphic); //20180104
- If ISB.Graphic.ImageFormat <> ifBlackWhite Then //20180104
- begin
- ConvertToBW(ISB_BW.Graphic);
- end;
- ///ISB_BW.SaveToFile('KKKKKKKK.tif');
-
- iGraphic_First := TTiffGraphic.Create;
- iGraphic_sec := TTiffGraphic.Create;
-
-
- //ShowMessage(IntToStr(iGraphic_First.Palette.palNumEntries)); //彩色 會為0 黑白 為2
-
- MpsGetBarcode(ISB_BW.Graphic, MpsBarcodeinf); //判斷A3 有用FormID 所以要先辨條碼
- For n := 1 To MpsBarcodeinf.Count Do
- Begin
- If (MpsBarcodeinf.r180[n] <> 0) and (Length(MpsBarcodeinf.Text[n])=FormIDLength) Then // 依條碼角度轉影像
- Begin
- Rotate(ISB.Graphic, MpsBarcodeinf.r180[n]);
- //MpsGetBarcode(iGraphic_First, MpsBarcodeinf);
- Break;
- End;
- End;
-
- iGraphic_First.Assign(ISB.Graphic);
- //有必要的話先把影像轉正 再開始切圖
- If CheckNeedCrop(iGraphic_First) Then
- Begin
- // 先取右邊的影像
- iRect.Left := ISB.Graphic.Width Div 2;
- iRect.Right := ISB.Graphic.Width;
- iRect.Top := 0;
- iRect.Bottom := ISB.Graphic.Height;
- CropImg(iGraphic_First, iRect);
-
- iGraphic_sec.Assign(ISB.Graphic);
- // 再取左邊的影像
- iRect.Left := 0;
- iRect.Right := ISB.Graphic.Width Div 2;
- iRect.Top := 0;
- iRect.Bottom := ISB.Graphic.Height;
- CropImg(iGraphic_sec, iRect);
- End;
- ISB.Graphic.Clear; //20220711 Hong 覺得ISB後面沒有到了,先清掉減少記憶體使用
- iGraphic := iGraphic_First;
-
- While Not iGraphic.IsEmpty Do
- Begin
- If (TreeView1.Selected = NewTreeNode) Or
- (TreeView1.Selected = MyTreeNode1) Then
- Begin
- SaveFilename := '';
- ISB_BW.Graphic.Assign(iGraphic); //20180104
- If iGraphic.ImageFormat <> ifBlackWhite Then //20180104
- begin
- ConvertToBW(ISB_BW.Graphic);
- end;
- MpsGetBarcode(ISB_BW.Graphic, MpsBarcodeinf);
-//ShowMessage(IntToStr(MpsBarcodeinf.Count));
- For n := 1 To MpsBarcodeinf.Count Do
- Begin
- If (MpsBarcodeinf.r180[n] <> 0) and (Length(MpsBarcodeinf.Text[n])=FormIDLength) Then // 依條碼角度轉影像
- Begin
- Rotate(iGraphic, MpsBarcodeinf.r180[n]);
- MpsGetBarcode(ISB_BW.Graphic, MpsBarcodeinf);
- Break;
- End;
- End;
-//ShowMessage('XXX '+IntToStr(MpsBarcodeinf.Count));
- FormID := BarCode2FormID;
-//ShowMessage('FormID='+FormID);
- // 取出FormID
- SaveFilename := FormID;
- If (TreeView1.Selected = NewTreeNode) Then
- Begin
- If FindDivFormCode(FormID) Then // 只找分案頁上的案件條碼
- Begin
- imageCount := 0;
- ClearView(1);
- ContextList.Clear;
- CaseID := BarCode2CaseID;
- If DirectoryExists(ImageSavePath + CaseID + '\') Then
- Begin
- _DelTree(ImageSavePath + CaseID + '\');
- SetCaseList('D', -1, CaseID);
- End;
- End;
- If CaseID = '' Then
- Begin
- CaseID := GetNoNameCase(ImageSavePath);
- ContextList.Clear;
- End;
- End;
- SavePath := ImageSavePath + CaseID + '\';
- Str2Dir(SavePath);
-
- DocNo := FormCode2DocNo(FormID);
- DocDir := FindLastestDocDir(CaseID, DocNo);
- if (FMode='ESCAN') and (FModeName=_Msg('補件掃描')) then
- begin
- DocDir := FindLastestDocDirForPage(CaseID, DocNo,FormID);
-//ShowMessage('DocDir='+DocDir);
- end;
-
- If DocNoNeedDiv(DocNo) Then // 要分份數
- Begin
- If ((FormCode2Page(FormID) = '01') And
- (GetDocDir_Page(CaseID, DocDir) > 0)) Or (DocDir = '') Then
- begin
- DocDir := DocNo2DocNoDir(ImageSavePath + CaseID + '\', DocNo);
- end;
- End
- Else // 不分份數
- Begin
- If DocNo <> '' Then
- DocDir := DocNo
- Else // Attach 附件
- DocDir := DocNo2DocNoDir(ImageSavePath + CaseID + '\', DocNo);
- End;
-
- If (Not DirectoryExists(ImageSavePath + CaseID + '\' + DocDir + '\'))
- And (DocDir <> AttName) Then
- SetDocNoList('A', -1, CaseID, DocDir, '1');
- SavePath := ImageSavePath + CaseID + '\' + DocDir + '\';
- Str2Dir(SavePath);
- ContextList.Clear;
- If FileExists(SavePath + 'Context.dat') Then
- ContextList.LoadFromFile(SavePath + 'Context.dat');
-
- WriteCaseIndex(ImageSavePath + CaseID + '\');
- // 寫入案件索引
- If SaveFilename = '' Then // 附件
- SaveFilename := Add_Zoo(ContextList.Count + 1, 3) + ext
- Else
- SaveFilename := Add_Zoo(ContextList.Count + 1, 3) + '_' +
- SaveFilename + ext;
-
- For n := 1 To MpsBarcodeinf.Count Do
- Begin
- If (MpsBarcodeinf.r180[n] <> 0) and (Length(MpsBarcodeinf.Text[n])=FormIDLength) Then // 依條碼角度轉影像
- Begin
- Rotate(iGraphic, MpsBarcodeinf.r180[n]);
- MpsGetBarcode(ISB_BW.Graphic, MpsBarcodeinf);
- Break;
- End;
- End;
-//ShowMessage(IntToStr(iGraphic.Palette.palNumEntries));
- if iGraphic.ImageFormat = ifBlackWhite then //20200806 出現無法匯入,是因color256無法壓JPEG,待報會後再開啟
- begin
- iGraphic.Compression:=tcGroup4;
- end
- else if iGraphic.ImageFormat= ifColor256 then
- begin
- ConverttoGray(iGraphic);
- iGraphic.Compression:=tcJPEG;
- iGraphic.JpegQuality:=cooom;
- end
- else if (iGraphic.ImageFormat = ifTrueColor) or (iGraphic.ImageFormat = ifGray256) then
- begin
- iGraphic.Compression:=tcJPEG;
- iGraphic.JpegQuality:=cooom;
- end
- else
- begin
- iGraphic.Compression:=tcLZW;
- end;
-
- {if (iGraphic.Palette.palNumEntries = 0) or (iGraphic.Palette.palNumEntries = 256) then //20171130 彩色 會為0 黑白 為2 灰階256 //20200806拿掉
- begin
- iGraphic.Compression:=tcJPEG;
- iGraphic.JpegQuality:=cooom;
- end;}
-
- If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.tif' Then
- Begin
- If FileExists(SavePath + SaveFilename) Then
- SaveStream := TFileStream.Create(SavePath + SaveFilename, fmOpenReadWrite)
- Else
- SaveStream := TFileStream.Create(SavePath + SaveFilename, fmCreate);
- Try
- SaveStream.Seek(0, soFromBeginning);
- iGraphic.AppendToStream(SaveStream);
- Finally
- SaveStream.Free;
- End;
- End
- Else If LowerCase(ExtractFileExt(SavePath + SaveFilename))
- = '.jpg' Then
- Begin
- If FileExists(SavePath + SaveFilename) Then
- DeleteFile(SavePath + SaveFilename);
- // SaveStream := TFileStream.Create( PEFileName ,fmCreate );
- JpgGr := TJpegGraphic.Create;
- Try
- JpgGr.Assign(iGraphic);
- JpgGr.SaveQuality := 30;
- // JpgGr.AppendToStream(SaveStream);
- JpgGr.SaveToFile(SavePath + SaveFilename);
- Finally
- JpgGr.Free;
- // SaveStream.Free;
- End;
- End;
-
- SetContextList('A', -1, CaseID, DocDir, SaveFilename);
- If (TreeView1.Selected = NewTreeNode) Then
- Begin
- If imageCount = 0 Then
- Begin
- SetCaseList('A', -1, CaseID);
- MyTreeNode1 := TreeView1.Items.AddChild(NewTreeNode, CaseID);
- MyTreeNode1.ImageIndex := 2;
- MyTreeNode1.SelectedIndex := 2;
- Application.ProcessMessages;
- End;
- End;
- inc(imageCount);
- // DrawDocItem1(MytreeNode1,Doc_Inf_List,CaseID);
- // DrawDocItem(MyTreeNode1,FORM_INF_List,CaseID);
- End
- Else If TreeView1.Selected = MyTreeNode3 Then
- Begin
- SavePath := ImageSavePath + CaseID + '\' + NowDocDir + '\';
- ContextList.Clear;
- If FileExists(ImageSavePath + CaseID + '\' + NowDocDir +
- '\Context.dat') Then
- ContextList.LoadFromFile(ImageSavePath + CaseID + '\' + NowDocDir +
- '\Context.dat');
- If NowFormCode <> '' Then
- SaveFilename := Add_Zoo(ContextList.Count + 1, 3) + '_' +
- NowFormCode + ext
- Else
- SaveFilename := Add_Zoo(ContextList.Count + 1, 3) + ext;
-
- For n := 1 To MpsBarcodeinf.Count Do
- Begin
- If MpsBarcodeinf.r180[n] <> 0 Then // 依條碼角度轉影像
- Begin
- Rotate(iGraphic, MpsBarcodeinf.r180[n]);
- MpsGetBarcode(iGraphic, MpsBarcodeinf);
- Break;
- End;
- End;
-
- if (iGraphic.Palette.palNumEntries = 0) or (iGraphic.Palette.palNumEntries = 256) then //20171130 彩色 會為0 黑白 為2
- begin
- iGraphic.Compression:=tcJPEG;
- iGraphic.JpegQuality:=cooom;
- end;
-
- If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.tif' Then
- Begin
- If FileExists(SavePath + SaveFilename) Then
- SaveStream := TFileStream.Create(SavePath + SaveFilename,
- fmOpenReadWrite)
- Else
- SaveStream := TFileStream.Create(SavePath + SaveFilename,
- fmCreate);
- Try
- SaveStream.Seek(0, soFromBeginning);
- iGraphic.AppendToStream(SaveStream);
- Finally
- SaveStream.Free;
- End;
- End
-
- Else
- Begin
- If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.jpg' Then
- Begin
- If FileExists(SavePath + SaveFilename) Then
- DeleteFile(SavePath + SaveFilename);
- // SaveStream := TFileStream.Create( PEFileName ,fmCreate );
- JpgGr := TJpegGraphic.Create;
- Try
- JpgGr.Assign(iGraphic);
- JpgGr.SaveQuality := 30;
- // JpgGr.AppendToStream(SaveStream);
- JpgGr.SaveToFile(SavePath + SaveFilename);
- Finally
- JpgGr.Free;
- // SaveStream.Free;
- End;
- End;
-
- End;
- // ISB.SaveToFile(SavePath+SaveFilename);
- ContextList.Add(SaveFilename);
- ContextList.SaveToFile(SavePath + 'Context.dat');
- End;
-
- if iGraphic = iGraphic_First then
- iGraphic := iGraphic_Sec
- else
- iGraphic.Assign(nil);
-
- End //While 結束
-
- End;
- ClearErrini(CaseID, MyTreeNode1);
- // 清掉檢核記錄
- If (TreeView1.Selected = MyTreeNode1) Or
- (TreeView1.Selected = NewTreeNode) Then
- Begin
- LoadImgFile;
- End
- Else
- Begin
- DrawDocItem2(MyTreeNode1, CaseID);
- // 長出文件名稱的樹並傳回是否有申請書的影像
- page := GetCasePage(ImageSavePath, CaseID);
- // ShowMessage('page='+IntToStr(page));
- MyTreeNode1.Text := Format(_Msg('%s-%d頁'), [CaseID, page]);
- End;
- // ShowMessage('AAAA');
- NewTreeNodeRefresh;
- Application.ProcessMessages;
- DataLoading(false, false);
-
-
-finally
-ISB.Free;
-iGraphic_First.Free;
-iGraphic_sec.Free;
-end;
-
-
- End;
-End;
-
-
-
-procedure TCB_IMGPSScanX.PM106Click(Sender: TObject);
-var
- i,n,x,v,v1 : Integer;
- CopyFormID,Copy2Caseno,CopyFileName : String;
- S : TStringlist;
-begin
- ShowText := _Msg('複製文件中,請稍候');
- DataLoading(True,True);
- DocCopyForm := TDocCopyForm.Create(Self);
- S := TStringlist.Create;
- try
- InitialLanguage(DocCopyForm); //載入多國語言
- DocCopyForm.CopyFromGB.Caption := NowCaseno+DocCopyForm.CopyFromGB.Caption;
- IF NewTreenode.Count = 1 Then
- begin
- Showmessage(_Msg('沒有其他可複製的文件'));
- Exit;
- end;
- For i := 0 to MyTreeNode1.Count -1 do
- begin
- v := Pos('-',MyTreeNode1.Item[i].Text);
- v1 := pos('{',MyTreeNode1.Item[i].Text);
- if V1 > 0 then
- begin
- CopyFormID := Copy(MyTreeNode1.Item[i].Text,1,v-1);
- DocCopyForm.CheckListBox1.Items.Add(CopyFormID);
- end;
- end;
- For i := 0 to NewTreenode.Count -1 do
- begin
- v := Posend('-',NewTreeNode.Item[i].Text);
- Copy2Caseno := Copy(NewTreeNode.Item[i].Text,1,v-1);
- IF Copy2Caseno <> NowCaseno Then
- begin
- DocCopyForm.CheckListBox2.Items.Add(Copy2Caseno);
- end;
- end;
-
- if DocCopyForm.ShowModal = mrok then
- begin
- If MessageDlg(_Msg('是否確定要將勾選的文件複製到勾選的編號裡?'),MtConfirmation,[Mbyes,mbcancel],0) = mrCancel Then
- Exit;
- ShowText := _Msg('複製中,請稍候');
- DataLoading(True,True);
- For i := 0 to DocCopyForm.CheckListBox2.Count -1 do
- begin
- IF DocCopyForm.CheckListBox2.Checked[i] Then
- begin
- S.Clear;
- Copy2Caseno := DocCopyForm.CheckListBox2.Items.Strings[i];
- ClearErrini(Copy2Caseno,MyTreeNode1); //清掉檢核記錄
- S.LoadFromFile(ImageSavePath + Copy2Caseno +'\Context.dat');
- For n := 0 to DocCopyForm.CheckListBox1.Count -1 do //文件
- begin
- If DocCopyForm.CheckListBox1.Checked[n] Then
- begin
- //v:= Posend('{',DocCopyForm.CheckContextList.Strings[n]);
- //v1 := Posend('}',DocCopyForm.CheckContextList.Strings[n]);
- //CopyFormID := Copy(DocCopyForm.CheckContextList.Strings[n],1,v-1);
- CopyFormID := DocCopyForm.CheckListBox1.Items.Strings[n];
- IF v = 0 Then
- CopyFormID := '';
- For x := 0 to ContextList.Count -1 do
- begin
- //Showmessage(CopyFormCode);
- //IF CopyFormID <> '' then //有文件代號
- // begin
- if FileName2FormCode(ContextList.Strings[x])=CopyFormID then
- begin
- //CopyFileName := Add_Zoo(S.Count+1,3)+ Copy(ContextList.Strings[x],4,length(ContextList.Strings[x])-3);
- CopyFileName := Add_Zoo(S.Count+1,3)+ FileName2NoQuene_Filename(ContextList.Strings[x]);
- CopyFile(PWideChar(DisplayPath+ContextList.Strings[x]),PWidechar(ImageSavePath + Copy2Caseno+'\'+CopyFileName),False);
- S.Add(CopyFileName);
- S.SaveToFile(ImageSavePath + Copy2Caseno +'\Context.dat');
- end;
- // end
-
- end;
- end;
- end;
-
- end;
- end;
- DataLoading(False,False);
- Showmessage(_Msg('複製完成!!'));
- LoadImgFile;
- end;
- finally
- DocCopyForm.Free;
- DataLoading(False,False);
- S.Free;
- end;
-end;
-
-procedure TCB_IMGPSScanX.PM107Click(Sender: TObject);
-begin
- WNoteBtnClick(nil);
-end;
-
-procedure TCB_IMGPSScanX.PM108Click(Sender: TObject);
-var
- i : Integer;
- DocListForm : TDocListForm;
- OldName,NewName,Ext : String;
- NewFormID,NewFormName,CustomDocNo : String;
-begin
- DocListForm := TDocListForm.Create(self);
- try
-LogFile1.LogToFile(logTimeString+'Tree 歸類開始');
- InitialLanguage(DocListForm); //載入多國語言
- DocListForm.CheckBox1.Visible:=True;
- for i := 1 to FORM_INF_List.Count - 1 do
- begin
- NewFormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i);
- NewFormName := GetSQLData(FORM_INF_List,'T1.FORM_DESC',i);
- if not FormIDAppear(NewFormID) then Continue; //20170816 先秀全部的
- if (NewFormID <> FileName2FormCode(DisplayISB.FileName)) and FormIDExists(NewFormID,False,i) then
- begin
- DocListForm.FormIDList.Add(NewFormID+'#@#'+NewFormName);
- With DocListForm.DocLV.Items.Add do
- begin
- Caption := NewFormID;
- SubItems.Add(GetSQLData(FORM_INF_List,'T1.FORM_DESC',i));
- end;
- end;
- end;
- if DocListForm.ShowModal = mrOk then
- begin
- if not (DocListForm.DocLV.Selected=nil) then
- NewFormID := DocListForm.DocLV.Selected.Caption;
- if DocListForm.CheckBox1.Checked then
- begin
- //歸類到自訂文件
- NewFormID:=DocListForm.Edit1.Text;
-
- if Trim(DocListForm.Edit1.Text)='' then
- begin
- Showmessage(_Msg('未輸入文件名稱'));
- Exit;
- end;
- if FindCustomDocName(DisplayPath,NewFormID) then
- begin
- Showmessage(Format(_Msg('文件名稱:"%s"己存在'),[NewFormID]));
- Exit;
- end;
- if NowFormCode <> AttName then
- begin
- If Messagedlg(Format(_Msg('是否將"%s"的所有影像歸類成"%s"'),[FormCode2FormName(NowCaseNo,NowFormCode),NewFormID]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel Then
- Exit;
- end
- Else
- begin
- If Messagedlg(Format(_Msg('是否將"%s"的所有影像歸類成"%s"'),[_Msg('附件')+MyTreeNode3.Text,FormCode2FormName(NowCaseNo,NewFormID)]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel Then
- Exit;
- end;
- CustomDocNo := GetNewCustomDocNo(DisplayPath,NewFormID);
-//ShowMessage('CustomDocNo='+CustomDocNo);
-LogFile1.LogToFile(logTimeString+'Tree 歸類到自訂文件 CustomDocNo='+CustomDocNo);
- ShowText := _Msg('歸類中,請稍侯');
- DataLoading(True,True);
- FormIDReplace(NowCaseNo,NowDocDir,NowFormCode,CustomDocNo+'010101A');
- end
- else
- begin
- //歸類到既有文件
- if NowFormCode <> AttName then
- begin
- If Messagedlg(Format(_Msg('是否將"%s"的所有影像歸類成"%s"'),[FormCode2FormName(NowCaseNo,NowFormCode),FormCode2FormName(NowCaseNo,NewFormID)]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel Then
- Exit;
- end
- Else
- begin
- If Messagedlg(Format(_Msg('是否將"%s"的所有影像歸類成"%s"'),[_Msg('附件')+MyTreeNode3.Text,FormCode2FormName(NowCaseNo,NewFormID)]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel Then
- Exit;
- end;
- ShowText := _Msg('歸類中,請稍侯');
- DataLoading(True,True);
-//ShowMessage('NowDocDir='+NowDocDir);
-LogFile1.LogToFile(logTimeString+'Tree 歸類到既有文件 NewFormID='+NewFormID);
- FormIDReplace(NowCaseNo,NowDocDir,NowFormCode,NewFormID);
-
- end;
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- DrawDocItem2(MytreeNode1,NowCaseno);
- DataLoading(False,False);
- TreeView1.Selected := MyTreeNode1;
- TreeView1Click(self);
- end;
-
- finally
- DocListForm.Free;
- end;
-
-end;
-
-procedure TCB_IMGPSScanX.PM109Click(Sender: TObject);
-var
- S : TStringlist;
- CaseID : String;
-begin
- //if TreeView1.Selected = nil then Exit;
- //if TreeView1.Selected = NewTreeNode then Exit;
- CaseID := NowCaseno;
- S := TStringlist.Create;
- try
- ClearView(1);
- ShowText := CaseID+_Msg('檢核中,請稍候');
- DataLoading(True,True);
- ShowText := CaseID+_Msg('檢核中,請稍候');
- DataLoading(True,True);
- If OMRCheckCase(CaseID) then //有成功
- begin
- S.Add('Y');
- S.SaveToFile(ImageSavePath+CaseID+'\OMRCheckOk.dat');
- end;
- //MyTreeNode2ReFresh(CaseID);
- LoadImgFile;
- TreeView1Click(nil);
- DataLoading(False,False);
- finally
- S.Free;
- end;
- Showmessage(_Msg('檢核完成'));
-end;
-
-procedure TCB_IMGPSScanX.PM110Click(Sender: TObject);
-var
- CustomDocName : String;
- CustomDocNo : String;
- DocDir : String;
- SavePath : String;
- ST1:TStringList;
-begin
- if InputQuery(_Msg('輸入其他文件名稱'),_Msg('文件名稱'),CustomDocName) then
- begin
- if CustomDocName <> '' then
- begin
- if FindCustomDocName(DisplayPath,CustomDocName) then
- begin
- Showmessage(Format('文件名稱:"%s"己存在',[CustomDocName]));
- Exit;
- end;
- ST1:=TStringList.Create;
- CustomDocNo := GetNewCustomDocNo(DisplayPath,CustomDocName);
- DocDir := CustomDocNo;
- SavePath := ImageSavePath+NowCaseNo+'\'+DocDir+'\';
- Str2Dir(SavePath);
- SetDocNoList('A',-1,NowCaseNo,DocDir,'1');
- DrawDocItem2(MytreeNode1,NowCaseno);
- MyTreeNode1.Expand(True);
- end;
- end;
-
-end;
-
-procedure TCB_IMGPSScanX.PM111Click(Sender: TObject);
-var
- oldCopies,NewCopies : Integer;
- copies : String;
-begin
- oldCopies := GetDocDirCopies(NowCaseno,NowDocDir);
- try
- NewCopies := Strtoint(inputBox(_Msg('修改份數'),_Msg('請輸入修改後的份數'),inttostr(oldCopies)));
- except
- Showmessage(_Msg('輸入錯誤'));
- Exit;
- end;
- if (NewCopies <= 0) and (NewCopies >= 10000) then
- begin
- Showmessage(_Msg('輸入範圍錯誤'));
- Exit;
- end;
-
- if (oldCopies <> NewCopies) and (NewCopies > 0) and (NewCopies < 10000) then
- begin
- if DocNoNeedDiv(NowDocNo) and (NewCopies = 1) and (MessageDlg(_Msg('修改至1份後此文件將無法再進行份數修改,是否確定??'),mtConfirmation,[mbyes,mbcancel],0)= mrcancel) then
- Exit;
-
- SetDocDirCopies(NowCaseno,NowDocDir,NewCopies);
- SetRecordEditedDocDir('A',NowCaseNo,NowDocDir);
- DrawDocItem2(MytreeNode1,NowCaseno);
- Showmessage(_Msg('修改完成'));
- end;
-
-end;
-
-procedure TCB_IMGPSScanX.PM301Click(Sender: TObject);
-begin
- ScanColor := ifBlackWhite;
- ScanDpi := Def_ScanDpi;
- Ext := '.tif';
- PM301.Checked := True;
-end;
-
-procedure TCB_IMGPSScanX.PM302Click(Sender: TObject);
-begin
- ScanColor := ifGray256;
- Ext := '.jpg';
- ScanDpi := 200;
- //Ext := '.tif';
- PM302.Checked := True;
-end;
-
-procedure TCB_IMGPSScanX.PM303Click(Sender: TObject);
-begin
- ScanColor := ifTrueColor;
- Ext := '.jpg'; //20130326 yuu說理賠改存jpg
- ScanDpi := 200;
- //Ext := '.tif';
- PM303.Checked := True;
-end;
-
-procedure TCB_IMGPSScanX.PM501Click(Sender: TObject);
-begin
- DisplayISB.ZoomMode := zmFitWidth;
- DisplayISB.AntiAliased := True;
- SetScrollData(DisplayISB,DisplayISB.HorzScrollBar.Position,DisplayISB.VertScrollBar.Position,DisplayISB.ZoomPercent);
-end;
-
-procedure TCB_IMGPSScanX.PM502Click(Sender: TObject);
-begin
- DisplayISB.ZoomMode := zmFitHeight;
- DisplayISB.AntiAliased := True;
- SetScrollData(DisplayISB,DisplayISB.HorzScrollBar.Position,DisplayISB.VertScrollBar.Position,DisplayISB.ZoomPercent);
-end;
-
-procedure TCB_IMGPSScanX.PM503Click(Sender: TObject);
-begin
- DisplayISB.ZoomMode := zmFittoPage;
- DisplayISB.AntiAliased := True;
- SetScrollData(DisplayISB,DisplayISB.HorzScrollBar.Position,DisplayISB.VertScrollBar.Position,DisplayISB.ZoomPercent);
-end;
-
-procedure TCB_IMGPSScanX.PM504Click(Sender: TObject);
-begin
- DisplayISB.ZoomMode := zmOriginalSize;
- DisplayISB.AntiAliased := True;
- SetScrollData(DisplayISB,DisplayISB.HorzScrollBar.Position,DisplayISB.VertScrollBar.Position,DisplayISB.ZoomPercent);
-end;
-
-procedure TCB_IMGPSScanX.PM505Click(Sender: TObject);
-begin
- if DisplayISB.FileName = '' then Exit;
- Panel1.Enabled := False;
- Panel2.Enabled := False;
- ScanMode := smReplace;
- ScanInfo.ImageCount := 0;
- ScanPath := DisplayPath;
- ScanCaseno := '';
- ScanSaveFilename := ExtractFileName(DisplayISB.FileName);
- Try
- StatrTwainScan;
- Except
- Panel1.Enabled := True;
- Panel2.Enabled := True;
- end;
- Panel1.Enabled := True;
- Panel2.Enabled := True;
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
-end;
-
-procedure TCB_IMGPSScanX.PM507Click(Sender: TObject);
-var
- i : Integer;
- DocListForm : TDocListForm;
- OldName,NewName,Ext : String;
- FormID,FormName,DocNo : String;
- PreNode2Name : String;
- iFormID : String;
-begin
- PreNode2Name := '';
- if TreeView1.Selected.Parent = MyTreeNode1 then
- PreNode2Name:= GetNode2Name(MyTreeNode2);
- ShowText := _Msg('文件歸類中,請稍候');
- DataLoading(True,True);
- DocListForm := TDocListForm.Create(self);
- try
- InitialLanguage(PatchDlg); //載入多國語言
- for i := 1 to FORM_INF_List.Count - 1 do
- begin
- FormID := GetSQLData(FORM_INF_List,'T1.FORM_ID',i);
- FormName := GetSQLData(FORM_INF_List,'T1.FORM_DESC',i);
- DocNo := GetSQLData(FORM_INF_List,'T1.DOC_NO',i)+GetSQLData(FORM_INF_List,'T1.DOC_VERSION',i);
- //Showmessage(FORM_INF_List.Text);
- //showmessage(inttostr(FORM_INF_List.Count)+#13+inttostr(self.Doc_Inf_List.Count));
- if (FormID <> FileName2FormCode(DisplayISB.FileName)) and FormIDExists(FormID,False,i) then
- begin
- DocListForm.FormIDList.Add(FormID+'#@#'+FormName);
- With DocListForm.DocLV.Items.Add do
- begin
- Caption := FormID;
- SubItems.Add(FormName);
- end;
- end;
- end;
- if DocListForm.ShowModal = mrOk then
- begin
- OldName := ExtractFileName(DisplayISB.FileName);
- Ext := ExtractFileExt(OldName);
- //NewName := Copy(OldName,1,3)+'_'+TransRealFormID(DocListForm.DocLV.Selected.Caption)+Ext;
- NewName := Add_Zoo(FileName2ScanPage(OldName),3)+'_'+DocListForm.DocLV.Selected.Caption+Ext;
- RenameFile(DisplayPath+OldName,DisplayPath+NewName);
- ReNameContext(DisplayPath,OldName,NewName);
- //DrawDocItem1(MytreeNode1,Doc_Inf_List,NowCaseno); //201408280改
- DrawDocItem2(MytreeNode1,NowCaseno);
- //DrawDocItem(MytreeNode1,FORM_INF_List,NowCaseno);
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- if PreNode2Name <> '' then // 回到原本點選的文件節點上
- begin
- for i := 0 to MyTreeNode1.Count - 1 do
- begin
- if GetNode2Name(MyTreeNode1.Item[i]) = PreNode2Name then
- begin
- TreeView1.Selected := MyTreeNode1.Item[i];
- Break;
- end;
- end;
- end;
- TreeView1click(self);
- //Showmessage(_Msg('歸類完成')); //20101103 User要求拿掉
- end;
- finally
- DataLoading(False,False);
- DocListForm.Free;
- end;
-
-end;
-
-
-procedure TCB_IMGPSScanX.PM508Click(Sender: TObject);
-var
- P : Integer;
- inx:Integer;
-begin
- if DisplayISB.FileName = '' then Exit;
- if (ContextList.Count = 1) and ((FMode = 'NSCAN') or (FMode = 'ASCAN') or (FMode = 'DSCAN') or (FMode = 'ISCAN') or (FMode = 'SSCAN') or (FMode = 'MSCAN') or (FMode = 'RI_SCAN')) then
- begin
- if Messagedlg(Format(_Msg('刪除後(%s)案件無影像,將刪除此案件,是否確定刪除?'),[NowCaseno]),mtconfirmation,[mbyes,mbcancel],0) = mrCancel then Exit;
- _DelTree(DisplayPath);
- SetCaseList('D',NewTreeNode.IndexOf(MyTreeNode1),'');
- LoadImgFile;
- end
- Else
- begin
- if Messagedlg(_Msg('是否確定刪除?'),mtconfirmation,[mbyes,mbcancel],0) = mrCancel then Exit;
- inx := ContextList.IndexOf(ExtractFileName(DisplayISB.FileName));
- ContextList.Delete(inx);
- ContextList.SaveToFile(ImageSavePath + NowCaseno+'\Context.dat');
- Context_DocnoList.Delete(inx);
- Context_DocnoList.SaveToFile(ImageSavePath + NowCaseno+'\Context_DocNo.dat');
- DeleteFile(DisplayISB.FileName);
- ReSortFileName(DisplayPath);
- ContextList.LoadFromFile(ImageSavePath + NowCaseno+'\Context.dat');
- Context_DocnoList.LoadFromFile(ImageSavePath + NowCaseno+'\Context_DocNo.dat');
- if FileExists(ImageSavePath + NowCaseno+'\CustomDocNo.dat') then
- Cust_DocNoList.LoadFromFile(ImageSavePath + NowCaseno+'\CustomDocNo.dat');
- //DrawDocItem1(MytreeNode1,Doc_Inf_List,NowCaseno); //201408280改
- DrawDocItem2(MytreeNode1,NowCaseno);
-
- //DrawDocItem(MytreeNode1,FORM_INF_List,NowCaseno);
- P := ContextList.Count;
- MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,p]);
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- NewTreeNodeRefresh;
- TreeView1Click(self);
-
- end;
- //Showmessage(_Msg('刪除完成')); //20101101 User要求拿掉
-end;
-
-procedure TCB_IMGPSScanX.PM509Click(Sender: TObject);
-begin
- PM401Click(nil);
-end;
-
-procedure TCB_IMGPSScanX.PM510Click(Sender: TObject);
-begin
- DeskewImg(DisplayISB.Graphic);
- DisplayISB.SaveToFile(DisplayISB.FileName);
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
-end;
-
-procedure TCB_IMGPSScanX.PopupMenu1Popup(Sender: TObject);
-begin
- PM101.Visible := False; //刪除
- PM102.Visible := False; //修改案件編號
- PM103.Visible := False; //掃瞄器加入影像
- PM104.Visible := False; //檔案加入影像
- PM106.Visible := False; //複製文件至其他編號
- PM107.Visible := False; //寫備註
- PM108.Visible := False; //歸類
- PM109.Visible := False; //檢核此筆
- PM110.Visible := False; //新增自訂文件
- PM111.Visible := False; //修改份數
-
- if (FMode = 'SAMPLESCAN') then Exit;
-
- if TreeView1.Selected = nil then Exit;
- if TreeView1.Selected = NewTreeNode then //新掃瞄件
- begin
- if (FMode = 'NSCAN') then
- begin
-//ShowMessage('AAAA');
- PM101.Visible := True; //刪除
- PM103.Visible := True; //掃瞄器加入影像
- PM104.Visible := True; //檔案加入影像
- end;
-
- if FModeName=_Msg('異動件') then
- begin
- PM101.Visible := True;
- end;
-// if FMode='ESCAN' then
-// begin
-// PM101.Visible := True;
-// end;
- end
- Else if TreeView1.Selected = MyTreeNode1 then //案件層
- begin
- PM101.Visible := True; //刪除
-
- if FImgDelete='Y' then
- begin
- PM101.Visible:=True;
- end;
- if FImgDelete='N' then
- begin
- PM101.Visible:=false;
- end;
-
- if FMode='ESCAN' then
- PM101.Visible:=false;
-
- if FModeName=_Msg('異動件') then
- begin
- PM101.Visible := True;
- end;
-
- if not CaseDelete_Enable(NowCaseno) then //
- PM101.Enabled := False
- else
- PM101.Enabled := True;
- PM103.Visible := True; //掃瞄器加入影像
- //PM107.Visible := True; //寫備註
- //PM109.Visible := True; //檢核此筆
-// if FCustDocYN <> 'N' Then
-// PM110.Visible := True; //新增自訂文件 20170914 先不在tree 中做自訂文件 讓user在縮圖做
- PM104.Visible := True; //檔案加入影像
- if (FMode = 'NSCAN') then
- begin
- PM102.Visible := True; //修改案件編號
- end;
-// if FMode='ESCAN' then
-// begin
-// PM101.Visible := True;
-// end;
- end
- Else if TreeView1.Selected = MyTreeNode2 then //文件層
- begin
- PM101.Visible := True; //刪除
- //PM107.Visible := True; //寫備註
- //PM109.Visible := True; //檢核此筆
-// if FCustDocYN <> 'N' Then
-// PM110.Visible := True; //新增自訂文件
- if FImgDelete='Y' then
- begin
- PM101.Visible:=True;
- end;
- if FImgDelete='N' then
- begin
- PM101.Visible:=false;
- end;
-
- if FModeName=_Msg('異動件') then
- begin
- PM101.Visible := True;
- end;
-
- if GetUseCase('T',DisplayPath,NowDocDir) <> '' then //沒有被引用走的
- PM101.Enabled := False //刪除
- Else
- PM101.Enabled := True; //刪除
- if ((GetDocDirCopies(NowCaseno,NowDocDir) > 1) or (not DocNoNeedDiv(NowDocNo)) or (Copy(NowDocNo,1,5)='ZZZZZ')) and (NowDocNo<> 'Attach') and (NowDocNo<> 'S_Attach') then
- PM111.Visible := True; //修改份數
- if (FMode = 'NSCAN') then
- PM102.Visible := True; //修改案件編號
-// if FMode='ESCAN' then
-// begin
-// PM101.Visible := True;
-// end;
- end
- Else if TreeView1.Selected = MyTreeNode3 then //表單層
- begin
- PM101.Visible := True; //刪除
- PM104.Visible := True; //檔案加入影像
- PM108.Visible := True; //歸類
- PM103.Visible := True; //掃瞄器加入影像
-// if FCustDocYN <> 'N' Then
-// PM110.Visible := True; //新增自訂文件
- if GetFormIDPage(ContextList,NowFormCode) < 1 Then
- begin
- PM108.Visible := False; //歸類
- end;
- if FImgDelete='Y' then
- begin
- PM101.Visible:=True;
- end;
- if FImgDelete='N' then
- begin
- PM101.Visible:=false;
- end;
-
- if FModeName=_Msg('異動件') then
- begin
- PM101.Visible := True;
- end;
-
- if GetUseCase('T',DisplayPath,NowDocDir) <> '' then //被引用走的
- begin
- PM101.Enabled := False; //刪除
- PM104.Enabled := False; //檔案加入影像
- PM108.Enabled := False; //歸類
- end
- Else
- begin
- PM101.Enabled := True; //刪除
- PM104.Enabled := True; //檔案加入影像
- PM108.Enabled := True; //歸類
- end;
-
- if (FMode = 'NSCAN') then
- begin
- PM102.Visible := True; //修改案件編號
- end;
- end;
-
-
-
-end;
-
-procedure TCB_IMGPSScanX.PopupMenu4Popup(Sender: TObject);
-begin
- PM401.Visible := False;
- PM402.Visible := False;
- PM403.Visible := False;
- PM404.Visible := False;
- if FMode = 'SAMPLESCAN' then Exit;
- if (TreeView1.Selected.Level =2) or (TreeView1.Selected.Level =3) then
- begin
- PM402.Visible := True;
- PM403.Visible := True;
- PM404.Visible := True;
- end;
- PM401.Visible := True;
- if (TreeView1.Selected <> MyTreeNode2) or (FMode = 'RSCAN') then
- PM401.Visible := False;
-end;
-
-procedure TCB_IMGPSScanX.PopupMenu5Popup(Sender: TObject);
-begin
- PM501.Visible := False;
- PM502.Visible := False;
- PM503.Visible := False;
- PM504.Visible := False;
- PM505.Visible := False;
- PM506.Visible := False;
- PM507.Visible := False;
- PM508.Visible := False;
- PM509.Visible := False;
- PM510.Visible := False;
- if FMode = 'SAMPLESCAN' then Exit;
- if (DisplayISB.FileName <> '') then
- begin
- PM501.Visible := True;
- PM502.Visible := True;
- PM503.Visible := True;
- PM504.Visible := True;
- //PM505.Visible := True;
- //PM506.Visible := True;
- //PM507.Visible := True;
- //PM508.Visible := True;
- //PM509.Visible := True;
- //PM510.Visible := True;
- end;
- if (TreeView1.Selected <> MyTreeNode2) or (FMode = 'RSCAN') or (FMode = 'ESCAN') then
- PM509.Visible := False;
-end;
-
-procedure TCB_IMGPSScanX.PopupMenu6Popup(Sender: TObject);
-begin
- PM601.Visible := True; //歸類
- PM602.Visible := True; //自行定義文件名稱
- PM603.Visible := False; //掃描替換此頁
- PM604.Visible := False; //歪斜矯正
- PM605.Visible := True; //刪除
-
-// if FMode='ESCAN' then
-// begin
-// PM601.Visible := False; //歸類
-// PM602.Visible := False; //自行定義文件名稱
-// PM603.Visible := False; //掃描替換此頁
-// PM604.Visible := False; //歪斜矯正
-// PM605.Visible := False; //刪除
-// end;
-
- if ((NowDocNo = 'Attach') or (NowDocNo = 'S_Attach')) and (FCustDocYN <> 'N') then
- begin
- PM602.Visible := True; //自行定義文件名稱
- //PM603.Visible := True; //掃描替換此頁
- PM604.Visible := True; //歪斜矯正
- PM601.Visible := True; //歸類
- PM605.Visible := True; //刪除
- end;
-
- if FModeName<>_Msg('異動件') then
- begin
- if (FImgDelete='Y') then
- begin
- PM605.Enabled:=True;
- end;
- if FImgDelete='N' then
- begin
- PM605.Enabled:=false;
- end;
- end;
-
-
-
-
- if CheckSelectImg_UseCase(DisplayPath,NowCaseNo) then //選擇的影像不可有引用的
- begin
- PM601.Enabled := False; //歸類
- PM605.Enabled := False; //刪除
- end;
-
-
-end;
-
-procedure TCB_IMGPSScanX.PrePageBtnClick(Sender: TObject);
-var
- page : Integer;
-begin
- {page := ScrollBar1.Position;
- Case Vmode of
- 0 : dec(page);
- 1 : Page := Page - 2;
- 2 : Page := Page - 4;
- 3 : Page := Page - 6;
- 4 : Page := Page - 8;
- end;
- IF page >= ScrollBar1.min Then
- begin
- ScrollBar1.Position := page;
- end
- Else
- ScrollBar1.Position := 1; }
- if selectISB = nil then Exit;
- PriorPage(SelectPage);
- if (SelectISB.Parent.Top-4) < 0 then
- scrollBox1.VertScrollBar.Position := scrollBox1.VertScrollBar.Position + SelectISB.Parent.Top-4;
-
- //ISBClick(TImageScrollBox(FindComponent(ISBName+'1')));
-
-
-end;
-
-procedure TCB_IMGPSScanX.SampleScanBtnClick(Sender: TObject);
-var
- SampleFormID : String;
- SendData : String;
- buttonSelected : Integer;
-begin
- ScanMode := smSample;
- ClearView(1);
- Vmode := 0; //切成單頁
- GoViewMode;
- ScanInfo.ImageCount := 0;
- ScanPath := SamplePath;
- ScanCaseno := '';
- ContextList.Clear;
- ShowText := _Msg('範本掃描中,請稍候');
- DataLoading(True,True);
- SampleFormID := UpperCase(InputBox(_Msg('範本檔掃瞄輸入畫面'),_Msg('請輸入文件編號'),''));
-
- if SampleFormIDList.IndexOf(SampleFormID)<>-1 then
- begin
- // Show a custom dialog
- buttonSelected := messagedlg(SampleFormID+_Msg('已有範本,是否取代?'),mtCustom,
- [mbYes,mbCancel], 0);
- if buttonSelected = mrCancel then
- begin
- DataLoading(false,false);
- Exit;
- end;
- end;
-
- if SampleFormID <> '' then
- begin
- if FormIDExists(SampleFormID,False,0) then
- begin
- ScanSaveFilename := SampleFormID + '.tif';
- end
- Else
- begin
- Showmessage(Format(_Msg('FormID:%s尚未註冊'),[SampleFormID]));
- Panel1.Enabled := True;
- Panel2.Enabled := True;
- DataLoading(false,false);
- Exit;
- end;
- SampleAnchorMode := FormID2Anchor(SampleFormID);
-
- Panel1.Enabled := False;
- Panel2.Enabled := False;
-//ShowMessage('AAAAA');
- Try
- StatrTwainScan;
- Except
- Panel1.Enabled := True;
- Panel2.Enabled := True;
- end;
-
- if (ISB1.FileName <> '') and FileExists(SamplePath+SampleFormID+'.tif') then
- begin
- ShowText := _Msg('範本傳送中,請稍候');
- DataLoading(True,True);
- //多存一份jpg
- ImageScrollBox1.LoadFromFile(SamplePath+SampleFormID+'.tif',1);
- BWTif2Jpg(ImageScrollBox1.Graphic);
- ImageScrollBox1.SaveToFile(SamplePath+SampleFormID+'.jpg');
- //多存一份jpg
-
- NowWork_No := FormCode2WorkNo(SampleFormID);
- SendData := 'data='+FData+'&verify='+FVerify+'&work_no='+FWork_no+'&file_name='+SampleFormID+'.tif';
- if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/sample',SendData,'file',SamplePath+SampleFormID+'.tif',FReWrite,Memo1,False) then
- begin
- Showmessage(_Msg('傳送範本檔案時,網路發生錯誤!!')+_MSg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+')');
- DataLoading(False,False);
- Exit;
- end;
- if memo1.Lines.Strings[0] = '1' then
- begin
- Showmessage(_Msg('傳送範本檔案時,網路發生錯誤!!')+_Msg('錯誤原因:')+memo1.Lines.Strings[1]);
- DataLoading(False,False);
- Exit;
- end
- Else if Pos('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',Memo1.Lines.Text) > 0 then
- begin
- Showmessage(_Msg('傳送範本檔案(JPG)時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'));
- DataLoading(False,False);
- Exit;
- end;
- end;
- Showmessage(_Msg('傳送完成'));
- end;
- end;
- DataLoading(False,False);
-
-end;
-
-procedure TCB_IMGPSScanX.ScrollBar1Change(Sender: TObject);
-begin
- Exit;
- If (TreeView1.Selected = MyTreenode1) or (TreeView1.Selected.ImageIndex = 6) Then
- begin
- view_image_FormCode(DisplayPath,'ShowAll',ScrollBar1.Position,1);
- end
- Else IF (TreeView1.Selected = MyTreenode2) then
- begin
- view_image_FormCode(DisplayPath,NowDocNo,ScrollBar1.Position,1);
- end
- Else if (TreeView1.Selected = MyTreenode3) then
- begin
- view_image_FormCode(DisplayPath,NowFormCode,ScrollBar1.Position,1);
- end;
-
-end;
-
-procedure TCB_IMGPSScanX.ScrollBox1MouseEnter(Sender: TObject);
-begin
-ScrollBox1.SetFocus;
-end;
-
-procedure TCB_IMGPSScanX.SelectScanBtnClick(Sender: TObject);
-begin
- Panel1.Enabled := False;
- Panel2.Enabled := False;
- scanner.SelectScanner;
- Panel1.Enabled := True;
- Panel2.Enabled := True;
-end;
-
-procedure TCB_IMGPSScanX.StatusBar1DblClick(Sender: TObject);
-begin
- Button3.Visible := not Button3.Visible;
- Button4.Visible := not Button4.Visible;
- if (GetKeyState(VK_CONTROL) < 0) Then
- begin
- ExportBt.Visible := not ExportBt.Visible;
- ImportBt.Visible := not ImportBt.Visible;
- end
- Else
- begin
- Memo1.Visible := not Memo1.Visible;
- Display1.Visible := not Display1.Visible;
- end;
-end;
-
-procedure TCB_IMGPSScanX.ActiveFormCreate(Sender: TObject);
-var IScrollBox : TImageScrollBox;
- i :integer;
-begin
- {HotKeyId1 := GlobalAddAtom('MyHotKey1')-$C000;
- HotKeyId2 := GlobalAddAtom('MyHotKey2')-$C000;
- HotKeyId3 := GlobalAddAtom('MyHotKey3')-$C000;
- HotKeyId4 := GlobalAddAtom('MyHotKey4')-$C000;
- RegisterHotKey(handle,HotKeyId1,0,VK_UP); //printscreen
- RegisterHotKey(handle,HotKeyId1,0,VK_Down); //printscreen }
- PostMessage(Handle,WM_ACTIVATE,WA_CLICKACTIVE,0);
- vmode := 1;
- DesableImage;
- For i:= 1 to 8 do begin
- IScrollBox := TImageScrollBox( FindComponent('ISB'+IntToStr(i)));
- IScrollBox.MouseMode := mmUser;
- iScrollBox.ZoomMode := zmFullPage;
- end;
- Sleep(500);
- Timer1.Enabled := True;
-end;
-
-procedure TCB_IMGPSScanX.ActiveFormKeyUp(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-begin
- if Edit1.Focused then
- begin
- if selectISB = nil then Exit;
-
- if (Key =VK_UP) then
- begin
- PriorPage(SelectPage);
- if (SelectISB.Parent.Top-4) < 0 then
- scrollBox1.VertScrollBar.Position := scrollBox1.VertScrollBar.Position + SelectISB.Parent.Top-4;
-
- //ISBClick(TImageScrollBox(FindComponent(ISBName+'1')));
- end;
- if (Key =VK_Down) then
- begin
- NextPage(SelectPage);
- if SelectISB.Parent.Top+SelectISB.Parent.Height+4 > scrollBox1.Height then
- ScrollBox1.VertScrollBar.Position := scrollBox1.VertScrollBar.Position + (SelectISB.Parent.Top+SelectISB.Parent.Height-ScrollBox1.Height+8);
- //scrollBox1.VertScrollBar.ScrollPos := SelectISB.Parent.Top+SelectISB.Parent.Height;
- //ISBClick(TImageScrollBox(FindComponent(ISBName+'2')));
- end;
- end;
-end;
-
-procedure TCB_IMGPSScanX.AddAttFileLBClick(Sender: TObject);
-var
- i : Integer;
- Addfile : String;
-begin
- OpenDialog1.Filter := 'PDF files|*.pdf';
- OpenDialog1.Options := [ofAllowMultiSelect];
- if OpenDialog1.Execute then
- begin
- ShowText :=_Msg('檔案加入中,請稍候');
- DataLoading(True,True);
- for i := 0 to OpenDialog1.Files.Count - 1 do
- begin
- AddFile := HTTPEncode(UTF8Encode(ExtractFileName(OpenDialog1.Files.Strings[i])));
- if FileExists(ImageSavePath+NowCaseno+'\'+AddFile) then
- begin
- if Messagedlg(Format(_Msg('%s己存在,是否覆蓋??'),[Addfile]),mtconfirmation,[mbyes,mbcancel],0) = mrcancel Then
- Continue;
- SetAttContextList('D',-1,NowCaseno,AddFile);
- end;
- // AttFileGB.Visible := True; //附加電子檔窗 //20120207楊玉說不在這加電子檔先拿掉
- // Splitter2.Visible := True;
- CopyFile(Pchar(OpenDialog1.Files.Strings[i]),Pchar(ImageSavePath+NowCaseno+'\'+AddFile),False);
- SetAttContextList('A',-1,NowCaseno,AddFile);
- LoadAttFile(NowCaseno);
- end;
- end;
- DataLoading(False,False);
-end;
-
-procedure TCB_IMGPSScanX.AddCredit1RGClick(Sender: TObject);
-begin
- if DisplayPath <> '' then
- begin
- Case AddCredit1RG.ItemIndex of
- -1:Case_loandoc := '';
- 0:Case_loandoc := 'Y';
- 1:Case_loandoc := 'N';
- end;
- WriteCaseIndex(DisplayPath);
- end;
-end;
-
-procedure TCB_IMGPSScanX.AddScanBtnClick(Sender: TObject);
-var
- P,v : Integer;
-begin
- IF not InitialOk Then
- begin
- Showmessage(_Msg('資訊尚未下載完成,請稍候或重新進入'));
- Exit;
- end;
- if MyTreeNode1 = nil then
- begin
- Showmessage(_Msg('請先選擇案件'));
- Exit;
- end;
- Panel1.Enabled := False;
- Panel2.Enabled := False;
- ScanMode := smInsert;
- ScanInfo.ImageCount := ContextList.Count;
- ScanPath := DisplayPath;
- ScanCaseno := NowCaseno;
- ScanDocDir := NowDocDir;
- Try
- StatrTwainScan;
- Except
- Panel1.Enabled := True;
- Panel2.Enabled := True;
- end;
- Panel1.Enabled := True;
- Panel2.Enabled := True;
- DrawDocItem2(MytreeNode1,NowCaseno);
- //DrawDocItem(MytreeNode1,FORM_INF_List,NowCaseno);
- //P := ContextList.Count;
- GetCase_PageCount(CaseCount,PageCount);
- v := Pos('-',NewTreeNode.Text);
- NewTreeNode.Text := Format(_Msg('%s-共%d筆共%d頁'),[Copy(NewTreeNode.Text,1,v-1),CaseCount,PageCount]);
- MytreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseno)]);
-
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- SetDocDirtoSelected(MyTreeNode1,FirstDocDir);
- TreeView1Click(self);
-end;
-
-procedure TCB_IMGPSScanX.AttListBoxClick(Sender: TObject);
-begin
- DelAttFileLB.Enabled := False;
- if AttListBox.ItemIndex >= 0 then
- DelAttFileLB.Enabled := True;
-end;
-
-procedure TCB_IMGPSScanX.AttListBoxDblClick(Sender: TObject);
-var
- AttFile : String;
-begin
- if AttListBox.ItemIndex < 0 then Exit;
-
- AttFile := HTTPEncode(UTF8Encode(AttListBox.Items.Strings[AttListBox.ItemIndex]));
- if FileExists(DisplayPath+AttFile) then
- ShellExecute(Application.Handle,'open',PChar(DisplayPath+AttFile),nil,nil,SW_SHOW)
- else
- Showmessage(Format(_Msg('找不到檔案:%s'),[AttFile]));
-end;
-
-procedure TCB_IMGPSScanX.BtnMouseEnter(Sender: TObject);
-begin
- AddToolTip(TBitBtn(Sender).Handle,nil,0,Pchar(TBitBtn(Sender).Hint),nil,0,0);
-end;
-
-procedure TCB_IMGPSScanX.Button3Click(Sender: TObject);
-begin
- //Showmessage(CreateDocNo_Info(NowCaseNo)+#13+'******'+#13+CreateCustDocNo_Info(NowCaseNo));
- //Showmessage(NowSelectFileList.Text);
- //SetIn_WH_DocNo;
- //CreateIn_WH(self.NowCaseno);
- //Create_Cust_DocDir(NowCaseNo);
- //Showmessage(self.GetDocNoDir(self.DisplayPath,'111'));
- //Case2upload(NowCaseNo);
- //mkdir(DisplayPath+'Test\');
- //Download2Case(DisplayPath+'Upload\',DisplayPath+'Test\');
- //CreateFormID_FormName(DisplayPath); //產生FormID_FormName.dat
- //CreateDocNo_DocName(DisplayPath); //產生DocNo_Name.dat
- //Showmessage(CreateDocNo_Info(DisplayPath)); //產生 Docno,份數,頁數;Docno,份數,頁數 的回傳字串
- //lb1.Caption:='AAAAAAAAAAA';
- //Showmessage(CreateDocnoFrom_Info(NowCaseno));
- //Showmessage(self.CreateCustDocNoFrom_Info(NowCaseno));
- //ShowMessage('FMaxUploadSize='+FMaxUploadSize);
- //initkscan;
- showmessage('FUrl='+FUrl+#10#13+
- 'FCaseID='+FCaseID+#10#13+
- 'FMode='+FMode+#10#13+
- 'FModeName='+FModeName+#10#13+
- 'FWork_no='+FWork_no+#10#13+
- 'FUserID='+FUserID+#10#13+
- 'FUserName='+FUserName+#10#13+
- 'FUserUnit='+FUserUnit+#10#13+
- 'FData='+FData+#10#13+
- 'FVerify='+FVerify+#10#13+
- 'FReWrite='+FReWrite+#10#13+
- 'FLanguage='+FLanguage+#10#13+
- 'FLoanDoc_Value='+FLoanDoc_Value+#10#13+
- 'FLoanDoc_Enable='+FLoanDoc_Enable+#10#13+
- 'FUseProxy='+FUseProxy+#10#13+
- 'FC_DocNoList='+FC_DocNoList+#10#13+
- 'FC_DocNameList='+FC_DocNameList+#10#13+
- 'FFixFileList='+FFixFileList+#10#13+
- 'FIs_In_Wh='+FIs_In_Wh+#10#13+
- 'FOldCaseInfo='+FOldCaseInfo+#10#13+
- 'FPrintyn='+FPrintyn+#10#13+
- 'FIs_OldCase='+FIs_OldCase+#10#13+
- 'FCustDocYN='+FCustDocYN);
- ShowMessage('FImgDPI='+IntToStr(FImgDPI)+#10#13+
- 'FScanColor='+ IntToStr(FScanColor)+#10#13+
- 'FFileSizeLimit='+ IntToStr(FFileSizeLimit) +#10#13+
- 'FCaseNoLength='+ IntToStr(FCaseNoLength) +#10#13+
- 'FImgDelete='+ FImgDelete+#10#13+
- 'FIsExternal='+ FIsExternal+#10#13+
- 'FWH_category='+FWH_category+
- 'FCheck_main_form='+ FCheck_main_form+#10#13+
- 'FMaxUploadSize='+FMaxUploadSize);
- //FImgDelete:='Y';
- LoadImgFile;
- { ShowMessage('UpLPoint='+IntToStr(UpLPoint.X)+','+IntToStr(UpLPoint.Y)+#10#13+
- 'UpRPoint='+IntToStr(UpRPoint.X)+','+IntToStr(UpRPoint.Y)+#10#13+
- 'DownLPoint='+IntToStr(DownLPoint.X)+','+IntToStr(DownLPoint.Y)+#10#13+
- 'DownRPoint='+IntToStr(DownRPoint.X)+','+IntToStr(DownRPoint.Y));
- }
-end;
-
-procedure TCB_IMGPSScanX.Button4Click(Sender: TObject);
-var
- i:integer;
- str:String;
-begin
- //Showmessage(self.Doc_Inf_List.Text);
- //LoadImgFile;
- //LoadImgFile1;
- //ISB1.MouseMode:=mmAmplifier;
-
- str:='';
- for I := 1 to 11 do // 看 OMRErrInfo 的內容
- begin
- str:=str+BoolToStr(OMRErrInfo[i].Display,true)+','
- +BoolToStr(OMRErrInfo[i].Ignore,true)+','+OMRErrInfo[i].Info+','
- +OMRErrInfo[i].Mode+#10#13;
- end;
- ShowMessage('OMRErrInfo='+str);
- ShowMessage('Doc_Inf_List='+Doc_Inf_List.Text);
- ShowMessage('DM_FORM_INF_List='+DM_FORM_INF_List.Text) ;
- ShowMessage('FORM_INF_List='+FORM_INF_List.Text) ;
- ShowMessage('CHECK_RULE_INF_List='+CHECK_RULE_INF_List.Text) ;
- ShowMessage('MEMO_INF_List='+MEMO_INF_List.Text) ;
- ShowMessage('WORK_INF_List='+WORK_INF_List.Text) ;
- ShowMessage('LASTEST_FORM_INF_List='+LASTEST_FORM_INF_List.Text) ;
- ShowMessage('SampleFormIDList='+SampleFormIDList.Text);
- ShowMessage('ExistImgList='+ExistImgList.Text);
- ShowMessage('LastInitFormidList='+LastInitFormidList.Text);
- ShowMessage('IN_WH_DocNoList='+IN_WH_DocNoList.Text);
-
-// SampleFormIDList.Add('31A00101011706A');
-// SampleFormIDList.Add('31A00101021706A');
-// SampleFormIDList.Add('31A00101031706A');
-end;
-
-procedure TCB_IMGPSScanX.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; //規零
-//ShowMessage(IntToStr(ScanDpi));
- Scanner.RequestedXDpi := ScanDpi;
- Scanner.RequestedYDpi := ScanDpi;
- Scanner.RequestedImageFormat := ScanColor;
- Scanner.ShowUI := TwainShowUI;
-
- Try
- Scanner.OpenSource;
- Scanner.Duplex := ScanDuplex; //雙面
-
- if FMode='SAMPLESCAN' then
- Scanner.Duplex:=False;
-
- //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 := FJpgCompression;
- end
- else if pScanInfo^.Graphic.ImageFormat = ifColor256 Then
- begin
- //Ext := '.jpg';
- ConvertToGray(pScanInfo^.Graphic);
- pScanInfo^.Graphic.Compression := tcJpeg;
- pScanInfo^.Graphic.JpegQuality := FJpgCompression;
- 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 := FJpgCompression;
-//ShowMessage(IntToStr(pScanInfo^.Graphic.JpegQuality));
-//if pScanInfo^.Graphic.Compression = tcJpeg then
-//begin
-//ShowMessage('jpg');
-//end;
-
- 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;
-
- if iGraphic.ImageFormat=ifGray256 then //20180104
- begin
- iGraphic.Compression:=tcJPEG;
- iGraphic.JpegQuality:=FJpgCompression;
- end;
- if iGraphic.ImageFormat=ifTrueColor then //20180104
- begin
- iGraphic.Compression:=tcJPEG;
- iGraphic.JpegQuality:=FJpgCompression;
- end;
-
-//ShowMessage('WTF');
- 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);
- For i := 1 To MpsBarcodeinf.Count Do
- Begin
- If MpsBarcodeinf.r180[i] <> 0 Then // 依條碼角度轉影像
- Begin
- Rotate(iGraphic, MpsBarcodeinf.r180[i]);
- Break;
- End;
- End;
-
- if iGraphic.ImageFormat=ifGray256 then //20180104 因此旋轉後變為回packbits 所以要改為jpeg
- begin
- iGraphic.Compression:=tcJPEG;
- iGraphic.JpegQuality:=FJpgCompression;
- end;
- if iGraphic.ImageFormat=ifTrueColor then
- begin
- iGraphic.Compression:=tcJPEG;
- iGraphic.JpegQuality:=FJpgCompression;
- end;
- 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 := FJpgCompression;
- //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);
-//ShowMessage('ISDivPageFormID(FormID)='+BoolToStr(ISDivPageFormID(FormID),true));
-//ShowMessage('FindDivFormCode(FormID)='+BoolToStr(FindDivFormCode(FormID),true));
-//ShowMessage('A NowDivPageFormID='+NowDivPageFormID+#10#13+'FormID='+FormID+#10#13+'ScanCaseno='+ScanCaseno);
- if (FormID <>'') and FindDivFormCode(FormID) and (NowDivPageFormID <> '') Then //只找分案頁上的案件條碼
- begin
-
- ScanInfo.ImageCount := 0;
- ClearView(1);
- ContextList.Clear;
- Context_DocnoList.Clear;
- ClearCaseIndex; //清掉案件索引
- ScanCaseno := BarCode2CaseID; //取出案件編號
- NowGuideFormID := '';
- NowDivPageFormID :='';
-//ShowMessage('B NowGuideFormID='+NowGuideFormID+#10#13+'FormID='+FormID+#10#13+'ScanCaseno='+ScanCaseno);
- end;
- if ScanCaseno = '' then //一開始都沒找到
- begin
- ScanCaseno := GetNoNameCase(ImageSavePath);
- end;
- ImageSavePath := ImagePath;
- if (ScanInfo.ImageCount = 0) then
- begin
- if DirectoryExists(ImageSavePath + ScanCaseno+'\') then
- begin
- _DelTree(ImageSavePath + ScanCaseno+'\');
- SetCaseList('D',-1,ScanCaseno);
- end;
- end;
-
- ScanPath := ImageSavePath+ScanCaseno+'\';
- Str2Dir(ScanPath);
-
- ScanDocDir := FindLastestDocDir(ScanCaseno,DocNo);
-//ShowMessage('AA ScanDocDir='+ScanDocDir);
-
-//ShowMessage('BB ScanDocDir='+ScanDocDir);
- if DocNoNeedDiv(DocNo)then //要分份數
- begin
- //Showmessage(DocNo+#13+FormCode2Page(FormID)+#13+inttostr(GetDocDir_Page(ScanCaseno,ScanDocDir))+#13+ScanDocDir);
- if ((FormCode2Page(FormID) = '01') and (GetDocDir_Page(ScanCaseno,ScanDocDir)>0)) or (ScanDocDir = '') then
- begin
- //ScanInfo.ImageCount := 0;
- ScanDocDir := DocNo2DocNoDir(ImageSavePath + ScanCaseno+'\',DocNo);
- end;
- end
- Else //不分份數
- begin
- if DocNo <> '' then
- ScanDocDir := DocNo
- else //Attach 附件
- ScanDocDir := DocNo2DocNoDir(ImageSavePath + ScanCaseno+'\',DocNo);
- end;
- //ScanDocDir := GetDocNoDir(ImageSavePath+ScanCaseno+'\',DocNo);
- if FirstDocDir = '' then
- FirstDocDir := ScanDocDir;
-
- ScanPath := ImageSavePath+ScanCaseno+'\'+ScanDocdir+'\';
- //Showmessage(ScanPath);
- if (not DirectoryExists(ScanPath)) and (ScanDocdir <> AttName) then
- begin
- //Showmessage('ADD:'+ScanCaseno+','+ScanDocdir);
- SetDocNoList('A',-1,ScanCaseno,ScanDocdir,'1');
- end;
- Str2Dir(ScanPath);
-
-
- ScanSaveFilename := FormID;
-
- Str2Dir(ScanPath);
- if ScanSaveFilename = '' then //附件
- ScanSaveFilename:= Add_Zoo(GetDocDir_Page(ScanCaseNo,ScanDocDir)+1,3)+ext
- //ScanSaveFilename:= Add_Zoo(ScanInfo.ImageCount+1,3)+ext
- Else
- ScanSaveFilename := Add_Zoo(GetDocDir_Page(ScanCaseNo,ScanDocDir)+1,3)+'_'+ScanSaveFilename+ext;
- if not FindNoSaveBarCode then //沒有不儲存影像的條碼
- begin
- if ScanInfo.ImageCount = 0 then
- begin
- SetCaseList('A',-1,ScanCaseno);
- WriteCaseIndex(ImageSavePath + ScanCaseno+'\'); //寫入案件索引
- MyTreeNode1 := TreeView1.Items.AddChild(NewTreenode,ScanCaseno);
- MyTreenode1.ImageIndex := 2;
- MyTreenode1.SelectedIndex := 2;
- Application.ProcessMessages;
- end;
-
- SetContextList('A',-1,ScanCaseno,ScanDocDir,ScanSaveFilename);
- //ContextList.Add(ScanSaveFilename);
- //ContextList.SaveToFile(ScanPath+'Context.dat');
-
- PEFileName := ScanPath+ScanSaveFilename;
- end;
- end;
- smReplace:
- begin
- if ScanInfo.ImageCount = 0 then
- begin
- DeleteFile(ScanPath+ScanSaveFilename);
- PEFileName := ScanPath+ScanSaveFilename;
- end;
- end;
- smInsert:
- begin
- ScanSaveFilename := '';
- FormID := BarCode2FormID; //取出FormID
- if (FormID <> '') and ISGuideFormID(FormID) then //20170510 註解 因為DSCAN 會全擠在導引頁下
- NowGuideFormID := FormID;
- if (NowGuideFormID <> '') {and (FormID = '')} then //20170510 註解 因為DSCAN 會全擠在導引頁下
- FormID := NowGuideFormID;
- DocNo := FormCode2DocNo(FormID);
- ScanDocDir := FindLastestDocDir(ScanCaseno,DocNo);
-
- if (FMode='ESCAN') and (FModeName=_Msg('補件掃描')) then //20180207 加入的特殊邏輯
- begin
- ScanDocDir := FindLastestDocDirForPage(ScanCaseno, DocNo,FormID);
- end;
-
- if (DocNoNeedDiv(DocNo)) then //要分份數
- begin
- if TreeView1.Selected = MyTreeNode1 then //20170421 掃瞄插頁時選則在案號上才要分份數 選在FormID上就不分份數
- begin
- if ((FormCode2Page(FormID) = '01') and (GetDocDir_Page(ScanCaseno,ScanDocDir)>0)) or (ScanDocDir = '') then
- begin
- ScanInfo.ImageCount := 0;
- ScanDocDir := DocNo2DocNoDir(ImageSavePath + ScanCaseno+'\',DocNo);
- end;
- end;
- end
- Else //不分份數
- begin
- if DocNo <> '' then
- ScanDocDir := DocNo
- else //Attach 附件
- ScanDocDir := DocNo2DocNoDir(ImageSavePath + ScanCaseno+'\',DocNo);
- end;
- if FirstDocDir = '' Then
- FirstDocDir := ScanDocDir;
-
- ScanPath := ImageSavePath+ScanCaseno+'\'+ScanDocdir+'\';
- if (not DirectoryExists(ScanPath)) and (ScanDocdir <> 'Attach') and (ScanDocdir <> 'S_Attach') then
- SetDocNoList('A',-1,ScanCaseno,ScanDocdir,'1');
-
-
- ScanSaveFilename := FormID;
- Str2Dir(ScanPath);
- if ScanSaveFilename = '' then //附件
- ScanSaveFilename:= Add_Zoo(GetDocDir_Page(ScanCaseno,ScanDocdir)+1,3)+ext
- Else
- ScanSaveFilename := Add_Zoo(GetDocDir_Page(ScanCaseno,ScanDocdir)+1,3)+'_'+ScanSaveFilename+ext;
- //ContextList.Add(ScanSaveFilename);
- //ContextList.SaveToFile(ScanPath+'Context.dat');
- SetContextList('A',-1,ScanCaseno,ScanDocDir,ScanSaveFilename);
- //Showmessage(ScanPath+ScanSaveFilename);
- //Showmessage('Stop');
- PEFileName := ScanPath+ScanSaveFilename;
- end;
- smSample:
- begin
- if ScanInfo.ImageCount = 0 then
- begin
- DeleteFile(ScanPath+ScanSaveFilename);
- PEFileName := ScanPath+ScanSaveFilename;
- BarStr := '';
- for i := 1 to MpsBarCodeinf.Count do
- begin
- BarStr := BarStr + MpsBarCodeinf.Text[i];
- end;
- Showmessage(_Msg('辨識到的BarCode:')+#13+BarStr);
- end;
- end;
- smRTS:
- begin
-
- end;
- end;
- Application.ProcessMessages;
-
-end;
-
-
-procedure TCB_IMGPSScanX.ExportBtClick(Sender: TObject);
-var
- SendData : String;
- EnCodeDateTime : String;
- S : TStringlist;
- SFileName,VFileName : String;
-begin
- SFileName := En_DecryptionStr_Base64('E','MPSLIC_SCAN.lic','9338430');
- VFileName := En_DecryptionStr_Base64('E','MPSLIC_VIEW.lic','9338430');
- IIS_File2Web.S_LicEnName := SFileName;
- IIS_File2Web.V_LicEnName := VFileName;
-
- /////下載MPSLIC_SCAN.lic //////
- EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey);
-
-
- //SendData := 'checktime='+EnCodeDateTime+'&workno=CW&formid=MPSLIC_SCAN.lic'+'&mode=sample';
- //if not dnFile(HTTPSClient,Furl,'servlet/CWC03',SendData,LngPath+SFileName,FReWrite,Memo1,False,DownImgStatus) then
- SendData:='data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&work_no=PLN&file=MPSLIC_SCAN.lic';
- if not dnFile_Get(HTTPSClient,Furl,'service/imgpsc/IMGPSC04/sample',SendData,LngPath+SFileName,FReWrite,Memo1,False,DownImgStatus) then
- begin
- Showmessage(_Msg('檢查註冊檔案時,網路發生錯誤!!')+_Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason);
- Exit;
- end;
- /////下載MPSLIC_SCAN.lic /////
-
- /////下載MPSLIC_VIEW.lic //////
- EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey);
- //SendData := 'checktime='+EnCodeDateTime+'&workno=CW&formid=MPSLIC_VIEW.lic'+'&mode=sample'; //這裡改成必傳CW 20121212
- //if not dnFile(HTTPSClient,Furl,'service/slic/SLIC04/sample',SendData,LngPath+VFileName,FReWrite,Memo1,False,DownImgStatus) then
- SendData:='data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&work_no=PLN&file=MPSLIC_VIEW.lic';
- if not dnFile_Get(HTTPSClient,Furl,'service/imgpsc/IMGPSC04/sample',SendData,LngPath+VFileName,FReWrite,Memo1,False,DownImgStatus) then
- begin
- Showmessage(_Msg('檢查註冊檔案時,網路發生錯誤!!')+_Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason);
- Exit;
- end;
- /////下載MPSLIC_VIEW.lic /////
-
- ////壓zip/////
- S := TStringlist.Create;
- try
- S.Add(En_DecryptionStr_Base64('E',GetDate,'9338430'));
- S.Add(SFileName);
- S.Add(VFileName);
- S.SaveToFile(LngPath+'mps.dat');
- S.Clear;
- S.Add(LngPath+'mps.dat');
- S.Add(LngPath+SFileName);
- S.Add(LngPath+VFileName);
- if FileExists(LngPath+'mps.zip') then
- DeleteFile(LngPath+'mps.zip');
- ExecuteZip_Pwd(LngPath+'mps.zip',LngPath,S,False,False,'9338430');
-
- finally
- S.Free;
- DeleteFile(LngPath+SFileName);
- DeleteFile(LngPath+VFileName);
- DeleteFile(LngPath+'mps.dat');
- end;
- ////壓zip//////
- Showmessage(_Msg('匯出完成,匯出檔案:')+LngPath+'mps.zip');
-end;
-
-procedure TCB_IMGPSScanX.ImportBtClick(Sender: TObject);
-var
- SendData : String;
- EnCodeDateTime : String;
- S : TStringlist;
- SFileName,VFileName : String;
- OpenDialog1 : TOpenDialog;
- ZipPath : String;
- ZipFile,ZipName : String;
- LicName : String;
- i : Integer;
-begin
- OpenDialog1 := TOpenDialog.Create(self);
- S := TStringlist.Create;
- try
- OpenDialog1.Filter := 'Zip files (*.zip)|*.ZIP';
- if OpenDialog1.Execute then
- begin
- ZipFile:= ExtractFileName(OpenDialog1.FileName);
- ZipName := Copy(ZipFile,1,length(ZipFile)-length(ExtractFileExt(OpenDialog1.FileName)));
- ZipPath := LngPath+ZipName+'\';
-
- str2dir(ZipPath);
- if not ExecuteUnZip_Pwd(OpenDialog1.FileName,ZipPath,False,'9338430') then
- Showmessage(_Msg('無法解壓縮'));
- if not FileExists(ZipPath+'mps.dat') then
- begin
- Showmessage(_Msg('格式不符,無法匯入'));
- Exit;
- end;
- S.LoadFromFile(ZipPath+'mps.dat');
- if (En_DecryptionStr_Base64('D',S.Strings[0],'9338430')<> ServerDate) then
- begin
- Showmessage(_Msg('檔案過期,無法匯入'));
- Exit;
- end;
-
- for i := 1 to S.Count -1 do
- begin
- LicName := En_DecryptionStr_Base64('D',S.Strings[i],'9338430');
- RenameFile(ZipPath+S.Strings[i],ZipPath+LicName);
- if (LicName = 'MPSLIC_SCAN.lic') or (LicName = 'MPSLIC_VIEW.lic') then
-
- /////上傳MPSLICXXXX.lic ////
- //if not upFile(HTTPSClient,FUrl,'servlet/CWC04','formid='+LicName+'@workno=CW@mode=sample','file',ZipPath+LicName,FReWrite,Memo1,False) then
- //begin
- SendData := 'data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&work_no=PLN&file_name='+LicName;
- if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/sample',SendData,'file',ZipPath+LicName,FReWrite,Memo1,False) then
- begin
- Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_MSg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+')');
- DataLoading(False,False);
- Exit;
- end;
- if memo1.Lines.Strings[0] = '1' then
- begin
- Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_Msg('錯誤原因:')+memo1.Lines.Strings[1]);
- DataLoading(False,False);
- Exit;
- end
- Else if Pos('<script type="text/javascript" src="scripts/CW00/login.js"></script>',Memo1.Lines.Text) > 0 then
- begin
- Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'));
- DataLoading(False,False);
- Exit;
- end;
- /////上傳MPSLICXXXX.lic /////
- end;
- end;
- Finally
- OpenDialog1.Free;
- S.Free;
- _DelTree(ZipPath);
- end;
- Showmessage(_Msg('匯入完成'));
-end;
-
-procedure TCB_IMGPSScanX.HotKeyDown (var Msg : TMessage);
-begin
-
-end;
-
-procedure TCB_IMGPSScanX.InitialLanguage(Sender: TObject);
-var
- ini : Tmeminifile;
- i,n : Integer;
- FormName : String;
- NowForm : TComponent;
-begin
- if Sender is TActiveForm then
- NowForm := TActiveForm(Sender);
- if Sender is TForm then
- NowForm := TForm(Sender);
-
- FormName := NowForm.Name;
- IISUnit.IIS_LngfileName := LngPath+'Language.Lng'; //給IISUnit 轉多國語言字串用
- if FLanguage = '' then
- FLanguage := 'zh_tw';
- IISUnit.IIS_NowLng := FLanguage;
- ini := TMeminifile.Create(LngPath+'Language.Lng');
- try
- IF NowForm is TForm Then
- TForm(NowForm).Caption := ini.ReadString(FLanguage,FormName+'.FormTitle','');
- for i := 0 to NowForm.ComponentCount - 1 do
- begin
-//ShowMessage(NowForm.Components[i].Name);
- if NowForm.Components[i] is TButton then
- begin
- TButton(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TButton(NowForm.Components[i]).Name,'');
- //TBitBtn(NowForm.Components[i]).Caption := ini.ReadString(FormName,TBitBtn(NowForm.Components[i]).Name,'');
- //TButton(NowForm.Components[i]).OnMouseEnter := BtnMouseEnter;
- end
- Else if NowForm.Components[i] is TBitBtn then
- begin
- TBitBtn(NowForm.Components[i]).Hint := ini.ReadString(FLanguage,FormName+'.'+TBitBtn(NowForm.Components[i]).Name,'');
- //TBitBtn(NowForm.Components[i]).Caption := ini.ReadString(FormName,TBitBtn(NowForm.Components[i]).Name,'');
- TBitBtn(NowForm.Components[i]).OnMouseEnter := BtnMouseEnter;
- end
- Else if NowForm.Components[i] is TMenuItem then
- begin
- if ini.ValueExists(FLanguage,FormName+'.'+TMenuItem(NowForm.Components[i]).Name) then
- TMenuItem(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TMenuItem(NowForm.Components[i]).Name,'');
- end
- Else if NowForm.Components[i] is TCheckBox then
- begin
- TCheckBox(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TCheckBox(NowForm.Components[i]).Name,'');
- end
- Else if NowForm.Components[i] is TPJMenuSpeedButton then
- begin
- TPJMenuSpeedButton(NowForm.Components[i]).Hint := ini.ReadString(FLanguage,FormName+'.'+TPJMenuSpeedButton(NowForm.Components[i]).Name,'');
- end
- Else if NowForm.Components[i] is TLabel then
- begin
- TLabel(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TLabel(NowForm.Components[i]).Name,'');
- end
- Else if NowForm.Components[i] is TGroupBox then
- begin
- TGroupBox(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TGroupBox(NowForm.Components[i]).Name,'');
- end
- Else if NowForm.Components[i] is TListView then
- begin
- for n := 0 to TListView(NowForm.Components[i]).Columns.Count - 1 do
- begin
- TListView(NowForm.Components[i]).Columns.Items[n].Caption := ini.ReadString(FLanguage,FormName+'.'+TListView(NowForm.Components[i]).Name+'_'+inttostr(n),'');
- end;
- end
- Else if NowForm.Components[i] is TRadioGroup then
- begin
- TRadioGroup(NowForm.Components[i]).Caption := ini.ReadString(FLanguage,FormName+'.'+TRadioGroup(NowForm.Components[i]).Name,'');
- for n := 0 to TRadioGroup(NowForm.Components[i]).Items.Count - 1 do
- begin
- TRadioGroup(NowForm.Components[i]).Items.Strings[n] := ini.ReadString(FLanguage,FormName+'.'+TRadioGroup(NowForm.Components[i]).Name+'_'+inttostr(n),'');
- end;
- end;
- end;
- finally
- ini.Free;
- end;
-end;
-
-function TCB_IMGPSScanX.GetSiteOMR(FileName,Site:String;bt: Integer): Integer;
-var
- OMRRect : TRect;
- Xdpi,Ydpi : Integer;
- W,H : Integer;
-begin
- Result := 0;
-//ShowMessage('GetSiteOMR');
-
- IF (ImageScrollBox1.FileName <> FileName) and (FileName <> '') then
- begin
-//ShowMessage('11111'+ImageScrollBox1.FileName+#10#13+FileName);
- ImageScrollBox1.LoadFromFile(FileName,1);
-{
-ShowMessage('UpLPoint='+IntToStr(UpLPoint.X)+','+IntToStr(UpLPoint.Y)+#10#13+
-'UpRPoint='+IntToStr(UpRPoint.X)+','+IntToStr(UpRPoint.Y)+#10#13+
-'DownLPoint='+IntToStr(DownLPoint.X)+','+IntToStr(DownLPoint.Y)+#10#13+
-'DownRPoint='+IntToStr(DownRPoint.X)+','+IntToStr(DownRPoint.Y));
- FindPoint(ImageScrollBox1.Graphic,UpLPoint,UpRPoint,DownLPoint,'');
-ShowMessage('UpLPoint='+IntToStr(UpLPoint.X)+','+IntToStr(UpLPoint.Y)+#10#13+
-'UpRPoint='+IntToStr(UpRPoint.X)+','+IntToStr(UpRPoint.Y)+#10#13+
-'DownLPoint='+IntToStr(DownLPoint.X)+','+IntToStr(DownLPoint.Y)+#10#13+
-'DownRPoint='+IntToStr(DownRPoint.X)+','+IntToStr(DownRPoint.Y));
-}
- ClearLine(ISB_BW.Graphic,bt);
- ISB_BW.Redraw(True);
- Application.ProcessMessages;
- end;
- If ImageScrollBox1.FileName <> '' Then
- begin
-
-//ShowMessage('22222'+ImageScrollBox1.FileName);
- Xdpi := ImagescrollBox1.Graphic.XDotsPerInch;
- Ydpi := ImagescrollBox1.Graphic.YDotsPerInch;
- H := ImageScrollBox1.Graphic.Height;
- W := ImageScrollBox1.Graphic.Width;
-//ShowMessage('Xdpi='+IntToStr(Xdpi)+#10#13+'Ydpi='+IntToStr(Ydpi)+#10#13+'H='+IntToStr(H)+#10#13+'W='+IntToStr(W)+#10#13);
-//ShowMessage('Site='+Site);
- OMRRect := CM_Str2Rect(Site,Xdpi,UpLPoint);
-Display1.Lines.Add('UpLPoint=('+IntToStr(UpLPoint.X)+','+IntToStr(UpLPoint.Y)+');'+Site+';'+IntToStr(OMRRect.Left)+','+IntToStr(OMRRect.top)+','+IntToStr(OMRRect.Right)+','+IntToStr(OMRRect.Bottom));
- if OMRRect.Left < 0 then
- OMRRect.Left := 0;
- if OMRRect.Top < 0 then
- OMRRect.Top := 0;
- if OMRRect.Right > ImageScrollBox1.Graphic.Width then
- OMRRect.Right := ImageScrollBox1.Graphic.Width;
- if OMRRect.Bottom > ImageScrollBox1.Graphic.Height then
- OMRRect.Bottom := ImageScrollBox1.Graphic.Height;
-
- result := Get_OMR(ISB_BW.Graphic,OMRRect);
-//ShowMessage('result='+IntToStr(result));
-
- end;
-end;
-
-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 := True;
- 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
- Else if UpperCase(GetSQLData(WORK_INF_List,'PARA_NO',i)) = 'FILE_COMPRESSION' Then //20171211 jpg to tif 壓縮比
- begin
- PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i);
- FJpgCompression := StrToInt(PARA_CONTENT);
- end
- Else if UpperCase(GetSQLData(WORK_INF_List,'PARA_NO',i)) = 'MAX_UPLOAD_SIZE' Then //取得 上傳大小的限制(MB)
- begin
- PARA_CONTENT := GetSQLData(WORK_INF_List,'PARA_CONTENT',i);
- FMaxUploadSize := 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.HTTPSClientRedirection(Sender: TObject;
- const OldURL: string; var NewURL: string; var AllowRedirection: Boolean);
-begin
- AllowRedirection := 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
-//ShowMessage(IntToStr(v));
- case v of
- -1 : Md := TMouseMode(mmUser);
- 0 : Md := TMouseMode(mmAmplifier);
- 1 : Md := TMouseMode(mmZoom);
- 2 : Md := TMouseMode(mmDrag);
- 3 : Md := TMouseMode(mmR270);
- 4 : Md := TMouseMode(mmR180);
- 5 : Md := TMouseMode(mmR90);
- 6 : Md := TMouseMode(mmDelete);
- end;
- for i := 1 to 8 do
- begin
- ISB := TImageScrollBox(FindComponent('ISB'+inttostr(i)));
- ISB.MouseMode := TMouseMode(Md);
- //Label3.Caption:='v='+IntToStr(v)+' time'+FormatDateTime('yyyy/mm/dd HH:MM:SS', now);
- end;
-end;
-
-Procedure TCB_IMGPSScanX.GoViewMode;
-begin
- case VMode of
- 0: DisplayMode(VMode,1,1,Panel9);
- 1: DisplayMode(VMode,1,1,Panel9);
- 2: DisplayMode(VMode,2,2,Panel9);
- 3: DisplayMode(VMode,2,3,Panel9);
- 4: DisplayMode(VMode,2,4,Panel9);
- end;
-end;
-
-
-Procedure TCB_IMGPSScanX.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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',Memo1.Lines.Text) > 0 then
- begin
- HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入');
- Result := False;
- Exit;
- end;
-
-end;
-
-Function TCB_IMGPSScanX.GetSampleInf : Boolean;
-var
- str:String;
-begin
- Result := False;
- If not ProcessServlet_Get(HTTPSClient,FURL+'service/imgpsc/IMGPSC01/serversampleforocx','work_no='+FWork_no,FReWrite,Memo1,False) Then
- begin
- HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason;
- Result := False;
- Exit;
- end;
- IF memo1.Lines.Strings[0] = '1' Then
- begin
- HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1];
- Result := False;
- Exit;
- end
- Else IF memo1.Lines.Strings[0] = '0' Then
- begin
- str := memo1.Lines.Strings[1];
- SampleFormIDList.CommaText:=str;
-
- Result := True;
- end
- Else if Pos('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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;
-
-function TCB_IMGPSScanX.CheckRequiredColumnValues(workno, caseno:String): Boolean;
-begin
-//
- Result:=False;
- if (workno='HLN') and (caseno[9]='3') then
- Result:=True;
- if (workno='HLN') and (caseno[9]='4') then
- Result:=True;
-end;
-
-Procedure TCB_IMGPSScanX.CheckRule2OMRErrInfo; //檢核規則填入OMRErrINFo Record
-var i : Integer;
- CheckNo : String;
-begin
- for I := 1 to 11 do
- begin
- CheckNo := Add_Zoo(i,3);
-
- if FindSQLData(CHECK_RULE_INF_List,'MESG_SHOW_TYPE,MESG_DISP_TYPE,CHECK_MESG,SCAN_MODE','CHECK_NO',CheckNo,0,FindResult) then
- begin
- if GetFindResult('MESG_SHOW_TYPE') = '1' then
- OMRErrInfo[i].Display := True //顯示
- Else if GetFindResult('MESG_SHOW_TYPE') = '2' then
- OMRErrInfo[i].Display := False; //不顯示
-
- if GetFindResult('MESG_DISP_TYPE') = '1' then
- OMRErrInfo[i].Ignore := True //可忽略
- Else if GetFindResult('MESG_DISP_TYPE') = '2' then
- OMRErrInfo[i].Ignore := False; //不可忽略
-
- OMRErrInfo[i].Info := GetFindResult('CHECK_MESG');
- OMRErrInfo[i].Mode := GetFindResult('SCAN_MODE');
- end;
- end;
-end;
-
-
-
-Procedure TCB_IMGPSScanX.ReNameContext(Path,OldName,NewName:String);
-var
- i : Integer;
-begin
- for i := 0 to ContextList.Count - 1 do
- begin
- if OldName = ContextList.Strings[i] then
- begin
- ContextList.Strings[i] := NewName;
- ContextList.SaveToFile(Path+'Context.dat');
- Context_DocnoList.Strings[i] := FormCode2DocNo(FileName2FormCode(NewName));
- Context_DocnoList.SaveToFile(Path+'Context_DocNo.dat');
- Break;
- end;
- end;
-end;
-
-Procedure TCB_IMGPSScanX.DeleteImageFile(Path,FileName,CaseID:String); // 刪除檔案 (無法得到DocDir用)
-var
- i : Integer;
- FileList:TStringlist;
- DocDir : String;
-begin
-
-
- DeleteFile(Path+FileName);
- DocDir := Path2DocDir(Path,CaseID);
-//ShowMessage('DocDir='+DocDir);
- 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
- if (FMode = 'ESCAN') and (FModeName<>_Msg('異動件')) then
- begin
- if ISExistImg(ImageSavePath+CaseID+'\'+DocDir+'\'+FileList.Strings[i]) then
- begin
- //ShowMessage('有圖為非當次掃瞄，不可刪除');
- Break;
- end;
- end;
-//ShowMessage(FileList.Strings[i]);
- DeleteImageFile(ImageSavePath+CaseID+'\'+DocDir+'\',FileList.Strings[i],CaseID);
- end;
- end;
- finally
- FileList.Free;
- end;
- ReSortFileName(ImageSavePath+CaseID+'\'+DocDir+'\');
- {for i := ContextList.Count - 1 downto 0 do
- begin
- FName := ContextList.Strings[i];
- if FormID = 'Err' then //刪未註冊文件
- begin
- If not FormIDExists(FileName2FormCode(FName),False,0) Then
- begin
- DeleteFile(Path+FName);
- ContextList.Delete(i);
- end;
- end
- Else
- begin
- If FormID = FileName2FormCode(FName) then
- begin
- DeleteFile(Path+FName);
- ContextList.Delete(i);
- end;
- end;
- end;
- ContextList.SaveToFile(Path+'Context.dat');
- ReSortFileName(Path); }
-end;
-
-Function TCB_IMGPSScanX.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;
-
-Function TCB_IMGPSScanX.DeleteDocNoFileForESCAN(Path,DocNo:String):Boolean; //刪除指定DocNo文件
-var
- i,j,k: Integer;
- FName : String;
- ST1,ST2,ST3:TStringList;
-
-begin
-
- Result := False;
-//ShowMessage(DocNo);
- for i := ContextList.Count - 1 downto 0 do
- begin
- FName := ContextList.Strings[i];
- If (DocNo = FormCode2DocNo(FileName2FormCode(FName))) or (DocNo=AttName) then
- begin
- if not ISExistImg(Path+'\'+FName) then
- begin
- DeleteFile(Path+'\'+FName);
- ContextList.Delete(i);
- end;
- Result := True; //有刪到指定文件
- end;
- end;
- ContextList.SaveToFile(Path+'\Context.dat');
- ContextList.LoadFromFile(Path+'\Context.dat');
-
- if ContextList.Count=0 then
- begin
- _DelTree(Path);
- SetDocNoList('D',-1,NowCaseNo,NowDocDir,'');
- end;
-
-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, S2 : TStringlist;
- FormCode,iPage : String;
- docInt,tempInt:integer;
- v,v2:integer;
-begin
- Count := 0;
- docInt:=0;
- tempInt:=0;
- S := TStringlist.Create;
- S2 := TStringlist.Create;
-//ShowMessage('page='+IntToStr(Pages));
- try
- S.LoadFromFile(ImageSavePath+CaseID+'\upload\Context.dat');
- S2.LoadFromFile(ImageSavePath+CaseID+'\upload\DocDir.dat'); //2017 1220 改成只承認第一份的
-
- 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
- if (FWH_category='N') and (FIs_In_Wh='Y') then
- begin
- if ISExistImg(ImageSavePath+CaseID+'\upload\'+S.Strings[n]) then
- begin
- Continue;
- end;
- end;
-
- if (Length(S2.Strings[n])>8) and (Pos(DocNo,S2.Strings[n])<>0) then //2017 1220 改成只承認第一份的
- begin
-//LogFile1.LogToFile(logTimeString+'有進'+docno+','+S2.Strings[n]+IntToStr(Pos(DocNo,S2.Strings[n])));
- v:=Pos('(',S2.Strings[n]);
- v2:=Pos(')',S2.Strings[n]);
- tempInt:=StrToInt(Copy(S2.Strings[n],v+1,v2-v-1));
-
- if docInt=0 then
- begin
- docInt:=tempInt;
- end;
- if docInt<>tempInt then
- begin
-//LogFile1.LogToFile(logTimeString+'docInt='+IntToStr(docInt)+',tempInt='+IntToStr(tempInt));
- Result := Count;
- Break;
- end;
- end;
-
- FormCode := FileName2FormCode(S.Strings[n]);
-//LogFile1.LogToFile(logTimeString+'S.Strings[n]='+S.Strings[n]);
-//Showmessage('1:'+version+','+FormCode2Version(FormCode)+','+DocNo+','+FormCode2DocNo(FormCode)+','+iPage+','+FormCode2Page(FormCode));
-//LogFile1.LogToFile(logTimeString+'FormCode='+FormCode);
-LogFile1.LogToFile(logTimeString+'CheckCaseDocNoPage caseno='+CaseID+','+version+','+FormCode2Version(FormCode)+','+DocNo+','+FormCode2DocNo(FormCode)+','+iPage+','+FormCode2Page(FormCode));
-//ShowMessage(DocNo+','+IntToStr(docInt)+','+IntToStr(tempInt));
-//LogFile1.LogToFile(logTimeString+'FormCode='+FormCode);
- if (version = FormCode2Version(FormCode)) and (DocNo = FormCode2DocNo(FormCode)) and (ipage = FormCode2Page(FormCode)) then
- begin
-LogFile1.LogToFile(logTimeString+'CheckCaseDocNoPage caseno='+CaseID+','+version+','+FormCode2Version(FormCode)+','+DocNo+','+FormCode2DocNo(FormCode)+','+iPage+','+FormCode2Page(FormCode));
-//Showmessage(version+','+DocNo+',iPage='+iPage);
-//Showmessage(inttostr(Count+1));
- Inc(Count);
- Break; //找到了...離開
- end;
- end;
- end;
- finally
- S.Free;
- S2.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
- if FWH_category='N' then
- begin
- if ISExistImg(ImageSavePath+CaseID+'\upload\'+S.Strings[i]) then
- begin
- Continue;
- end;
- end;
- iFormCode := FileName2FormCode(S.Strings[i]);
- if FormCode = iFormCode then
- begin
- Inc(Count);
- end;
- end;
- finally
- S.Free;
- end;
- Result := Count;
-end;
-
-Function TCB_IMGPSScanX.GetDataFormCodePages(FormCode:String):Integer; //取記錄的FormcID的頁數
-begin
- If FindSQLData(FORM_INF_List,'T1.MAX_PAGE','T1.FORM_ID',FormCode,0,FindResult) Then
- begin
- IF GetFindResult('T1.MAX_PAGE') = '' Then
- Result := 9999
- Else
- Result := Strtoint(GetFindResult('T1.MAX_PAGE'));
- end;
-end;
-
-Procedure TCB_IMGPSScanX.CaseReSize(CaseID:String); //案件的影像縮放
-var
- S : TStringlist;
- FileName : String;
- i : Integer;
-begin
- {if FileExists(ImageSavePath+CaseID+'\ReSize.dat') then
- DeleteFile(ImageSavePath+CaseID+'\ReSize.dat');}
- if FileExists(ImageSavePath+CaseID+'\Upload\AnchorError.dat') then
- DeleteFile(ImageSavePath+CaseID+'\Upload\AnchorError.dat');
- S := TStringlist.Create;
- try
- S.LoadFromFile(ImageSavePath+CaseID+'\Upload\Context.dat');
- For i := 0 to S.Count -1 do
- begin
- FileName := S.Strings[i];
- ImageReSize_FormID(CaseID,FileName); //依十字定位點做縮放
- end;
- finally
- S.Free;
- end;
-end;
-
-Procedure TCB_IMGPSScanX.ImageReSize_FormID(CaseID,FileName:String); //依十字定位點做縮放
-var
- FormID : String;
- DH,DW : String;
- NowW,NowH : Integer;
- ANCHOR : String; //是否有十字線
- SizeStr : String;
- S : TStringlist;
- v,v1:Integer;
- IsRecordMD5:Boolean;
-begin
- IsRecordMD5:=False;
- FormID := FileName2FormCode(FileName);
- if FormID = '' then Exit;
-
- IF FindSQLData(FORM_INF_List,'T1.FORM_HEIGHT,T1.FORM_WIDTH,T1.ANCHOR','T1.FORM_ID',FormID,0,FindResult) then
- begin
- DH := GetFindResult('T1.FORM_HEIGHT');
- DW := GetFindResult('T1.FORM_WIDTH');
- ANCHOR := UpperCase(GetFindResult('T1.ANCHOR'));
- ANCHOR := Index2Anchor(ANCHOR);
-Display1.Lines.Add(FormID+','+DH+','+DW);
-//ShowMessage('AAAAAAAAA');
- if ((ANCHOR = 'ANCHOR') or (ANCHOR = 'FRAME')) and (DH <> '') and (DW <> '') then //有十字定位點
- begin
-//ShowMessage('BBBBBBB');
- ImageScrollBox1.LoadFromFile(ImageSavePath+CaseID+'\Upload\'+FileName,1);
-
- if (FWH_category='N') and ISExistImg(ImageSavePath+CaseID+'\Upload\'+FileName) then
- begin
- Exit;//20171103 補件 原有的圖不作resize
- end;
-
- //FindPoint(ImageScrollBox1.Graphic,UpLPoint,UpRPoint,DownLPoint,NowW,NowH);
- FindPoint(ISB_BW.Graphic,UpLPoint,UpRPoint,DownLPoint,NowW,NowH,ANCHOR);
-
- SizeStr := CheckSize(ISB_BW,UpLPoint,UpRPoint,DownLPoint,DW,DH);
- ImageResize(ImageScrollBox1.Graphic,ISB_BW.Graphic.Width,ISB_BW.Graphic.Height);
-
- FindPoint(ISB_BW.Graphic,UpLPoint,UpRPoint,DownLPoint,NowW,NowH,ANCHOR);
- v := 5;
- v1 := length(SizeStr);
- IF (SizeStr <> '') and (Copy(SizeStr,1,v) <> 'ERROR') then
- begin
-//ShowMessage('CCCCC');
- if (ISExistImg(ImageSavePath+CaseID+'\Upload\'+FileName)) and (reSizeExistImgList.IndexOf(LoadFileGetMD5(ImageSavePath+CaseID+'\Upload\'+FileName))=-1) then
- begin
- IsRecordMD5:=True;
- end;
- ImageScrollBox1.SaveToFile(ImageSavePath+CaseID+'\Upload\'+FileName);
- if IsRecordMD5 then
- begin
- reSizeExistImgList.add(LoadFileGetMD5(ImageSavePath+CaseID+'\Upload\'+FileName));
- end;
-//showmessage(ImageSavePath+CaseID+'\Upload\'+FileName);
- S := TStringlist.Create; ///20110422拿掉 換成上傳才做
- if FileExists(ImageSavePath+CaseID+'\Upload\ReSize.dat') then
- S.LoadFromFile(ImageSavePath+CaseID+'\Upload\ReSize.dat');
- //S.Add(FormCode2FormName(FormID)+' '+SizeStr);
- S.Add(FileName+','+SizeStr+#8+DateTimetoStr(Now));
- S.SaveToFile(ImageSavePath+CaseID+'\Upload\ReSize.dat');
- S.Free;
- end;
- if (Copy(SizeStr,1,v) = 'ERROR') then //未找到三個定位點
- begin
- S := TStringlist.Create;
- if FileExists(ImageSavePath+CaseID+'\Upload\AnchorError.dat') then
- S.LoadFromFile(ImageSavePath+CaseID+'\Upload\AnchorError.dat');
- S.Add(FileName+'-->'+Copy(SizeStr,V+1,V1-v));
- S.SaveToFile(ImageSavePath+CaseID+'\Upload\AnchorError.dat');
- S.Free;
- end;
-
- ImageScrollBox1.FileName := '';
- end;
- end;
-end;
-
-Procedure TCB_IMGPSScanX.ImageReSize_tmp(FormID,FileName:String); //依十字定位點做縮放(暫存檔)
-var
- DH,DW : String;
- ANCHOR : String; //是否有十字線
- SizeStr : String;
- S : TStringlist;
-begin
- IF FindSQLData(FORM_INF_List,'T1.FORM_HEIGHT,T1.FORM_WIDTH,T1.ANCHOR','T1.FORM_ID',FormID,0,FindResult) then
- begin
- DH := GetFindResult('T1.FORM_HEIGHT');
- DW := GetFindResult('T1.FORM_WIDTH');
- ANCHOR := UpperCase(GetFindResult('T1.ANCHOR'));
- ANCHOR := Index2Anchor(ANCHOR);
- if ((ANCHOR = 'ANCHOR') or (ANCHOR = 'FRAME')) and (DH <> '') and (DW <> '') then //有十字定位點
- begin
- ImageScrollBox1.LoadFromFile(FileName,1);
- SizeStr := CheckSize(ImageScrollBox1,UpLPoint,UpRPoint,DownLPoint,DW,DH);
- IF SizeStr <> '' then
- begin
- ImageScrollBox1.SaveToFile(FileName);
- end;
- ImageScrollBox1.FileName := '';
- end;
- end;
-end;
-
-procedure TCB_IMGPSScanX.ImageScrollBox1NewGraphic(const Graphic: TDibGraphic);
-begin
- IF ImageScrollBox1.Graphic.Empty Then Exit;
- ISB_BW.Graphic.Assign(ImageScrollBox1.Graphic);
- If ImageScrollBox1.Graphic.ImageFormat <> ifBlackWhite Then
- begin
- ConvertToBW(ISB_BW.Graphic);
- end;
-end;
-
-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;
- Fname:String;
- FileRec:TSearchrec;
-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);
-//ShowMessage(LastInitFormidList.Text);
- ST2:=TStringList.Create;
-
- for I := 0 to ST1.Count - 1 do
- begin
- if (Pos('_',St1.Strings[i])<>1) and (Pos('_',St1.Strings[i])<>-1) then
- begin
- str1:=Copy(ST1.Strings[i],1,Pos('_',St1.Strings[i])-1);
- ST2.Add(str1);
- must_formidStr:= must_formidStr+str1+'@#,';
- end;
- end;
- must_formidStr:=Copy(must_formidStr,1,Length(must_formidStr)-3) ;
-//ShowMessage('must_formidStr='+must_formidStr);
-//ShowMessage('AST2='+ST2.Text);
- 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;
-//ShowMessage('BST2='+ST2.Text);
- for I := 0 to ST2.Count - 1 do
- begin
- last_add_formidstr:=last_add_formidstr+ST2.Strings[i]+'@#,';
- end;
- last_add_formidstr:=Copy(last_add_formidstr,1,Length(last_add_formidstr)-3) ;
- ST1.Free;
- ST2.Free;
-//ShowMessage('last_add_formidstr='+last_add_formidstr);
- ///////必要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'); //有遮罩設定的才產生
- /////壓檔////
- ///檢查上傳的zip大小////
- FName :=Path+ 'Img.zip';
-
- FindFirst(FName, faAnyfile, FileRec);
-
- //FMaxUploadSize
-//ShowMessage(IntToStr(FileRec.Size));
-//Result:=False;
-//exit; //目前上傳檔案大小為xxMB，已超過50MB，無法上傳 %.3f ,[FileRec.Size / 1048576]
- If FileRec.Size > StrtoInt(FMaxUploadSize) * 1048576 Then // 檢查檔案大小
- Begin
- ShowMessage(Format(_Msg('%s目前上傳檔案大小為%.3fMB，已超過%sMB，無法上傳'),[caseid,FileRec.Size / 1048576,FMaxUploadSize]));
- //ShowMessage(Format('%s目前上傳檔案大小為%.3fMB，已超過'+FMaxUploadSize+'MB，無法上傳',[caseid,FileRec.Size / 1048576]) );
- FindClose(FileRec);
- Result := False;
- Exit;
- End;
- FindClose(FileRec);
- ///檢查上傳的zip大小////
-//ShowMessage('last_add_formidstr='+last_add_formidstr);
- ////上傳/////
- 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);
- //Showmessage('Wait');
-
- if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/caseupload',SendData,'file',Path+'Img.zip',FReWrite,Memo1,False) then
- begin
- Showmessage(Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+'.');
- Result := False;
- Exit;
- end;
- if memo1.Lines.Strings[0] = '1' then
- begin
- Showmessage(Format(_Msg('')+_Msg(''),[CaseID])+memo1.Lines.Strings[1]+'。');
- Result := False;
- Exit;
- end
- Else if Pos('<script type="text/javascript" src="scripts/IMGPS00/login.js"></script>',Memo1.Lines.Text) > 0 then
- begin
- Showmessage(Format(_Msg('')+_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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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('<script type="text/javascript" src="scripts/IMGPS00/login.js"></script>',Memo1.Lines.Text) > 0 then
- begin
- HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入');
- Result := False;
- Exit;
- end;
-//ShowMessage('替換zip');
- AttPath := Path + 'AttFile\';
- if FileExists(Path+CaseID+'.zip') then
- begin
- ExecuteUnZip(Path+CaseID+'.zip',Path,True);
- if FileExists(Path+'img.zip') then
- begin
- ExecuteUnZip(Path+'img.zip',Path,False);
- end;
- if FileExists(Path+'att.zip') then
- begin
- Str2Dir(AttPath);
- ExecuteUnZip(Path+'att.zip',AttPath,False);
- end;
- end
- Else
- begin
- HttpErrStr := _Msg('找不到影像');
- Result := True;
- Exit;
- end;
-
-end;
-
-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
- if FWH_category='N' then
- begin
- if (ISExistImg(Path+S.Strings[i])) or (reSizeExistImgList.IndexOf(LoadFileGetMD5(Path+S.Strings[i]))<>-1) then
- begin
- Continue;
- end;
- end;
- 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]); //20170912 要刪除 不然我寫不下去
-
- 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]); //20170912 要刪除 不然我寫不下去
- 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));
-//ShowMessage('FileName='+FileName);
- if DocDir = '' then
- DocDir := AttName ; //附件
- ContextList.Clear;
- if FileExists(ImageSavePath+CaseNo+'\'+DocDir+'\Context.dat') then
- ContextList.LoadFromFile(ImageSavePath+CaseNo+'\'+DocDir+'\Context.dat');
- SetRecordEditedDocDir('A',CaseNo,DocDir); //記錄文件有異動
- case Mode of
- 'A':begin
- ContextList.Add(FileName);
- end;
- 'I':begin
- ContextList.Insert(Index,FileName);
- end;
- 'E':begin
- ContextList.Strings[Index] := FileName;
- end;
- 'D':begin
- if Index <> -1 then
- begin
- ContextList.Delete(Index);
- end
- Else if (text <> '') then
- begin
- for i := 0 to ContextList.Count - 1 do
- begin
- if FileName = ContextList.Strings[i] then
- begin
- ContextList.Delete(i);
- Break;
- end;
- end;
- end;
- if ContextList.Count = 0 then
- DeleteFile(ImageSavePath+CaseNo+'\'+DocDir+'\Context.dat');
- end;
- end;
- if ContextList.Count > 0 then
- begin
- ContextList.SaveToFile(ImageSavePath+CaseNo+'\'+DocDir+'\Context.dat');
- end;
-end;
-
-Procedure TCB_IMGPSScanX.SetAttContextList(Mode:Char;Index:Integer;CaseNo,FileName:String); //'A:加入,I:插入,D:刪除,E:修改'
-var
- i : Integer;
-begin
- AttContextList.Clear;
- if FileExists(ImageSavePath+CaseNo+'\AttContext.dat') then
- AttContextList.LoadFromFile(ImageSavePath+CaseNo+'\AttContext.dat');
- case Mode of
- 'A':begin
- AttContextList.Add(FileName);
- end;
- 'I':begin
- AttContextList.Insert(Index,FileName);
- end;
- 'E':begin
- AttContextList.Strings[Index] := FileName;
- end;
- 'D':begin
- if Index <> -1 then
- begin
- AttContextList.Delete(Index);
- end
- Else if (text <> '') then
- begin
- for i := 0 to AttContextList.Count - 1 do
- begin
- if FileName = AttContextList.Strings[i] then
- begin
- AttContextList.Delete(i);
- Break;
- end;
- end;
- end;
- if AttContextList.Count = 0 then
- DeleteFile(ImageSavePath+CaseNo+'\AttContext.dat');
- end;
- end;
- if AttContextList.Count > 0 then
- begin
- AttContextList.SaveToFile(ImageSavePath+CaseNo+'\AttContext.dat');
- end;
-end;
-
-Function TCB_IMGPSScanX.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;
-
-Function TCB_IMGPSScanX.CheckCaseAttach_OK:Boolean; //檢查是否有未歸類的案件
-var
- i,j : Integer;
-begin
- Result := True;
- for i := 0 to NewTreeNode.Count - 1 do
- begin
- for j := 0 to NewTreeNode.Item[i].Count - 1 do
- begin
- if Pos(_msg('未歸類'),NewTreeNode.Item[i].Item[j].Text) > 0 then
- begin
- Result := False;
- Break;
- end;
- 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;
- ST1:TStringList;
-begin
- ST1:=TStringList.Create;
- OldFileList := TStringlist.Create;
- NewFileList := TStringlist.Create;
- try
- NewDocNo := FormCode2DocNo(NewFormID);
- NewDocDir := FindLastestDocDir(CaseID,NewDocNo);
-
- /////20190319 Hong 原本的程式判斷怪怪的先Mark在下方,改用這段
- if DocNoNeedDiv(NewDocNo) then //要分份數
- begin
- if ((FormCode2Page(NewFormID) = '01') and (GetDocDir_Page(CaseID,NewDocDir)>0)) or (NewDocDir = '') then
- begin
- NewDocDir := DocNo2DocNoDir(ImageSavePath + CaseID+'\',NewDocNo);
- end
- else
- begin //20171016 真對補件影響 所加的判斷
- ST1.Clear;
- if FileExists(ImageSavePath + CaseID+'\'+NewDocDir+'\Context.dat') then
- begin
- ST1.LoadFromFile(ImageSavePath + CaseID+'\'+NewDocDir+'\Context.dat');
- if (ST1.Count > 0) and ISExistImg(ImageSavePath + CaseID+'\'+NewDocDir+'\'+ST1.Strings[0]) then //20181210 多增加判斷ST1>0 否則會有機會出現List out of bound Hong
- begin
- NewDocDir := DocNo2DocNoDir(ImageSavePath + CaseID+'\',NewDocNo);
- end;
- end;
- end;
- end
- Else //不分份數
- begin
- if NewDocNo <> '' then
- NewDocDir := NewDocNo
- else //Attach 附件
- NewDocDir := DocNo2DocNoDir(ImageSavePath + CaseID+'\',NewDocNo);
- end;
-
- {if NewDocDir = '' then
- begin
- if DocNoNeedDiv(NewDocNo) then
- begin
- NewDocDir:=DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',NewDocNo);
- end
- else
- begin
- NewDocDir := NewDocNo;
- end;
- end;
-//ShowMessage('NewDocDir='+NewDocDir);
- if DocNoNeedDiv(NewDocNo) and (FormCode2Page(NewFormID)='01') then
- begin
- NewDocDir := DocNo2DocNoDir(ImageSavePath+CaseID+'\',NewDocNo);
- end
- else
- begin
- ST1.Clear;
- if FileExists(ImageSavePath + NowCaseno+'\'+NewDocDir+'\Context.dat') then
- begin
- ST1.LoadFromFile(ImageSavePath + NowCaseno+'\'+NewDocDir+'\Context.dat');
- if ISExistImg(ImageSavePath + NowCaseno+'\'+NewDocDir+'\'+ST1.Strings[0]) then
- begin
- NewDocDir := DocNo2DocNoDir(ImageSavePath + NowCaseno+'\',NewDocNo);
- end;
- end;
- end; }
- if Not DirectoryExists(ImageSavePath+CaseID+'\'+NewDocDir) then
- begin
- MkDir(ImageSavePath+CaseID+'\'+NewDocDir);
- SetDocNoList('A',-1,CaseID,NewDocDir,'1');
- end;
- if FileExists(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat') then
- OldFileList.LoadFromFile(ImageSavePath+CaseID+'\'+DocDir+'\Context.dat');
- if FileExists(ImageSavePath+CaseID+'\'+NewDocDir+'\Context.dat') then
- NewFileList.LoadFromFile(ImageSavePath+CaseID+'\'+NewDocDir+'\Context.dat');
- for i := 0 to OldFileList.Count - 1 do
- begin
- OldFile := OldFileList.Strings[i];
- Ext := ExtractFileExt(OldFile);
- if FileName2FormCode(OldFile) = OldFormID then
- begin
- NewFile := Add_Zoo(NewFileList.Count+1,3)+'_'+NewFormID+Ext;
- CopyFile(PWideChar(ImageSavePath+CaseID+'\'+DocDir+'\'+OldFile),PWideChar(ImageSavePath+CaseID+'\'+NewDocDir+'\'+NewFile),False);
- NewFileList.Add(NewFile);
- SetContextList('A',-1,CaseID,NewDocDir,NewFile);
- end;
- end;
- DeleteFormCodeFile(CaseID,DocDir,OldFormID);
-
- {for i := 0 to S.Count - 1 do
- begin
- FormID := FileName2FormCode(S.Strings[i]);
- if FormID = OldFormID then
- begin
- OldFile := S.Strings[i];
- Ext := ExtractFileExt(OldFile);
- //NewFile := Copy(S.Strings[i],1,3)+'_'+NewFormID+Ext;
- NewFile := Add_Zoo(FileName2ScanPage(S.Strings[i]),3)+'_'+NewFormID+Ext;
- ReNameFile(Path+OldFile,Path+NewFile);
- S.Strings[i] := NewFile;
- end;
- end;
- S.SaveToFile(Path+'Context.dat');
- ContextList.LoadFromFile(Path+'Context.dat'); }
-
- finally
- OldFileList.Free;
- NewFileList.Free;
- ST1.Free;
- end;
-end;
-
-Procedure TCB_IMGPSScanX.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.GetCasePage(Path,CaseID:String):Integer;
-var
- DocDirList,FileList,ST1 :TStringlist;
- iDocDir,iDocNo : String;
- i,n,Count : Integer;
-begin
- Count := 0;
- DocDirList := TStringlist.Create;
- FileList := TStringlist.Create;
- ST1:=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; //20170817 先註解
-
- FileList.Clear;
- if FileExists(Path+CaseID+'\'+iDocDir+'\Context.dat') then
- begin
- FileList.LoadFromFile(Path+CaseID+'\'+iDocDir+'\Context.dat');
-
- if (FWH_category='N') and (FIs_In_Wh='Y') then
- begin
- ST1.Clear;
- for n := 0 to FileList.Count - 1 do
- begin
- if ISExistImg(Path+CaseID+'\'+iDocDir+'\'+FileList.Strings[n]) then
- begin
- ST1.Add(FileList.Strings[n]);
- end;
- end;
-
- for n := 0 to ST1.Count - 1 do
- begin
- if (FileList.IndexOf(ST1.Strings[n])<>-1) and (not DocNoIs_In_WH(iDocNo)) then
- begin
- FileList.Delete(FileList.IndexOf(ST1.Strings[n]));
- end;
- end;
- end
- Else
- if not DocNoAppear(iDocNo) then Continue; //20180925 Hong覺得應該要加這段
- end;
-
-
- 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;
- ST1.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,k: Integer;
- CaseList,DocList,FileList,ST1 : TStringlist;
-begin
- Result := False;
- CaseCount := 0;
- PageCount := 0;
- CaseList := TStringlist.Create;
- DocList := TStringlist.Create;
- FileList := TStringlist.Create;
- ST1:= TStringlist.Create;
- try
- ImageSavePath := ImagePath;
- CaseList.Clear;
- if FileExists(ImageSavePath + 'CaseList.dat') then
- CaseList.LoadFromFile(ImageSavePath + 'CaseList.dat');
- CaseCount := CaseCount+CaseList.Count;
-//ShowMessage('ImageSavePath='+ImageSavePath+#10#13+'CaseList.Count='+IntToStr(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');
-//ShowMessage('DocList='+DocList.Text);
- for n := 0 to DocList.Count - 1 do
- begin
-//ShowMessage(DocList.Strings[n]+','+BoolToStr(DocNoAppear(DocNoDir2DocNo(DocList.Strings[n])),true));
- 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='+FileList.Text);
- PageCount := PageCount+FileList.Count;
-//Showmessage('PageCount='+inttostr(PageCount));
- if (FWH_category='N') and (FIs_In_Wh='Y') then //20170912 針對非入庫並當次掃描做頁數計算
- begin
- if FileExists(ImageSavePath+NowCaseno+'\EditedDocDir.dat') then
- begin
- ST1.LoadFromFile(ImageSavePath+NowCaseno+'\EditedDocDir.dat');
- for n := 0 to ST1.Count - 1 do
- begin
- if ST1.Strings[n]=AttName then Continue;
-//ShowMessage(ST1.Strings[n]+','+BoolToStr(DocNoIs_In_WH(DocNoDir2DocNo(ST1.Strings[n])),true));
- if not DocNoIs_In_WH(DocNoDir2DocNo(ST1.Strings[n])) then
- begin
-
- FileList.Clear;
- if FileExists(ImageSavePath+CaseList.Strings[i]+'\'+ST1.Strings[n]+'\Context.dat') then
- begin
- FileList.LoadFromFile(ImageSavePath+CaseList.Strings[i]+'\'+ST1.Strings[n]+'\Context.dat');
- for k := 0 to FileList.Count - 1 do
- begin
- if not ISExistImg(ImageSavePath+CaseList.Strings[i]+'\'+ST1.Strings[n]+'\'+FileList.Strings[k]) then
- PageCount := PageCount+1;
- end;
- end;
- end;
- end;
- end;
- end;
- end;
- Finally
- CaseList.Free;
- DocList.Free;
- FileList.Free;
- ST1.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 do //20180920 拿掉-1
- 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
- try
- S.Add(Case_loandoc);
- S.SaveToFile(Path+'CaseIndex.dat');
- except on E: Exception do
- end;
-
- 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.ReduceLogFile; //20171011 必免log檔掌太大
-var
- ST1:TStringlist;
- I:integer;
-begin
- ST1:=TStringList.Create;
- if FileExists(LngPath+'IMGPSCheck.log') then
- begin
- ST1.LoadFromFile(LngPath+'IMGPSCheck.log');
- if ST1.count>100000 then
- begin
- for I := 0 to 10000 do
- begin
- ST1.Delete(0);
- end;
- ST1.SaveToFile(LngPath+'IMGPSCheck.log');
- end;
- end;
- ST1.Free;
-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');
-
- AttContextList.Clear;
- if FileExists(SoPath+'ATTContext.dat') then
- AttContextList.LoadFromFile(SoPath+'ATTContext.dat');
- for n := 0 to AttContextList.Count - 1 do
- begin
- ZipFileList.Add(SoPath+AttContextList.Strings[n]);
- end;
- if FileExists(SoPath+'ATTContext.dat') then
- ZipFileList.Add(SoPath+'ATTContext.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;
-
-procedure TCB_IMGPSScanX.ScanGrayCBClick(Sender: TObject);
-begin
-
- if ScanGrayCB.Checked then
- begin
- ScanColor:=ifGray256;
- end
- else
- begin
- if FScanColor = 0 then
- begin
- ScanColor := ifBlackWhite;
- end;
-
- if FScanColor = 1 then
- begin
- //ScanColor := ifGray256 ;
- ScanColor := ifBlackWhite; //
- end;
-
-
- if FScanColor = 2 then
- begin
- ScanColor := ifTrueColor ;
- end;
- end;
-
-end;
-
-Function TCB_IMGPSScanX.GetFormatID(CaseID: string):String;
-Var
- S : TStringlist;
- FormatID : String;
-begin
- Result := '';
- S := TStringlist.Create;
- try
- if FileExists(ImageSavePath+CaseID+'\CaseIndex.dat') then
- begin
- S.LoadFromFile(ImageSavePath+CaseID+'\CaseIndex.dat');
- //Format_ID := S.Strings[5]; //主鍵值 (報價單號or續保單號or保單號碼or保險證號or原案件受編)
- //Result := Format_ID;
- //Handle_No := S.Strings[0]; //經辦代號
- //Cen_Uid := S.Strings[1]; //被保人ID
- //Cen_Cliname := S.Strings[2]; //被保人姓名
- //Cen_Platno := S.Strings[3]; //車號
- //Case_Priority := S.Strings[4];//案件等級
- end;
- finally
- S.Free;
- end;
-end;
-
-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 := _Msg('自行輸入');
- 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;
- Anchor : String;
-begin
- ShowText := _Msg('處理檢核失敗中,請稍候');
- DataLoading(True,True);
-LogFile1.LogToFile(logTimeString+'處理檢核失敗中開始');
- ErrlistForm := TErrlistForm.Create(Self);
- RejectCase := False;
- S := TStringlist.Create;
- try
- InitialLanguage(ErrlistForm);
- Application.ProcessMessages;
- ErrlistForm.LogFile1.LogFile:=LogFile1.LogFile;
- ErrlistForm.DeleteBt.Caption := ErrlistForm.DeleteBt.Caption+'(&D)';
- ErrlistForm.iniPath := ImageSavePath + NowCaseNo+'\upload\';
- OMRErrini2List(NowCaseno,ErrlistForm);
- ErrlistForm.ErrListLV.ItemIndex := ErrIndex;
- ErrlistForm.Timer1.Enabled := true;
- if ErrlistForm.ShowModal = mrok then
- begin
- TransPath := ImageSavePath+NowCaseNo+'\upload\';
- if FMode = 'ISCAN' then
- TransPath := ImageSavePath + NowCaseNo+'\DownTemp\';
- ShowText := NowCaseNo+_Msg('資料上傳中,請稍候');
- DataLoading(True,True);
-
- if FMode = 'ISCAN' then
- begin
- If Not TransCaseID(TransPath,NowCaseNo,True) Then //傳送案件
- begin
- DataLoading(False,False);
- Exit;
- end;
- end
- Else
- begin
- If Not TransCaseID(TransPath,NowCaseNo,True) Then //傳送案件
- begin
- DataLoading(False,False);
- Exit;
- end;
- end;
- CaseHelpBtn.Visible := False;
- LoadImgFile;
- if (FMode='NSCAN') or (FMode='DSCAN') then
- begin
- Showmessage(NowCaseNo+_Msg('影像上傳完成。此案已進入下一流程。'));
- end;
-
- if FMode='ESCAN' then
- begin
- Showmessage(NowCaseNo+_Msg('影像已補件完成。'));
- end;
-
- DataLoading(False,False);
- end
- Else
- begin
- MyTreeNode2ReFresh(NowCaseNo);
- end;
- finally
- ErrlistForm.Free;
- DataLoading(False,False);
- S.Free;
- end;
-end;
-
-procedure TCB_IMGPSScanX.CheckCaseBtnClick(Sender: TObject);
-Var
- CaseID : String;
- i,n,v : Integer;
- S : TStringlist;
-begin
- //if TreeView1.Selected = nil then Exit;
- //if TreeView1.Selected = NewTreeNode then Exit;
- Displaypath := ''; //20130327 修正報價單號會錯置的問題
- S := TStringlist.Create;
- try
- ClearView(1);
- ShowText := CaseID+_Msg('檢核中,請稍候');
- DataLoading(True,True);
- For i := 0 to NewTreeNode.Count -1 do
- begin
- v := posend('-',NewTreenode.Item[i].Text);
- CaseID := Copy(NewTreenode.Item[i].Text,1,v-1);
- ShowText := CaseID+_Msg('檢核中,請稍候');
- DataLoading(True,True);
- if (NewTreenode.Item[i].ImageIndex <> 7) and (NewTreenode.Item[i].ImageIndex <> 5) then //檢核完成的不再檢核
- begin
- If OMRCheckCase(CaseID) then //有成功
- begin
- S.Add('Y');
- S.SaveToFile(ImageSavePath+CaseID+'\OMRCheckOk.dat');
- end;
- end;
- //MyTreeNode2ReFresh(CaseID); //原本是OMR單一案件,後改成OMR全部案件 所以這個要mark
- end;
- LoadImgFile;
- TreeView1Click(nil);
- DataLoading(False,False);
- finally
- S.Free;
- end;
- Showmessage(_Msg('檢核完成'));
-end;
-
-procedure TCB_IMGPSScanX.ClearView(stkv:Integer);
-var i:integer;
- ISB : TImageScrollBox;
- lb : TLabel;
-begin
- For i:= stkv to 8 do
- begin
- ISB := TImageScrollBox(FindComponent('ISB'+intToStr(i)));
- ISB.FileName := '';
- Lb := TLabel(FindComponent('Lb'+intToStr(i)));
- Lb.Caption := '';
- end;
- FreePreViewISB;
- ISB1Click(ISB1);
-end;
-
-Function TCB_IMGPSScanX.DrawDocItem2(CaseNode : TTreenode;Caseno:String):Boolean; //畫出文件名稱的Tree
-Var
- i,n,m : Integer;
- DocNode,FormNode : TTreeNode;
- DocNoPage,FormPage : Integer;
- DocNoCopies : Integer;
- DocNo,iDocNo : String;
- DocVer : String;
- FileList : TStringlist;
- FormID,iFormID : String;
- FormName : String;
- CaseDocNoList,CaseDocNo_CopiesList,StrList : TStringlist;
- iiDocNo,iiFormID,iiDocVer : String;
- ST1:TStringList;
-begin
- Result := False;
- FileList := TStringlist.Create;
- CaseDocNoList := TStringlist.Create;
- CaseDocNo_CopiesList := TStringlist.Create;
- StrList := TStringlist.Create;
- ST1:=TStringList.Create;
-LogFile1.LogToFile(logTimeString+'產文件樹開始');
- try
- CaseNode.ImageIndex := 1;
- CaseNode.SelectedIndex := 1;
- While CaseNode.Count > 0 do //全刪
- begin
- CaseNode.Item[0].Delete;
- end;
- CaseDocNoList.Clear;
- if FileExists(ImageSavePath+Caseno+'\CaseDocNo.dat') then
- CaseDocNoList.LoadFromFile(ImageSavePath+Caseno+'\CaseDocNo.dat');
- if FileExists(ImageSavePath+Caseno+'\CaseDocNo_Copies.dat') then
- CaseDocNo_CopiesList.LoadFromFile(ImageSavePath+Caseno+'\CaseDocNo_Copies.dat');
- for i := 0 to CaseDocNoList.Count - 1 do
- begin
- FileList.Clear;
- //Showmessage(ImageSavePath+Caseno+'\'+CaseDocNoList.Strings[i]+'\Context.dat');
- if FileExists(ImageSavePath+Caseno+'\'+CaseDocNoList.Strings[i]+'\Context.dat') then
- FileList.LoadFromFile(ImageSavePath+Caseno+'\'+CaseDocNoList.Strings[i]+'\Context.dat');
- iDocNo := DocNoDir2DocNo(CaseDocNoList.Strings[i]);
- ST1.Clear;
-
-LogFile1.LogToFile(logTimeString+'FileList.Text='+FileList.CommaText);
- if (FWH_category='N') and (FIs_In_Wh='Y') then
- begin
- for n := 0 to FileList.Count - 1 do
- begin
- if ISExistImg(ImageSavePath+Caseno+'\'+CaseDocNoList.Strings[i]+'\'+FileList.Strings[n]) then
- begin
- ST1.Add(FileList.Strings[n]);
- end;
- end;
- for n := 0 to ST1.Count - 1 do
- begin
- if (FileList.IndexOf(ST1.Strings[n])<>-1) and (not DocNoIs_In_WH(iDocNo)) then
- begin
- FileList.Delete(FileList.IndexOf(ST1.Strings[n]));
- end;
- end;
- end
- Else
- if not DocNoAppear(iDocNo) then Continue; //20180925 Hong覺得應該加這段
-
-
-
-LogFile1.LogToFile(logTimeString+'WH_category='+FWH_category+',Is_In_Wh='+FIs_In_Wh+',FileList.Text='+FileList.CommaText);
- if FileList.Count=0 then Continue;
-
- DocNoCopies := Strtoint(CaseDocNo_CopiesList.Strings[i]);
- DocNoPage := FileList.Count;
- iDocNo := DocNoDir2DocNo(CaseDocNoList.Strings[i]);
-//Showmessage(iDocNo);
-//Showmessage(DocNo2DocName(Caseno,iDocNo));
-//ShowMessage('FileList='+FileList.Text);
- {if (((FIs_In_Wh = 'Y') and (not DocNoIs_In_WH(iDocNo))) or //入庫掃描不看非入庫文件
- ((FIs_In_Wh = 'N') and (DocNoIs_In_WH(iDocNo)))) and
- ((iDocNo <> 'Attach') and (Copy(iDocNo,1,5)<>'ZZZZZ')) then //非入庫掃描不看入庫文件
- begin
- Continue;
- end;}
-
- //if not DocNoAppear(iDocNo) then Continue;
-
-
- //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('頁'),[CaseDocNoList.Strings[i],DocNo2DocName(Caseno,iDocNo),DocNoPage]));
- //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('份'),[CaseDocNoList.Strings[i],DocNo2DocName(Caseno,iDocNo),DocNoCopies]));
-//ShowMessage('iDocNo='+iDocNo);
- DocNode := TreeView1.Items.AddChild(CaseNode,Format(_Msg('%s{%s}-%d份'),[DocNo2DocName(Caseno,iDocNo),CaseDocNoList.Strings[i],DocNoCopies]));
-
- if GetUseCase('F',ImageSavePath+Caseno+'\',CaseDocNoList.Strings[i]) <> '' Then
- begin
- DocNode.ImageIndex := 8;
- DocNode.SelectedIndex := 8;
- end
- Else if GetUseCase('T',ImageSavePath+Caseno+'\',CaseDocNoList.Strings[i]) <> '' Then
- begin
- DocNode.ImageIndex := 9;
- DocNode.SelectedIndex := 9;
- end
- Else
- begin
- DocNode.ImageIndex := 2;
- DocNode.SelectedIndex := 2;
- end;
- if ((Pos('ZZZZZ',DocNode.Text) = 0) and (Pos('YYYYY',DocNode.Text) = 0)) and (FileList.Count =0) then //制式文件
- begin
- for n := 1 to LASTEST_FORM_INF_List.Count - 1 do
- begin
- StrList := SplitString('!@!',LASTEST_FORM_INF_List.Strings[n]);
- iiFormID := StrList.Strings[0];
- iiDocNo := StrList.Strings[1];
- if iiDocNo = iDocNo then
- begin
- FormID := iiFormID;
- FormPage := GetFormIDPage(FileList,FormID);
- FormName := FormCode2FormName(Caseno,FormID);
- //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁'));
- FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage]));
- FormNode.ImageIndex := 4;
- FormNode.SelectedIndex := 4;
- DocNode.AlphaSort(True);
- end;
- end;
- end
- else if (Pos('ZZZZZ',DocNode.Text) > 0) or (Pos('YYYYY',DocNode.Text) > 0) then //自訂文件
- begin
- FormID := GetCustomFormID(ImageSavePath+Caseno+'\',CaseDocNoList.Strings[i]);
- //showmessage(FileList.Text);
- FormPage := GetFormIDPage(FileList,FormID);
- FormName := FormCode2FormName(Caseno,FormID);
- //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁'));
- //FormNode := TreeView1.Items.AddChild(DocNode,FormName+'{'+FormID+'}-'+inttostr(FormPage)+_msg('頁'));
- FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage]));
- FormNode.ImageIndex := 4;
- FormNode.SelectedIndex := 4;
- DocNode.AlphaSort(True);
- end;
- SortDocDir_FormID(Caseno,CaseDocNoList.Strings[i]); //檔名依FormID排序
-
- for n := 0 to FileList.Count - 1 do
- begin
- FormID := FileName2FormCode(FileList.Strings[n]);
- DocVer := FormCode2Version(FormID);
- DocNo := FormCode2DocNo(FormID);
- if CheckFormIDExists(DocNode,FormID) then Continue;
- //Showmessage(FormID+#13+DocNo+#13+DocVer);
- for m := 0 to FormID_List.Count - 1 do
- begin
- iiFormID := FormID_List.Strings[m];
- iiDocNo := DocNo_List.Strings[m];
- iiDocVer := FormCode2Version(iiFormID);
- if (iiDocNo = DocNo) and (iiDocVer = DocVer) then
- begin
- //Showmessage(iiFormID+#13+iiDocNo+#13+iiDocVer);
- FormID := iiFormID;
- FormPage := GetFormIDPage(FileList,FormID);
- FormName := FormCode2FormName(Caseno,FormID);
- //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁'));
- //FormNode := TreeView1.Items.AddChild(DocNode,FormName+'{'+FormID+'}-'+inttostr(FormPage)+_msg('頁'));
- FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage]));
- FormNode.ImageIndex := 4;
- FormNode.SelectedIndex := 4;
- DocNode.AlphaSort(True);
- end;
- end;
-
-
- //if not CheckFormIDExists(DocNode,FormID) then
- //begin
- // Application.ProcessMessages;
- // FormPage := GetFormIDPage(FileList,FormID);
- /// FormName := FormCode2FormName(Caseno,FormID);
- /// FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁'));
- // FormNode.ImageIndex := 4;
- // FormNode.SelectedIndex := 4;
- //end;
- end;
- end;
-
- if DirectoryExists(ImageSavePath+Caseno+'\'+AttName) then
- begin
-
- FileList.Clear;
- if FileExists(ImageSavePath+Caseno+'\'+AttName+'\Context.dat') then
- FileList.LoadFromFile(ImageSavePath+Caseno+'\'+AttName+'\Context.dat')
- Else
- begin
- Rmdir(ImageSavePath+Caseno+'\'+AttName);
- Exit;
- end;
- DocNoPage := FileList.Count;
- iDocNo := DocNoDir2DocNo(AttName);
- //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('份'),[AttName,DocNo2DocName(Caseno,iDocNo),1]));
- DocNode := TreeView1.Items.AddChild(CaseNode,Format(_Msg('%s{%s}-%d份'),[DocNo2DocName(Caseno,iDocNo),AttName,1]));
- DocNode.ImageIndex := 2;
- DocNode.SelectedIndex := 2;
- for n := 0 to FileList.Count - 1 do
- begin
- FormID := FileName2FormCode(FileList.Strings[n]);
- if not CheckFormIDExists(DocNode,FormID) then
- begin
- FormPage := GetFormIDPage(FileList,FormID);
- FormName := FormCode2FormName(Caseno,FormID);
- //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁'));
- //FormNode := TreeView1.Items.AddChild(DocNode,FormName+'{'+FormID+'}-'+inttostr(FormPage)+_msg('頁'));
- FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage]));
- FormNode.ImageIndex := 4;
- FormNode.SelectedIndex := 4;
- end;
- end;
- end;
-
- if FModeName='件' then //20170904 先裝死 因為異動 同時存在兩種附件太難寫
- begin
- if DirectoryExists(ImageSavePath+Caseno+'\Attach') then
- begin
- FileList.Clear;
- if FileExists(ImageSavePath+Caseno+'\Attach'+'\Context.dat') then
- FileList.LoadFromFile(ImageSavePath+Caseno+'\Attach'+'\Context.dat')
- Else
- begin
- Rmdir(ImageSavePath+Caseno+'\Attach');
- Exit;
- end;
- DocNoPage := FileList.Count;
- iDocNo := DocNoDir2DocNo(AttName);
- //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('份'),[AttName,DocNo2DocName(Caseno,iDocNo),1]));
- //DocNode := TreeView1.Items.AddChild(CaseNode,Format('%s{%s}-%d'+_msg('份'),[DocNo2DocName(Caseno,iDocNo),'Attach',1]));
- DocNode := TreeView1.Items.AddChild(CaseNode,Format(_Msg('%s{%s}-%d份'),[DocNo2DocName(Caseno,iDocNo),'Attach',1]));
-
- DocNode.ImageIndex := 2;
- DocNode.SelectedIndex := 2;
- for n := 0 to FileList.Count - 1 do
- begin
- FormID := FileName2FormCode(FileList.Strings[n]);
- if not CheckFormIDExists(DocNode,FormID) then
- begin
- FormPage := GetFormIDPage(FileList,FormID);
- FormName := FormCode2FormName(Caseno,FormID);
- //FormNode := TreeView1.Items.AddChild(DocNode,FormID+'{'+FormName+'}-'+inttostr(FormPage)+_msg('頁'));
- //FormNode := TreeView1.Items.AddChild(DocNode,FormName+'{'+FormID+'}-'+inttostr(FormPage)+_msg('頁'));
- FormNode := TreeView1.Items.AddChild(DocNode,Format(_Msg('%s{%s}-%d頁'),[FormName,FormID,FormPage]));
-
- FormNode.ImageIndex := 4;
- FormNode.SelectedIndex := 4;
- end;
- end;
- end;
- end;
-LogFile1.LogToFile(logTimeString+'產文件樹結束');
- Finally
- FileList.Free;
- CaseDocNoList.Free;
- CaseDocNo_CopiesList.Free;
- StrList.Free;
- ST1.Free;
- end;
-end;
-
-procedure TCB_IMGPSScanX.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 ;
- ScanGrayCB.Checked:=True;
- 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 := _Msg('列印中,請稍候');
- DataLoading(True,True);
- Case2upload(NowCaseNo); //產生原影像結構
-
-
- //ontextList.LoadFromFile(ImageSavePath+NowCaseNo+'\Upload\Context.dat');
-
- PrintForm := TPrintForm.create(Self);
- DocDirList := TStringlist.Create;
- FileList := TStringlist.Create;
- try
- FileList.LoadFromFile(ImageSavePath+NowCaseNo+'\Upload\Context.dat');
- DocDirList.LoadFromFile(ImageSavePath+NowCaseNo+'\Upload\DocDir.dat');
-
- InitialLanguage(PrintForm); //載入多國語言
- PrintForm.CheckListBox1.Items.Clear;
- For i := 0 to FileList.Count - 1 do
- begin
- iDocDir := DocDirList.Strings[i];
- iDocno := DocNoDir2DocNo(iDocDir);
-
- if not DocNoAppear(iDocNo) then Continue;
-
- PrintForm.CheckListBox1.Items.Add(FileList.Strings[i]);
- if CheckFormID_Prt(FileName2FormCode(FileList.Strings[i])) then
- PrintForm.CheckListBox1.Checked[i] := True;
- PrintForm.ListBox1.Items.Add(Add_Zoo(i+1,3))
- end;
- If (PrintForm.ShowModal = mrOK) then
- begin
- S := '';
- for I := 0 to PrintForm.CheckListBox1.Count -1 do
- begin
- if PrintForm.CheckListBox1.Checked[i] then
- begin
- if S = '' then
- S := S+PrintForm.CheckListBox1.Items[i]
- Else
- S := S+#13+PrintForm.CheckListBox1.Items[i];
- end;
- end;
- if S = '' then
- begin
- Showmessage(_msg('尚未選擇欲列印文件'));
- Exit;
- end
- Else
- begin
- PrintImg(S,FUserID,ServerDate,ImageSavePath+NowCaseNo+'\Upload\');
- If not Writelog(NowCaseNo) then
- begin
- //Showmessage('false');
- end;
- end;
- end;
- finally
- DataLoading(False,False);
- PrintForm.Free;
- end;
-end;
-
-procedure TCB_IMGPSScanX.UseOldCaseLbClick(Sender: TObject);
-var
- i,n : Integer;
- CaseID,Year,BS_No,IS_Old : String;
- OldCaseInfoForm : TOldCaseInfoForm;
- OldCaseInfoList,Caseinfolist,FileList,DocNoList,iFileList,iDocNoList,iDocNo_CopiesList : TStringlist;
- OldDocdir,OldDocNo,OldDocName,NewDocDir,FileName : String;
- OldPath,NewPath,OldFile,NewFile:String;
- Oldcopies:Integer;
-begin
- OldCaseInfoForm := TOldCaseInfoForm.Create(Self);
- OldCaseInfoList := TStringlist.Create;
- Caseinfolist := TStringlist.Create;
- FileList := TStringlist.Create;
- DocNoList := TStringlist.Create;
- iDocNo_CopiesList := TStringlist.Create;
- iFileList := TStringlist.Create;
- iDocNoList := TStringlist.Create;
- OldCaseInfoForm.OldDocDirList := TStringlist.Create;
- OldCaseInfoForm.OldDocNameList := TStringlist.Create;
- OldCaseInfoForm.IN_WH_DocNoList := TStringlist.Create;
- OldCaseInfoForm.OldCopiesList := TStringlist.Create;
- try
- InitialLanguage(OldCaseInfoForm); //載入多國語言
- OldCaseInfoForm.Notebook1.ActivePage := 'CaseInfo';
- OldCaseInfoForm.ImageSavePath := ImageSavePath;
- OldCaseInfoForm.CaseID := NowCaseNo;
- OldCaseInfoForm.Furl := Furl;
- OldCaseInfoForm.Fdata := FData;
- OldCaseInfoForm.FVerify := FVerify;
- OldCaseInfoForm.FReWrite := FReWrite;
- OldCaseInfoForm.FOldCaseInfo := FOldCaseInfo;
-
- //OldCaseInfoList 案件編號@#,年度@#,業務別@#,是否舊件@#,文件編號[份數]@#,文件編號[份數] tab 案件編號@#,年度@#,業務別@#,是否舊件@#,文件編號[份數]@#,文件編號[份數]
- OldCaseInfoList.StrictDelimiter := true;
- OldCaseInfoList.Delimiter := #9;
- OldCaseInfoList.DelimitedText := FOldCaseInfo;
- //Showmessage(FOldCaseInfo);
- //Showmessage(OldCaseInfoList.Text);
- OldCaseInfoForm.IN_WH_DocNoList.Assign(IN_WH_DocNoList);
- OldCaseInfoForm.FIs_In_Wh := FIs_In_Wh;
- for i := 0 to OldCaseInfoList.Count - 1 do
- begin
- Caseinfolist:=SplitString('@#,',OldCaseInfoList.Strings[i]);
- //Caseinfolist.Delimiter := '_';
- //Caseinfolist.DelimitedText := OldCaseInfoList.Strings[i];
- CaseID := Caseinfolist.Strings[0];
- Year := Caseinfolist.Strings[1];
- BS_No := Caseinfolist.Strings[2];
- IS_Old := Caseinfolist.Strings[3];
- With OldCaseInfoForm.OldCaseLV.Items.Add do
- begin
- Caption := CaseID;
- SubItems.Add(Year);
- SubItems.Add(BS_No);
- SubItems.Add(IS_Old);
- end;
- end;
-
- if OldCaseInfoForm.ShowModal = MrOk then
- begin
- OldPath := ImageSavePath+NowCaseNo+'\'+OldCaseInfoForm.UseCaseID+'\';
- NewPath := ImageSavePath+NowCaseNo+'\';
-
- iDocNoList.Clear;
- if FileExists(NewPath+'CaseDocNo.dat') then
- iDocNoList.LoadFromFile(NewPath+'CaseDocNo.dat');
- if FileExists(NewPath+'CaseDocNo_Copies.dat') then
- iDocNo_CopiesList.LoadFromFile(NewPath+'CaseDocNo_Copies.dat');
-
- for i := 0 to OldCaseInfoForm.OldDocDirList.Count - 1 do
- begin
- FileList.LoadFromFile(OldPath+'Context.dat');
- DocNoList.LoadFromFile(OldPath+'DocDir.dat');
-
-
- OldDocName := OldCaseInfoForm.OldDocNameList.Strings[i];
- OldDocDir := OldCaseInfoForm.OldDocDirList.Strings[i];
- OldDocNo := DocNoDir2DocNo(OldDocDir);
- if Copy(OldDocNo,1,5)<>'ZZZZZ' then
- begin
- if DocNoNeedDiv(OldDocNo) then
- NewDocDir := DocNo2DocNoDir(NewPath,OldDocNo)
- else
- NewDocDir := OldDocNo;
- end
- Else
- begin
- NewDocDir := GetNewCustomDocNo(NewPath,OldDocName);
- end;
- SetRecordEditedDocDir('A',NowCaseNo,NewDocDir);
- iFileList.Clear;
- if FileExists(NewPath+NewDocDir+'\Context.dat') then
- iFileList.LoadFromFile(NewPath+NewDocDir+'\Context.dat');
-
- if Not DirectoryExists(NewPath+NewDocDir) then
- begin
-
-
- iDocNoList.Add(NewDocDir);
- Oldcopies := GetDocDirCopies(NowCaseNo+'\'+OldCaseInfoForm.UseCaseID,OldDocDir); //舊案的CaseID 放在新案CaseID目錄裡
- if FileExists(ImageSavePath+NowCaseNo+'\'+OldCaseInfoForm.UseCaseID+'\CaseDocNo_Copies.dat') then
- iDocNo_CopiesList.Add(inttostr(Oldcopies))
- else
- begin
- OldCopies := GetDocDircopies_Rec(OldPath,OldCaseInfoForm.UseCaseID,OldDocDir);
- iDocNo_CopiesList.Add(inttostr(Oldcopies));
- //iDocNo_CopiesList.Add('1');
- end;
- MkDir(NewPath+NewDocDir);
- end;
- SetUseCase('A',NewPath,NewDocDir,OldCaseInfoForm.UseCaseID,''); //NewDocDir 從哪來的
- SetUseCase('A',OldPath,OldDocDir,'',NowCaseNo); //OldDocDir 去哪了
- StringtoFile('Y',OldPath+'UseCase.dat'); //要上傳
- for n := 0 to DocNoList.Count - 1 do
- begin
- if OldDocDir = DocNoList.Strings[n] then
- begin
- OldFile := FileList.Strings[n];
- if Copy(NewDocDir,1,5)<>'ZZZZZ' then
- NewFile := Add_Zoo(iFileList.Count+1,3)+FileName2NoQuene_Filename(OldFile)
- Else
- NewFile := Add_Zoo(iFileList.Count+1,3)+'_'+GetCustomFormID(NewPath,NewDocDir)+ExtractFileExt(OldFile);
-
- iFileList.Add(NewFile);
- CopyFile(PwideChar(OldPath+OldFile),Pwidechar(NewPath+NewDocDir+'\'+NewFile),False);
- end;
- end;
- iFileList.SaveToFile(NewPath+NewDocDir+'\Context.dat');
- end;
-
- iDocNoList.SaveToFile(NewPath+'CaseDocNo.dat');
- iDocNo_CopiesList.SaveToFile(NewPath+'CaseDocNo_Copies.dat');
- DrawDocItem2(MyTreeNode1,NowCaseNo);
- //MyTreeNode1.Text := Format('%s-%d'+_Msg('頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]);
- MyTreeNode1.Text := Format(_Msg('%s-%d頁'),[NowCaseno,GetCasePage(ImageSavePath,NowCaseNo)]);
- NewTreeNodeRefresh;
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- end;
- finally
- OldCaseInfoForm.OldDocDirList.Free;
- OldCaseInfoForm.OldDocNameList.Free;
- OldCaseInfoForm.OldCopiesList.Free;
- OldCaseInfoList.Free;
- Caseinfolist.Free;
- FileList.Free;
- DocNoList.Free;
- iDocNo_CopiesList.Free;
- iFileList.Free;
- iDocNoList.Free;
- OldCaseInfoForm.Free;
- end;
-end;
-
-procedure TCB_IMGPSScanX.LastInitFormidListCreate(path: string);
-var
- i:integer;
- ST1:TStringList;
- str1:string;
-begin
-//ShowMessage('path='+path);
- ST1:=TStringList.Create;
- ST1.LoadFromFile(path+'FormCode_Name.dat');
- for I := 0 to ST1.Count - 1 do
- begin
- if (Pos('_',St1.Strings[i])<>1) and (Pos('_',St1.Strings[i])<>-1) then
- begin
- str1:=Copy(ST1.Strings[i],1,Pos('_',St1.Strings[i])-1);
- LastInitFormidList.Add(str1);
- end;
- end;
-
- ST1.Free;
-end;
-
-function TCB_IMGPSScanX.LoadFileGetMD5(const filename: string): string;
-var
- Stream: TFileStream;
- //Buffer: array[0..1023] of AnsiChar;
- Buffer: array[0..1023] of AnsiChar;
- TempStr: string;
- i: Integer;
- idmd5:TIdHashMessageDigest5; //import IdHashMessageDigest, idHash
-
-begin
- idmd5 := TIdHashMessageDigest5.Create;
-
- try
- Stream := TFileStream.Create(filename, fmOpenRead);
- Stream.Read(Buffer[0], SizeOf(Buffer));
-
- result := idmd5.HashStreamAsHex(Stream) ;
- finally
- idmd5.Free;
- Stream.Free;
-
- end;
-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;
- AttListBox.Items.Clear;
- AddAttFileLB.Enabled := False;
- DelAttFileLB.Enabled := False;
- 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]);
-//ShowMessage('CasePage='+IntToStr(CasePage));
- 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;
-
-procedure TCB_IMGPSScanX.LoadAttFile(CaseID:String); //載入附加檔案
-var
- AttContextList : TStringlist;
- i : Integer;
-begin
- AttListBox.Clear;
- AttContextList := TStringlist.Create;
- try
- if FileExists(ImageSavePath+CaseID+'\AttContext.dat') then
- begin
- AttContextList.LoadFromFile(ImageSavePath+CaseID+'\AttContext.dat');
- end;
- for i := 0 to AttContextList.Count - 1 do
- begin
- AttListBox.Items.Add(UTF8Decode(HTTPDEcode(AttContextList.Strings[i])));
- end;
- finally
- AttContextList.Free;
- end;
-end;
-
-function TCB_IMGPSScanX.logTimeString: String;
-begin
-Result:=FormatDateTime('yyyymmdd hh:mm:ss',now) +' caseNo='+NowCaseno+' ';
-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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',Memo1.Lines.Text) > 0 then
- begin
- Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'));
- DataLoading(False,False);
- Exit;
- end;
- /////上傳MPSLICSCAN.lic /////
- //Sleep(30000); //第一次註冊睡30秒 先不睡
- Result := True;
- end;
- end;
- end;
- if FileExists(LngPath+'MPSLIC_SCAN.lic') then
- DeleteFile(LngPath+'MPSLIC_SCAN.lic');
- if LegalDate = '' then
- StatusBar1.Panels[4].Text := Format(_Msg('註冊號:%s 剩餘註冊數:%s'),[MacID,inttostr(Totalcount-Nowcount)]);
- if LegalDate <> '' then
- StatusBar1.Panels[4].Text := '*'+Format(_Msg('註冊號:%s 剩餘註冊數:%s'),[MacID+'('+inttostr(Lic_Idx)+')',inttostr(Totalcount-Nowcount)]);
-end;
-
-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;//產生遮罩影像 20170639 發現沒用到
-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+FWork_no+'\'+FormID+'.xml') then //沒有Xml就不用遮罩
- begin
- XT.LoadFromFile(CheckXmlPath+FWork_no+'\'+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;
-
-//ShowMessage('FormIDCount='+IntToStr(FormIDCount)+#10#13+'MpsBarcodeinf.count='+IntToStr(MpsBarcodeinf.count));
- 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);
-
- if (FMode='ESCAN') and (FWH_category='N') then //20170914 補件下改成非入庫的自定文件
- begin
- DocNo := 'YYYYY'+Add_Zoo(Ct,3);
- end;
-
- 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.DelAttFileLBClick(Sender: TObject);
-var
- AttFile : String;
- SelectCount : Integer;
- i : Integer;
-begin
- SelectCount := 0;
- for i := 0 to AttListBox.Items.Count - 1 do
- begin
- if AttListBox.Selected[i] then
- inc(SelectCount);
- end;
- if SelectCount = 0 then
- begin
- Showmessage(_Msg('請選擇要刪除的電子檔'));
- Exit;
- end;
-
- if SelectCount > 0 then
- begin
- if Messagedlg(Format(_Msg('是否刪除這%d筆??'),[SelectCount]),MtConfirmation,[mbyes,mbcancel],0) = mrcancel then Exit;
- for i := 0 to AttListBox.Items.Count - 1 do
- begin
- if AttListBox.Selected[i] then
- begin
- AttFile := HTTPEncode(UTF8Encode(AttListBox.Items.Strings[i]));
- DeleteFile(ImageSavePath+NowCaseNo+'\'+AttFile);
- SetAttContextList('D',-1,NowCaseno,AttFile);
- end;
- end;
- end;
- LoadAttFile(NowCaseNo);
- Showmessage(_msg('刪除完成'));
-end;
-
-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 := _Msg('影像列印');
- end;
-
- IF (Page mod 2) = 1 Then
- Printer.BeginDoc
- Else
- Printer.NewPage;
-
- ImageScrollBox1.DisplayedGraphic.Canvas.Font.Size := 24;
-
- //ImageScrollBox1.DisplayedGraphic.Canvas.TextOut(20,20, _Msg('列印人員:')+LoginID+' '+_Msg('列印分行:')+FUserUnit+' '+_Msg('列印日期:')+DateTime);
-
- GraphicPrinter.Print(ImageScrollBox1.DisplayedGraphic);
-
-
- { this shows how to print text on a page.
- Printer.Canvas.TextOut(10,10, 'Envision Image Library');
- }
- If ((Page mod 2) = 0) or (Page = pages) Then
- Printer.EndDoc;
- end;
-
- procedure PrintWithAutoPrintJob;
- begin
- GraphicPrinter.UsePrintJob := True;
- GraphicPrinter.Title := _Msg('影像列印');
- GraphicPrinter.Print(ImageScrollBox1.Graphic);
- end;
-
-begin
- S := TStringlist.Create;
- GraphicPrinter := TDibGraphicPrinter.Create;
- PrtDialog := TPrintDialog.Create(self);
- //PrtDialog.Copies:=99;
- try
- IF PrtDialog.Execute Then
- begin
- S.Text := FileName;
- Pages := S.Count;
-
- for i := 0 to S.Count -1 do
- begin
- ImageScrollBox1.LoadFromFile(Path+S.Strings[i],1);
- watermark2(Image1.Picture.Bitmap,70,'',ImageScrollBox1.DisplayedGraphic);
- PrintWithManualPrintJob(LoginID,DateTime,Pages,i+1);
- end;
- end;
-
- Finally
- PrtDialog.Free;
- GraphicPrinter.Free;
- S.Free;
- end;
-end;
-
-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;
-
-Function TCB_IMGPSScanX.FindLastestDocDirForPage(CaseID,DocNo,formid:String):String; //找出最新的DocDir 20180207 排除隱藏的資料夾
-var
- i,j:integer;
- DocNoList,FileList : TStringlist;
- Imglist: TStringlist;
- DirIsHide:Boolean;
-begin
- Result := '';
- DocNoList := TStringlist.Create;
- FileList := TStringlist.Create;
- imglist := 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
-//ShowMessage(ImageSavePath+CaseID+'\'+DocNoList.Strings[i]);
- if not DocNoIsExistImg(ImageSavePath+CaseID+'\'+DocNoList.Strings[i]+'\') then
- begin
-//ShowMessage('DDDDD');
- Result := '';
- Break;
- end
- else
- begin
- Result := DocNoList.Strings[i];
- Break;
- end;
- end;
- end;
- finally
- DocNoList.Free;
- FileList.Free;
- imglist.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)檔案時,網路發生錯誤!!'),[OldCaseID])+_Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason);
- Result := False;
- Exit;
- end;
- if memo1.Lines.Strings[0] = '1' then
- begin
- Showmessage(Format(_Msg('傳送舊件編號(%s)檔案時,網路發生錯誤!!'),[OldCaseID])+_Msg('錯誤原因:')+memo1.Lines.Strings[1]);
- Result := False;
- Exit;
- end
- Else if Pos('<script type="text/javascript" src="scripts/CW00/login.js"></script>',Memo1.Lines.Text) > 0 then
- begin
- Showmessage(Format(_Msg('傳送舊件編號(%s)檔案時,網路發生錯誤!!'),[OldCaseID])+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'));
- 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('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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;
-
- if (FIs_In_Wh='Y') and (FWH_category='Y') then //20170816 新加
- begin
- if (((FIs_In_Wh = 'Y') and (not DocNoIs_In_WH(iDocNo))) or //入庫掃描不看非入庫文件
- ((FIs_In_Wh = 'N') and (DocNoIs_In_WH(iDocNo)))) and //非入庫掃描不看入庫文件
- ((iDocNo <> 'Attach') and (iDocNo <> 'S_Attach') and (Copy(iDocNo,1,5)<>'ZZZZZ')) then
- Result := False;
- end;
-
- if (FIs_In_Wh='Y') and (FWH_category='N') then //20170816 新加
- begin
- Result:=True;
- end;
-
-end;
-
-Function TCB_IMGPSScanX.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;}
- //20181031 應該要換成下面的判斷比較對,FIs_In_Wh傳空的話才會出全部
- 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.ISExistImg(const filename: string): boolean;
-begin
- if ExistImgList.IndexOf(LoadFileGetMD5(filename))<>-1 then
- begin
- Result:=True;
- end
- else
- begin
- Result:=False;
- 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,AttFile : String;
- DocNoList,FileList:TStringlist;
- iFileList,iFile_DocNoList :TStringlist;
- iDocDirList : TStringlist;
- iAttFileList : TStringlist;
-begin
- DocNoList := TStringlist.Create;
- FileList := TStringlist.Create;
- iFileList := TStringlist.Create;
- iFile_DocNoList := TStringlist.Create;
- iDocDirList := TStringlist.Create;
- iAttFileList := 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;
- OldPath := ImageSavePath+CaseID+'\';
- if FileExists(OldPath+'AttContext.dat') then
- begin
- iAttFileList.LoadFromFile(OldPath+'AttContext.dat');
- for n := 0 to iAttFileList.Count - 1 do
- begin
- AttFile := iAttFileList.Strings[n];
- CopyFile(PWideChar(OldPath+AttFile),PWideChar(NewPath+AttFile),False);
- end;
- iAttFileList.SaveToFile(NewPath+'AttContext.dat');
- end;
-
-
- iFileList.SaveToFile(NewPath+'Context.dat');
- iFile_DocNoList.SaveToFile(NewPath+'Context_DocNo.dat');
- iDocDirList.SaveToFile(NewPath+'DocDir.dat');
-
- finally
- iFileList.Free;
- iAttFileList.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,AttFile:String;
- DocNoList,FileList : TStringlist;
- iFileList,iFile_DocDirList :TStringlist;
- iAttFileList :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;
- iAttFileList := 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;}
- if FileExists(SoDir+'AttContext.dat') then
- begin
- iAttFileList.LoadFromFile(SoDir+'AttContext.dat');
- for i := 0 to iAttFileList.Count - 1 do
- begin
- AttFile := iAttFileList.Strings[i];
- CopyFile(PWideChar(SoDir+AttFile),PWideChar(DeDir+AttFile),False);
- end;
- iAttFileList.SaveToFile(DeDir+'AttContext.dat');
- end;
-
-
- if FMode='ESCAN' then
- begin
- InitExistImgList(DeDir);
- 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
-//ShowMessage(FindResult.Text);
- 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
-LogFile1.LogToFile(logTimeString+S.Strings[i]+' ISExistImg='+BoolToStr(ISExistImg(ImageSavePath+CaseID+'\upload\'+S.Strings[i]),true));
-LogFile1.LogToFile(logTimeString+S.Strings[i]+' reSizeExistImgList='+BoolToStr(reSizeExistImgList.IndexOf(LoadFileGetMD5(ImageSavePath+CaseID+'\upload\'+S.Strings[i]))<>-1,true));
- if FWH_category='N' then
- begin
- if (ISExistImg(ImageSavePath+CaseID+'\upload\'+S.Strings[i]))
- or (reSizeExistImgList.IndexOf(LoadFileGetMD5(ImageSavePath+CaseID+'\upload\'+S.Strings[i]))<>-1) then
- begin
- Continue;
- end;
- end;
-
- LForm := FileName2FormCode(S.Strings[i]);
- AddOk := True;
- for n := 0 to OMRFileList.Count - 1 do
- begin
- OForm := FileName2FormCode(OMRFileList.Strings[n]);
- if (LForm <> '') and (LForm = OForm) then
- begin
- AddOk := False;
- Break;
- end;
- end;
- if AddOk then
- begin
- OMRFileList.Add(S.Strings[i]);
- end;
- end;
- finally
- S.Free;
- end;
-
-end;
-
-
-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; //是否要做完整檢核
-
- ISB8W,ISB8H:integer;
-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);
-LogFile1.LogToFile(logTimeString+' '+FModeName+' '+CaseID+' '+'MainFormID='+MainFormID);
- if MainFormID = ''then
- begin
- //20131203 yuu說不檢查這個,先拿掉 20170315 楷琳說未歸類要擋 20170726 因此有檢查必要FormID 所以 可以拿掉
- {if FCheck_main_form='Y' then
- begin
- if (FMode <> 'SSCAN') AND (FMode<>'ESCAN') then //簽署章件會換主FormID,先跳過 20170629 ESCAN 也不檢查
- begin
- ErrStr:=_Msg('找不到分案文件'); //找不到主文件
- OMRErr2ini(CaseID,ErrStr,'','','','','','',False,False,True);
- CaseOk := false;
-//ShowMessage('AAAAA');
- end;
- end;
- }
- end
- Else
- begin
- //////主要非主要文件//////
- DistinctDocinCase(ImageSavePath+CaseID+'\upload\');
-//ShowMessage(DocNo_VerinCase.Text);
-//DocNo_VerinCase.Add('31A00101_1706A');
-LogFile1.LogToFile(logTimeString+' '+CaseID+' '+'DocNo_VerinCase.Text='+DocNo_VerinCase.Text);
- 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); //案件主文件的頁數
-LogFile1.LogToFile(logTimeString+CaseID+',MainDocNo='+MainDocNo+',MainVersion='+MainVersion+',MainFormPage='+IntToStr(MainFormPage)+',CaseFormPage='+IntToStr(CaseFormPage));
- //CheckFirstDocNoPage
- 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
- if FWH_category='N' then
- begin
- if ISExistImg(ImageSavePath+CaseID+'\upload\'+List.Strings[i]) then
- begin
- Continue;
- end;
- end;
- 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
- if FWH_category='N' then
- begin
- if ISExistImg(ImageSavePath+CaseID+'\upload\'+List.Strings[i]) then
- begin
- Continue;
- end;
- end;
- 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; //MainFormID結束
- //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
- //////最大頁數///
-LogFile1.LogToFile(logTimeString+'最大頁數A段 '+CaseID+' '+'OMRFileList.Text='+OMRFileList.Text);
- DistinctFormCode(CaseID);
- if ModeNeedCheck(OMRErrInfo[10].Mode,FMode) then //是否要檢核
- begin
-//ShowMessage('AAA'+OMRFileList.Text);
-LogFile1.LogToFile(logTimeString+'最大頁數B段 '+CaseID+' '+'OMRFileList.Text='+OMRFileList.Text);
- For i := 0 to OMRFileList.Count - 1 do
- begin
- if FModeName=_Msg('異動件') then Continue;
-
- if FWH_category='N' then
- begin
- if ISExistImg(ImageSavePath+CaseID+'\upload\'+OMRFileList.Strings[i]) then
- begin
- Continue;
- end;
- end;
- 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
-//ShowMessage('必填'+OMRFileList.Text);
-LogFile1.LogToFile(logTimeString+'必填 '+CaseID+' '+'OMRFileList.Text='+OMRFileList.Text);
- For i := 0 to OMRFileList.Count - 1 do
- begin
-//ShowMessage('OMRFileList.Strings['+IntToStr(i)+']'+OMRFileList.Strings[i]);
- if CheckRequiredColumnValues(FWork_NO,CaseID) then Continue;
-
- OMRFile := OMRFileList.Strings[i];
- OMRFormCode := FileName2FormCode(OMRFileList.Strings[i]);
- OMRFormName := FormCode2FormName(CaseID,OMRFormCode);
- Anchor := FormID2Anchor(OMRFormCode);
- ///依十字定位點縮放////
- ImageReSize_FormID(CaseID,OMRFile);
- ////依十字定位點縮放///
-//Display1.Lines.Add('OMRFile='+OMRFile+',OMRFormCode='+OMRFormCode+',OMRFormName='+OMRFormName);
-LogFile1.LogToFile(logTimeString+'OMRFile='+OMRFile+',OMRFormCode='+OMRFormCode+',OMRFormName='+OMRFormName);
-//ShowMessage('KKKKK');
- if not FileExists(CheckXmlPath+FWork_no+'\'+OMRFormCode+'.xml') then //沒有Xml就不用檢核
- Continue;
-
-//ShowMessage('11638 OMRFileList.Strings['+IntToStr(i)+']'+OMRFileList.Strings[i]);
- XT := TXmltool.Create(CheckXmlPath+FWork_no+'\'+OMRFormCode+'.xml');
- RelaXT := TXmltool.Create;
-//ShowMessage('ModeNeedCheck='+BoolToStr(ModeNeedCheck(OMRErrInfo[4].Mode,FMode),true));
- 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));
-//SafePixel:=90000;
-Display1.Lines.Add(ColEName+' '+ColCName+' 圖像實際點數='+IntToStr(GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt))+' 設定點數='+IntToStr( (Pixel + SafePixel)));
-//FindPoint(ISB_BW.Graphic,UpLPoint,UpRPoint,DownLPoint,ANCHOR);
- 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;
- //*******必填********
-//ShowMessage('11692 OMRFileList.Strings['+IntToStr(i)+']'+OMRFileList.Strings[i]);
- //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'];
-Display1.Lines.Add(ColEName+' '+ColCName+' 圖像實際點數='+IntToStr(GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt))+' 設定點數='+IntToStr( (Pixel + SafePixel)));
- 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+FWork_no+'\'+RelaFormCode+'.xml');
-Display1.Lines.Add(RelaFile+','+RelaFormName);
-//ShowMessage(RelaFile);
-//ShowMessage(ImageSavePath+CaseID+'\upload\'+RelaFile);
- if RelaFile<>'' then
- begin
- ISB8.LoadFromFile(ImageSavePath+CaseID+'\upload\'+RelaFile,1); //20170815
- ISB8W:= ISB8.Graphic.Width;
- ISB8H:= ISB8.Graphic.Height;
- FindPoint(ISB8.Graphic,UpLPoint,UpRPoint,DownLPoint,ISB8W,ISB8H,ANCHOR); //20170815 抓相關然欄位所在圖檔的定位
- end;
-
- 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
-Display1.Lines.Add(ColEName+' '+ColCName+' 圖像實際點數='+IntToStr(GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt))+' 設定點數='+IntToStr( (Pixel + SafePixel)));
- if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+RelaFile,RelaSite,Bt) > (RelaPixel + SafePixel) then
- begin
- OMROK := True;
- Break;
- end;
- ///依十字定位點縮放////
- ImageReSize_FormID(CaseID,OMRFile); //20170815 重新抓定位
- ////依十字定位點縮放////
- end;
- 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;
- //*******有值相關文件的欄位也要有值*******
-//ShowMessage('11788 OMRFileList.Strings['+IntToStr(i)+']'+OMRFileList.Strings[i]);
-
- //*******有值相關文件的欄位不能有值*******
- 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'];
-Display1.Lines.Add(ColEName+' '+ColCName+' 圖像實際點數='+IntToStr(GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt))+' 設定點數='+IntToStr( (Pixel + SafePixel)));
-
- 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+FWork_no+'\'+RelaFormCode+'.xml');
-
- if RelaFile<>'' then
- begin
- ISB8.LoadFromFile(ImageSavePath+CaseID+'\upload\'+RelaFile,1); //20170815
- ISB8W:= ISB8.Graphic.Width;
- ISB8H:= ISB8.Graphic.Height;
- FindPoint(ISB8.Graphic,UpLPoint,UpRPoint,DownLPoint,ISB8W,ISB8H,ANCHOR); //20170815 抓相關然欄位所在圖檔的定位
- end;
-
- 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
-Display1.Lines.Add(ColEName+' '+ColCName+' 圖像實際點數='+IntToStr(GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt))+' 設定點數='+IntToStr( (Pixel + SafePixel)));
- if GetSiteOMR(ImageSavePath+CaseID+'\upload\'+RelaFile,RelaSite,Bt) > (RelaPixel + SafePixel) then
- begin
- inc(OMROkCount);
- //OMROK := True;
- //Break;
- end;
- ///依十字定位點縮放////
- ImageReSize_FormID(CaseID,OMRFile);
- ////依十字定位點縮放////
- 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;
- //*******有值相關文件的欄位不能有值*******
-
-//ShowMessage('11889 OMRFileList.Strings['+IntToStr(i)+']'+OMRFileList.Strings[i]);
-
- //*******有值相依文件*******
- 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'];
- Display1.Lines.Add(ColEName+' '+ColCName+' 圖像實際點數='+IntToStr(GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt))+' 設定點數='+IntToStr( (Pixel + SafePixel)));
-
- 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'];
- Display1.Lines.Add(ColEName+' '+ColCName+' 圖像實際點數='+IntToStr(GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt))+' 設定點數='+IntToStr( (Pixel + SafePixel)));
-
- 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;
-
- Display1.Lines.Add(ColEName+' '+ColCName+' 圖像實際點數='+IntToStr(GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt))+' 設定點數='+IntToStr( (Pixel + SafePixel)));
-
- 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
- Display1.Lines.Add(ColEName+' '+ColCName+' 圖像實際點數='+IntToStr(GetSiteOMR(ImageSavePath+CaseID+'\upload\'+OMRFile,Site,Bt))+' 設定點數='+IntToStr( (Pixel + SafePixel)));
-
- 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.OMRErrini2ListForLog(CaseID: String): String;
-var
- ini : Tinifile;
- Errcount : Integer;
- Del : Boolean;
- i,j : Integer;
- ST,CaseList:TStringList;
-
-begin
- Result:='';
- //CaseList.dat
- ST:=TStringList.Create;
- CaseList:=TStringList.Create;
- CaseList.LoadFromFile(ImageSavePath+'CaseList.dat');
- for I := 0 to CaseList.Count - 1 do
- begin
- ini := Tinifile.Create(ImageSavePath + CaseList.Strings[i]+'\upload\Checkerr.ini');
- try
- Errcount := ini.ReadInteger('OMRCount','Count',0);
-
- for j := 1 to ErrCount do
- begin
- Del := ini.ReadBool(inttostr(j),'Del',False); //是否被移除了
- if Not Del then
- begin
- ST.Add(ini.ReadString(inttostr(j),'Reason','')) ;
- end;
- end;
- finally
- ini.Free;
- end;
- end;
- Result:=ST.Text;
- ST.Free;
- CaseList.Free;
-end;
-
-
-Function TCB_IMGPSScanX.DownLanguage:Boolean; //下載多國語言檔
-begin
- Result := True; // http://192.168.0.101:8080/fbnp/servlet/CWC01?act=getservertime
- //dnFile(HTTPSClient,FUrl+'Language.Lng','','',LngPath+'Language.Lng',FReWrite.Text,Memo1,False,DownImgStatus)
- If not dnFile_Get(HTTPSClient,FUrl+'Language.Lng','','',LngPath+'Language.Lng',FReWrite,Memo1,False,DownImgStatus) Then
- begin
- HttpErrStr := _Msg('錯誤代碼:')+inttostr(HttpError.HttpErrorCode)+','+HttpError.HttpReason;
- Result := False;
- Exit;
- end;
- IF memo1.Lines.Strings[0] = '1' Then
- begin
- HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1];
- Result := False;
- Exit;
- end
- Else if Pos('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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 := _Msg('影像顯示中,請稍候');
- DataLoading(True,True);
-
- IF FormCode = 'ShowAll' then //顯示所有的影像 (因為附件會傳空字串,所以用ShowAll)
- begin
- ClearView(1);
- CreatePreViewISB(ContextList.Count);
- For i := Stpage-1 to ContextList.Count -1 do
- begin
- ISB := TImageScrollBox(FindComponent(ISBName+intToStr(stview+i)));
- ISB.AntiAliased := True;
- if ISB.ZoomPercent > 100 then
- ISB.AntiAliased := False;
- ISB.LoadFromFile(Path+ContextList.Strings[i],1);
-
- {GetScrollData(ISB,HS,VS,iRate);
- if iRate = 0 then
- ISB.ZoomMode := zmFittoPage
- Else
- ISB.ZoomPercent := iRate;
- ISB.HorzScrollBar.Position := HS;
- ISB.VertScrollBar.Position := VS;
-
- List_FormCode := FileName2FormCode(ContextList.Strings[i]);
- lb := TLabel(FindComponent('lb'+intToStr(stview)));
- lb.Caption := Format(_Msg('第%s頁'),[Add_Zoo(i+1,3)]);
- If List_FormCode = '' Then
- lb.Caption := lb.Caption+'('+FormCode2FormName(List_FormCode)+')'
- Else
- lb.Caption := lb.Caption+'('+FormCode2FormName(List_FormCode)+'-'+List_FormCode+')';
- Inc(Stview);
- If ((VMode = 0) and (Stview>1))
- or ((VMode = 1) and ((Stview>2)))
- or ((VMode = 2) and ((Stview>4)))
- or ((VMode = 3) and ((Stview>6)))
- or ((VMode = 4) and ((Stview>8))) Then
- break;
- }
- end;
- FitPreViewISB;
- end
- Else //顯示指定FormCode的影像
- begin
- If (TreeView1.Selected <> nil) Then
- begin
- If Stpage = 0 Then
- Stpage := 1;
- Page := 0;
- ClearView(stview);
- If Stpage > ContextList.Count Then Exit;
- For i := 0 to ContextList.Count -1 do
- begin
- List_FormCode := FileName2FormCode(ContextList.Strings[i]);
- {iFormID := GetMainFormID(List_FormCode);
- if iFormID <> '' then
- List_FormCode := iFormID;}
-
- Err_FormCode := 'NoCode';
- if (List_Formcode <> '') and (not FormIDExists(List_Formcode,False,0)) then
- Err_FormCode := 'Err';
- IF (List_FormCode = FormCode) or (Err_FormCode=Formcode) or (FormCode2DocNo(List_FormCode) = FormCode) Then
- begin
- Inc(Page);
- IF Page< Stpage Then
- Continue;
- ISB := TImageScrollBox(FindComponent('ISB'+intToStr(stview)));
- ISB.AntiAliased := True;
- if ISB.ZoomPercent > 100 then
- ISB.AntiAliased := False;
- ISB.LoadFromFile(Path+ContextList.Strings[i],1);
-
- GetScrollData(ISB,HS,VS,iRate);
- if iRate = 0 then
- ISB.ZoomMode := zmFittoPage
- Else
- ISB.ZoomPercent := iRate;
- ISB.HorzScrollBar.Position := HS;
- ISB.VertScrollBar.Position := VS;
- {if not SortMode then
- begin
- SetScrollData(MPSViewX,MPSViewX.HorzScrollBarPos,MPSViewX.VertScrollBarPos,MPSViewX.ZoomPercent);
- end;}
- //MPSViewX.ImageZoomMode := zmFullpage;
- //MPSViewX.AntiAliased := True;
- lb := TLabel(FindComponent('lb'+intToStr(stview)));
- lb.Caption := Format(_Msg('第%s頁'),[Add_Zoo(i+1,3)]);
- If List_FormCode = '' Then
- lb.Caption := lb.Caption+'('+FormCode2FormName(NowCaseno,List_FormCode)+')'
- Else
- lb.Caption := lb.Caption+'('+FormCode2FormName(NowCaseNo,List_FormCode)+'-'+List_FormCode+')';
- Inc(Stview);
- end;
- If ((VMode = 0) and (Stview>1))
- or ((VMode = 1) and ((Stview>2)))
- or ((VMode = 2) and ((Stview>4)))
- or ((VMode = 3) and ((Stview>6)))
- or ((VMode = 4) and ((Stview>8))) Then
- break;
- end;
- end;
- end;
- ISB1Click(ISB1);
-
-
- DataLoading(False,False);
-end;
-
-procedure TCB_IMGPSScanX.view_image_DocNo(Path,DocNo,FormID:String;Pages:integer); //用DocNo來找影像
-var i,n,p:integer;
- ISB : TImageScrollBox;
- lb : TLabel;
- v ,v1 : Integer;
- List_DocNo,Trans_DocNo,List_FormCode,Form_Page: String;
- iDocNo : String;
- iGroupNo,page,Ct,int1 : Integer;
- ST1:TStringList;
-begin
- ShowText := _Msg('影像顯示中,請稍候');
- DataLoading(True,True);
-ST1:=TStringList.Create;
-//Display1.Lines.Clear;
- IF DocNo = 'ShowAll' then //顯示所有的影像 (因為附件會傳空字串,所以用ShowAll)
- begin
- ClearView(1);
- if GetCasePage(ImageSavePath,NowCaseno) > 30 then
- begin
- DataLoading(False,False);
- Exit;
- end;
- CreatePreViewISB(GetCasePage(ImageSavePath,NowCaseno));
-//Showmessage(inttostr(GetCasePage(ImageSavePath,NowCaseno)));
- Ct := 0;
- For i := 0 to CaseDocNoList.Count-1 do
- begin
-
- if (FWH_category='N') and (FIs_In_Wh='Y') then
- begin
- if FileExists(ImageSavePath+NowCaseno+'\EditedDocDir.dat') then
- begin
- ST1.LoadFromFile(ImageSavePath+NowCaseno+'\EditedDocDir.dat');
- end;
- end;
-
- iDocNo := CaseDocNoList.Strings[i];
-//ShowMessage('ST1.Count='+IntToStr(ST1.Count));
- if ST1.Count<>0 then
- begin
- if ST1.IndexOf(iDocNo)<>-1 then
- begin
- end
- else
- begin
- if not DocNoAppear(DocNoDir2DocNo(iDocNo)) then continue; //20170817 這不能被註解
- end;
- end
- else
- begin
- if not DocNoAppear(DocNoDir2DocNo(iDocNo)) then continue; //20170817 這不能被註解
- end;
- ContextList.Clear;
- if FileExists(Path+iDocNo+'\Context.dat') then
- ContextList.LoadFromFile(Path+iDocNo+'\Context.dat');
-//ShowMessage('ContextList='+ContextList.Text);
- for n := 0 to ContextList.Count - 1 do
- begin
-
- if (FWH_category='N') and (FIs_In_Wh='Y') then
- begin
- if ISExistImg(Path+iDocNo+'\'+ContextList.Strings[n]) then
- begin
-
- if not DocNoIs_In_WH(Copy(iDocNo,1,8)) then
- begin
- Continue;
- end;
- end;
- end;
-
- inc(Ct);
- ISB := TImageScrollBox(FindComponent(ISBName+intToStr(Ct)));
- ISB.AntiAliased := True;
- if ISB.ZoomPercent > 100 then
- ISB.AntiAliased := False;
- ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[n],1);
-
- DpiResize(ISB.Graphic,36,False);
- ISB.Redraw(true);
-
- end;
-
- end;
- //if DirectoryExists(Path+'Attach') then
- if DirectoryExists(Path+AttName) then
- begin
- //iDocNo := 'Attach';
- iDocNo := AttName;
- ContextList.Clear;
- if FileExists(Path+iDocNo+'\Context.dat') then
- ContextList.LoadFromFile(Path+iDocNo+'\Context.dat');
- for n := 0 to ContextList.Count - 1 do
- begin
- inc(Ct);
- ISB := TImageScrollBox(FindComponent(ISBName+intToStr(Ct)));
- ISB.AntiAliased := True;
- if ISB.ZoomPercent > 100 then
- ISB.AntiAliased := False;
- ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[n],1);
- end;
- end;
-
- FitPreViewISB;
-
- end
- Else if (DocNo <> '') and (FormID = '') then //顯示指定DocNo+組別的影像 附件傳 Attach
- begin //顯示 文件層下的影像
- iDocNo := DocNo;
- ContextList.Clear;
- if FileExists(Path+iDocNo+'\Context.dat') then
- ContextList.LoadFromFile(Path+iDocNo+'\Context.dat');
-
-//ShowMessage('ContextList.Count='+IntToStr(ContextList.Count));
- CreatePreViewISB(ContextList.Count);
-//ShowMessage(IntToStr(ContextList.Count));
- int1:=0;
-//ShowMessage(BoolToStr(DocNoIs_In_WH(Copy(iDocNo,1,8)),true));
- For i := 0 to ContextList.Count -1 do
- begin
- if (FWH_category='N') and (FIs_In_Wh='Y') then
- begin
- if ISExistImg(Path+iDocNo+'\'+ContextList.Strings[i]) then
- begin
-
- if not DocNoIs_In_WH(Copy(iDocNo,1,8)) and ( iDocNo<>'Attach') then
- begin
- inc(int1);
- Continue;
- end;
- end;
- end;
-//ShowMessage(Path+iDocNo+'\'+ContextList.Strings[i]);
- ISB := TImageScrollBox(FindComponent(ISBName+intToStr(i+1-int1)));
- ISB.AntiAliased := True;
- if ISB.ZoomPercent > 100 then
- ISB.AntiAliased := False;
- ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[i],1);
- DpiResize(ISB.Graphic,36,False);
- ISB.Redraw(true);
- end;
- FitPreViewISB;
- end
- Else if (FormID <> '') {and (FormID <> 'Attach')} then //顯示指定FormID的影像
- begin
- If (TreeView1.Selected <> nil) Then
- begin
- iDocNo := DocNo;
- ContextList.Clear;
- if FileExists(Path+iDocNo+'\Context.dat') then
- ContextList.LoadFromFile(Path+iDocNo+'\Context.dat');
- iGroupNo := 0;
- page := 0;
- Ct := 0;
- CreatePreViewISB(Pages);
-//ShowMessage('formID page'+IntToStr(Pages)+', ContextList='+ContextList.Text);
- For i := 0 to ContextList.Count -1 do
- begin
- if FileName2FormCode(ContextList.Strings[i]) = FormID then
- begin
- if (FWH_category='N') and (FIs_In_Wh='Y') then
- begin
-//ShowMessage(Path+iDocNo+'\'+ContextList.Strings[i]);
-//ShowMessage(BoolToStr(ISExistImg(Path+iDocNo+'\'+ContextList.Strings[i]),true));
- if ISExistImg(Path+iDocNo+'\'+ContextList.Strings[i]) then
- begin
- if not DocNoIs_In_WH(FormCode2DocNo(FormID)) then
- Continue;
- end;
- end;
- inc(Ct);
- ISB := TImageScrollBox(FindComponent(ISBName+intToStr(Ct)));
-//ShowMessage(ISB.Name);
- ISB.AntiAliased := True;
- if ISB.ZoomPercent > 100 then
- ISB.AntiAliased := False;
- ISB.LoadFromFile(Path+iDocNo+'\'+ContextList.Strings[i],1);
- DpiResize(ISB.Graphic,36,False);
- ISB.Redraw(true);
-
- //NowShowFileList.Add(ContextList.Strings[i]);
- end;
- end;
- FitPreViewISB;
- end;
- end;
-
- if FindComponent(ISBName+'1') <> nil then
- begin
- ISBClick(TImageScrollBox(FindComponent(ISBName+'1')));
- end;
- ISB1Click(ISB1);
- DataLoading(False,False);
-end;
-
-Function TCB_IMGPSScanX.ShapeName2PreViewISBName(SP:TShape):String; //轉出指定PreViewISBName
-begin
- Result := ISBName+Copy(SP.Name,3,length(SP.Name)-2);
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton14Click(Sender: TObject);
-var
- Count : Integer;
-begin
- if not ISB1.Graphic.IsEmpty then
- begin
- ISB1.LoadFromFile(ISB1.FileName,1);
- Rotate(ISB1.Graphic,270);
- if ISB1.Graphic.ImageFormat <> ifBlackWhite then
- begin
- TJpegGraphic(ISB1.Graphic).SaveQuality := 30;
- TJpegGraphic(ISB1.Graphic).SaveToFile(ISB1.FileName);
- end
- Else
- ISB1.SaveToFile(ISB1.FileName);
- ISB1.Redraw(True);
- SelectISB.Graphic.Assign(ISB1.Graphic);
- SelectISB.Redraw(True);
- FitPreViewISB;
- ISBClick(SelectISB);
- end;
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton15Click(Sender: TObject);
-begin
- if not ISB1.Graphic.IsEmpty then
- begin
- ISB1.LoadFromFile(ISB1.FileName,1);
- Rotate(ISB1.Graphic,180);
- if ISB1.Graphic.ImageFormat <> ifBlackWhite then
- begin
- TJpegGraphic(ISB1.Graphic).SaveQuality := 30;
- TJpegGraphic(ISB1.Graphic).SaveToFile(ISB1.FileName);
- end
- Else
- ISB1.SaveToFile(ISB1.FileName);
- ISB1.Redraw(True);
- SelectISB.Graphic.Assign(ISB1.Graphic);
- SelectISB.Redraw(True);
- FitPreViewISB;
- ISBClick(SelectISB);
- end;
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton16Click(Sender: TObject);
-begin
- if not ISB1.Graphic.IsEmpty then
- begin
- ISB1.LoadFromFile(ISB1.FileName,1);
- Rotate(ISB1.Graphic,90);
- if ISB1.Graphic.ImageFormat <> ifBlackWhite then
- begin
- TJpegGraphic(ISB1.Graphic).SaveQuality := 30;
- TJpegGraphic(ISB1.Graphic).SaveToFile(ISB1.FileName);
- end
- Else
- ISB1.SaveToFile(ISB1.FileName);
- ISB1.Redraw(True);
- SelectISB.Graphic.Assign(ISB1.Graphic);
- SelectISB.Redraw(True);
- FitPreViewISB;
- ISBClick(SelectISB);
- end;
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton17Click(Sender: TObject);
-begin
- ISB1.ZoomMode := zmFitHeight;
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton18Click(Sender: TObject);
-begin
- ISB1.ZoomMode := zmFitWidth;
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton19Click(Sender: TObject);
-begin
- ISB1.ZoomMode := zmOriginalSize;
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton20Click(Sender: TObject);
-begin
- ISB1.ZoomMode := zmFittoPage;
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton21Click(Sender: TObject);
-begin
- ISB1.ZoomMode := zmPercent;
- ISB1.ZoomPercent := 50;
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton22Click(Sender: TObject);
-begin
- ISB1.ZoomMode := zmPercent;
- ISB1.ZoomPercent := 25;
-end;
-
-procedure TCB_IMGPSScanX.SpeedButton3Click(Sender: TObject);
-begin
- ISB1.ZoomMode := zmFullPage;
-end;
-
-Procedure TCB_IMGPSScanX.CreatePreViewISB(Count:Integer);
-var
- ISB : TImageScrollBox;
- Panel : TPanel;
- i,W,H : Integer;
- myDate : TDateTime;
-begin
- FreePreViewISB;
- ScrollBox1.HorzScrollBar.Visible := False;
- W := 150;
- H := 250;
- for I := 1 to Count do
- begin
-
- if FindComponent('M_Pl'+inttostr(i))=nil then
- begin
- Panel := TPanel.Create(Self);
- Panel.Name := 'M_Pl'+inttostr(i);//FormatDateTime('yyyymmddhhnnsszzz', now)
- Panel.Left := 4;
- Panel.Top := (i-1)*H+(6*i);
- Panel.Height := H;
- Panel.Width := W;
- Panel.Parent := ScrollBox1;
- Panel.Caption :='';
-
- if FindComponent(ISBName+inttostr(i))=nil then
- begin
- ISB := TImageScrollBox.Create(Self);
- ISB.Name := ISBName+inttostr(i);
- ISB.Parent := Panel;
- ISB.Align := alClient;
- ISB.ZoomMode := zmFullPage;
- ISB.DragMode := dmAutomatic;
- ISB.MouseMode := mmuser;
- ISB.OnImageClick := ISBClick;
- ISB.OnImageMouseMove := ISBMouseMove;
- ISB.PopupMenu := PopupMenu6;
- ISB.OnImageMouseDown := ISBImageMouseDown;
- ISB.OnImageMouseUp := ISBImageMouseUp;
- ISB.OnEndDrag := ISBEndDrag;
- ISB.OnDragDrop := ISBDragDrop;
- ISB.OnDragOver := ISBDragOver;
- end;
- end;
-
- end;
-
-end;
-
-Procedure TCB_IMGPSScanX.FreePreViewISB;
-var
- i : Integer;
-begin
-try
- For i:= ComponentCount -1 downto 0 do
- begin
- IF (Components[i] is TImageScrollBox) and (Components[i]<>nil) Then
- begin
- IF Pos(ISBName,Components[i].Name) > 0 Then
- Components[i].Free;
- end
- Else If (Components[i] is TPanel) and (Components[i]<>nil) Then
- begin
- IF Pos('M_Pl',Components[i].Name) > 0 Then
- Components[i].Free;
- end
- Else If (Components[i] is TShape) and (Components[i]<>nil) Then
- begin
- IF Pos('SP',Components[i].Name) > 0 Then
- Components[i].Free;
- end;
- end;
- Application.ProcessMessages;
-except on E: Exception do
-end;
-
- //showmessage(inttostr(Count));
-end;
-
-Procedure TCB_IMGPSScanX.FitPreViewISB;
-var
- i : Integer;
- iISB : TImageScrollBox;
- iPanel : TPanel;
- T,H : Integer;
-begin
- T := 0;
- i := 1;
-
- while FindComponent(ISBName+inttostr(i)) <> nil do
- begin
- iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i)));
- iISB.Parent.Height := 250;
- iISB.Parent.Top := T+4;
- iISB.Parent.Height := iISB.DisplayedGraphic.Height;
- H := iISB.Parent.Height;
- T := iISB.Parent.Top+H;
- inc(i);
- end;
-
-
- {For i:= 1 to Count do
- begin
- if TImageScrollBox(FindComponent(ISBName+inttostr(i))) = nil then Break;
-
-
- iISB := TImageScrollBox(FindComponent(ISBName+inttostr(i)));
- iISB.Parent.Height := H;
- iISB.Parent.Top := T+4;
- iISB.Parent.Height := iISB.DisplayedGraphic.Height;
- H := iISB.Parent.Height;
- T := iISB.Parent.Top+H;
- end;}
-
-end;
-
-Procedure TCB_IMGPSScanX.PaintShape(FromImg,ToImg:TImageScrollBox); //畫有被選取的影像
-var
- i,F_No,T_No : Integer;
- SP : TShape;
- ISB : TImageScrollBox;
- Function GetImgNo(iISB:TImageScrollBox):Integer;
- begin
- Result := strtoint(Copy(iISB.Name,length(ISBName)+1,length(iISB.Name)-length(ISBName))); //'PreViewISB'
- end;
-begin
- IF ToImg = nil Then //只畫單一個
- begin
- ISB := TImageScrollBox(FindComponent(ISBName+inttostr(GetImgNo(FromImg))));
- if TShape(FindComponent('SP'+inttostr(GetImgNo(FromImg)))) = nil then
- begin
-
- SP := TShape.Create(self);
- SP.Pen.Color := clblue;
- SP.Pen.Width := 3;
- SP.Parent := ScrollBox1;
- SP.Name := 'SP'+inttostr(GetImgNo(FromImg));
- SP.Left := ISB.Parent.Left-4;
- SP.Top := ISB.Parent.Top -4;
- SP.Width := ISB.Parent.Width + 8;
- SP.Height := ISB.Parent.Height + 8;
- end;
- end
- Else
- begin
- FreeShapeobj(nil);
- IF GetImgNo(FromImg) <= GetImgNo(ToImg) Then
- begin
- F_No := GetImgNo(FromImg);
- T_No := GetImgNo(ToImg);
- end
- Else
- begin
- F_No := GetImgNo(ToImg);
- T_No := GetImgNo(FromImg);
- end;
- For i := F_No to T_No do
- begin
- ISB := TImageScrollBox(FindComponent(ISBName+inttostr(i)));
- SP := TShape.Create(self);
- SP.Pen.Color := clblue;
- SP.Pen.Width := 3;
- SP.Parent := ScrollBox1;
- SP.Name := 'SP'+inttostr(i);
- SP.Left := ISB.Parent.Left-4;
- SP.Top := ISB.Parent.Top -4;
- SP.Width := ISB.Parent.Width + 8;
- SP.Height := ISB.Parent.Height + 8;
- end;
- end;
-end;
-
-Procedure TCB_IMGPSScanX.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;
-//ShowMessage('SelectISB.FileName='+SelectISB.FileName);
- //if SelectISB.FileName='' then exit;
-
- ISB1.LoadFromFile(SelectISB.FileName,1);
- if (ISB1.Graphic.ImageFormat <> ifBlackWhite) and (SmoothCB.Checked)then
- Image_Smooth(ISB1.Graphic);
- ISB1.Redraw(True);
- ISB1Click(ISB1);
-end;
-
-Procedure TCB_IMGPSScanX.ISBMouseMove(Sender: TObject; Shift: TShiftState;
- X, Y: Integer);
-begin
- //Edit1.SetFocus;
- if Draging then
- begin
- if not (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then
- begin
- SelectISB.BeginDrag(False);
- Draging := False;
- end;
- end;
-end;
-
-procedure TCB_IMGPSScanX.ISBImageMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-var
- v,ln:Integer;
-begin
- if Button = TMouseButton(mbLeft) Then
- begin
- Draging := True;
- //if SelectISB <> nil then
-
- //if not Draging then
- //begin
-
- end;
- //end;
-
- {if not (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then
- begin
- //Showmessage('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)));
- if (Button = TMouseButton(mbLeft)) and (GetKeyState(VK_CONTROL) >= 0) then
- begin
- if SelectISB <> nil then
- SelectISB.BeginDrag(False);
- end;
- end;
- //if (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then
- //begin
- //else
- //begin
- if not Draging then
- begin
- if (GetKeyState(VK_SHIFT) < 0) Then
- begin
- PaintShape(SelectISB,TImageScrollBox(Sender));
- SelectISB := TImageScrollBox(Sender);
- end
- Else if (GetKeyState(VK_CONTROL) < 0) Then
- begin
- SelectISB := TImageScrollBox(Sender);
- IF TShape(FindComponent('SP'+Copy(SelectISB.Name,length(ISBName)+1,length(SelectISB.Name)-length(ISBName)))) = nil Then
- PaintShape(SelectISB,nil)
- else
- FreeShapeobj(SelectISB);
- end
- Else
- begin
- FreeShapeobj(nil);
- SelectISB := TImageScrollBox(Sender);
- PaintShape(SelectISB,nil);
- end;
- v := length(ISBName);
- ln := length(SelectISB.Name);
- SelectPage := Strtoint(Copy(SelectISB.Name,v+1,ln-v));
- ISB1.ZoomMode := zmFittoPage;
- ISB1.LoadFromFile(SelectISB.FileName,1);
- ISB1Click(ISB1);
- end;
- //end;
- //end
- //Else
- //begin
-
- //end; }
-
- {if (Button = TMouseButton(mbRight)) and (TShape(FindComponent('SP'+Copy(TImageScrollBox(Sender).Name,length(ISBName)+1,length(TImageScrollBox(Sender).Name)-length(ISBName)))) = nil) then
- begin
- //ISBClick(Sender);
- end;
- if (Button = TMouseButton(mbLeft)) then
- begin
-
- end; }
-end;
-
-procedure TCB_IMGPSScanX.ISBImageMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-begin
- Draging := False;
-end;
-
-procedure TCB_IMGPSScanX.ISBEndDrag(Sender, Target: TObject; X, Y: Integer);
-begin
- TreeView1Click(self);
-end;
-
-procedure TCB_IMGPSScanX.ISBDragDrop(Sender, Source: TObject; X, Y: Integer);
-var
- fp,tp : Integer;
-begin
- fp := FileName2ScanPage(TimageScrollBox(Source).FileName);
- tp := FileName2ScanPage(TimageScrollBox(Sender).FileName);
- MoveImage_Drag(DisplayPath+NowDocDir+'\',fp,tp );
-
-end;
-
-procedure TCB_IMGPSScanX.ISBDragOver(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean);
-var
- So : Boolean;
-begin
- {if (TObject(Source) is TImageScrollBox) and (TObject(Sender) is TImageScrollBox) then
- begin
- Label3.Caption := TImageScrollBox(Source).FileName+#13+TImageScrollBox(Sender).FileName;
- end; }
-
- So := False;
- if TObject(Source) is TImageScrollBox then
- So := True;
- Accept := True;
- if not So
- or (TImageScrollBox(Source).FileName = TImageScrollBox(Sender).FileName)
- or (TreeView1.Selected.Level <> 2)
- Then
- Accept := False;
-end;
-
-Function TCB_IMGPSScanX.FindMpsView(Vmode: Integer):TImageScrollBox;
-var
- i,n : Integer;
- ISB : TImageScrollBox;
-begin
- case Vmode of
- 0 : n := 1;
- 1 : n := 2;
- 2 : n := 4;
- 3 : n := 6;
- 4 : n := 8;
- end;
- for i := 1 to 8 do
- begin
- if i > n then Break;
- ISB := TImageScrollBox(FindComponent('ISB'+inttostr(i)));
- if (i = n) and (ISB.FileName <> '') then
- begin
- clearView(i);
- Result := ISB1;
- end
- Else if ISB.FileName = '' then
- Result := ISB;
- end;
-end;
-
-Function TCB_IMGPSScanX.GetCaseFormID(Path:String):String; //取案件的主FormID
-var i,n : Integer;
- FileFormID : String;
-begin
- Result := '';
- ContextList.LoadFromFile(Path+'Context.dat');
- for I := 0 to ContextList.Count - 1 do
- begin
- FileFormID := FileName2FormCode(ContextList.Strings[i]);
-
- if DivPageFormIDList.IndexOf(FileFormID)<>-1 then //20170509 跳過分案頁的formid
- begin
- Continue;
- end;
- if FindDivFormCode(FileFormID) then
- begin
- Result := FileFormID;
- Break;
- end;
- end;
-end;
-
-Procedure TCB_IMGPSScanX.CreateFormID_FormName(Path,CaseID:String); //產生FormID_FormName.dat
-var i : Integer;
- S : TStringlist;
- FormID : String;
- FormName : String;
-begin
- S := TStringlist.Create;
- try
- for I := 0 to ContextList.Count - 1 do
- begin
- FormID := FileName2FormCode(ContextList.Strings[i]);
- FormName := FormCode2FormName(CaseID,FormID);
- S.Add(FormID+'_'+FormName);
- end;
- S.SaveToFile(Path + 'FormCode_Name.dat',TEnCoding.UTF8);
- finally
- S.Free;
- end;
-end;
-
-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);
-//ShowMessage(OldName+#10#13+NewName);
- 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,True);
- S.Clear;
- S.Add(ServerDate+GetBalance2Time(Balance));
- S.SaveToFile(CheckXmlPath+'LastDateTime.dat');
- end
- Else
- begin
- if (Memo1.Lines.Strings[0] = 'nodata') Then //沒更新
- begin
- Result := True;
- end
- Else if (Memo1.Lines.Strings[0] = '1') Then
- begin
- HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1];
- Result := False;
- Exit;
- end
- Else if Pos('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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,True);
- S.Clear;
- S.Add(ServerDate+GetBalance2Time(Balance));
- S.SaveToFile(SitePath+'LastDateTime.dat');
- end
- Else
- begin
- if (Memo1.Lines.Strings[0] = 'nodata') Then //沒更新
- begin
- Result := True;
- end
- Else if (Memo1.Lines.Strings[0] = '1') Then
- begin
- HttpErrStr := _Msg('錯誤原因:')+memo1.Lines.Strings[1];
- Result := False;
- Exit;
- end
- Else if Pos('<script type="text/javascript" src="scripts/CW00/login.js"></script>',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);
-
- 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;
- //FIs_In_Wh:='Y'; /// test 記得關掉
- //FWH_category :='N'; // test 記得關掉
-// FImgDelete := 'Y'; //test 記得關掉
- //Showmessage('a');
- //self.FIs_OldCase := 'Y';
- PageLVclear := True;
- InitialOk := False;
-
- FMaxUploadSize:='10';
- FJpgCompression:=50;
- //FMode := 'DSCAN' ;
- //FIs_In_Wh := 'Y';
- if FIs_In_Wh = 'Y' then
- AttName := 'Attach' //入庫附件
- else
- AttName := 'S_Attach'; //Smartlending 附件
-//ShowMessage('1111111');
- if FMode = 'SAMPLESCAN' then
- begin
- NewScanBtn.Visible := False;
- PJLinkedMenuSpeedButton2.Visible := False;
- AddScanBtn.Visible := False;
- CheckCaseBtn.Visible := False;
- Panel18.Visible := False;
- TransBtn.Visible := False;
- FC6.Visible := False;
- SampleScanBtn.Visible := True;
- Panel1.Visible := True;
- Panel6.Visible := True;
- ScanDuplexCB.Visible := False; //雙面掃描
- end
- Else if (FMode = 'NSCAN') then
- begin
- Panel18.Visible := True;
- Panel1.Visible := True;
- Panel6.Visible := True;
- Panel21.Visible := True;
- Panel23.Visible := True;
-
- AttFileGB.Visible := True;
- Splitter2.Visible := True;
- ScanDuplexCB.Visible := True; //雙面掃描
- end
- Else if FMode = 'FSCAN' then
- begin
- Panel1.Visible := True;
- //Panel6.Visible := True;
- end
- Else
- begin
- Panel18.Visible := True;
- Panel1.Visible := True;
- Panel6.Visible := True;
- Panel21.Visible := True;
- Panel23.Visible := True;
- AttFileGB.Visible := True;
- Splitter2.Visible := True;
- end;
- DisplayMode(1,1,1,Panel9);
- Application.ProcessMessages;
- StatusBar1.Panels[0].Text := 'Ver'+GetCurrentVersionNo;
- StatusBar1.Panels[1].Text := 'Login User:'+FUserName;
- if FPrintyn = 'Y' then
- PrtLB.Visible := True;
-
- initParameter; //20170222 針對新加的parameter 作初始化參數
- InitScrollRec;
- If FUrl = '' then
- begin
- Showmessage(_Msg('URL cannot be empty,please contact system administrator'));
- Exit;
- end;
- if FUrl[length(FUrl)]<>'/' then
- FUrl := FUrl + '/';
- //20221028 把語言檔改放至 Local目錄裡,才不會有些文字來不及使用
- LngPath := GetLocalAppDir(Handle)+'MPS\CB_IMGPS\';
- Str2Dir(LngPath);
- ////下載語言檔///// 20170218 先拿調以便測試
- If not DownLanguage Then
- begin
- Showmessage('Language File error!!'+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
-
- InitialLanguage(Self); //載入多國語言
-
-
- if FWork_no='' then
- begin
- Showmessage(_Msg('業務別不能為空白,請洽詢程式人員'));
- Exit;
- end;
-
- if CaseIDLength = 0 then
- begin
- Showmessage(_Msg('案件編號長度限制不能為空白,請洽詢程式人員'));
- //Exit; //測試時不退出
- end;
-
- //********清單區********
-
- Doc_Inf_List := TStringList.Create; //Doc_Inf 清單 Docno + 版本為key
- DM_FORM_INF_List := TStringList.Create; //DM_FORM_INF 清單 Docno + 版本為key
- FORM_INF_List := TStringList.Create; //FORM_INF的清單
- CHECK_RULE_INF_List := TStringList.Create; //CHECK_RULE_INF 清單
- MEMO_INF_List := TStringList.Create; //MEMO_INF 清單
- WORK_INF_List := TStringList.Create; //WORK_INF 清單
- LASTEST_FORM_INF_List := TStringList.Create; // LASTEST_FORM_INF 清單
- FindResult := TStringlist.Create; //找SQLData的結果
-
- OMRFileList := TStringList.Create; //要OMR檢核的文件(只檢查每種Form的第一頁)
- FormCode_PageSize := TStringList.Create; //文件的預設大小 FormCode_Height_Width
- DocNo_NeedDoc := TStringList.Create; //有Docno時要相依的文件 DocNo_相依文件_相依文件
- DocNo_NoDoc := TStringList.Create; //有Docno時互斥的文件 DocNo_互斥文件_互斥文件
- DocNo_VerinCase := TStringList.Create; //案件裡的DocNo+版本的清單
- CaseDocNoList := TStringlist.Create; //案件裡的DocNo清單
- CaseDocNo_CopiesList := TStringlist.Create; //案件裡的DocNo份數清單
- CaseList := TStringList.Create; //記錄掃瞄案件的順序
- Context_DocnoList := TStringlist.Create; //案件裡的檔案Docno清單
- ContextList := TStringlist.Create; //案件裡的檔案清單
- AttContextList := TStringlist.Create; //案件裡的附加檔案清單
- NoSaveBarCodeList := TStringlist.Create; //不儲存的條碼清單
- FormID_List := TStringlist.Create; //FormID清單
- DocNo_List := TStringlist.Create; //DocNo清單
- NowShowFileList := TStringlist.Create; //目前顯示的影像清單
- NowSelectFileList := TStringlist.Create; //目前被點選的影像清單
- Cust_DocNoList := TStringlist.Create; //自行定義的文件名稱
- IN_WH_DocNoList := TStringlist.Create; //入庫的文件清單
- GuideFormIDList := TStringlist.Create; //要當導引頁表單清單
- DivPageFormIDList := TStringList.Create; //要當分案頁表單清單
- LastInitFormidList :=TStringList.Create;
- LastAddFormidList := TStringList.Create;
- SampleFormIDList := TStringList.Create;//20170627 加入
- ExistImgList := TStringList.Create; //20170724 新增
- reSizeExistImgList :=TStringList.Create; //20171012 新增
- //********清單區********
-
- ShowText := _Msg('資料載入中,請稍候');
- DataLoading(True,True);
-
- IF not GetServerDate Then
- begin
- Showmessage(_Msg('取主機時間時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
-
- if FMode='SAMPLESCAN' then
- begin
- IF not GetSampleInf Then //取已存在sample
- begin
- Showmessage(_Msg('取存在範本資訊時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
- end;
-
-
-
-//ShowMessage('GetServerDate '+ServerDate+' , '+ServerTime);
- ////下載系統資訊////
- IF not GetSetInf1 Then //取DOC_INF 文件資訊
- begin
- Showmessage(_Msg('取文件資訊時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
-//ShowMessage('GetSetInf1');
- //showmessage(self.Doc_Inf_List.Text);
- IF not GetSetInf2 Then //取DM_FORM_INF 相依互斥資訊
- begin
- Showmessage(_Msg('取相依互斥資訊時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
-//ShowMessage('GetSetInf2');
- //Showmessage(self.Doc_Inf_List.Text);
- IF not GetSetInf3 Then //取FORM_INF 表單資訊
- begin
- Showmessage(_Msg('取表單資訊時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
-//ShowMessage('GetSetInf3');
- IF not GetSetInf4 Then //取CHECK_RULE_INF 檢核規則資訊
- begin
- Showmessage(_Msg('取檢核規則資訊時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
- //showmessage(self.CHECK_RULE_INF_List.Text);
-//ShowMessage('GetSetInf4');
- IF not GetSetInf5 Then //取MEMO_INF 常用片語資訊
- begin
- Showmessage(_Msg('取常用片語資訊時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
-//ShowMessage('GetSetInf5');
- //showmessage(self.MEMO_INF_List.Text);
- IF not GetSetInf6 Then //取WORK_INF 系統參數資訊
- begin
- Showmessage(_Msg('取系統參數資訊時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
-//ShowMessage('GetSetInf6');
- //showmessage(FORM_INF_List.Text);
- IF not GetSetInf7 Then //取LASTES_FORM_INF 系統參數資訊
- begin
- Showmessage(_Msg('取最新版FORMID參數資訊時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
-//ShowMessage('GetSetInf7');
- //Showmessage(LASTEST_FORM_INF_List.Text);
- SetFormID_DocNo; //將FormID及Docno抽出塞入List裡 20130403增加
- SetIn_WH_DocNo; //將要入庫的DocNo抽出來另存入list裡
- GetDefScanIni; //取得掃描預設值及相關設定
-
- ////下載系統資訊/////
- if ImagePath = '' then
- begin
- Showmessage(_Msg('本機暫存路徑不得為空白'));
- DataLoading(False,False);
- Panel1.Enabled := False;
- Panel2.Enabled := False;
- Exit;
- end;
- initkscan;
- if ImagePath[Length(ImagePath)] <> '\' then
- ImagePath := ImagePath + '\';
-//ShowMessage('ImagePath='+ImagePath);
- //CheckXmlPath := ImagePath+'OMRSITE\'+FWork_No;
- CheckXmlPath := ImagePath+'OMRSITE\'; // 20200612 發現影像平台是取回所有業務的設定,所以不能有業務別目錄
-//ShowMessage('CheckXmlPath='+CheckXmlPath);
- //SitePath := ImagePath+'Site\'+FWork_No+'\';
- SitePath := ImagePath+'Site\'; // 20200612 發現影像平台是取回所有業務的設定,所以不能有業務別目錄
- //LngPath := ImagePath; //改放至上面取Local目錄
- SamplePath := ImagePath+'Sample\'+FWork_No+'\';
- ImagePath := ImagePath + 'Scantemp\';
-//ShowMessage('AA ImagePath='+ImagePath);
- ScaniniPath :=ImagePath+FWork_No+'\'+FUserUnit +'\';
-//ShowMessage('ScaniniPath='+ScaniniPath);
- ImagePath := ImagePath + FWork_No+'\'+FUserUnit+'\'+FMode+'\';
- ImagePath := StringReplace(ImagePath, '\\', '\',[rfReplaceAll, rfIgnoreCase]);
-//ShowMessage('BB ImagePath='+ImagePath);
- ImageSavePath := ImagePath;
- str2dir(CheckXmlPath);
- str2dir(SitePath);
- str2dir(ImagePath);
- str2dir(SamplePath);
- Del_Sub_NothingPath(ImagePath); //清掉案件目錄是空的
-
-
- LogFile1.LogFile:=LngPath+'IMGPSCheck.log';
-
- ReduceLogFile;
-
- LogFile1.LogToFile(logTimeString+'OCX取表data結束');
-
- ShowText := _Msg('資料載入中,請稍候');
- DataLoading(True,True);
-
-// if not CheckAvailable Then //檢查授權 20170218 說不用了
-// begin
-// DataLoading(False,False);
-// Panel1.Enabled := False;
-// Panel2.Enabled := False;
-// Exit;
-// end;
-
-//Button3Click(Self);
-//ShowMessage('CheckAvailable');
- ShowText := _Msg('資料載入中,請稍候');
- DataLoading(True,True);
-
-
- StatusBar1.Panels[1].Text := _Msg('登入人員:')+FUserName;
- //FCaseID:='20150302180133';//測試用
- ////下載語言檔/////
-//ShowMessage('OOOO');
-
- if (FMode = 'RSCAN') or (FMode = 'DSCAN') or (FMode = 'ESCAN') or (FMode = 'FSCAN') then //重掃件及異動件要只能掃指定編號的件
- begin
- _Deltree(ImagePath);
- str2dir(ImagePath);
- ImageSavePath := ImagePath;
- str2dir(ImageSavePath);
- MkDir(ImageSavePath+FCaseID);
- CreateEmptyCase(ImageSavePath,FCaseID);
- MkDir(ImageSavePath+FCaseID+'\Download');
- IF (FMode = 'ESCAN') or (FMode = 'DSCAN') then //異動件先下載影像
- begin
- ShowText := _Msg('案件下載中,請稍候');
- DataLoading(True,True);
- If not Down_Img(ImageSavePath+FCaseID+'\Download\',FCaseID) then
- begin
- Showmessage(FCaseID+_msg('載入異動影像時,網路發生錯誤')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
-//Showmessage(ImageSavePath+FCaseID+'\Download\'+#10#13+ImageSavePath+FCaseID+'\');
- Download2Case(ImageSavePath+FCaseID+'\Download\',ImageSavePath+FCaseID+'\');
-//Showmessage('aaa');
- //Download2Case('C:\Users\Hong\Downloads\沒有括號\',ImageSavePath+FCaseID+'\');
- if (FIs_OldCase = 'Y') then
- begin
- if (FWork_no='HLN') then
- ErrFormtoCurrentForm(FCaseID,'10000001011112A','11000001011112A'); //換掉錯的FormID
- //if not FileExists(ImageSavePath+FCaseID+'\CaseDocNo_Copies.dat') then //這個會在Download2Case時一律產生所以不能有這行 20141013
- OldCasetoNewCase(FCaseID);
- //ErrFormtoCurrentForm(FCaseID,'11B00005011312A','11000001011112A'); //換掉錯的FormID
- //LoadImgFile;
- end;
-// if (FIs_OldCase = 'Y') and (FWork_no='HLN') then //77版的
-// begin
-// ErrFormtoCurrentForm(FCaseID,'10000001011112A','11000001011112A'); //換掉錯的FormID
-// if not FileExists(ImageSavePath+FCaseID+'\CaseDocNo_Copies.dat') then
-// OldCasetoNewCase(FCaseID);
-// //ErrFormtoCurrentForm(FCaseID,'11B00005011312A','11000001011112A'); //換掉錯的FormID
-// //LoadImgFile;
-// end;
- Create_Cust_DocDir(FCaseID); //產生外面傳入的文件
- if FMode='ESCAN' then
- LastInitFormidListCreate(ImageSavePath+FCaseID+'\Download\');
- end;
- end;
-
-//ShowMessage('GetOMRCheckSet前');
- ////下載檢核XML//////
- IF not GetOMRCheckSet Then
- begin
- Showmessage(_Msg('下載檢核定位檔案時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
- ////下載檢核XML/////
-//ShowMessage('GetOMRCheckSet後來');
- ////下載登打設定/////
- IF not GetKeyinSet Then
- begin
- Showmessage(_Msg('下載登打定位檔案時,網路發生錯誤!!')+HttpErrStr);
- DataLoading(False,False);
- Exit;
- end;
- ////下載登打設定/////
-//ShowMessage('GetKeyinSet');
- if ScanDenialHint <> '' then //有設定提示字串就秀在右上角
- begin
- DenialTimeLb.Visible := True;
- DenialTimeLb.Caption := Format(ScanDenialHint,[ScanDenialTime]);
- end;
-//ShowMessage(IntToStr(ScanDpi));
- R_W_Scanini('R'); //掃瞄設定的ini
-//ShowMessage(IntToStr(ScanDpi));
-//ShowMessage('停掉DataLoading');
-//DataLoading(False,False);
- ScanDuplexCB.Checked := ScanDuplex;
- if FMode <> 'SAMPLESCAN' then
- LoadImgFile;
- if (FMode = 'RSCAN') or (FMode = 'ESCAN') or (FMode = 'FSCAN') then
- begin
- if TreeView1.Items.Count > 0 then
- begin
- TreeView1.Selected := NewTreeNode.Item[0];
- TreeView1click(self);
- end;
- end;
- InitialOk := True;
-
- {AttFileGB.Visible := True; //附加電子檔窗 //20120207楊玉說不在這加電子檔先拿掉
- Splitter2.Visible := True;
- AttFileGB.Visible := False; //附加電子檔窗
- Splitter2.Visible := False; }
-//ShowMessage('ImageSavePath='+ImageSavePath);
- DataLoading(False,False);
-
- LogFile1.LogToFile(logTimeString+'OCX初始化結束');
- LogFile1.LogToFile(logTimeString+'FUrl='+FUrl+
- ',FCaseID='+FCaseID+
- ',FMode='+FMode+
- ',FModeName='+FModeName+
- ',FWork_no='+FWork_no+
- ',FUserID='+FUserID+
- ',FUserName='+FUserName+
- ',FUserUnit='+FUserUnit+
- ',FData='+FData+
- ',FVerify='+FVerify+
- ',FReWrite='+FReWrite+
- ',FLanguage='+FLanguage+
- ',FLoanDoc_Value='+FLoanDoc_Value+
- ',FLoanDoc_Enable='+FLoanDoc_Enable+
- ',FUseProxy='+FUseProxy+
- ',FC_DocNoList='+FC_DocNoList+
- ',FC_DocNameList='+FC_DocNameList+
- ',FFixFileList='+FFixFileList+
- ',FIs_In_Wh='+FIs_In_Wh+
- ',FOldCaseInfo='+FOldCaseInfo+
- ',FPrintyn='+FPrintyn+
- ',FIs_OldCase='+FIs_OldCase+
- ',FCustDocYN='+FCustDocYN);
- LogFile1.LogToFile(logTimeString+'FImgDPI='+IntToStr(FImgDPI)+
- ',FScanColor='+ IntToStr(FScanColor)+
- ',FFileSizeLimit='+ IntToStr(FFileSizeLimit)+
- ',FCaseNoLength='+ IntToStr(FCaseNoLength)+
- ',FImgDelete='+FImgDelete+
- ',FIsExternal='+FIsExternal+
- ',FWH_category='+FWH_category+
- ',FCheck_main_form='+FCheck_main_form+
- ',FMaxUploadSize='+FMaxUploadSize);
-
-end;
-
-procedure TCB_IMGPSScanX.Timer2Timer(Sender: TObject);
-begin
- IF Panel22.Caption = ShowText+'......' Then
- Panel22.Caption := ShowText
- Else
- Panel22.Caption := Panel22.Caption + '.';
- Application.ProcessMessages;
-end;
-
-procedure TCB_IMGPSScanX.TransBtnClick(Sender: TObject);
-Var
- CaseID : String;
- i,n,v: Integer;
- ZipFileList : TStringlist;
- CaseTrans : Integer; //-1:失敗 0:可 1:不行
- SuccessCount,ReCasecount,CheckErrCount : Integer;
- TransMsg : String;
- AreaStr : String;
- S : TStringlist;
- CheckStr : String;
- uploadMsg:String;//20171122 新增 配合不同mode下要秀不能上傳訊息
-begin
- IF not InitialOk Then
- begin
- Showmessage(_msg('資訊尚未下載完成,請稍候或重新進入'));
- Exit;
- end;
-LogFile1.LogToFile(logTimeString+'按下上傳');
- ClearView(1);
- CaseHelpBtn.Visible := False;
- DisplayPath := '';
- ClearCaseIndex;
- RejectCase := False;
- uploadMsg:='';
- if not CheckCaseID_OK then //檢查是否有未配號的案件
- begin
- Showmessage(_Msg('尚有「無案件編號」之案件，無法上傳'));
- Exit;
- end;
-
- if not CheckCaseAttach_OK then //20170911檢查是否有未歸類的案件
- begin
- Showmessage(_Msg('尚有未歸類文件,無法上傳'));
- Exit;
- end;
-
-
- if NewTreeNode.Count = 0 then
- begin
- Showmessage(_Msg('無影像需傳送'));
- Exit;
- end;
-
- SuccessCount := 0;
- ReCasecount := 0;
- CheckErrCount := 0;
- if (FMode = 'NSCAN') and (not CheckScanDenialTime) then
- begin
- if Messagedlg(Format(_Msg('己超過收件時間(%s),預定作業日為下個營業日,是否繼續上傳??'),[ScanDenialTime]),mtConfirmation,[mbyes,mbcancel],0)=mrcancel then Exit;
- end;
-
- ShowText := _Msg('資料上傳中,請稍候');
- DataLoading(True,True);
-
- For i := 0 to NewTreeNode.Count -1 do
- begin
- v := posend('-',NewTreenode.Item[i].Text);
- CaseID := Copy(NewTreenode.Item[i].Text,1,v-1);
- ShowText := CaseID+_Msg('資料上傳中,請稍候');
- DataLoading(True,True);
- CreateIn_WH(CaseID); //產生入庫文件文字檔 In_Wh.dat
- Case2upload(CaseID); //產生原影像結構
- TransPath := ImageSavePath+CaseID+'\Upload\';
- {if FMode = 'ESCAN' then //20140320 yuu說拿掉此檢查
- begin
- S := TStringlist.Create;
- try
- S.LoadFromFile(TransPath + 'Context.dat');
- if S.Count = 0 then
- begin
- Showmessage(_Msg('無影像檔無法傳送'));
- DataLoading(False,False);
- LoadImgFile;
- Exit;
- end;
- finally
- s.Free;
- end;
- end;}
- if (FMode = 'NSCAN') or (FMode = 'DSCAN') then //20170406 待掃瞄也要問一下
- begin
- /////訊問是否可上傳/////
- CaseTrans := CaseAsk(CaseID);
- /////訊問是否可上傳////
- end
- Else ///不是新件、重掃件、異動件的不查
- begin
- CaseTrans := 0;
- end;
- if CaseTrans = -1 then //失敗
- begin
- Showmessage(_Msg('')+HttpErrStr+'.');
- DataLoading(False,False);
- LoadImgFile;
- Exit;
- end;
- if CaseTrans = 1 then
- begin
- ////重複處理/////
- Inc(ReCasecount);
- ////重複處理/////
- Continue;
- end
- Else if CaseTrans = 0 then //可以傳送
- begin
- ///////檢核////// 20100927 User改為搬至外面做 ///20101019 User又改回上傳要做
- //if FMode = 'NSCAN' then //20101019改成讀設定那些模式要做那些檢核
- //begin
- ///依十字定位點縮放////
- CaseReSize(CaseID); //所以影像再做一次縮放
- ////依十字定位點縮放/////// }
- if (FMode <> 'FSCAN') then
- begin
- if (NewTreenode.Item[i].ImageIndex <> 7) and (NewTreenode.Item[i].ImageIndex <> 5) then //檢核完成的不再檢核
- begin
- ShowText := CaseID+_Msg('檢核中,請稍候');
- DataLoading(True,True);
- If not OMRCheckCase(CaseID) then //進檢核
- begin
- Inc(CheckErrCount);
- Continue;
- end;
- end;
- if (NewTreenode.Item[i].ImageIndex = 5) then
- begin
- Inc(CheckErrCount);
- Continue;
- end;
- end;
- //end;
- ///////檢核//////
- ShowText := CaseID+_Msg('資料上傳中,請稍候');
- DataLoading(True,True);
-//ShowMessage('退出');DataLoading(False,False);Exit;
- If Not TransCaseID(TransPath,CaseID,True) Then //傳送案件
- begin
- DataLoading(False,False);
- LoadImgFile;
- Exit;
- end;
- Inc(SuccessCount);
- end;
- end;
- DataLoading(False,False);
- TransMsg := Format(_Msg('成功件【%d】件'),[SuccessCount]);
- if ReCasecount > 0 then
- TransMsg := TransMsg + #13#10 + Format(_Msg('無法上傳件【%d】件'),[ReCasecount]);
- if CheckErrCount > 0 then
- begin
- TransMsg := TransMsg + #13#10 + Format(_Msg('檢核失敗件【%d】件，請先點選「案件編號」，再點選「問號」查看錯誤原因'),[CheckErrCount]);
-LogFile1.LogToFile(logTimeString+'檢核失敗原因:'+OMRErrini2ListForLog(''));
- end;
-
- if (FMode = 'DSCAN') and (SuccessCount = 1) then
- begin
- uploadMsg:=NowCaseNo+_Msg('影像上傳完成。此案已進入下一流程');
- end;
- if (FMode='ESCAN') and (FModeName=_Msg('補件掃描')) and (SuccessCount = 1) then
- begin
- uploadMsg:=NowCaseNo+_Msg('影像已補件完成');
- end;
-//ShowMessage('uploadMsg='+uploadMsg);
- if uploadMsg<>'' then
- begin
- ShowMessage(uploadMsg);
- end
- else
- begin
- Showmessage(_Msg('傳送完成')+#13#10+TransMsg);
- end;
-
- LoadImgFile;
- if (FMode = 'ESCAN') and (SuccessCount = 1) then
- begin
- if FEvents <> nil Then
- begin
- FEvents.OnClosePage;
- end;
- end;
- if (FMode = 'DSCAN') and (SuccessCount = 1) then
- begin
- if FEvents <> nil Then
- begin
- FEvents.OnClosePage;
- end;
- end;
-end;
-
-procedure TCB_IMGPSScanX.TreeView1Click(Sender: TObject);
-Var
- v,v1,v2,v3,ln : Integer;
- i,page : Integer;
- F : TSearchrec;
-begin
- ScanMode := smNew;
- IF TreeView1.Selected = nil Then Exit;
- Scrollbar1.Position := 1;
- Scrollbar1.Max := 1;
- DisplayPath := '';
- NowCaseno := '';
- NowDocDir := '';
- NowDocNo := '';
- NowFormCode := '';
- NowFormName := '';
- NowPage := 0;
- NowShowFileList.Clear;
- StatusBar1.Panels[2].Text := '';
- ClearCaseIndex;
- PageLv.Items.Clear; //頁數清單
- //Panel18.Enabled:= False;
- AttListBox.Items.Clear;
- AddAttFileLB.Enabled := False;
- DelAttFileLB.Enabled := False;
- UseOldCaseLb.Visible := False;
- PM107.Visible := False; //備註功能
- CaseHelpBtn.Visible := False; //檢核失敗原因鈕
- Panel5.Visible := True;
- ContextList.Clear;
- SortMode := false;
- ISB1.ZoomMode := zmFullPage;
- IF TreeView1.Selected.Parent <> nil Then
- begin
- if TreeView1.Selected.Parent = NewTreenode then //點在案件上
- begin
- //Panel18.Enabled := True;
- PM107.Visible := True; //備註功能
- MyTreeNode1 := TreeView1.Selected;
- MyTreeNode2 := nil;
- MyTreeNode3 := nil;
- v := Posend('-',MyTreenode1.Text);
- v1 := Length(MyTreenode1.Text);
- NowCaseNo := Copy(TreeView1.Selected.Text,1,v-1);
- if (FMode = 'ESCAN') and (FOldCaseInfo <> '') then
- UseOldCaseLb.Visible := True;
- ClearView(1);
- DisplayPath := ImageSavePath+NowCaseNo+'\';
- if FLoanDoc_Enable = 'Y' then
- begin
- AddCredit1RG.Enabled := True;
- end;
- ReadCaseIndex(DisplayPath);
- If FileExists(DisplayPath+'\upload\Checkerr.ini') and (not FileExists(DisplayPath+'\upload\OMRCheckOk.dat')) Then
- CaseHelpBtn.Visible := True;
- IF FileExists(DisplayPath+'CaseDocNo.dat') Then
- begin
- CaseDocNoList.LoadFromFile(DisplayPath+'CaseDocNo.dat');
-
-
- view_image_DocNo(DisplayPath,'ShowAll','',1);
- end;
- if FileExists(DisplayPath+'CustomDocNo.dat') then
- Cust_DocNoList.LoadFromFile(DisplayPath+'CustomDocNo.dat');
-
-
- Page := ContextList.Count;
- For i := 1 to page do
- begin
- With PageLV.Items.Add do
- begin
- Caption := Add_Zoo(i,3);
- end;
- end;
- If Page > 0 then
- ScrollBar1.Max := page;
- MyTreeNode1.Expand(True);
- end
- Else If TreeView1.Selected.Parent.Parent = NewTreenode Then //點在文件上
- begin
-
- MyTreeNode1 := TreeView1.Selected.Parent;
- MyTreeNode2 := TreeView1.Selected;
- MyTreeNode3 := nil;
- v := Pos('-',MyTreenode1.Text);
- NowCaseNo := Copy(MyTreenode1.Text,1,v-1);
-
- v := Posend('{',MyTreenode2.Text);
- v1 := Posend('}',MyTreenode2.Text);
- v2 := posend('-',MyTreenode2.Text);
- ln := length(MyTreenode2.Text);
- NowDocDir := Copy(MyTreeNode2.Text,v+1,v1-v-1);
- NowDocNo := DocNoDir2DocNo(NowDocDir);
- page :=Strtoint(Copy(MyTreeNode2.Text,v2+1,ln-v2-1));
- if (FMode = 'ESCAN') and (FOldCaseInfo <> '') then
- UseOldCaseLb.Visible := True;
- ClearView(1);
- DisplayPath := ImageSavePath+NowCaseNo+'\';
-
- if GetUseCase('F',DisplayPath,NowDocDir) <> '' then
- StatusBar1.Panels[2].Text := Format(_Msg('從%s引用'),[GetUseCase('F',DisplayPath,NowDocDir)]);
- if GetUseCase('T',DisplayPath,NowDocDir) <> '' then
- StatusBar1.Panels[2].Text := Format(_Msg('被%s引用'),[GetUseCase('T',DisplayPath,NowDocDir)]);
- if FLoanDoc_Enable = 'Y' then
- begin
- AddCredit1RG.Enabled := True;
- end;
- ReadCaseIndex(DisplayPath);
- If FileExists(DisplayPath+'Checkerr.ini') and (not FileExists(DisplayPath+'OMRCheckOk.dat')) Then
- CaseHelpBtn.Visible := True;
- If Page > 0 then
- ScrollBar1.Max := page;
- For i := 1 to page do
- begin
- With PageLV.Items.Add do
- begin
- Caption := Add_Zoo(i,3);
- end;
- end;
-
- If FileExists(DisplayPath+'Checkerr.ini') and (not FileExists(DisplayPath+'OMRCheckOk.dat')) Then
- CaseHelpBtn.Visible := True;
- IF FileExists(DisplayPath+NowDocDir+'\Context.dat') Then
- begin
- ContextList.LoadFromFile(DisplayPath+NowDocDir+'\Context.dat');
- //Context_DocnoList.LoadFromFile(DisplayPath+'Context_Docno.dat');
- view_image_DocNo(DisplayPath,NowDocDir,'',Page);
- end;
- if FileExists(DisplayPath+'CustomDocNo.dat') then
- Cust_DocNoList.LoadFromFile(DisplayPath+'CustomDocNo.dat');
- MyTreeNode1.Expand(True);
- end
- Else If (NewTreenode <> nil) and (TreeView1.Selected.Parent.Parent.Parent = NewTreenode) Then //點在表單上
- begin
- //NoteBtn.Visible := True; //備註功能
- //Panel18.Enabled := True;
- ClearView(1);
- PM107.Visible := True; //備註功能
- MyTreeNode1 := TreeView1.Selected.Parent.Parent;
- MyTreeNode2 := TreeView1.Selected.Parent;
- MyTreeNode3 := TreeView1.Selected;
-
- v := Posend('-',MyTreenode1.Text);
- NowCaseNo := Copy(MyTreenode1.Text,1,v-1);
-
- if (FMode = 'ESCAN') and (FOldCaseInfo <> '') then
- UseOldCaseLb.Visible := True;
-
- v := Posend('{',MyTreenode2.Text);
- v1 := Posend('}',MyTreenode2.Text);
- v2 := posend('-',MyTreenode2.Text);
- ln := length(MyTreenode2.Text);
- NowDocDir := Copy(MyTreeNode2.Text,v+1,v1-v-1);
- NowDocNo := DocNoDir2DocNo(NowDocDir);
-
- v := Posend('{',MyTreenode3.Text);
- v1 := Posend('}',MyTreeNode3.Text);
- v2 := Posend('-',MyTreeNode3.Text);
- ln := Length(MyTreeNode3.Text);
- if v>0 then
- begin
- NowFormCode := Copy(MyTreeNode3.Text,v+1,v1-v-1);
- if (NowFormCode = 'Attach') or (NowFormCode = 'S_Attach') then
- NowFormCode := '';
- NowFormName := Copy(MyTreeNode3.Text,v+1,v1-v-1);
- page := strtoint(Copy(MyTreeNode3.Text,v2+1,ln-v2-1));
- end
- Else //點在附件的頁數
- begin
- NowFormCode := '';
- page := 1;
- end;
-
- DisplayPath := ImageSavePath+NowCaseNo+'\';
-
- if GetUseCase('F',DisplayPath,NowDocDir) <> '' then
- StatusBar1.Panels[2].Text := Format(_Msg('從%s引用'),[GetUseCase('F',DisplayPath,NowDocDir)]);
- if GetUseCase('T',DisplayPath,NowDocDir) <> '' then
- StatusBar1.Panels[2].Text := Format(_Msg('被%s引用'),[GetUseCase('T',DisplayPath,NowDocDir)]);
-
- if FLoanDoc_Enable = 'Y' then
- begin
- AddCredit1RG.Enabled := True;
- end;
- ReadCaseIndex(DisplayPath);
- If FileExists(DisplayPath+'Checkerr.ini') and (not FileExists(DisplayPath+'OMRCheckOk.dat')) Then
- CaseHelpBtn.Visible := True;
- If Page > 0 then
- ScrollBar1.Max := page;
- For i := 1 to page do
- begin
- With PageLV.Items.Add do
- begin
- Caption := Add_Zoo(i,3);
- end;
- end;
- If FileExists(DisplayPath+NowDocDir+'\Context.dat') Then
- begin
- ContextList.LoadFromFile(DisplayPath+NowDocDir+'\Context.dat');
- view_image_DocNo(DisplayPath,NowDocDir,NowFormCode,Page);
- //view_image_FormCode(DisplayPath,NowFormCode,1,1);
- end;
- if FileExists(DisplayPath+'CustomDocNo.dat') then
- Cust_DocNoList.LoadFromFile(DisplayPath+'CustomDocNo.dat');
- end;
- MyTreeNode1.Expand(True);
- AddAttFileLB.Enabled := True;
- if FileExists(DisplayPath+'ATTContext.dat') then
- begin
- LoadAttFile(NowCaseno);
- end;
- end
- Else //點在NewTreenode or MyTreenode1 上
- begin
- ClearView(1);
- MyTreeNode1 := nil;
- MyTreeNode2 := nil;
- MyTreeNode3 := nil;
- end;
- TreeView1.Selected.MakeVisible;
- CaseList.Clear;
- if FileExists(ImageSavePath + 'CaseList.dat') then
- CaseList.LoadFromFile(ImageSavePath + 'CaseList.dat');
- //CountCaseno;
- //CountCaseCount;
- Application.ProcessMessages;
-end;
-
-procedure TCB_IMGPSScanX.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
-var
- NewCaseno,NewDocNo,NewDocDir,NewFormCode,NewFormName : String;
- NewPath,NewFileName:String;
- OldFileName : String;
- iTreeNode1,iTreeNode2,iTreeNode3: TTreeNode;
- i,v,v1,v2 : Integer;
- PreIndex,Precount,NowCount:Integer;
- GoAtt : Boolean;
- AttLv : Integer;
-begin
- NewCaseno := '';
- NewFormCode := '';
- NewFormName := '';
- Precount := MyTreeNode1.Count;
- PreIndex := -1;
- GoAtt := False;
- if (MytreeNode2 <> nil) and (Pos('Attach',MyTreeNode2.Text)>0) then
- begin
- AttLv := TreeView1.Selected.Level;
- GoAtt := True;
- end;
-
- if TTreeView(Sender).GetNodeAt(X,Y).Level =2 then
- begin
- iTreeNode2 := TTreeView(Sender).GetNodeAt(X,Y);
- iTreeNode1 := iTreeNode2.Parent;
- v := Pos('-',iTreenode1.Text);
- v1 := Length(iTreenode1.Text);
- NewCaseNo := Copy(iTreeNode1.Text,1,v-1);
- v := Posend('{',iTreeNode2.Text);
- v1 := Posend('}',iTreeNode2.Text);
- NewDocNo := Copy(iTreeNode2.Text,v+1,v1-v-1);
- NewPath := ImagePath+NewCaseNo+'\';
- OldFileName := ExtractFileName(DisplayISB.FileName);
- if Copy(NewDocNo,1,5) = 'ZZZZZ' then //自訂文件
- begin
- NewFileName := Add_Zoo(FileName2ScanPage(OldFileName),3)+'_'+NewDocNo+'0000000'+ExtractFileExt(OldFileName);
- NewFormCode := NewDocNo+'0000000';
- {ReNameFile(DisplayISB.FileName,NewPath+NewFileName);
- ReNameContext(DisplayPath,OldFileName,NewFileName);
- MyTreeNode2ReFresh(NowCaseno);
- TreeView1Click(nil);}
- end;
- //NewFileName := Add_Zoo(GetCasePage(ImagePath,NewCaseno)+1,3)+FileName2NoQuene_Filename(OldFileName);
- end
- Else if TTreeView(Sender).GetNodeAt(X,Y).Level =3 then
- begin
- OldFileName := ExtractFileName(DisplayISB.FileName);
- iTreeNode1 := TTreeView(Sender).GetNodeAt(X,Y).Parent.Parent;
- iTreeNode2 := TTreeView(Sender).GetNodeAt(X,Y).Parent;
- iTreeNode3 := TTreeView(Sender).GetNodeAt(X,Y);
- v := Pos('-',iTreenode1.Text);
- v1 := Length(iTreenode1.Text);
- NewCaseNo := Copy(iTreeNode1.Text,1,v-1);
- v := Pos('{',iTreeNode2.Text);
- v1 := Pos('}',iTreeNode2.Text);
- NewDocDir := Copy(iTreeNode2.Text,v+1,v1-v-1);
-
- v := Pos('{',iTreeNode3.Text);
- v1 := Pos('}',iTreeNode3.Text);
- NewFormName := Copy(iTreeNode3.Text,1,v-1);
- NewFormCode := Copy(iTreeNode3.Text,v+1,v1-v-1);
- IF v = 0 Then
- begin
- NewFormCode := '';
- v := Posend('-',iTreeNode3.Text);
- NewFormName := Copy(iTreeNode3.Text,1,v1-1);
- end;
- NewPath := ImagePath+NewCaseNo+'\'+NewDocDir+'\';
- if NewPath = DisplayPath Then //同案件
- begin
- if NewFormCode <> '' then
- //NewFileName := Copy(OldFileName,1,3)+'_'+NewFormCode+ExtractFileExt(OldFileName)
- NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir),3)+'_'+NewFormCode+ExtractFileExt(OldFileName)
- Else
- //NewFileName := Copy(OldFileName,1,3)+ExtractFileExt(OldFileName)
- NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir),3)+ExtractFileExt(OldFileName);
- end
- else //不同案件
- begin
- if NewFormCode <> '' then
- //NewFileName := Copy(OldFileName,1,3)+'_'+NewFormCode+ExtractFileExt(OldFileName)
- NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir),3)+'_'+NewFormCode+ExtractFileExt(OldFileName)
- Else
- //NewFileName := Copy(OldFileName,1,3)+ExtractFileExt(OldFileName)
- NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir),3)+ExtractFileExt(OldFileName);
- end;
- end;
- //Showmessage('a');
- for I := 0 to NowSelectFileList.Count - 1 do
- begin
- OldFileName := NowSelectFileList.Strings[i];
- if NewFormCode <> '' then
- //NewFileName := Copy(OldFileName,1,3)+'_'+NewFormCode+ExtractFileExt(OldFileName)
- NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir)+1,3)+'_'+NewFormCode+ExtractFileExt(OldFileName)
- Else
- //NewFileName := Copy(OldFileName,1,3)+ExtractFileExt(OldFileName)
- NewFileName := Add_Zoo(GetDocDir_Page(NewCaseNo,NewDocDir)+1,3)+ExtractFileExt(OldFileName);
-
- if NewCaseNo = NowCaseNo then //同案件不改順序
- begin
- CopyFile(PWideChar(OldFileName),PwideChar(NewPath+NewFileName),False);
- SetContextList('A',-1,NewCaseNo,NewDocDir,NewFileName);
- DeleteImageFile(ExtractFilePath(OldFileName),ExtractFileName(OldFileName),NowCaseNo);
- TreeView1.Selected := MyTreeNode1;
- //ReNameFile(DisplayPath + OldFileName,NewPath+NewFileName);
- //ReNameContext(DisplayPath,OldFileName,NewFileName);
- //MyTreeNode2ReFresh(NowCaseno);
- //TreeView1Click(nil);
- end
- Else
- begin
- //Showmessage(DisplayMpsView.FileName+#13+NewPath+NewFileName);
- ContextList.LoadFromFile(DisplayPath+'Context.dat');
- if (ContextList.Count = 1) and ((FMode = 'NSCAN') or (FMode = 'ASCAN') or (FMode = 'DSCAN') or (FMode = 'SSCAN') or (FMode = 'MSCAN') or (FMode = 'RI_SCAN') or (FMode = 'ISCAN')) then
- begin
- if Messagedlg(Format(_Msg('移動後(%s)案件無影像,將刪除此案件,是否確定移動?'),[NowCaseno]),mtconfirmation,[mbyes,mbcancel],0) = mrCancel then Exit;
- end;
- CopyFile(PWideChar(DisplayISB.FileName),PWideChar(NewPath+NewFileName),False);
- ContextList.LoadFromFile(NewPath+'Context.dat');
- ContextList.Add(NewFileName);
- ContextList.SaveToFile(NewPath+'Context.dat');
- //Showmessage('1');
- iTreeNode2.Text := Format(_Msg('%s-%d頁'),[NewCaseNo,GetCasePage(ImagePath,NewCaseNo)]);
- //Showmessage('2');
- //DrawDocItem(iTreeNode1,FORM_INF_List,NewCaseNo);
- //DrawDocItem1(MytreeNode1,Doc_Inf_List,NewCaseno); 20140820改
- DrawDocItem2(MytreeNode1,NewCaseno);
- //Showmessage('3');
- ClearErrini(NewCaseNo,iTreeNode1);
- ContextList.LoadFromFile(DisplayPath+'Context.dat');
- if (ContextList.Count = 1) and ((FMode = 'NSCAN') or (FMode = 'ASCAN') or (FMode = 'DSCAN') or (FMode = 'SSCAN') or (FMode = 'MSCAN') or (FMode = 'RI_SCAN') or (FMode = 'ISCAN')) then
- begin
- _DelTree(DisplayPath);
- SetCaseList('D',MyTreeNode1.IndexOf(MyTreeNode2),'');
- LoadImgFile;
- end
- Else
- begin
- ContextList.Delete(ContextList.IndexOf(ExtractFileName(DisplayISB.FileName)));
- ContextList.SaveToFile(DisplayPath+'Context.dat');
- DeleteFile(DisplayISB.FileName);
- ReSortFileName(DisplayPath);
- ClearErrini(NowCaseNo,MyTreeNode1);
- MyTreeNode2ReFresh(NowCaseno);
- //MyTreeNode3ReFresh(NowCaseno);
- ContextList.LoadFromFile(DisplayPath+'Context.dat');
- NowCount := MyTreeNode1.Count;
- if PreCount = NowCount then
- begin
- TreeView1.Selected := MyTreeNode1.Item[PreIndex];
- TreeView1Click(nil);
- end
- Else
- begin
- TreeView1.Selected := MyTreeNode1;
- TreeView1Click(nil);
- end;
- end;
- end;
- end;
- for I := 0 to NowSelectFileList.Count - 1 do
- begin
- OldFileName := NowSelectFileList.Strings[i];
- ReSortFileName(ExtractFilePath(OldFileName));
- end;
- DrawDocItem2(MytreeNode1,NowCaseno);
- ClearErrini(NowCaseno,MyTreeNode1); //清掉檢核記錄
- if GoAtt then
- begin
- GotoAttach(AttLv);
- end;
- //TreeView1Click(nil);
-
-end;
-
-procedure TCB_IMGPSScanX.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean);
-var
- NewNode : TTreeNode;
- ImgFormCode : String;
- ImgDocNo : String;
- So : Boolean;
-begin
- ImgFormCode := FileName2FormCode(ExtractFileName(DisplayISB.FileName));
- ImgDocNo := Path2DocDir(ExtractFilePath(DisplayISB.FileName),NowCaseno);
- //ImgDocNo := FileName2NowDcoNo(ExtractFileName(DisplayISB.FileName),ContextList,Context_DocnoList);
- NewNode := TTreeView(Sender).GetNodeAt(X,Y);
- //Label3.Caption := format('%d/%s/%s',[NewNode.Level,ImgDocNo,Node2DocNo(NewNode)]);
- So := False;
- if TObject(Source) is TImageScrollBox then
- So := True;
- Accept := True;
- if not So
- or(NewNode=nil)
- or((NewNode.Level<>3))
- or((NewNode.Level =3) and (((ImgFormCode=Node3FormID(NewNode)) and (ImgDocNo = Node3DocNo(NewNode))) or (Node3DocNo(NewNode)='')))
- or(Pos(_Msg('Attach'),Newnode.Text)>0)
- Then
- Accept := False;
-
- {if not So
- or(NewNode=nil)
- or((NewNode.Level <>2) and (NewNode.Level<>3))
- or((NewNode.Level =2) and ((ImgDocNo = Node2DocNo(NewNode))or(Node2DocNo(NewNode)='')or (copy(Node2DocNo(NewNode),1,5)<>'ZZZZZ')))
- or((NewNode.Level =3) and ((ImgFormCode=Node3FormID(NewNode)) or (ImgDocNo = Node3DocNo(NewNode)) or (Node3DocNo(NewNode)='')))
- or(Pos(_Msg('未註冊文件'),Newnode.Text)>0)
- Then
- Accept := False;}
-end;
-
-procedure TCB_IMGPSScanX.TreeView1KeyUp(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-begin
- IF TreeView1.Selected.Parent <> nil Then
- begin
- TreeView1Click(nil);
- end
- else
- begin
- ClearView(1);
- end;
-
-end;
-
-procedure TCB_IMGPSScanX.TreeView1MouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
-begin
- IF Button = TMouseButton(MbRight) Then
- begin
- MDown := True;
- If TreeView1.GetNodeAt(X,Y) = nil then Exit;
- TreeView1.Selected := TreeView1.GetNodeAt(X,Y);
- end;
-end;
-
-procedure TCB_IMGPSScanX.TreeView1MouseEnter(Sender: TObject);
-begin
-TreeView1.SetFocus;
-end;
-
-procedure TCB_IMGPSScanX.TreeView1MouseMove(Sender: TObject; Shift: TShiftState;
- X, Y: Integer);
-begin
- //TreeView1.SetFocus;
- {UnRegisterHotKey(Handle, HotKeyId1);
- UnRegisterHotKey(Handle, HotKeyId2); }
-end;
-
-procedure TCB_IMGPSScanX.TreeView1MouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-begin
- IF Button = TMouseButton(MbRight) Then
- begin
- If TreeView1.GetNodeAt(X,Y) = nil then Exit;
- if MDown then
- begin
- TreeView1Click(self);
- TreeView1.PopupMenu.Popup(Mouse.CursorPos.X ,Mouse.CursorPos.Y);
- end;
- Application.ProcessMessages; //需加這行,不然有些全域變數會沒變到
- MDown:= False;
- end;
-end;
-
-procedure TCB_IMGPSScanX.ViewModeBtnMouseEnter(Sender: TObject);
-begin
- AddToolTip(TBitBtn(Sender).Parent.Handle,nil,0,Pchar(TBitBtn(Sender).Hint),nil,0,0);
-end;
-
-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);
- FFileSizeLimit:=0;
- 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;
-
-function TCB_IMGPSScanX.Get_WH_CATEGORY: WideString;
-begin
-
-end;
-
-procedure TCB_IMGPSScanX.Set_WH_CATEGORY(const Value: WideString);
-begin
- FWH_category:=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('4B2CF65E8C2A86CE8A0DD0F6A7DB03BC0B0126168B48AE4C27EBD78CAE75CF0F' +
- 'A612190861E0D99F6FAE3ED97AC1941B5E97843CFFCF705A3787989072D4EB2C' +
- 'AE6CAB3F5B69B86616ACC8A37AD6A2AB21C7BDD5C9AE1EDF9E4193D353805C9A' +
- '403631CE8A3D0803FEBB1BE4C209CE7A63B1298EF080EB34B8628CED567D2B68' +
- 'E777FAC58E2E32B7411FC217A04336231D1E861A93474759DAA6EDF53F6EB632' +
- 'A3055229A52F3053FB844754741409022DDE3DFB19473510F2BE63328E74BE20' +
- 'A6A29AA24878F91ADA9DF8CE1F320AF4DAF58EBF95D9BE761D70EEA274E19475' +
- '1C15948B184264C5C49E60493F3BCD2FFAE2CA8B021D00B96F45550C5F050D8A');
-
-
- SetLicenseKey('A6A94A8D91B08A9D58F300C0573EA9EF1B9DB0BF69B90E13B958DB4CB6B44F5A' +
- '4EE9CB22C9A68C2D07ED52ED4D13C755D890E4074996755361E6CDE2A6F1B563' +
- '5DDC8999AC4D71FB092EA9F1F87BFA25694FBF0D6D250087D2B39629713FCCB0' +
- 'D0A83135BC14FC63A4E8331CFF9E24C45C2D9CFD837EB70BAFDB79A75B7B97D5' +
- 'E9EB271685118C29D90A7C85E7793908989E295DA50021C795A448366026E975' +
- 'F49EA75B721B80427B99E5CF24A225FB498C07946ED7B806B483654C00D85C66' +
- 'E34215CA3EDEF1D4C3F5896090E97E1E2C9752BA2D5B49EE58CF19A0D374077F' +
- '6D13B90B6FED22D9EBC3AD6CDC76E595E08725BF2E12B8EF30A524A2E00504DF');
-end.
+{$I reassemble/CB_IMGPSScanImp.misc.pas}
+{$I reassemble/view/toolBar.pas}
+{$I reassemble/CB_IMGPSScanImp.lfcycle.pas}
+{$I reassemble/view/misc.pas}
+{$I reassemble/view/scrollView.pas}
+{$I reassemble/view/popupMenu.pas}
+{$I reassemble/view/listView.pas}
+{$I reassemble/view/msger.pas}
+{$I reassemble/scan/twain.pas}
+{$I reassemble/CB_IMGPSScanImp.omr.pas}
+{$I reassemble/CB_IMGPSScanImp.api.pas}
+{$I reassemble/CB_IMGPSScanImp.listMgr.pas}
+{$I reassemble/CB_IMGPSScanImp.fileOp.pas}
+{$I reassemble/CB_IMGPSScanImp.docq.pas}
+{$I reassemble/img/transformer.pas}
+{$I reassemble/CB_IMGPSScanImp.caseMgr.pas}
+{$I reassemble/bloc/entityMapping.pas}
+{$I reassemble/transp/payloadArchiver.pas}
+{$I reassemble/view/treeView.pas}
+{$I reassemble/CB_IMGPSScanImp.custdoc.pas}
+{$I reassemble/CB_IMGPSScanImp.docmod.pas}
+{$I reassemble/CB_IMGPSScanImp.convert.pas}
+{$I reassemble/CB_IMGPSScanImp.inbound.pas}
+{$I reassemble/CB_IMGPSScanImp.prUpload.pas}
+{$I reassemble/transp/fileClient.pas}
+{$I reassemble/bloc/caseManager.pas}
+{$I reassemble/CB_IMGPSScanImp.preview.pas}
\ No newline at end of file
--
Gitblit v1.8.0