From bf489952e4fae3a5f891573614a6bbadc93d869f Mon Sep 17 00:00:00 2001
From: Hong-Dell\Hong <chlin1022@i-mps.com>
Date: 星期二, 14 五月 2024 11:27:12 +0800
Subject: [PATCH] Ver 2,0,1,79
---
CB_IMGPSScanImp.pas | 33 +++++++++++++++++++--------------
1 files changed, 19 insertions(+), 14 deletions(-)
diff --git a/CB_IMGPSScanImp.pas b/CB_IMGPSScanImp.pas
index 6a587cb..88d347a 100644
--- a/CB_IMGPSScanImp.pas
+++ b/CB_IMGPSScanImp.pas
@@ -1,5 +1,5 @@
unit CB_IMGPSScanImp;
-//PRO
+//TEST
{$WARN SYMBOL_PLATFORM OFF}
interface
@@ -454,7 +454,8 @@
FFtpIP : String;
FFtpID : String;
FFtpPwd : String;
- FFtpPath : String;
+ FFtpRootPath : String;
+ FFtpExtraPath : String;
FFtpPort : Integer;
FFtpProtocol : TFtpProtocol;
//********Ftp參數*********
@@ -2803,7 +2804,7 @@
SaveStreamB:TFileStream;
cooom:integer;
Begin
- OpenDialog1.Filter := 'Image files|*.TIF;*.JPG';
+ OpenDialog1.Filter := 'Image files|*.TIF;*.JPG;*.PNG';
If OpenDialog1.Execute Then
Begin
ISB := TImageScrollBox.Create(self);
@@ -2998,16 +2999,19 @@
//ShowMessage(IntToStr(iGraphic.Palette.palNumEntries));
if iGraphic.ImageFormat = ifBlackWhite then //20200806 出現無法匯入,是因color256無法壓JPEG,待報會後再開啟
begin
+ SaveFilename := changefileext(SaveFilename,'.tif'); //20240320 Hong 調整黑白存tif
iGraphic.Compression:=tcGroup4;
end
else if iGraphic.ImageFormat= ifColor256 then
begin
+ SaveFilename := changefileext(SaveFilename,'.jpg'); //20240320 Hong 調整Color256存jpg
ConverttoGray(iGraphic);
iGraphic.Compression:=tcJPEG;
iGraphic.JpegQuality:=cooom;
end
else if (iGraphic.ImageFormat = ifTrueColor) or (iGraphic.ImageFormat = ifGray256) then
begin
+ SaveFilename := changefileext(SaveFilename,'.jpg'); //20240320 Hong 調整彩色灰階存jpg
iGraphic.Compression:=tcJPEG;
iGraphic.JpegQuality:=cooom;
end
@@ -3035,8 +3039,7 @@
SaveStream.Free;
End;
End
- Else If LowerCase(ExtractFileExt(SavePath + SaveFilename))
- = '.jpg' Then
+ Else If LowerCase(ExtractFileExt(SavePath + SaveFilename)) = '.jpg' Then
Begin
If FileExists(SavePath + SaveFilename) Then
DeleteFile(SavePath + SaveFilename);
@@ -3125,7 +3128,7 @@
JpgGr := TJpegGraphic.Create;
Try
JpgGr.Assign(iGraphic);
- JpgGr.SaveQuality := 30;
+ JpgGr.SaveQuality := cooom;
// JpgGr.AppendToStream(SaveStream);
JpgGr.SaveToFile(SavePath + SaveFilename);
Finally
@@ -4370,7 +4373,7 @@
SetFtpInfo;
IIS_Ftp.FtpsConnect;
- IIS_Ftp.FtpsToMain(FFtpPath,NowCaseno+'.pdf','d:\1.pdf',display1);
+ IIS_Ftp.FtpsToMain(FFtpExtraPath,NowCaseno+'.pdf','d:\1.pdf',display1);
end;
procedure TCB_IMGPSScanX.Button6Click(Sender: TObject);
@@ -6640,7 +6643,7 @@
+'&must_formid='+must_formidStr //擁有的 formid
+'&last_add_formid='+last_add_formidstr //當次新加的 formid
+'&form_code='+ScanListStr //scanlist.dat 表單代號
- +'&ftp_image_path='+FFtpPath //加傳FTP目錄 HTTP上傳時會是空白
+ +'&ftp_image_path='+FFtpExtraPath //加傳FTP目錄 HTTP上傳時會是空白
+'&in_doc1='+HTTPEncode(UTF8Encode(In_Doc1))
+'&in_doc2='+HTTPEncode(UTF8Encode(In_Doc2));
@@ -6682,7 +6685,7 @@
Result := False;
Exit;
end;
- if not IIS_Ftp.FtpsToMain(FFtpPath,CaseID+'.zip',Path+'Img.zip',display1) then
+ if not IIS_Ftp.FtpsToMain(FFtpExtraPath,CaseID+'.zip',Path+'Img.zip',display1) then
begin
Showmessage(Format(_msg('上傳案件(%s)時,發生錯誤,錯誤原因:%s'),[CaseID,FtpErrStr]));
Result := False;
@@ -6961,7 +6964,7 @@
Result := False;
Exit;
end;
- if not IIS_Ftp.FtpsDownloadFile(IIS_Ftp.FtpPath,CaseID+'.zip',Path+CaseID+'.zip',display1) then
+ if not IIS_Ftp.FtpsDownloadFile(FFtpExtraPath,CaseID+'.zip',Path+CaseID+'.zip',display1) then
begin
DownFileErrStr := Format(_Msg('錯誤原因:%s'),[FtpErrStr]);
Result := False;
@@ -11022,14 +11025,15 @@
Exit;
end;
TransMode := tsHttp;
- FFtpPath := '';
+ FFtpExtraPath := '';
+
if memo1.Lines.Strings[0] = '0' then
begin
- if memo1.Lines.Strings[2] = 'Y' then
+ if memo1.Lines.Strings[2] = 'Y' then //要使用FTP
TransMode := tsFtp;
if memo1.Lines.Count > 3 then
begin
- FFtpPath := memo1.Lines.Strings[3];
+ FFtpExtraPath := memo1.Lines.Strings[3];
DecodeFtpInfo(memo1.Lines.Strings[4]);
end;
end;
@@ -11044,7 +11048,7 @@
IIS_Ftp.Ftpip := FFtpIP;
IIS_Ftp.Ftpuserid := FFtpID;
IIS_Ftp.FtpPwd := FFtpPwd;
- IIS_Ftp.FtpPath := FFtpPath;
+ IIS_Ftp.FtpPath := FFtpRootPath;
IIS_Ftp.FtpPort := FFtpPort;
IIS_Ftp.FtpSSL := True;
IIS_Ftp.FtpPassive := True;
@@ -14913,6 +14917,7 @@
FMaxUploadSize:='10';
FJpgCompression:=50;
+ FFtpRootPath := ''; //影像平台沒有給FtpRoot目錄,會直接用FFtpExtraPath切換至指定目錄
//FMode := 'DSCAN' ;
//FIs_In_Wh := 'Y';
if FIs_In_Wh = 'Y' then
--
Gitblit v1.8.0