{ ==============================================================================
方法名稱：Initialize
引用相依：TDibGraphic
方法描述：初始化元件狀態。註冊各類視窗與滑鼠事件處理函式（如 OnActivate, OnClick
, OnCreate 等），並設定多項預設參數，包含 MpsKey、瀏覽窗邊界、檔案副檔名、
案件與表單編號長度、去直線容忍值及切圖條碼類型。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Get_Active
引用相依：
方法描述：獲取元件的 Active 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_Active: WordBool;
begin
Result := Active;
end;
{ ==============================================================================
方法名稱：Get_AlignDisabled
引用相依：
方法描述：獲取元件的 AlignDisabled 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_AlignDisabled: WordBool;
begin
Result := AlignDisabled;
end;
{ ==============================================================================
方法名稱：Get_AlignWithMargins
引用相依：
方法描述：獲取元件的 AlignWithMargins 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_AlignWithMargins: WordBool;
begin
Result := AlignWithMargins;
end;
{ ==============================================================================
方法名稱：Get_AutoScroll
引用相依：
方法描述：獲取元件的 AutoScroll 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_AutoScroll: WordBool;
begin
Result := AutoScroll;
end;
{ ==============================================================================
方法名稱：Get_AutoSize
引用相依：
方法描述：獲取元件的 AutoSize 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_AutoSize: WordBool;
begin
Result := AutoSize;
end;
{ ==============================================================================
方法名稱：Get_AxBorderStyle
引用相依：
方法描述：獲取元件的 AxBorderStyle 邊框樣式。
============================================================================== }
function TCB_IMGPSScanX.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
Result := Ord(AxBorderStyle);
end;
{ ==============================================================================
方法名稱：Get_Caption
引用相依：
方法描述：獲取元件的標題文字。
============================================================================== }
function TCB_IMGPSScanX.Get_Caption: WideString;
begin
Result := WideString(Caption);
end;
{ ==============================================================================
方法名稱：Get_Color
引用相依：
方法描述：獲取元件的背景顏色。
============================================================================== }
function TCB_IMGPSScanX.Get_Color: OLE_COLOR;
begin
Result := OLE_COLOR(Color);
end;
{ ==============================================================================
方法名稱：Get_DockSite
引用相依：
方法描述：獲取元件的 DockSite 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_DockSite: WordBool;
begin
Result := DockSite;
end;
{ ==============================================================================
方法名稱：Get_DoubleBuffered
引用相依：
方法描述：獲獲取元件的 DoubleBuffered 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_DoubleBuffered: WordBool;
begin
Result := DoubleBuffered;
end;
{ ==============================================================================
方法名稱：Get_DropTarget
引用相依：
方法描述：獲取元件的 DropTarget 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_DropTarget: WordBool;
begin
Result := DropTarget;
end;
{ ==============================================================================
方法名稱：Get_Enabled
引用相依：
方法描述：獲取元件的啟用狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_Enabled: WordBool;
begin
Result := Enabled;
end;
{ ==============================================================================
方法名稱：Get_ExplicitHeight
引用相依：
方法描述：獲取元件的明確高度。
============================================================================== }
function TCB_IMGPSScanX.Get_ExplicitHeight: Integer;
begin
Result := ExplicitHeight;
end;
{ ==============================================================================
方法名稱：Get_ExplicitLeft
引用相依：
方法描述：獲取元件的明確左座標。
============================================================================== }
function TCB_IMGPSScanX.Get_ExplicitLeft: Integer;
begin
Result := ExplicitLeft;
end;
{ ==============================================================================
方法名稱：Get_ExplicitTop
引用相依：
方法描述：獲取元件的明確頂座標。
============================================================================== }
function TCB_IMGPSScanX.Get_ExplicitTop: Integer;
begin
Result := ExplicitTop;
end;
{ ==============================================================================
方法名稱：Get_ExplicitWidth
引用相依：
方法描述：獲取元件的明確寬度。
============================================================================== }
function TCB_IMGPSScanX.Get_ExplicitWidth: Integer;
begin
Result := ExplicitWidth;
end;
{ ==============================================================================
方法名稱：Get_Font
引用相依：
方法描述：獲取元件的字型。
============================================================================== }
function TCB_IMGPSScanX.Get_Font: IFontDisp;
begin
GetOleFont(Font, Result);
end;
{ ==============================================================================
方法名稱：Get_HelpFile
引用相依：
方法描述：獲取元件的說明檔路徑。
============================================================================== }
function TCB_IMGPSScanX.Get_HelpFile: WideString;
begin
Result := WideString(HelpFile);
end;
{ ==============================================================================
方法名稱：Get_KeyPreview
引用相依：
方法描述：獲取元件的鍵盤預覽狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_KeyPreview: WordBool;
begin
Result := KeyPreview;
end;
{ ==============================================================================
方法名稱：Get_MouseInClient
引用相依：
方法描述：獲取滑鼠是否在元件內部區域。
============================================================================== }
function TCB_IMGPSScanX.Get_MouseInClient: WordBool;
begin
Result := MouseInClient;
end;
{ ==============================================================================
方法名稱：Get_ParentCustomHint
引用相依：
方法描述：獲取元件的 ParentCustomHint 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_ParentCustomHint: WordBool;
begin
Result := ParentCustomHint;
end;
{ ==============================================================================
方法名稱：Get_ParentDoubleBuffered
引用相依：
方法描述：獲取元件的 ParentDoubleBuffered 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_ParentDoubleBuffered: WordBool;
begin
Result := ParentDoubleBuffered;
end;
{ ==============================================================================
方法名稱：Get_PixelsPerInch
引用相依：
方法描述：獲取元件的 PixelsPerInch 設定。
============================================================================== }
function TCB_IMGPSScanX.Get_PixelsPerInch: Integer;
begin
Result := PixelsPerInch;
end;
{ ==============================================================================
方法名稱：Get_PopupMode
引用相依：
方法描述：獲取元件的彈出視窗模式。
============================================================================== }
function TCB_IMGPSScanX.Get_PopupMode: TxPopupMode;
begin
Result := Ord(PopupMode);
end;
{ ==============================================================================
方法名稱：Get_PrintScale
引用相依：
方法描述：獲取元件的列印縮放比例。
============================================================================== }
function TCB_IMGPSScanX.Get_PrintScale: TxPrintScale;
begin
Result := Ord(PrintScale);
end;
{ ==============================================================================
方法名稱：Get_Scaled
引用相依：
方法描述：獲取元件的 Scaled 縮放狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_Scaled: WordBool;
begin
Result := Scaled;
end;
{ ==============================================================================
方法名稱：Get_ScreenSnap
引用相依：
方法描述：獲取元件的 ScreenSnap 狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_ScreenSnap: WordBool;
begin
Result := ScreenSnap;
end;
{ ==============================================================================
方法名稱：Get_SnapBuffer
引用相依：
方法描述：獲取元件的 SnapBuffer 設定。
============================================================================== }
function TCB_IMGPSScanX.Get_SnapBuffer: Integer;
begin
Result := SnapBuffer;
end;
{ ==============================================================================
方法名稱：Get_UseDockManager
引用相依：
方法描述：獲取元件是否使用 Dock 管理。
============================================================================== }
function TCB_IMGPSScanX.Get_UseDockManager: WordBool;
begin
Result := UseDockManager;
end;
{ ==============================================================================
方法名稱：Get_Visible
引用相依：
方法描述：獲取元件的顯示狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_Visible: WordBool;
begin
Result := Visible;
end;
{ ==============================================================================
方法名稱：Get_VisibleDockClientCount
引用相依：
方法描述：獲取元件的可見 Dock 客戶端數量。
============================================================================== }
function TCB_IMGPSScanX.Get_VisibleDockClientCount: Integer;
begin
Result := VisibleDockClientCount;
end;
{ ==============================================================================
方法名稱：_Set_Font
引用相依：
方法描述：設定元件的字型。
============================================================================== }
procedure TCB_IMGPSScanX._Set_Font(var Value: IFontDisp);
begin
SetOleFont(Font, Value);
end;
{ ==============================================================================
方法名稱：mode1Click
引用相依：
方法描述：切換至檢視模式 0（單頁顯示），呼叫 GoViewMode 更新佈局，並隱藏 Panel14
控制面版。
============================================================================== }
procedure TCB_IMGPSScanX.mode1Click(Sender: TObject);
begin
VMode := 0;
GoViewMode;
//ScrollBar1Change(Self);
Panel14.Visible := False;
end;
{ ==============================================================================
方法名稱：mode2Click
引用相依：
方法描述：切換至檢視模式 1（兩頁顯示），呼叫 GoViewMode 更新佈局，並顯示 Panel14
控制面版。
============================================================================== }
procedure TCB_IMGPSScanX.mode2Click(Sender: TObject);
begin
VMode := 1;
GoViewMode;
//ScrollBar1Change(Self);
Panel14.Visible := True;
end;
{ ==============================================================================
方法名稱：mode3Click
引用相依：
方法描述：切換至檢視模式 2（多頁網格顯示），呼叫 GoViewMode 更新佈局，並觸發捲軸變
動以重新載入影像。
============================================================================== }
procedure TCB_IMGPSScanX.mode3Click(Sender: TObject);
begin
VMode := 2;
GoViewMode;
ScrollBar1Change(Self);
end;
{ ==============================================================================
方法名稱：mode4Click
引用相依：
方法描述：切換至檢視模式 3（自定義檢視模式），呼叫 GoViewMode 更新佈局，並觸發捲軸
變動以重新載入影像。
============================================================================== }
procedure TCB_IMGPSScanX.mode4Click(Sender: TObject);
begin
VMode := 3;
GoViewMode;
ScrollBar1Change(Self);
end;
{ ==============================================================================
方法名稱：Set_AlignWithMargins
引用相依：
方法描述：設定元件的 AlignWithMargins 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_AlignWithMargins(Value: WordBool);
begin
AlignWithMargins := Value;
end;
{ ==============================================================================
方法名稱：Set_AutoScroll
引用相依：
方法描述：設定元件的 AutoScroll 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_AutoScroll(Value: WordBool);
begin
AutoScroll := Value;
end;
{ ==============================================================================
方法名稱：Set_AutoSize
引用相依：
方法描述：設定元件的 AutoSize 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_AutoSize(Value: WordBool);
begin
AutoSize := Value;
end;
{ ==============================================================================
方法名稱：Set_AxBorderStyle
引用相依：
方法描述：設定元件的 AxBorderStyle 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
begin
AxBorderStyle := TActiveFormBorderStyle(Value);
end;
{ ==============================================================================
方法名稱：Set_Caption
引用相依：
方法描述：設定元件的標題文字。
============================================================================== }
procedure TCB_IMGPSScanX.Set_Caption(const Value: WideString);
begin
Caption := TCaption(Value);
end;
{ ==============================================================================
方法名稱：Set_Color
引用相依：
方法描述：設定元件的背景顏色。
============================================================================== }
procedure TCB_IMGPSScanX.Set_Color(Value: OLE_COLOR);
begin
Color := TColor(Value);
end;
{ ==============================================================================
方法名稱：Set_DockSite
引用相依：
方法描述：設定元件的 DockSite 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_DockSite(Value: WordBool);
begin
DockSite := Value;
end;
{ ==============================================================================
方法名稱：Set_DoubleBuffered
引用相依：
方法描述：設定元件的 DoubleBuffered 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_DoubleBuffered(Value: WordBool);
begin
DoubleBuffered := Value;
end;
{ ==============================================================================
方法名稱：Set_DropTarget
引用相依：
方法描述：設定元件的 DropTarget 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_DropTarget(Value: WordBool);
begin
DropTarget := Value;
end;
{ ==============================================================================
方法名稱：Set_Enabled
引用相依：
方法描述：設定元件的啟用狀態。
============================================================================== }
procedure TCB_IMGPSScanX.Set_Enabled(Value: WordBool);
begin
Enabled := Value;
end;
{ ==============================================================================
方法名稱：Set_Font
引用相依：
方法描述：設定元件的字型。
============================================================================== }
procedure TCB_IMGPSScanX.Set_Font(const Value: IFontDisp);
begin
SetOleFont(Font, Value);
end;
{ ==============================================================================
方法名稱：Set_HelpFile
引用相依：
方法描述：設定元件的說明檔路徑。
============================================================================== }
procedure TCB_IMGPSScanX.Set_HelpFile(const Value: WideString);
begin
HelpFile := string(Value);
end;
{ ==============================================================================
方法名稱：Set_KeyPreview
引用相依：
方法描述：設定元件的鍵盤預覽狀態。
============================================================================== }
procedure TCB_IMGPSScanX.Set_KeyPreview(Value: WordBool);
begin
KeyPreview := Value;
end;
{ ==============================================================================
方法名稱：Set_ParentCustomHint
引用相依：
方法描述：設定元件的 ParentCustomHint 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_ParentCustomHint(Value: WordBool);
begin
ParentCustomHint := Value;
end;
{ ==============================================================================
方法名稱：Set_ParentDoubleBuffered
引用相依：
方法描述：設定元件的 ParentDoubleBuffered 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_ParentDoubleBuffered(Value: WordBool);
begin
ParentDoubleBuffered := Value;
end;
{ ==============================================================================
方法名稱：Set_PixelsPerInch
引用相依：
方法描述：設定元件的 PixelsPerInch 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_PixelsPerInch(Value: Integer);
begin
PixelsPerInch := Value;
end;
{ ==============================================================================
方法名稱：Set_PopupMode
引用相依：
方法描述：設定元件的彈出視窗模式。
============================================================================== }
procedure TCB_IMGPSScanX.Set_PopupMode(Value: TxPopupMode);
begin
PopupMode := TPopupMode(Value);
end;
{ ==============================================================================
方法名稱：Set_PrintScale
引用相依：
方法描述：設定元件的列印縮放比例。
============================================================================== }
procedure TCB_IMGPSScanX.Set_PrintScale(Value: TxPrintScale);
begin
PrintScale := TPrintScale(Value);
end;
{ ==============================================================================
方法名稱：Set_Scaled
引用相依：
方法描述：設定元件的 Scaled 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_Scaled(Value: WordBool);
begin
Scaled := Value;
end;
{ ==============================================================================
方法名稱：Set_ScreenSnap
引用相依：
方法描述：設定元件的 ScreenSnap 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_ScreenSnap(Value: WordBool);
begin
ScreenSnap := Value;
end;
{ ==============================================================================
方法名稱：Set_SnapBuffer
引用相依：
方法描述：設定元件的 SnapBuffer 屬性。
============================================================================== }
procedure TCB_IMGPSScanX.Set_SnapBuffer(Value: Integer);
begin
SnapBuffer := Value;
end;
{ ==============================================================================
方法名稱：Set_UseDockManager
引用相依：
方法描述：設定元件是否使用 Dock 管理。
============================================================================== }
procedure TCB_IMGPSScanX.Set_UseDockManager(Value: WordBool);
begin
UseDockManager := Value;
end;
{ ==============================================================================
方法名稱：Set_Visible
引用相依：
方法描述：設定元件的顯示狀態。
============================================================================== }
procedure TCB_IMGPSScanX.Set_Visible(Value: WordBool);
begin
Visible := Value;
end;
{ ==============================================================================
方法名稱：N1Click
引用相依：
方法描述：彈出對話框要求使用者輸入目標頁碼，呼叫 MoveImage 將當前顯示的影像移動
到指定的位置。
============================================================================== }
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;
{ ==============================================================================
方法名稱：N51Click
引用相依：
方法描述：切換至檢視模式 4，呼叫 GoViewMode 更新佈局，並觸發捲軸變動以重新載入影
像。
============================================================================== }
procedure TCB_IMGPSScanX.N51Click(Sender: TObject);
begin
VMode := 4;
GoViewMode;
ScrollBar1Change(Self);
end;
{ ==============================================================================
方法名稱：Panel11DblClick
引用相依：
方法描述：Panel11 的連按兩下事件，目前實作已註解掉。
============================================================================== }
procedure TCB_IMGPSScanX.Panel11DblClick(Sender: TObject);
begin
// Button3.Visible := not Button3.Visible;
//Button4.Visible := not Button4.Visible;
//self.FCustDocYN := 'N';
end;
{ ==============================================================================
方法名稱：Panel1DblClick
引用相依：
方法描述：Panel1 的連按兩下事件，用於切換 Button1 與 Button2 的顯示狀態。
============================================================================== }
procedure TCB_IMGPSScanX.Panel1DblClick(Sender: TObject);
begin
Button1.Visible := not Button1.Visible;
Button2.Visible := not Button2.Visible;
end;
{ ==============================================================================
方法名稱：Panel9Resize
引用相依：
方法描述：當 Panel9 大小改變時，呼叫 GoViewMode 重新調整影像佈局。
============================================================================== }
procedure TCB_IMGPSScanX.Panel9Resize(Sender: TObject);
begin
GoViewMode;
end;
{ ==============================================================================
方法名稱：DocNoIsExistImg
引用相依：FileExists, LoadFromFile
方法描述：檢查指定的文件目錄路徑下是否存在影像檔案。首先讀取目錄中的 Context.da
t 檔案，接著遍歷清單中的所有檔名並檢查實際檔案是否存在。若發現任何一個
影像檔案存在則回傳 False（表示非空），否則回傳 True。
============================================================================== }
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;
{ ==============================================================================
方法名稱：_DelTreeForExistImg
引用相依：_DelTree
方法描述：存根方法，目前未包含具體實作邏輯。
============================================================================== }
procedure TCB_IMGPSScanX._DelTreeForExistImg(ASourceDir:String);
var
i:integer;
ST:TStringList;
begin
end;
{ ==============================================================================
方法名稱：ScrollBar1Change
引用相依：
方法描述：捲軸變動處理，目前實作已透過 Exit 暫時停用。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ActiveFormKeyUp
引用相依：
方法描述：處理 ActiveForm 按鍵放開事件。當文字輸入框取得焦點且有選取影像時，攔截
上下方向鍵並將其轉化為 PriorPage 或 NextPage 翻頁操作，並同步滾動捲軸
。
============================================================================== }
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;
{ ==============================================================================
方法名稱：AddAttFileLBClick
引用相依：CopyFile, FileExists
方法描述：處理「加入附加電子檔」按鈕點擊。開啟檔案對話框選取多個 PDF 檔案，支援覆
蓋檢查。執行 CopyFile 將檔案複製到案件目錄下，並呼叫 SetAttContextList
更新附加檔案清單後載入顯示。
============================================================================== }
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;
{ ==============================================================================
方法名稱：AddCredit1RGClick
引用相依：
方法描述：處理信用註記點擊，更新 Case_loandoc 狀態並寫入索引檔。
============================================================================== }
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;
{ ==============================================================================
方法名稱：BtnMouseEnter
引用相依：
方法描述：當滑鼠進入按鈕區域時，顯示該按鈕的 Hint 文字提示。
============================================================================== }
procedure TCB_IMGPSScanX.BtnMouseEnter(Sender: TObject);
begin
AddToolTip(TBitBtn(Sender).Handle,nil,0,Pchar(TBitBtn(Sender).Hint),nil,0,0);
end;
{ ==============================================================================
方法名稱：Button3Click
引用相依：initkscan
方法描述：工程師測試用按鈕。用於顯示當前系統環境變數與參數狀態，包含伺服器 URL、
案件資訊、權限、DPI 設定及各類長度限制，最後重新載入影像檔案。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Button4Click
引用相依：
方法描述：工程師測試用按鈕。用於傾印內部多個 TStringList 與 Record 資料，包含 OM
R 錯誤資訊、表單與檢核規則清單、範本與已存在影像清單等，用於除錯。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Button5Click
引用相依：IIS_Ftp, SetFtpInfo
方法描述：測試 FTP 上傳功能。連線 FTP 後嘗試將特定的 PDF 檔案上傳至伺服器路徑。
============================================================================== }
procedure TCB_IMGPSScanX.Button5Click(Sender: TObject);
begin
GetftpInfo(NowCaseno,'upload');
SetFtpInfo;
IIS_Ftp.FtpsConnect;
IIS_Ftp.FtpsToMain(FFtpExtraPath,NowCaseno+'.pdf','d:\1.pdf',display1);
end;
{ ==============================================================================
方法名稱：Button6Click
引用相依：FJpgCompression, IIS_Ftp, Rotate, Scanner, SetFtpInfo
方法描述：測試 FTP 下載功能。連線 FTP 後嘗試從伺服器下載 ZIP 案件檔至本地。
============================================================================== }
procedure TCB_IMGPSScanX.Button6Click(Sender: TObject);
begin
GetftpInfo(NowCaseno,'download');
SetFtpInfo;
IIS_Ftp.FtpsConnect;
IIS_Ftp.FtpsCWD(IIS_Ftp.FtpPath);
IIS_Ftp.FtpsReceive(NowCaseNo+'.zip','d:\'+NowCaseNo+'.zip');
end;
{ ==============================================================================
方法名稱：ExportBtClick
引用相依：En_DecryptionStr_Base64, FileExists, SaveToFile, dnFile, dnFile_Get
方法描述：處理「匯出授權檔」按鈕點擊。透過 HTTPS 下載掃瞄與檢視用的 .lic 授權檔案
。將授權檔連同加密的 mps.dat 檔案打包成帶有密碼保護的 mps.zip 壓縮包，
完成後清理暫存檔並提示路徑。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ImportBtClick
引用相依：En_DecryptionStr_Base64, FileExists, LoadFromFile, RenameFile, Str2D
ir, _DelTree, upFile
方法描述：處理「匯入授權檔」按鈕點擊。選取 mps.zip 授權包後進行解壓與過期驗證。驗
證通過後對授權檔執行重新命名，並透過 upFile 函式逐一上傳至伺服器範本
目錄，過程中會嚴格檢查 Session 與回傳狀態。
============================================================================== }
procedure TCB_IMGPSScanX.ImportBtClick(Sender: TObject);
var
SendData : String;
EnCodeDateTime : String;
S : TStringlist;
SFileName,VFileName : String;
OpenDialog1 : TOpenDialog;
ZipPath : String;
ZipFile,ZipName : String;
LicName : String;
i : Integer;
begin
OpenDialog1 := TOpenDialog.Create(self);
S := TStringlist.Create;
try
OpenDialog1.Filter := 'Zip files (*.zip)|*.ZIP';
if OpenDialog1.Execute then
begin
ZipFile:= ExtractFileName(OpenDialog1.FileName);
ZipName := Copy(ZipFile,1,length(ZipFile)-length(ExtractFileExt(OpenDialog1.FileName)));
ZipPath := LngPath+ZipName+'\';
str2dir(ZipPath);
if not ExecuteUnZip_Pwd(OpenDialog1.FileName,ZipPath,False,'9338430') then
Showmessage(_Msg('無法解壓縮'));
if not FileExists(ZipPath+'mps.dat') then
begin
Showmessage(_Msg('格式不符,無法匯入'));
Exit;
end;
S.LoadFromFile(ZipPath+'mps.dat');
if (En_DecryptionStr_Base64('D',S.Strings[0],'9338430')<> ServerDate) then
begin
Showmessage(_Msg('檔案過期,無法匯入'));
Exit;
end;
for i := 1 to S.Count -1 do
begin
LicName := En_DecryptionStr_Base64('D',S.Strings[i],'9338430');
RenameFile(ZipPath+S.Strings[i],ZipPath+LicName);
if (LicName = 'MPSLIC_SCAN.lic') or (LicName = 'MPSLIC_VIEW.lic') then
/////上傳MPSLICXXXX.lic ////
//if not upFile(HTTPSClient,FUrl,'servlet/CWC04','formid='+LicName+'@workno=CW@mode=sample','file',ZipPath+LicName,FReWrite,Memo1,False) then
//begin
SendData := 'data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&work_no=PLN&file_name='+LicName;
if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/sample',SendData,'file',ZipPath+LicName,FReWrite,Memo1,False) then
begin
Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_MSg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+')');
DataLoading(False,False);
Exit;
end;
if memo1.Lines.Strings[0] = '1' then
begin
Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_Msg('錯誤原因:')+memo1.Lines.Strings[1]);
DataLoading(False,False);
Exit;
end
Else if Pos('',Memo1.Lines.Text) > 0 then
begin
Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'));
DataLoading(False,False);
Exit;
end;
/////上傳MPSLICXXXX.lic /////
end;
end;
Finally
OpenDialog1.Free;
S.Free;
_DelTree(ZipPath);
end;
Showmessage(_Msg('匯入完成'));
end;
{ ==============================================================================
方法名稱：HTTPSClientCertificateValidate
引用相依：HTTPSClientCertificateValidate
方法描述：HTTPS 用戶端憑證驗證回呼函數，預設直接將 Validate 設為 True，以接受所
有伺服器憑證。
============================================================================== }
procedure TCB_IMGPSScanX.HTTPSClientCertificateValidate(Sender: TObject;
X509Certificate: TElX509Certificate; var Validate: Boolean);
begin
Validate := True;
end;
{ ==============================================================================
方法名稱：HTTPSClientRedirection
引用相依：
方法描述：處理 HTTPS 客戶端的重導向事件，目前為空實作。
============================================================================== }
procedure TCB_IMGPSScanX.HTTPSClientRedirection(Sender: TObject;
const OldURL: string; var NewURL: string; var AllowRedirection: Boolean);
begin
AllowRedirection := True;
end;
{ ==============================================================================
方法名稱：EnableImage
引用相依：
方法描述：啟用滑鼠工具列功能，更新按鈕圖示並切換滑鼠模式。
============================================================================== }
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;
{ ==============================================================================
方法名稱：DesableImage
引用相依：
方法描述：停用所有工具列功能。重置點選狀態，將所有功能按鈕（FC0-FC6）圖示切換為灰
階，並將所有影像捲軸盒的滑鼠模式切換回一般使用者模式。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ViewMouseMode
引用相依：
方法描述：設定全域的滑鼠作業模式。根據參數對應至放大鏡、縮放、拖曳、旋轉或刪除等模
式，並同步更新所有影像捲軸盒（ISB1-ISB8）的屬性，確保行為一致。
============================================================================== }
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;
{ ==============================================================================
方法名稱：GoViewMode
引用相依：
方法描述：依檢視模式索引 VMode，呼叫 DisplayMode 來調整佈局。
============================================================================== }
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;
{ ==============================================================================
方法名稱：DisplayMode
引用相依：
方法描述：調整影像視窗的網格佈局（1x1, 2x2 等）。隱藏所有影像面板後，根據行數與列
數計算面板寬高與位置，重新排列並顯示。同時調整標記框 Shape1 的大小，最
後更新模式圖示並初始化首個視窗。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CheckRequiredColumnValues
引用相依：
方法描述：檢查特定業務邏輯下的必填欄位。針對特定的 workno 與案號格式（caseno[9]）
判斷是否符合要求。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CaseReSize
引用相依：FileExists, ImageReSize_FormID, ImageResize, LoadFromFile
方法描述：對案件執行影像縮放處理。清空舊有的檢核與定位錯誤記錄，隨後遍歷影像清單
，對每個檔案執行 ImageReSize_FormID 處理。
============================================================================== }
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;
{ ==============================================================================
方法名稱：TransCaseID
引用相依：CopyFile, FileExists, FindFirst, FtpCaseComplete, IIS_Ftp, LoadFromF
ile, SetFtpInfo, _DelTree, upFile
方法描述：傳送案件核心程序。包含排序影像、產生描述檔（FormID/DocNo對照、OMR資訊、附
件狀態等）、建立 ZIP 壓縮包（含主圖與遮罩）並檢查大小。最後根據 HTTP 或 F
TP 模式上傳至伺服器。上傳完成後針對異動模式處理舊件引入，並在最後清理
本地暫存目錄。
============================================================================== }
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,ST3:TStringList;
str1,str2:String;
must_formidStr :string;
last_add_formidstr :string;
ScanListStr: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
Doc_Data := CreateDocNo_Info(CaseID); //產生保管袋文件 Docno,份數,頁數;Docno,份數,頁數 的回傳字串
Doc_Data1 := CreateCustDocNo_Info(CaseID); //產生自定文件 Docname,份數,頁數;Docno,份數,頁數 的回傳字串
In_Doc1 := CreateDocnoFrom_Info(CaseID); //產生被引進的保管袋文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號
In_Doc2 := CreateCustDocNoFrom_Info(CaseID); //產生被引進的自定文件資訊 Docno[tab]份數[tab]案件編號#13#10Docno[tab]份數[tab]案件編號
AttachYN := CreateAttach_Info(CaseID); //是否還有附件 Y:有 N:沒有
ReadCaseIndex(Path);
//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;
ST3:=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) ;
ST3.LoadFromFile(path+'scanlist.dat');
for I := 0 to ST3.Count - 1 do
begin
if ScanListStr = '' then
ScanListStr := FileName2FormCode(ST3.Strings[i])
else
ScanListStr := Format('%s,%s',[ScanListStr,FileName2FormCode(ST3.Strings[i])]);
end;
ST1.Free;
ST2.Free;
ST3.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);
if not GetftpInfo(CaseID,'upload') then //取案件上傳方式
begin
//Showmessage(_Msg()Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+'.');
DownFileErrStr := _Msg('取案件上傳資訊失敗!!')+HttpErrStr;
Result := False;
Exit;
end;
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
+'&form_code='+ScanListStr //scanlist.dat 表單代號
+'&ftp_image_path='+FFtpExtraPath //加傳FTP目錄 HTTP上傳時會是空白
+'&in_doc1='+HTTPEncode(UTF8Encode(In_Doc1))
+'&in_doc2='+HTTPEncode(UTF8Encode(In_Doc2));
case TransMode of
tsHttp :
begin
////上傳/////
ShowText := CaseID+_Msg('資料上傳中(Http),請稍候');
DataLoading(True,True);
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('',Memo1.Lines.Text) > 0 then
begin
Showmessage(Format(_Msg('')+_Msg('')+_Msg('閒置過久或被登出,請重新登入'),[CaseID]));
Result := False;
Exit;
end;
////上傳////
end;
tsFtp :
begin
ShowText := CaseID+_Msg('資料上傳中(Ftp),請稍候');
DataLoading(True,True);
SetFtpInfo;
try
if not IIS_Ftp.FtpsConnect then
begin
Showmessage(Format('無法連上Ftp主機,錯誤原因:%s',[FtpErrReason]));
Result := False;
Exit;
end;
if not IIS_Ftp.FtpsToMain(FFtpExtraPath,CaseID+'.zip',Path+'Img.zip',display1) then
begin
Showmessage(Format(_msg('上傳案件(%s)時,發生錯誤,錯誤原因:%s'),[CaseID,FtpErrStr]));
Result := False;
Exit;
end;
if not FtpCaseComplete(SendData) then //Ftp上傳後通知完成
begin
Showmessage(Format(_Msg('通知案件(%s)Ftp上傳完成時,發生錯誤!!'),[CaseID])+HttpErrStr);
Result := False;
Exit;
end;
finally
IIS_Ftp.FtpsClose;
end;
end;
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;
{ ==============================================================================
方法名稱：NewTreeNodeRefresh
引用相依：
方法描述：更新樹狀結構根節點文字，顯示總案件筆數與總頁數。
============================================================================== }
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;
{ ==============================================================================
方法名稱：MyTreeNode1Refresh
引用相依：
方法描述：更新樹狀結構案件層級節點文字，顯示該層下的項目數量。
============================================================================== }
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;
{ ==============================================================================
方法名稱：MyTreeNode2ReFresh
引用相依：
方法描述：重新整理並繪製指定案件的文件層級樹狀結構。
============================================================================== }
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;
{ ==============================================================================
方法名稱：MyTreeNode3ReFresh
引用相依：
方法描述：重新整理並繪製指定案件的表單層級樹狀結構。
============================================================================== }
Procedure TCB_IMGPSScanX.MyTreeNode3ReFresh(CaseID:String);
begin
//DrawDocItem1(MytreeNode1,Doc_Inf_List,CaseID); //201408280改
DrawDocItem2(MytreeNode1,CaseID);
//DrawDocItem(MytreeNode1,FORM_INF_List,CaseID);
end;
{ ==============================================================================
方法名稱：Node3FormID
引用相依：
方法描述：從樹狀結構節點 3（表單層）的文字中解析並提取表單 ID（FormID）。
============================================================================== }
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;
{ ==============================================================================
方法名稱：GetNode2Name
引用相依：CopyFile, DeleteDocNoFile, DirectoryExists, En_DecryptionStr_Base64,
FileExists, LoadFromFile, SaveToFile, Str2Dir, dnFile
方法描述：提取文件層級節點的識別名稱字串，用於記錄與恢復節點選取狀態。
============================================================================== }
Function TCB_IMGPSScanX.GetNode2Name(Node2:TTreeNode):String; //取MyTreeNode2的識別字出來(記之前點選用)
var
v : Integer;
begin
v := Posend('-',Node2.Text);
Result := Copy(Node2.Text,1,v-1);
end;
{Function TCB_IMGPSScanX.Down_Replace_Img(SPath,DPath,CaseID:String):Boolean;
var
EnCodeDateTime : String;
DownUrl : String;
SC,Main_C : TStringlist;
i,n : Integer;
FormID,DocNo,Version : String;
OldFName,NewMainFName,NewSubFName : String;
AttPath : String;
begin
SC := TStringlist.Create;
Main_C := TStringlist.Create;
try
Result := True;
HaveAppDoc := False;
EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey);
DownUrl := FUrl+CaseID+'&checktime='+EnCodeDateTime;
if not dnFile(HTTPSClient,DownUrl,'','',DPath+CaseID+'.zip',FReWrite,Memo1,False,DownImgStatus) then
begin
HttpErrStr := _Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason;
Result := False;
Exit;
end;
if Memo1.Lines.Strings[0] = '1' then
begin
HttpErrStr :=_Msg('錯誤原因:')+memo1.Lines.Strings[1];
Result := False;
Exit;
end
Else if Pos('',Memo1.Lines.Text) > 0 then
begin
HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入');
Result := False;
Exit;
end;
AttPath := DPath + 'AttFile\';
if FileExists(DPath+CaseID+'.zip') then
begin
ExecuteUnZip(DPath+CaseID+'.zip',DPath,True);
if FileExists(DPath+'img.zip') then
begin
ExecuteUnZip(DPath+'img.zip',DPath,False);
end;
if FileExists(DPath+'att.zip') then
begin
Str2Dir(AttPath);
ExecuteUnZip(DPath+'att.zip',AttPath,False);
end;
end
Else
begin
if ((FMode = 'FSCAN') or (FMode = 'ISCAN')) and (Memo1.Lines.Strings[0] ='NO_FILE') then //FGIS前台匯入件沒有影像是對的
begin
SC.Clear;
SC.SaveToFile(DPath+'Context.dat');
end
Else
begin
HttpErrStr := _Msg('找不到影像');
Result := False;
Exit;
end;
end;
if FileExists(SPath+'Context.dat') then
SC.LoadFromFile(SPath+'Context.dat');
for I := 0 to SC.Count - 1 do
begin
FormID := FileName2FormCode(SC.Strings[i]);
DocNo := FormCode2DocNo(FormID);
Version := FormCode2Version(FormID);
If FindSQLData(Doc_Inf_List,'ADD_SCAN_RULE','DOC_NO,DOC_VERSION',DocNo+','+Version,0,FindResult) Then
begin
if GetFindResult('ADD_SCAN_RULE') = 'R' then //替換的先刪再加 20101026 User由刪FormCode改刪DocNo
begin
//DeleteFormCodeFile(DPath,FormID);
ContextList.LoadFromFile(DPath+'Context.dat');
DeleteDocNoFile(DPath,DocNo);
end;
end;
end;
for I := 0 to SC.Count - 1 do //複製補充進來的影像
begin
OldFName := SC.Strings[i];
Main_C.LoadFromFile(DPath+'Context.dat');
//NewMainFName:= Add_Zoo(Main_C.Count+1,3)+Copy(OldFName,4,length(OldFName)-3);
NewMainFName:= Add_Zoo(Main_C.Count+1,3)+FileName2NoQuene_Filename(OldFName);
FormID := FileName2FormCode(OldFName);
DocNo := FormCode2DocNo(FormID);
Version := FormCode2Version(FormID);
If FindSQLData(Doc_Inf_List,'ADD_SCAN_RULE','DOC_NO,DOC_VERSION',DocNo+','+Version,0,FindResult) Then
begin
CopyFile(PWideChar(SPath+OldFName),PWideChar(DPath+NewMainFName),False);
end;
if FormID = '' then //附件
begin
CopyFile(PWideChar(SPath+OldFName),PWideChar(DPath+NewMainFName),False);
end;
Main_C.Add(NewMainFName);
Main_C.SaveToFile(DPath+'Context.dat');
end;
finally
SC.Free;
Main_C.Free;
end;
///加入的電子檔匯入案件裡
if DirectoryExists(SPath+'AttFile\') then
AttFile_Arrange(SPath+'AttFile\',DPath+'AttFile\');
end;}
{ ==============================================================================
方法名稱：DownLoadImage
引用相依：IIS_Ftp, SetFtpInfo
方法描述：處理影像下載流程。根據案件上傳/下載方式（HTTP 或 FTP），從伺服器下載對應
的 ZIP 檔案並解壓縮至本地案件目錄，供後續異動或補件使用。
============================================================================== }
Function TCB_IMGPSScanX.DownLoadImage(Path,CaseID:String):Boolean;
begin
Result := True;
if not GetftpInfo(CaseID,'download') then //取案件下載方式
begin
DownFileErrStr := _Msg('取案件下載資訊失敗,')+HttpErrStr;
Result := False;
Exit;
end;
case TransMode of
tsHttp:
begin
ShowText := _Msg('案件下載中(Http),請稍候');
DataLoading(True,True);
If not Down_Img(ImageSavePath+FCaseID+'\Download\',FCaseID) then
begin
Showmessage(FCaseID+_msg('載入異動影像時,網路發生錯誤')+HttpErrStr);
DataLoading(False,False);
Exit;
end;
end;
tsFtp:
begin
ShowText := _Msg('案件下載中(Ftp),請稍候');
DataLoading(True,True);
SetFtpInfo;
if not IIS_Ftp.FtpsConnect then
begin
DownFileErrStr := Format(_Msg('無法連上Ftp主機,錯誤原因:%s')+#13+'%s',[FtpErrReason,FTPSClient1.LastReceivedReply]);
Result := False;
Exit;
end;
if not IIS_Ftp.FtpsDownloadFile(FFtpExtraPath,CaseID+'.zip',Path+CaseID+'.zip',display1) then
begin
DownFileErrStr := Format(_Msg('錯誤原因:%s'),[FtpErrStr]);
Result := False;
Exit;
end;
ExecuteUnZip(Path+CaseID+'.zip',Path,False);
DeleteFile(Path+CaseID+'.zip');
end;
end;
end;
{ ==============================================================================
方法名稱：Down_Img
引用相依：En_DecryptionStr_Base64, FileExists, Str2Dir, dnFile, dnFile_Get
方法描述：透過 HTTPS 從伺服器下載案件影像。下載 ZIP 檔案（含 img.zip 與 att.zip）
後執行本地解壓縮，將主影像與附件部署至指定目錄。
============================================================================== }
Function TCB_IMGPSScanX.Down_Img(Path,CaseID:String):Boolean;
var
EnCodeDateTime : String;
SendData : String;
AttPath : String;
begin
Result := True;
EnCodeDateTime := En_DecryptionStr_Base64('E',ServerDate+GetBalance2Time(Balance),Mpskey);
///service/slic/SLIC04/case?data=&verify=&case_no=&file=
SendData := 'data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&case_no='+CaseID+'&file=';
//ShowMessage(SendData);
if not dnFile_Get(HTTPSClient,Furl,'service/imgpsc/IMGPSC04/case',SendData,Path+CaseID+'.zip',FReWrite,Memo1,False,DownImgStatus) then
begin
HttpErrStr := _Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason;
Result := False;
Exit;
end;
if Memo1.Lines.Strings[0] = '1' then
begin
HttpErrStr :=_Msg('錯誤原因:')+memo1.Lines.Strings[1]+'。';
Result := False;
Exit;
end
Else if Pos('',Memo1.Lines.Text) > 0 then
begin
HttpErrStr := _Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入');
Result := False;
Exit;
end;
//ShowMessage('替換zip');
AttPath := Path + 'AttFile\';
if FileExists(Path+CaseID+'.zip') then
begin
ExecuteUnZip(Path+CaseID+'.zip',Path,True);
if FileExists(Path+'img.zip') then
begin
ExecuteUnZip(Path+'img.zip',Path,False);
end;
if FileExists(Path+'att.zip') then
begin
Str2Dir(AttPath);
ExecuteUnZip(Path+'att.zip',AttPath,False);
end;
end
Else
begin
HttpErrStr := _Msg('找不到影像');
Result := True;
Exit;
end;
end;
{ ==============================================================================
方法名稱：GetNoNameCase
引用相依：DirectoryExists, GetNoNameCase
方法描述：在指定的本地路徑中尋找尚未被佔用的「未配號XXXX」目錄名稱。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CaseResort
引用相依：FileExists, LoadFromFile, ReSortFileName, RenameFile, SaveToFile
方法描述：對案件檔案進行實體重新排序。依據文件清單（Doc_Inf_List）的順序，對主文件
與次文件進行更名與重新編號，確保檔名序號符合業務邏輯。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CaseResort2Scanlist
引用相依：FileExists, LoadFromFile, ReSortFileName, RenameFile, SaveToFile
方法描述：產生依表單代號排序的影像清單（scanlist.dat），用於上傳。
============================================================================== }
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;
{ ==============================================================================
方法名稱：DistinctDocinCase
引用相依：LoadFileGetMD5, LoadFromFile
方法描述：列出案件目錄下所有具備文件編號與版本的唯一組合。
============================================================================== }
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;
{ ==============================================================================
方法名稱：DistinctDocNoinCase
引用相依：LoadFromFile
方法描述：列出案件目錄下所有實際存在的文件編號（DocNo）。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ClearErrini
引用相依：FileExists
方法描述：清除指定案件的所有檢核輔助檔案（如 Checkerr.ini, OMRCheckOk 等），並將
樹狀節點恢復為預設的影像索引狀態。
============================================================================== }
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;
{ ==============================================================================
方法名稱：SetCaseList
引用相依：FileExists, LoadFromFile, SaveToFile
方法描述：維護本地案件清單資料。支援對 CaseList.dat 執行加入、插入、刪除或修改案
號操作，確保本地磁碟目錄與資料清單狀態同步。
============================================================================== }
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;
{ ==============================================================================
方法名稱：SetDocNoList
引用相依：FileExists, LoadFromFile, SaveToFile
方法描述：維護案件的文件目錄清單（CaseDocNo.dat）與份數清單（CaseDocNo_Copies.dat
）。根據 Mode 參數執行「加入 (A)」、「插入 (I)」、「修改 (E)」或「刪除 (D)」操作
。刪除時支援透過索引或目錄名稱進行，並會同步更新異動記錄（SetRecordEdit
edDocDir）。最後將更新後的清單存回檔案。
============================================================================== }
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;
{ ==============================================================================
方法名稱：SetContextList
引用相依：FileExists, LoadFromFile, SaveToFile
方法描述：維護特定文件目錄下的影像檔案清單（Context.dat）。支援「加入」、「插入」、「修
改」與「刪除」模式。操作前會先從磁碟載入既有的清單，執行變動後再存回，並記
錄該文件目錄已被異動。
============================================================================== }
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;
{ ==============================================================================
方法名稱：SetAttContextList
引用相依：FileExists, LoadFromFile, SaveToFile
方法描述：維護案件的附件檔案清單（AttContext.dat）。邏輯與 SetContextList 相似，針
對附件目錄進行檔案名稱的「加入」、「插入」、「修改」與「刪除」管理，並將結果持
久化至磁碟。
============================================================================== }
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;
{ ==============================================================================
方法名稱：checkCaseOMRDone
引用相依：
方法描述：檢查當前案件是否已完成 OMR 檢核。遍歷 NewTreeNode 中的所有項目，判斷其
ImageIndex 是否皆為 7（代表已檢核通過的圖示索引），若有任何一項未達成
則回傳 False。
============================================================================== }
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;
{ ==============================================================================
方法名稱：checkFormCodeIsCustom
引用相依：
方法描述：檢查指定的表單代碼（FormCode）是否為自定義文件。透過讀取 CustomDocNo.in
i 設定檔中的 FormID 資訊，比對傳入的代碼是否與設定值一致。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CheckCaseID_OK
引用相依：
方法描述：檢查樹狀結構中是否存在「未配號」的案件。遍歷所有節點，若節點文字包含「未
配號」字樣則回傳 False。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CheckCaseAttach_OK
引用相依：
方法描述：檢查樹狀結構中是否存在「未歸類」的文件。遞迴遍歷案件下的所有子節點，若有
任何節點文字包含「未歸類」則回傳 False。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CreateEmptyCase
引用相依：SaveToFile
方法描述：產生一個空白的案件結構，主要用於重掃件。建立必要的目錄，並產生初始的 Co
ntext.dat 與更新 CaseList.dat。
============================================================================== }
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;
{ ==============================================================================
方法名稱：InitScrollRec
引用相依：
方法描述：初始化影像捲軸記錄，將 1 到 8 號影像視窗的水平與垂直捲軸位置重設為 0。
============================================================================== }
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;
{ ==============================================================================
方法名稱：FormIDReplace
引用相依：CopyFile, DirectoryExists, FileExists, LoadFromFile, RenameFile, Sav
eToFile
方法描述：將指定文件中的舊表單代碼替換為新代碼。首先決定目標目錄（考慮是否分份數
、補件狀況），若目標目錄不存在則建立。接著將符合舊代碼的檔案複製到新目錄
下並重新命名（產生新序號），同時更新新目錄的 Context.dat 與清單。最後刪
除原目錄中的舊代碼檔案。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ShowFileReplace
引用相依：RenameFile
方法描述：將當前顯示清單（NowShowFileList）中的檔案更名為新的表單代碼。遍歷檔案，
保留原序號但替換 FormID 部分，執行實體更名並同步更新全域的 ContextLis
t 記錄。
============================================================================== }
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;
{ ==============================================================================
方法名稱：PageReplaceFormID
引用相依：LoadFromFile, RenameFile, SaveToFile
方法描述：針對影像列表（PageLV）中選取的頁面進行表單代碼更換。先過濾出符合條件的
檔案，再對選取項執行實體檔案更名（更新 FormID 部分），最後同步更新 Conte
xt.dat 檔案內容。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ModeNeedCheck
引用相依：
方法描述：判斷目前的掃瞄模式是否需要執行 OMR 檢核。
============================================================================== }
Function TCB_IMGPSScanX.ModeNeedCheck(OMRMode,ScanMode:String):Boolean; //掃瞄模式是否要做檢核
begin
Result := False;
if Pos(ScanMode,OMRMode) > 0 then
Result := True;
end;
{ ==============================================================================
方法名稱：GetCasePage
引用相依：FileExists, LoadFromFile
方法描述：計算案件的總影像頁數。遍歷案件下所有的文件目錄（CaseDocNo.dat），讀取每
個目錄的 Context.dat 並累加檔案數量。過程中會考慮入庫/非入庫文件的權
限與顯示過濾條件，最後也包含附件目錄的計數。
============================================================================== }
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;
{ ==============================================================================
方法名稱：GetFormIDPage
引用相依：
方法描述：在指定的檔案清單中，計算符合特定表單代碼（FormID）的影像頁數。
============================================================================== }
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;
{ ==============================================================================
方法名稱：SetFile2Case
引用相依：LoadFromFile, SaveToFile
方法描述：將指定的檔案名稱加入到案件的主 Context.dat 清單中。
============================================================================== }
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;
{ ==============================================================================
方法名稱：WriteResize
引用相依：FileExists, GetTag, LoadFromFile, SaveToFile
方法描述：產生影像縮放記錄檔（Resize.dat）。載入影像後比對原始標記（Tag）中的長寬資
訊與實際 Graphic 的長寬，若有變動則將差異記錄至文字檔中。
============================================================================== }
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;
{ ==============================================================================
方法名稱：GetCase_PageCount
引用相依：FileExists, LoadFromFile
方法描述：獲取所有案件的總數量與總頁數。讀取 CaseList.dat 取得案件清單，逐一計算
各案件目錄與附件目錄下的影像檔案數。針對非入庫且當次掃瞄的特殊情況，會
額外檢查 EditedDocDir.dat 以精確計算實際變動的頁數。
============================================================================== }
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;
{ ==============================================================================
方法名稱：FindNoSaveBarCode
引用相依：
方法描述：檢查目前的條碼資訊中是否包含被標記為「不儲存影像」的條碼。遍歷所有辨識
到的條碼，並與排除清單（NoSaveBarCodeList）進行比對，若匹配則回傳 True。
============================================================================== }
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;
{ ==============================================================================
方法名稱：WriteCaseIndex
引用相依：SaveToFile
方法描述：將案件的信用註記狀態（Case_loandoc）寫入到指定路徑下的 CaseIndex.dat
檔案中。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ReadCaseIndex
引用相依：FileExists, LoadFromFile
方法描述：從磁碟讀取案件索引檔（CaseIndex.dat）。載入信用註記狀態，並據此更新畫面
上 AddCredit1RG 選項組的選取狀態（Y 設為第一項，N 設為第二項）。若檔案不
存在但有預設值，則自動建立檔案。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ReduceLogFile
引用相依：FileExists, LoadFromFile, SaveToFile
方法描述：防止日誌檔案過大。檢查 IMGPSCheck.log，若行數超過 100,000 行，則自動刪
除最前面的 10,000 行記錄並重新存檔。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ClearCaseIndex
引用相依：
方法描述：重設案件索引相關的 UI 狀態，將信用註記選項設為不可用且取消選取。
============================================================================== }
Procedure TCB_IMGPSScanX.ClearCaseIndex;
begin
AddCredit1RG.Enabled := False;
AddCredit1RG.ItemIndex := -1;
end;
{ ==============================================================================
方法名稱：GetSelectImageFile
引用相依：
方法描述：取得當前所有被選取的影像檔案路徑。遍歷畫面上的 TShape 元件（選取框），透
過名稱關聯找到對應的影像捲軸盒（ISB），並將其載入的檔名加入到 NowSelect
FileList 清單中。
============================================================================== }
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;
{ ==============================================================================
方法名稱：GetDocNoDir
引用相依：DirectoryExists
方法描述：根據文件編號產生下一個可用的目錄名稱（用於區分份數）。若文件編號不為空，
會遞增序號並檢查磁碟目錄是否存在，直到找到未使用的名稱（格式如 DocNo_1
）；若編號為空則回傳附件目錄名稱。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CheckFormIDExists
引用相依：
方法描述：檢查特定的表單代碼（FormID）是否已經存在於樹狀結構中指定文件的子節點中
。
============================================================================== }
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;
{ ==============================================================================
方法名稱：DocNo2DocNoDir
引用相依：DirectoryExists
方法描述：類似 GetDocNoDir，但產生的目錄名稱格式為 DocNo(1)。透過循環檢查目錄是
否存在，自動產生下一個可用的份數目錄名稱。
============================================================================== }
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;
{ ==============================================================================
方法名稱：DocNoDir2DocNo
引用相依：
方法描述：將包含份數括號的目錄名稱（如 A001(2)）還原為原始的文件編號（如 A001）。排
除附件目錄後，尋找左括號的位置並擷取前面的字串。
============================================================================== }
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;
{ ==============================================================================
方法名稱：DocNoDir2Index
引用相依：LoadFromFile
方法描述：將文件目錄名稱轉換為其在 CaseDocNo.dat 清單中的索引位置。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ParserPoint
引用相依：
方法描述：解析代表影像十字點座標的字串。將包含四個端點（左上、左下、右上、右下）座標
及長寬資訊的字串拆解，並轉換為 TPoint 結構存入全域變數中，若字串格式不
符則全部重設為 (0,0)。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CheckScanDenialTime
引用相依：
方法描述：檢查目前時間是否已超過系統設定的「禁止掃瞄時間」。
============================================================================== }
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;
{ ==============================================================================
方法名稱：FormID2Anchor
引用相依：
方法描述：根據表單代碼（FormID）從 FORM_INF_List 中查詢對應的定位模式（ANCHOR 模
式），並回傳轉換後的模式字串（NONE/ANCHOR/FRAME）。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Index2Anchor
引用相依：
方法描述：將數值型的定位模式索引（0, 1, 2）轉換為易讀的模式名稱字串。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ScanDuplexCBClick
引用相依：
方法描述：處理雙面掃瞄勾選框點擊事件，同步更新全域的 ScanDuplex 變數。
============================================================================== }
procedure TCB_IMGPSScanX.ScanDuplexCBClick(Sender: TObject);
begin
ScanDuplex := ScanDuplexCB.Checked;
//R_W_ScanIni('W'); //user要求改成預設後不能改
end;
{ ==============================================================================
方法名稱：ScanGrayCBClick
引用相依：ifBlackWhite, ifGray256, ifTrueColor
方法描述：根據掃瞄勾選框狀態，設定掃瞄色彩模式（灰階、全彩或黑白）。
============================================================================== }
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;
{ ==============================================================================
方法名稱：GetFormatID
引用相依：FileExists, LoadFromFile
方法描述：從案件索引檔（CaseIndex.dat）中獲取案件的 FormatID（主鍵值）。目前實作為
存根，包含讀取邏輯但未回傳特定欄位。
============================================================================== }
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;
{ ==============================================================================
方法名稱：MemoInfoTransfer
引用相依：
方法描述：註記代碼與類別名稱的轉換函數。支援「代碼轉名稱」或「名稱轉代碼」兩種模式，
若無匹配代碼則預設為「自行輸入」。
============================================================================== }
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;
{ ==============================================================================
方法名稱：SetSQLData
引用相依：
方法描述：將 SQL 查詢結果格式化後塞入目標字串清單。此方法會先清除目標清單 (ToLi
st)，第一行加入欄位定義字串 (ColumeStr)，隨後將來源清單 (FromList) 中
扣除標題後的資料列依序填入，用於更新系統本地的資料快取。
============================================================================== }
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;
{ ==============================================================================
方法名稱：GetSQLData
引用相依：
方法描述：從結構化字串清單中提取特定欄位的值。邏輯如下：
1. 解析 TableList 的第一行（欄位定義）以確定目標欄位 (Colname) 的索引
位置。
2. 讀取指定行 (colNo) 的資料字串，該字串使用 '!@!' 作為欄位分隔符。
3. 透過循環將資料拆分並存入臨時清單，最後返回對應欄位索引位置的數值內
容。若找不到欄位或索引超出範圍，則返回空字串。
============================================================================== }
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;
{ ==============================================================================
方法名稱：FindSQLData
引用相依：
方法描述：在資料快取清單中搜尋符合鍵值的紀錄。核心邏輯：
1. 支援多個鍵值比對 (KeyColumeStr 與 KeyStr 可包含多個欄位)。
2. 若 ColNo 為 0，則從頭搜尋清單；若非 0 則僅檢查該指定行。
3. 搜尋時會調用 GetSQLData 提取欄位值並與目標鍵值比對。
4. 一旦匹配成功，會將 ColumeStr 中指定的所有欄位名稱及其對應數值（格式
為「欄位名,數值」）填入 ResultList 中並返回 True。若搜尋無結果則返回 Fal
se。
============================================================================== }
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;
{ ==============================================================================
方法名稱：GetFindResult
引用相依：
方法描述：從資料查詢結果（FindResult）中，根據指定的欄位名稱（Col）提取對應的值。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ClearView
引用相依：
方法描述：清空指定的影像顯示區域。將索引從 stkv 到 8 的 TImageScrollBox 檔名重
設為空，並清空對應的標籤文字，最後釋放預覽資源並將焦點設回 ISB1。
============================================================================== }
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;
{ ==============================================================================
方法名稱：initParameter
引用相依：ifBlackWhite, ifGray256, ifTrueColor
方法描述：初始化掃瞄相關參數。設定檔案大小限制（預設 5MB）、DPI（預設 300）以及掃瞄
顏色模式（黑白、灰階、全彩），並同步更新 UI 狀態（如 ScanGrayCB）。
============================================================================== }
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;
{ ==============================================================================
方法名稱：PrtLbClick
引用相依：LoadFromFile
方法描述：處理「列印」按鈕點擊。首先產生上傳用的暫存影像結構，接著開啟 TPrintForm
供使用者勾選欲列印的文件。確認後呼叫 PrintImg 進行實體列印，並記錄操作
日誌。
============================================================================== }
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;
{ ==============================================================================
方法名稱：UseOldCaseLbClick
引用相依：CopyFile, DirectoryExists, FileExists, LoadFromFile, SaveToFile
方法描述：處理「使用舊件」功能。開啟 TOldCaseInfoForm 讓使用者選擇舊有案件的文件。
選定後，將舊件影像複製到新案件目錄下，自動產生新序號檔名，建立關聯記錄（
UseCase.dat），並同步更新新案件的文件清單與樹狀統計。
============================================================================== }
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;
{ ==============================================================================
方法名稱：LastInitFormidListCreate
引用相依：LoadFromFile
方法描述：從 FormCode_Name.dat 檔案中提取表單代碼（底線前的部分），並將其加入到 L
astInitFormidList 清單中。
============================================================================== }
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;
{ ==============================================================================
方法名稱：LoadFileGetMD5
引用相依：LoadFileGetMD5, TIdHashMessageDigest5
方法描述：計算指定檔案的 MD5 雜湊值。方法會以唯讀模式開啟檔案串流 (TFileStream)
，利用 TIdHashMessageDigest5 元件處理串流內容，並返回以十六進位字串表
示的 MD5 值。此功能主要用於確認影像檔案在傳輸或處理前後的完整性與一致
性，防止資料受損或被重複處理。
============================================================================== }
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;
{ ==============================================================================
方法名稱：LoadImgFile
引用相依：FileExists, LoadFromFile, SaveToFile
方法描述：載入當前所有的影像案件至樹狀結構。清空舊有節點後，讀取 CaseList.dat，為
每個案件建立父節點，並呼叫 DrawDocItem2 繪製子文件與表單。同時會根據 O
MR 檢核狀態設定對應的案件圖示。
============================================================================== }
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;
{ ==============================================================================
方法名稱：LoadImgFile1
引用相依：FileExists, LoadFromFile, SaveToFile
方法描述：載入影像檔案的另一種實作版本。包含更細緻的 Context_DocNo.dat 管理，若
檔案不存在會自動掃描 ContextList 並根據 FormCode 產生對應的文件編號
記錄。主要用於特定的資料結構載入。
============================================================================== }
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;
{ ==============================================================================
方法名稱：LoadAttFile
引用相依：FileExists, LoadFromFile
方法描述：載入指定案件的附件檔案。讀取 AttContext.dat，將附件檔名解碼後加入到 At
tListBox 列表中。
============================================================================== }
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;
{ ==============================================================================
方法名稱：logTimeString
引用相依：
方法描述：產生帶有當前日期時間與案件編號的日誌前綴字串。
============================================================================== }
function TCB_IMGPSScanX.logTimeString: String;
begin
Result:=FormatDateTime('yyyymmdd hh:mm:ss',now) +' caseNo='+NowCaseno+' ';
end;
{ ==============================================================================
方法名稱：FindDivFormCode
引用相依：
方法描述：檢查特定的表單代碼是否具有「分案」屬性。從 FORM_INF_List 中查詢該表單的
DIVISION 欄位，判斷是否包含目前的作業模式（如 NSCAN/ISCAN）。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CheckAvailable
引用相依：FileExists, dnFile, dnFile_Get, upFile
方法描述：檢查元件的使用授權。透過 HTTPS 下載掃瞄授權檔，並驗證 MacID、註冊數量與
使用期限。若尚未註冊且仍有額度，則自動進行註冊並上傳新的授權檔至伺服器
。最後在狀態列顯示註冊資訊。
============================================================================== }
Function TCB_IMGPSScanX.CheckAvailable:Boolean; //檢查是否可使用元件
var
SendData : String;
Msg:String;
Nowcount,Totalcount,Lic_Idx : Integer;
MacID,IPStr,LegalDate :String;
begin
Result := False;
/////下載MPSLIC_SCAN.lic //////
SendData:='data='+HTTPEncode(UTF8Encode(FData))+'&verify='+FVerify+'&work_no=PLN&file=MPSLIC_SCAN.lic';
if not dnFile_Get(HTTPSClient,Furl,'service/imgpsc/IMGPSC04/sample',SendData,LngPath+'MPSLIC_SCAN.lic',FReWrite,Memo1,False,DownImgStatus) then
begin
Showmessage(_Msg('檢查註冊檔案時,網路發生錯誤!!')+_Msg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason);
Exit;
end;
/////下載MPSLIC_SCAN.lic ///
if CheckLicensebyIP_new(LngPath+'MPSLIC_SCAN.lic',MacID,IPStr,LegalDate,Msg,Nowcount,Totalcount,Lic_Idx) then //檢查是否己註冊過
begin
if (LegalDate <> '') and (ServerDate>LegalDate) and (Lic_Idx>(Totalcount)) then
begin
Showmessage(_Msg('已經超過可使用期限及超出授權數請連絡廠商'));
Result := False;
//Exit;
end
else
Result := True;
end
Else
begin
if Msg <> '' then
begin
Showmessage(Format(_Msg('註冊檔有問題,請連絡廠商 錯誤原因:%s'),[Msg]));
Result := false;
Exit;
end
Else
begin
if (LegalDate <> '') and (ServerDate>LegalDate) and (NowCount =0 ) then
begin
Lic_Idx := 0;
Showmessage(_Msg('已經超過可使用期限請連絡廠商'));
Result := False;
//Exit;
end
//else if (LegalDate = '') and (Nowcount >= Totalcount+10) then //超過註冊數量
else if ((LegalDate = '') or ((LegalDate <> '') and (ServerDate>LegalDate)) ) and (Nowcount >= Totalcount) then //超過註冊數量 20150717 yuu說拿掉送的10個
begin
Lic_Idx := 0;
Showmessage(_Msg('已經超過授權數請連絡廠商'));
Result := False;
end
Else //未超過註冊數量要寫入註冊檔
begin
{if Messagedlg(_Msg('您尚未註冊授權是否要進行註冊??'),MtConfirmation,[mbyes,mbcancel],0) = mrcancel then
begin
Result := False;
Exit;
end;}
ShowText := _Msg('授權中,請稍候');
AddLicense(LngPath+'MPSLIC_SCAN.lic',MacID,IPStr,Msg);
Nowcount := Nowcount + 1;
DataLoading(True,True);
/////上傳MPSLICSCAN.lic ////
SendData:='data='+HTTPEncode(UTF8Encode(FData))+'@verify='+FVerify+'@work_no=PLN@file_name=MPSLIC_SCAN.lic';
if not upFile(HTTPSClient,FUrl,'service/imgpsc/IMGPSC02/sample',SendData,'file',LngPath+'MPSLIC_SCAN.lic',FReWrite,Memo1,False) then
begin
Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_MSg('錯誤代碼:')+Inttostr(HttpError.HttpErrorCode)+' '+HttpError.HttpReason+')');
DataLoading(False,False);
Exit;
end;
if memo1.Lines.Strings[0] = '1' then
begin
Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_Msg('錯誤原因:')+memo1.Lines.Strings[1]);
DataLoading(False,False);
Exit;
end
Else if Pos('',Memo1.Lines.Text) > 0 then
begin
Showmessage(_Msg('檢查註冊時,網路發生錯誤!!')+_Msg('錯誤原因:')+_Msg('閒置過久或被登出,請重新登入'));
DataLoading(False,False);
Exit;
end;
/////上傳MPSLICSCAN.lic /////
//Sleep(30000); //第一次註冊睡30秒 先不睡
Result := True;
end;
end;
end;
if FileExists(LngPath+'MPSLIC_SCAN.lic') then
DeleteFile(LngPath+'MPSLIC_SCAN.lic');
if LegalDate = '' then
StatusBar1.Panels[4].Text := Format(_Msg('註冊號:%s 剩餘註冊數:%s'),[MacID,inttostr(Totalcount-Nowcount)]);
if LegalDate <> '' then
StatusBar1.Panels[4].Text := '*'+Format(_Msg('註冊號:%s 剩餘註冊數:%s'),[MacID+'('+inttostr(Lic_Idx)+')',inttostr(Totalcount-Nowcount)]);
end;
{ ==============================================================================
方法名稱：SmoothCBClick
引用相依：Image_Smooth
方法描述：處理「影像平滑化」勾選框。若勾選，則對 ISB1 的影像執行平滑化處理並重新繪
製。
============================================================================== }
procedure TCB_IMGPSScanX.SmoothCBClick(Sender: TObject);
begin
if SmoothCB.Checked then
begin
Image_Smooth(ISB1.Graphic);
ISB1.Redraw(True);
end;
end;
{ ==============================================================================
方法名稱：Case2Mask
引用相依：DirectoryExists, FileExists, FindPoint, LoadFromFile, Str2Dir, _DelT
ree
方法描述：產生案件的遮罩影像（用於遮蔽敏感個資）。讀取 Context.dat，針對每張影像尋
找定位點，並依據對應表單的 XML 定義執行區域遮罩，最後存入指定目錄。
============================================================================== }
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;
{ ==============================================================================
方法名稱：DelAttFileLBClick
引用相依：
方法描述：處理「刪除附件電子檔」點擊。確認使用者選取的檔案後，從磁碟刪除實體檔案並
呼叫 SetAttContextList 移除清單記錄。完成後重新載入附件清單並提示。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CheckFormID_Prt
引用相依：
方法描述：查詢指定表單（FormID）是否被設定為預設列印。透過 FORM_INF_List 檢核 IS_
PRINT 欄位是否為 'Y'。
============================================================================== }
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;
{ ==============================================================================
方法名稱：PrintImg
引用相依：TDibGraphic
方法描述：執行影像列印的核心程序。開啟列印對話框供選擇印表機，隨後遍歷檔案清單，
逐一載入影像、套用浮水印後發送至印表機。支援多頁列印於同一個任務或分頁
處理。
============================================================================== }
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;
{ ==============================================================================
方法名稱：FindLastestDocDir
引用相依：FileExists, LoadFromFile
方法描述：針對指定的文件編號，從 CaseDocNo.dat 中反向尋找最新的份數目錄名稱（例
如 A001(2)）。
============================================================================== }
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;
{ ==============================================================================
方法名稱：FindLastestDocDirForPage
引用相依：FileExists, LoadFromFile
方法描述：類似 FindLastestDocDir，但額外呼叫 DocNoIsExistImg 確保該目錄下確實存
在影像檔案，若為空目錄則不視為有效結果。
============================================================================== }
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;
{ ==============================================================================
方法名稱：SortDocDir_FormID
引用相依：FileExists, LoadFromFile, RenameFile, SaveToFile
方法描述：對文件目錄內的影像檔案依表單代碼（FormID）進行重新排序。先提取所有檔案
的 FormID 並排序，依序產生新檔名進行更名，最後更新 Context.dat 檔案順
序。
============================================================================== }
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;
{ ==============================================================================
方法名稱：GotoAttach
引用相依：
方法描述：將樹狀結構的焦點跳轉至案件的附件節點。
============================================================================== }
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;
{ ==============================================================================
方法名稱：SetDocDirtoSelected
引用相依：
方法描述：在樹狀結構中自動選取符合指定目錄名稱的節點。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CheckSelectImg_UseCase
引用相依：
方法描述：檢查當前選取的影像所在的文件目錄是否已被其他程序引用（UseKey 標記為 '
T'）。
============================================================================== }
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;
{ ==============================================================================
方法名稱：ISExistImg
引用相依：LoadFileGetMD5
方法描述：透過 MD5 雜湊值比對，檢查指定的影像檔案是否已存在於 ExistImgList 清單
中。
============================================================================== }
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;
{ ==============================================================================
方法名稱：MoveImage
引用相依：LoadFromFile, ReSortFileName, RenameFile, SaveToFile
方法描述：執行影像頁面的位置移動。先對目錄下所有檔案進行臨時更名（加上 @ 標記），
根據選取狀態重新排列清單順序，最後更新 Context.dat 並重新排序實體檔案
。
============================================================================== }
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;
{ ==============================================================================
方法名稱：MoveImage_Drag
引用相依：LoadFromFile, ReSortFileName, RenameFile, SaveToFile
方法描述：處理影像拖拉移動。邏輯與 MoveImage 相似，但針對單一來源索引移動至目標
索引的情境進行排列。
============================================================================== }
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;
{ ==============================================================================
方法名稱：PriorPage
引用相依：
方法描述：跳轉至上一頁影像。根據當前頁碼尋找前一個影像捲軸盒組件（ISB），若存在則
觸發其點擊事件。
============================================================================== }
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;
{ ==============================================================================
方法名稱：NextPage
引用相依：
方法描述：跳轉至下一頁影像。根據當前頁碼尋找下一個影像捲軸盒組件（ISB），若存在則
觸發其點擊事件。
============================================================================== }
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;
{ ==============================================================================
方法名稱：view_image_FormCode
引用相依：LoadFromFile
方法描述：根據表單代碼（FormCode）顯示對應的影像。支援顯示全部影像（ShowAll）或指定
表單的影像。若是顯示全部，會重置視窗並建立縮圖；若指定特定表單，則遍歷 C
ontextList 尋找匹配的檔案，載入至影像捲軸盒（ISB），並設定縮放模式（zmFit
toPage 或指定百分比）與捲軸位置，最後更新頁碼標籤資訊。
============================================================================== }
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;
{ ==============================================================================
方法名稱：view_image_DocNo
引用相依：DirectoryExists, DpiResize, FileExists, LoadFromFile
方法描述：根據文件代號（DocNo）或表單代號（FormID）顯示影像。函式包含三種模式：顯示
案件內所有影像（ShowAll）、顯示指定文件夾（如 Attach）下的影像，以及顯示指
定文件代號下特定表單的影像。處理過程中會檢查在席狀態（In_WH）、執行影像
DPI 調整、建立縮圖預覽視窗，並逐一載入檔案至對應的 ISB 元件中，最後自動
點擊首張影像以進行預覽。
============================================================================== }
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;
{ ==============================================================================
方法名稱：CB1Click
引用相依：
方法描述：處理核取方塊點擊，設定是否要在掃描時顯示 TWAIN 使用者介面（TwainShowUI
）。
============================================================================== }
procedure TCB_IMGPSScanX.CB1Click(Sender: TObject);
begin
TwainShowUI := CB1.Checked;
end;
{ ==============================================================================
方法名稱：ViewModeBtnMouseEnter
引用相依：
方法描述：當滑鼠進入檢視模式按鈕時，顯示該按鈕的 Hint 文字作為工具提示（Tooltip）
。
============================================================================== }
procedure TCB_IMGPSScanX.ViewModeBtnMouseEnter(Sender: TObject);
begin
AddToolTip(TBitBtn(Sender).Parent.Handle,nil,0,Pchar(TBitBtn(Sender).Hint),nil,0,0);
end;
{ ==============================================================================
方法名稱：Set_caseid
引用相依：
方法描述：設定內部變數 FCaseID 的值。
============================================================================== }
procedure TCB_IMGPSScanX.Set_caseid(const Value: WideString);
begin
FCaseID := Value;
end;
{ ==============================================================================
方法名稱：Set_data
引用相依：
方法描述：設定內部變數 FData 的值。
============================================================================== }
procedure TCB_IMGPSScanX.Set_data(const Value: WideString);
begin
FData := Value;
end;
{ ==============================================================================
方法名稱：Set_mode
引用相依：
方法描述：設定作業模式（FMode），並將傳入的字串轉換為大寫。
============================================================================== }
procedure TCB_IMGPSScanX.Set_mode(const Value: WideString);
begin
FMode := UpperCase(Value);
end;
{ ==============================================================================
方法名稱：Set_rewrite
引用相依：
方法描述：設定是否強制覆蓋檔案的標記（FReWrite）。
============================================================================== }
procedure TCB_IMGPSScanX.Set_rewrite(const Value: WideString);
begin
FReWrite := Value;
end;
{ ==============================================================================
方法名稱：Set_url
引用相依：
方法描述：設定後端伺服器的基礎 URL 路徑。
============================================================================== }
procedure TCB_IMGPSScanX.Set_url(const Value: WideString);
begin
FUrl := Value;
end;
{ ==============================================================================
方法名稱：Set_userid
引用相依：
方法描述：設定當前登入的使用者代號。
============================================================================== }
procedure TCB_IMGPSScanX.Set_userid(const Value: WideString);
begin
FUserID := Value;
end;
{ ==============================================================================
方法名稱：Set_username
引用相依：
方法描述：設定當前登入的使用者名稱。
============================================================================== }
procedure TCB_IMGPSScanX.Set_username(const Value: WideString);
begin
FUserName := Value;
end;
{ ==============================================================================
方法名稱：Set_verify
引用相依：
方法描述：設定 API 呼叫所需的驗證字串。
============================================================================== }
procedure TCB_IMGPSScanX.Set_verify(const Value: WideString);
begin
FVerify := Value;
end;
{ ==============================================================================
方法名稱：Set_language
引用相依：FileExists
方法描述：設定語系代碼並執行初始化。會自動修正語系格式（如 zh-tw 轉 zh_tw），若語
言檔存在則觸發介面語系切換。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Set_modename
引用相依：
方法描述：設定作業模式的顯示名稱。
============================================================================== }
procedure TCB_IMGPSScanX.Set_modename(const Value: WideString);
begin
FModeName := Value;
end;
{ ==============================================================================
方法名稱：Set_userunit
引用相依：
方法描述：設定使用者所屬的單位代碼。
============================================================================== }
procedure TCB_IMGPSScanX.Set_userunit(const Value: WideString);
begin
FUserUnit := Value;
end;
{ ==============================================================================
方法名稱：Set_work_no
引用相依：
方法描述：設定當前的業務別（WORK_NO）。
============================================================================== }
procedure TCB_IMGPSScanX.Set_work_no(const Value: WideString);
begin
FWork_no := Value;
end;
{ ==============================================================================
方法名稱：Set_loandoc_enable
引用相依：
方法描述：設定信用註記功能是否啟用。根據參數（Y/I）動態切換 AddCredit1RG 元件的可
用性與可見度。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Set_loandoc_value
引用相依：
方法描述：設定信用註記的具體數值。
============================================================================== }
procedure TCB_IMGPSScanX.Set_loandoc_value(const Value: WideString);
begin
FLoanDoc_Value := Value;
end;
{ ==============================================================================
方法名稱：Set_useproxy
引用相依：
方法描述：設定系統是否使用 Proxy 代理伺服器進行網路連線。
============================================================================== }
procedure TCB_IMGPSScanX.Set_useproxy(const Value: WideString);
begin
FUseProxy := UpperCase(Value);
if FUseProxy = 'Y' then
UseProxy := True; //要不要用Proxy
end;
{ ==============================================================================
方法名稱：Set_c_docnamelist
引用相依：
方法描述：設定預設的文件名稱清單。
============================================================================== }
procedure TCB_IMGPSScanX.Set_c_docnamelist(const Value: WideString);
begin
FC_DocNameList := Value;
end;
{ ==============================================================================
方法名稱：Set_c_docnolist
引用相依：
方法描述：設定預設的文件代號清單。
============================================================================== }
procedure TCB_IMGPSScanX.Set_c_docnolist(const Value: WideString);
begin
FC_DocNoList := Value;
end;
{ ==============================================================================
方法名稱：Set_fixfilelist
引用相依：
方法描述：設定固定的檔案清單字串。
============================================================================== }
procedure TCB_IMGPSScanX.Set_fixfilelist(const Value: WideString);
begin
FFixFileList := Value;
end;
{ ==============================================================================
方法名稱：Set_is_in_wh
引用相依：
方法描述：設定是否為在席（In-Warehouse）作業模式。
============================================================================== }
procedure TCB_IMGPSScanX.Set_is_in_wh(const Value: WideString);
begin
FIs_In_Wh := UpperCase(Value);
end;
{ ==============================================================================
方法名稱：Set_oldcaseinfo
引用相依：
方法描述：設定舊案件的相關資訊字串。
============================================================================== }
procedure TCB_IMGPSScanX.Set_oldcaseinfo(const Value: WideString);
begin
FOldCaseInfo := Value;
end;
{ ==============================================================================
方法名稱：Get_c_docnamelist
引用相依：
方法描述：獲取預設文件名稱清單的存根函式，目前未實作回傳內容。
============================================================================== }
function TCB_IMGPSScanX.Get_c_docnamelist: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_c_docnolist
引用相依：
方法描述：獲取預設文件代號清單的存根函式，目前未實作回傳內容。
============================================================================== }
function TCB_IMGPSScanX.Get_c_docnolist: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_caseid
引用相依：
方法描述：獲取內部案件編號（FCaseID）。
============================================================================== }
function TCB_IMGPSScanX.Get_caseid: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_data
引用相依：
方法描述：獲取內部資料字串（FData）。
============================================================================== }
function TCB_IMGPSScanX.Get_data: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_fixfilelist
引用相依：
方法描述：獲取固定的檔案清單字串（FFixFileList）。
============================================================================== }
function TCB_IMGPSScanX.Get_fixfilelist: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_is_in_wh
引用相依：
方法描述：獲取是否為在席作業模式的標記（FIs_In_WH）。
============================================================================== }
function TCB_IMGPSScanX.Get_is_in_wh: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_language
引用相依：
方法描述：獲取當前設定的語系代碼（FLanguage）。
============================================================================== }
function TCB_IMGPSScanX.Get_language: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_loandoc_enable
引用相依：
方法描述：獲取信用註記功能是否啟用的狀態。
============================================================================== }
function TCB_IMGPSScanX.Get_loandoc_enable: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_loandoc_value
引用相依：
方法描述：獲取當前設定的信用註記數值。
============================================================================== }
function TCB_IMGPSScanX.Get_loandoc_value: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_mode
引用相依：
方法描述：獲取當前作業模式（FMode）。
============================================================================== }
function TCB_IMGPSScanX.Get_mode: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_modename
引用相依：
方法描述：獲取作業模式的顯示名稱（FModeName）。
============================================================================== }
function TCB_IMGPSScanX.Get_modename: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_oldcaseinfo
引用相依：
方法描述：獲取舊案件的相關資訊字串（FOldCaseInfo）。
============================================================================== }
function TCB_IMGPSScanX.Get_oldcaseinfo: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_rewrite
引用相依：
方法描述：獲取是否強制覆蓋檔案的標記（FReWrite）。
============================================================================== }
function TCB_IMGPSScanX.Get_rewrite: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_url
引用相依：
方法描述：獲取後端伺服器的基礎 URL（FUrl）。
============================================================================== }
function TCB_IMGPSScanX.Get_url: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_useproxy
引用相依：
方法描述：獲取是否使用 Proxy 代理伺服器的設定。
============================================================================== }
function TCB_IMGPSScanX.Get_useproxy: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_userid
引用相依：
方法描述：獲取當前登入的使用者代號（FUserID）。
============================================================================== }
function TCB_IMGPSScanX.Get_userid: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_username
引用相依：
方法描述：獲取當前登入的使用者名稱（FUserName）。
============================================================================== }
function TCB_IMGPSScanX.Get_username: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_userunit
引用相依：
方法描述：獲取使用者所屬的單位代碼（FUserUnit）。
============================================================================== }
function TCB_IMGPSScanX.Get_userunit: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_verify
引用相依：
方法描述：獲取 API 驗證字串（FVerify）。
============================================================================== }
function TCB_IMGPSScanX.Get_verify: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_work_no
引用相依：
方法描述：獲取當前的業務別代碼（FWork_No）。
============================================================================== }
function TCB_IMGPSScanX.Get_work_no: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_printyn
引用相依：
方法描述：獲取是否預設列印的標記（FPrintyn）。
============================================================================== }
function TCB_IMGPSScanX.Get_printyn: WideString;
begin
end;
{ ==============================================================================
方法名稱：Set_printyn
引用相依：
方法描述：設定是否預設列印的標記，並將傳入值轉換為大寫。
============================================================================== }
procedure TCB_IMGPSScanX.Set_printyn(const Value: WideString);
begin
FPrintyn := UpperCase(Value);
end;
{ ==============================================================================
方法名稱：Get_is_oldcase
引用相依：
方法描述：獲取是否為舊件處理模式的標記（FIs_OldCase）。
============================================================================== }
function TCB_IMGPSScanX.Get_is_oldcase: WideString;
begin
end;
{ ==============================================================================
方法名稱：Set_is_oldcase
引用相依：
方法描述：設定是否為舊件處理模式，並將傳入值轉換為大寫。
============================================================================== }
procedure TCB_IMGPSScanX.Set_is_oldcase(const Value: WideString);
begin
FIs_OldCase := UpperCase(Value);
end;
{ ==============================================================================
方法名稱：Get_custdocyn
引用相依：
方法描述：獲取是否支援自定義文件的標記（FCustDocYN）。
============================================================================== }
function TCB_IMGPSScanX.Get_custdocyn: WideString;
begin
end;
{ ==============================================================================
方法名稱：Set_custdocyn
引用相依：
方法描述：設定是否支援自定義文件，並將傳入值轉換為大寫。
============================================================================== }
procedure TCB_IMGPSScanX.Set_custdocyn(const Value: WideString);
begin
FCustDocYN := UpperCase(Value);
end;
{ ==============================================================================
方法名稱：Get_casenolength
引用相依：
方法描述：獲取案件編號的長度限制。
============================================================================== }
function TCB_IMGPSScanX.Get_casenolength: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_filesizelimit
引用相依：
方法描述：獲取單一影像檔案的大小限制（KB）。
============================================================================== }
function TCB_IMGPSScanX.Get_filesizelimit: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_imgdpi
引用相依：
方法描述：獲取掃描影像的 DPI 設定值。
============================================================================== }
function TCB_IMGPSScanX.Get_imgdpi: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_scancolor
引用相依：
方法描述：獲取掃描顏色模式的索引值。
============================================================================== }
function TCB_IMGPSScanX.Get_scancolor: WideString;
begin
end;
{ ==============================================================================
方法名稱：Set_casenolength
引用相依：
方法描述：設定案件編號的長度限制。若傳入值為空字串則設為 0；否則將字串轉換為整數
後賦值給 FCaseNoLength 與全域變數 CaseIDLength。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Set_filesizelimit
引用相依：
方法描述：設定影像檔案的大小限制（KB）。若傳入值為空，則預設為 5120 KB (5MB)；否則
將字串轉換為整數後賦值給 FFileSizeLimit。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Set_imgdpi
引用相依：
方法描述：設定掃描 DPI。若傳入值為空，則預設為 300 DPI；否則將字串轉整數後賦值給
FImgDPI，並同步更新全域變數 ScanDpi 與 Def_ScanDpi。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Set_scancolor
引用相依：ifBlackWhite, ifGray256, ifTrueColor
方法描述：設定掃描色彩模式。將傳入的數值字串轉為整數。0 代表黑白（ifBlackWhite），1
代表灰階（ifGray256），2 代表全彩（ifTrueColor）。此函式會同步更新 FScanC
olor 與全域變數 ScanColor，確保掃描器使用正確的色彩模式。
============================================================================== }
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;
{ ==============================================================================
方法名稱：Get_imgdelete
引用相依：
方法描述：獲取影像刪除權限的標記（FImgDelete）。
============================================================================== }
function TCB_IMGPSScanX.Get_imgdelete: WideString;
begin
end;
{ ==============================================================================
方法名稱：Set_imgdelete
引用相依：
方法描述：設定影像刪除權限。
============================================================================== }
procedure TCB_IMGPSScanX.Set_imgdelete(const Value: WideString);
begin
FImgDelete:=Value;
end;
{ ==============================================================================
方法名稱：Get_check_main_form
引用相依：
方法描述：獲取是否檢查主表單的標記（FCheck_main_form）。
============================================================================== }
function TCB_IMGPSScanX.Get_check_main_form: WideString;
begin
end;
{ ==============================================================================
方法名稱：Get_isExternal
引用相依：
方法描述：獲取是否為外部呼叫模式的標記（FIsExternal）。
============================================================================== }
function TCB_IMGPSScanX.Get_isExternal: WideString;
begin
end;
{ ==============================================================================
方法名稱：Set_check_main_form
引用相依：
方法描述：設定是否檢查主表單。
============================================================================== }
procedure TCB_IMGPSScanX.Set_check_main_form(const Value: WideString);
begin
FCheck_main_form := Value;
end;
{ ==============================================================================
方法名稱：Set_isExternal
引用相依：
方法描述：設定是否為外部呼叫模式。
============================================================================== }
procedure TCB_IMGPSScanX.Set_isExternal(const Value: WideString);
begin
FIsExternal:=Value;
end;
{ ==============================================================================
方法名稱：Get_WH_CATEGORY
引用相依：
方法描述：獲取倉庫類別資訊（FWH_category）。
============================================================================== }
function TCB_IMGPSScanX.Get_WH_CATEGORY: WideString;
begin
end;
{ ==============================================================================
方法名稱：Set_WH_CATEGORY
引用相依：
方法描述：設定倉庫類別（WH_CATEGORY）。此範圍除包含 setter 實作外，亦涵蓋了組件的
initialization 初始區段，負責註冊 ActiveForm 工廠並設定多組授權金鑰（L
icenseKey），確保 OCX 運作環境與權限正確初始化。
============================================================================== }
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.