~curtischang/CB_IMGPSScan.git

$Hong-Dell\Hong$

Hong-Dell\Hong

2024-05-14 bf489952e4fae3a5f891573614a6bbadc93d869f

Ver 2,0,1,79

1.新增匯入檔案時可選擇PNG檔匯入,並依色彩另存為tif/jpg檔
2.調整使用IIS_Ftp方法(ftp路徑分成Root及Extra)

修改10個檔案

	CB_IMGPSScan.dproj	4 ●●●●● 修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程
	CB_IMGPSScan.identcache	修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程
	CB_IMGPSScan.ocx	修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程
	CB_IMGPSScan.res	修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程
	CB_IMGPSScanImp.dcu	修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程
	CB_IMGPSScanImp.dfm	8 ●●●●● 修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程
	CB_IMGPSScanImp.pas	33 ●●●●● 修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程
	CB_IMGPSScan_test.dproj	4 ●●●●● 修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程
	CB_IMGPSScan_test.ocx	修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程
	CB_IMGPSScan_test.res	修補檔 \| 檢視 \| 原始 \| 究查 \| 歷程

 CB_IMGPSScan.dproj

@@ -96,7 +96,7 @@
                        <VersionInfo Name="MajorVer">2</VersionInfo>
                        <VersionInfo Name="MinorVer">0</VersionInfo>
                        <VersionInfo Name="Release">1</VersionInfo>
                        <VersionInfo Name="Build">78</VersionInfo>
                        <VersionInfo Name="Build">79</VersionInfo>
                        <VersionInfo Name="Debug">False</VersionInfo>
                        <VersionInfo Name="PreRelease">False</VersionInfo>
                        <VersionInfo Name="Special">False</VersionInfo>
@@ -108,7 +108,7 @@
                    <VersionInfoKeys>
                        <VersionInfoKeys Name="CompanyName"/>
                        <VersionInfoKeys Name="FileDescription"/>
                        <VersionInfoKeys Name="FileVersion">2.0.1.78</VersionInfoKeys>
                        <VersionInfoKeys Name="FileVersion">2.0.1.79</VersionInfoKeys>
                        <VersionInfoKeys Name="InternalName"/>
                        <VersionInfoKeys Name="LegalCopyright"/>
                        <VersionInfoKeys Name="LegalTrademarks"/>

 CB_IMGPSScan.identcache

Binary files differ

 CB_IMGPSScan.ocx

Binary files differ

 CB_IMGPSScan.res

Binary files differ

 CB_IMGPSScanImp.dcu

Binary files differ

 CB_IMGPSScanImp.dfm

@@ -5818,7 +5818,7 @@
    Left = 32
    Top = 360
    Bitmap = {
      494C01010A000D00700010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
      494C01010A000D007C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000400000003000000001002000000000000030
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
@@ -6227,7 +6227,7 @@
    Left = 32
    Top = 225
    Bitmap = {
      494C010105000900700020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
      494C0101050009007C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000800000004000000001002000000000000080
      0000000000000000000000000000000000000000000000000000000000000000
      0000000000000000000000000000000000000000000000000000000000000000
@@ -7298,7 +7298,7 @@
    Left = 29
    Top = 273
    Bitmap = {
      494C010107000900700020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
      494C0101070009007C0020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000800000004000000001002000000000000080
      000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF
      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
@@ -8369,7 +8369,7 @@
    Left = 37
    Top = 313
    Bitmap = {
      494C010107000900700020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
      494C0101070009007C0020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
      0000000000003600000028000000800000004000000001002000000000000080
      000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF
      FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF

 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

 CB_IMGPSScan_test.dproj

@@ -96,7 +96,7 @@
                        <VersionInfo Name="MajorVer">2</VersionInfo>
                        <VersionInfo Name="MinorVer">0</VersionInfo>
                        <VersionInfo Name="Release">1</VersionInfo>
                        <VersionInfo Name="Build">78</VersionInfo>
                        <VersionInfo Name="Build">79</VersionInfo>
                        <VersionInfo Name="Debug">False</VersionInfo>
                        <VersionInfo Name="PreRelease">False</VersionInfo>
                        <VersionInfo Name="Special">False</VersionInfo>
@@ -108,7 +108,7 @@
                    <VersionInfoKeys>
                        <VersionInfoKeys Name="CompanyName"/>
                        <VersionInfoKeys Name="FileDescription"/>
                        <VersionInfoKeys Name="FileVersion">2.0.1.78</VersionInfoKeys>
                        <VersionInfoKeys Name="FileVersion">2.0.1.79</VersionInfoKeys>
                        <VersionInfoKeys Name="InternalName"/>
                        <VersionInfoKeys Name="LegalCopyright"/>
                        <VersionInfoKeys Name="LegalTrademarks"/>

 CB_IMGPSScan_test.ocx

Binary files differ

 CB_IMGPSScan_test.res

Binary files differ

			@@ -96,7 +96,7 @@
			<VersionInfo Name="MajorVer">2</VersionInfo>
			<VersionInfo Name="MinorVer">0</VersionInfo>
			<VersionInfo Name="Release">1</VersionInfo>
			<VersionInfo Name="Build">78</VersionInfo>
			<VersionInfo Name="Build">79</VersionInfo>
			<VersionInfo Name="Debug">False</VersionInfo>
			<VersionInfo Name="PreRelease">False</VersionInfo>
			<VersionInfo Name="Special">False</VersionInfo>
			@@ -108,7 +108,7 @@
			<VersionInfoKeys>
			<VersionInfoKeys Name="CompanyName"/>
			<VersionInfoKeys Name="FileDescription"/>
			<VersionInfoKeys Name="FileVersion">2.0.1.78</VersionInfoKeys>
			<VersionInfoKeys Name="FileVersion">2.0.1.79</VersionInfoKeys>
			<VersionInfoKeys Name="InternalName"/>
			<VersionInfoKeys Name="LegalCopyright"/>
			<VersionInfoKeys Name="LegalTrademarks"/>

			@@ -5818,7 +5818,7 @@
			Left = 32
			Top = 360
			Bitmap = {
			494C01010A000D00700010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
			494C01010A000D007C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
			0000000000003600000028000000400000003000000001002000000000000030
			0000000000000000000000000000000000000000000000000000000000000000
			0000000000000000000000000000000000000000000000000000000000000000
			@@ -6227,7 +6227,7 @@
			Left = 32
			Top = 225
			Bitmap = {
			494C010105000900700020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
			494C0101050009007C0020002000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
			0000000000003600000028000000800000004000000001002000000000000080
			0000000000000000000000000000000000000000000000000000000000000000
			0000000000000000000000000000000000000000000000000000000000000000
			@@ -7298,7 +7298,7 @@
			Left = 29
			Top = 273
			Bitmap = {
			494C010107000900700020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
			494C0101070009007C0020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
			0000000000003600000028000000800000004000000001002000000000000080
			000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF
			FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
			@@ -8369,7 +8369,7 @@
			Left = 37
			Top = 313
			Bitmap = {
			494C010107000900700020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
			494C0101070009007C0020002000FFFFFF00FF10FFFFFFFFFFFFFFFF424D3600
			0000000000003600000028000000800000004000000001002000000000000080
			000000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF
			FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF

			@@ -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