// 公司 IIS_ImageProcess 相關方法 unit IIS_ImageProcess; interface uses EnImgScr, EnDiGrph, { for TDibGraphic } EnTifGr, { for TTifGraphic } EnJpgGr, { for TJpegGraphic} EnPngGr, { for TPngGraphic } EnTransf, { for TImageTransform } EnMisc, { for MinFloat } EnRubber, { for TRubberbandMouseHandler } EnPrint, { for TEnvisionPrintMode, TDibGraphicPrinter } DeskewTransform, WatermarkTransform, mpsBarco, NBLib, Barcode, vrsx, dExif,dIPTC,jpeg, windows,Graphics,SysUtils,dialogs,classes,iisunit,Printers, FindBlackSpots, ExtCtrls; Procedure Rotate(Graphic:TDibGraphic;Angle : Double); //旋轉 Procedure DeskewImg(Graphic : TDibGraphic);Overload; //歪斜矯正 Procedure DeskewImg(Graphic : TDibGraphic;CR_Graphic : TDibGraphic);Overload; //以黑白影像歪斜矯正後再轉彩色影像 Procedure CleanupBorder(Graphic : TDibGraphic); // 清黑邊 procedure NegativeImg(Graphic : TDibGraphic); //反向 procedure ConvertToGray(Graphic : TDibGraphic); //轉成灰階 Function GetTag(FileName :String):String; //將資訊從CustomTag裡取出 Procedure SetTag(FileName,DataStr :String); //將資訊記在CustomTag裡 Procedure CreateStamp(FileName,Title,UserID,StampDate:String;StampWidth,StampHeight:Single); //產生印章 procedure CreateNote(FileName,Title:String); //產生便條紙 procedure CreateDraft(FileName,Title:String); //產生便條紙 Procedure CreateReportImg(FileName,BarCode,Memo,BGFileName:String;DataList,ItemList:TStringlist); //產生補件清單影像 Procedure CreateReportImg_JSON(FileName,BGFileName,BarCode,JSONStr:String); procedure PrintBarcode(const FileName, Content: WideString; L, T, Width, Height: Integer); //印條碼 procedure Watermark(logoBmp:TBitmap;Opacity:Byte;Content:String;Graphic:TDibGraphic); //讀bmp印在正中央 procedure Watermark1(Opacity:Byte;Content,Content1:String;Graphic:TDibGraphic); //自行產生文字330度印在左上右下 procedure Watermark1_Hong(Opacity:Byte;Content,Content1:String;Graphic:TDibGraphic;ImgH:Integer); //自行產生文字330度印在左上右下 procedure Watermark1_Hong_New(Opacity:Byte;Content,Content1:String;Graphic,DisGraphic:TDibGraphic;ImgH:Integer); //自行產生文字330度印在左上右下 procedure Watermark2(logoBmp:TBitmap;Opacity:Byte;Content:String;Graphic:TDibGraphic); //讀bmp印在左上方 Procedure FindPoint(Graphic:TDibGraphic;Var UpPointL,UpPointR,DownPointL:TPoint;Var FormWidth,FormHeight:Integer;Anchor:String);overload; Procedure FindPoint(Graphic:TDibGraphic;Var UpPointL,UpPointR,DownPointL:TPoint;Anchor:String);overload; function GetBlackSpots(Graphic:TDibGraphic;L, T, R, B, Ratio: Integer): WideString; Procedure FindBlackPoint(Graphic:TDibGraphic;Var BlackPoint:Tpoint); Function Get_OMR(Graphic:TDibGraphic;iRect:Trect):integer; //取點數 Function GetSelectRect(ISB:TImageScrollBox):TRect; //取出影像上的框選範圍 Function GetSelectRect_Back(ISB:TImageScrollBox):TRect; //取出影像上的框選範圍(從右下回來) function GetSelectRect2String(ISB:TImageScrollBox;UpPointL:TPoint): WideString; //取出影像上的框選範圍轉公分字串 function GetSelectRect_Black2String(ISB:TImageScrollBox;BlackPoint:TPoint): WideString; //取出影像上的框選範圍從右下小黑框轉公分字串 Procedure SetSelectRect(ISB:TImageScrollBox;iRect:TRect); //顯示出指定的框 Procedure SetSelectRect_Original(ISB:TImageScrollBox;iRect:TRect); //顯示出指定的框(不縮放) Procedure ShowKeyinRect(ISB:TImageScrollBox;iRect:TRect); //顯示登打位置 procedure ImageResize(Graphic:TDibGraphic;DesWidth,DesHeight:Integer); //影像縮放 Procedure DpiResize(Graphic:TDibGraphic;DesDpi:Integer;CheckDpi:Boolean); //改變Dpi並依Dpi縮放影像 Procedure DrawPointLine(ISB:TImageScrollBox;UpPointL,UpPointR,DownPointL:TPoint); //畫十字位置 Procedure Gray2BW_RTS(ISB:TImageScrollBox;Para1,Para2,Para3:Integer);Overload; Procedure Gray2BW_RTS(ISB:TImageScrollBox;Para1,Para2,Para3:Integer;Part:Trect); Overload; //用RTS灰階轉黑白 Procedure Color2BW_RTS(ISB:TImageScrollBox;Para1,Para2,Para3:Integer); Overload; //用RTS彩色轉黑白 Procedure Color2BW_RTS(ISB:TImageScrollBox;Para1,Para2,Para3:Integer;Part:Trect); Overload; //用RTS彩色轉黑白 procedure Emboss(ISB:TImageScrollBox); Procedure BrightnessImg(ISB:TImageScrollBox;Precent:Integer); //調整亮度 Procedure ConvertToBW(Graphic : TDibGraphic); //轉成黑白 Procedure ConvertTo256Gray(Graphic : TDibGraphic); //轉成256灰階 Procedure ClearLine(Graphic : TDibGraphic;bt:Integer); //清影像上的線條 procedure CropImg(Graphic : TDibGraphic;iRect:TRect); //切範圍影像 Function GetPosAngle(UpL,DownL,UpR:TPoint):Single; //取三點夾角角度 function CheckSize(ISB:TImageScrollBox;UpL,UpR,DownL:TPoint;DefWidth,DefHeight:String): WideString; //檢查Size並縮放 Function GetPixBW( srcGraphic : TDibGraphic; x,y:integer ):integer; Procedure BmpConverJpg(Source,SaveFileName:STring); //Bmp轉不壓縮jpeg Procedure BWTif2Jpg(Graphic:TDibGraphic); //黑白Tif轉彩色jpg Procedure Color2tif(Graphic:TObject;FileName:String); //彩色影像存Tif Procedure FieldMask(ISB:TImageScrollBox;SiteList,Mode: WideString;UpPointL:TPoint); //遮罩 Mode:mark mask procedure SaveAnnotation(ISB:TImageScrollBox;FileName: WideString); //遮罩存檔 Procedure FilterColor(SoISB,DeISB:TImageScrollBox;Ration:Integer); //濾掉顏色 留黑白 procedure JpgReSize_Exif(Maxlength,Quality:integer;OldFile,NewFile:String;WaterGraphic:TGraphic;PrintDate:Boolean); //照片縮放包含Exif Function GetExif_CaptureDateTime(FileName : String):String; //取出檔案裡的Exif拍攝日期 procedure SetKeyinRect_New( ISB:TImageScrollBox; SiteStr, SiteStr_Black,FormHeight: String; UpPointL,UpPointR:TPoint); overload; procedure SetKeyinRect_New( ISB:TImageScrollBox; SiteStr, SiteStr_Black,FormHeight: String; UpPointL,UpPointR:TPoint;SP:TShape); overload; Procedure Image_Smooth(Graphic:TDibGraphic); procedure PrintImg(FileName, LoginID, Datetime,Path: WideString;WaterBmp:TBitmap); overload; procedure PrintImg(FileName, LoginID, Datetime,Path: WideString;WaterBmp:TBitmap;Spec_Page:Integer); overload; procedure PrintImg(FileName, LoginID, Datetime,Path: WideString;WaterBmp:TBitmap;Spec_Page:Integer;NeedSetup:Boolean); overload; implementation Procedure Rotate(Graphic:TDibGraphic;Angle : Double); var Transform : TRotateTransform; AngleStr : String; FUndoGraphic : TDibGraphic; begin FUndoGraphic := TDibGraphic.Create; FUndoGraphic.Assign(Graphic); Transform := TRotateTransform.Create; try Transform.Angle := Angle; //Transform.BackgroundColor := MakeRgb(255, 255, 255); Transform.ApplyOnDest(FUndoGraphic, Graphic); finally Transform.Free; FUndoGraphic.Free; end; end; Procedure DeskewImg(Graphic : TDibGraphic); Var Deskew:TDeskewTransform; begin // Create a deskew component Deskew:=TDeskewTransform.Create; try //Deskew.ImageExpansion := True; //Deskew.FastEstimation := True; // Apply the deskew transform to the image component Deskew.Apply(Graphic); // Redraw the deskewed image finally //Destroy the deskew component Deskew.Free; end; end; Procedure DeskewImg(Graphic : TDibGraphic;CR_Graphic : TDibGraphic);Overload; //以黑白影像歪斜矯正後再轉彩色影像 Var Deskew:TDeskewTransform; Angle : Single; begin // Create a deskew component Deskew:=TDeskewTransform.Create; try //Deskew.ImageExpansion := True; //Deskew.FastEstimation := True; // Apply the deskew transform to the image component Angle := Deskew.DetectSkew(Graphic); Deskew.Apply(Graphic); Rotate(CR_Graphic,Angle); // Redraw the deskewed image finally //Destroy the deskew component Deskew.Free; end; end; Procedure CleanupBorder(Graphic : TDibGraphic); // 清黑邊 var Transform : TNBCleanupBorderTransform; FUndoGraphic : TDibGraphic; begin FUndoGraphic := TDibGraphic.Create; try FUndoGraphic.Assign(Graphic); Transform := TNBCleanupBorderTransform.Create; try Transform.MarginInches := 5; Transform.ApplyOnDest(FUndoGraphic, Graphic); finally Transform.Free; end; Finally FUndoGraphic.Free; end; end; procedure NegativeImg(Graphic : TDibGraphic); //反向 var Transform : TNegativeTransform; FUndoGraphic : TDibGraphic; begin FUndoGraphic := TDibGraphic.Create; try FUndoGraphic.Assign(Graphic); Transform := TNegativeTransform.Create; try Transform.ApplyOnDest(FUndoGraphic, Graphic); finally Transform.Free; end; finally FUndoGraphic.Free; end; end; procedure ConvertToGray(Graphic : TDibGraphic); //轉灰階 var Transform : TConvertToGrayTransform; FUndoGraphic : TDibGraphic; begin FUndoGraphic := TDibGraphic.Create; try FUndoGraphic.Assign(Graphic); Transform := TConvertToGrayTransform.Create; try //Transform.OnProgress := Self.OnProgress; Transform.ApplyOnDest(FUndoGraphic, Graphic); finally Transform.Free; end; finally FUndoGraphic.Free; end; end; Function GetTag(FileName :String):String; //將資訊從CustomTag裡取出 var Tif : TTiffGraphic; begin Result := ''; if (Uppercase(ExtractFileExt(FileName)) = '.TIF') or (Uppercase(ExtractFileExt(FileName))='.TIFF') then begin Tif := TTiffGraphic.Create; Try Tif.LoadFromFile(FileName); IF Tif.ImageDescriptionTag <> '' then Result := Tif.ImageDescriptionTag; Finally Tif.Free; end; end; end; Procedure SetTag(FileName,DataStr :String); //將資訊記在CustomTag裡 var Tif : TTiffGraphic; begin if (Uppercase(ExtractFileExt(FileName)) = '.TIF') or (Uppercase(ExtractFileExt(FileName))='.TIFF') then begin Tif := TTiffGraphic.Create; Try Tif.LoadFromFile(FileName); Tif.ImageDescriptionTag := DataStr; Tif.SaveToFile(FileName); Finally Tif.Free; end; end; end; Procedure CreateStamp(FileName,Title,UserID,StampDate:String;StampWidth,StampHeight:Single); //產生印章 var i,v:integer; bmp:Tbitmap; s:string; ISB : TImageScrollBox; TextH,TextW : Integer; X,Y : Integer; seg:Integer; begin IF FileExists(FileName) Then DeleteFile(FileName); //開新影像檔 bmp := Tbitmap.Create; ISB := TImageScrollBox.Create(nil); try bmp.Width := Round(StampWidth/2.54 *300); bmp.Height:= Round(StampHeight/ 2.54 *300); bmp.Monochrome := False; bmp.Canvas.Font.PixelsPerInch := 300; bmp.Canvas.Font.Size := 24; bmp.Canvas.Font.Style := [fsBold]; bmp.Canvas.Font.Name := '標楷體'; bmp.Canvas.Font.Color := clBlue; bmp.Canvas.Brush.Color:= clwhite; bmp.Canvas.Rectangle(1,1,bmp.Width,bmp.Height); bmp.Canvas.Pen.Width:=24; bmp.Canvas.Pen.Color := clblue; bmp.Canvas.Rectangle(1,1,bmp.Width,bmp.Height); bmp.Transparent := True; TextH := bmp.Canvas.TextHeight('退'); TextW := bmp.Canvas.TextWidth('退'); Seg := ((bmp.Height - 60 - TextH) - (Length(Title)*TextH)) Div (length(Title)-1); X := (Bmp.Width Div 2) - (TextW Div 2); Y := 15; for i := 1 to length(Title) do begin bmp.Canvas.TextOut(X,Y,Title[i]); if i < length(Title) then Y := Y + seg +(TextH) else Y := Y + TextH; end; bmp.Canvas.Font.Size := 10; bmp.Canvas.Font.Name := '標楷體'; TextW := bmp.Canvas.TextWidth(GetDate); bmp.Canvas.TextOut(((bmp.Width) div 2)-(TextW div 2),Y+20,StampDate); Y := Y + 60; bmp.Canvas.Font.Size := 10; bmp.Canvas.Font.Name := '標楷體'; TextW := bmp.Canvas.TextWidth(UserID); bmp.Canvas.TextOut((bmp.Width div 2)-(TextW div 2),Y+20,UserID); {if Title <> '' then begin TextW := bmp.Canvas.TextWidth(Title); bmp.Canvas.TextOut((bmp.Width div 2) - (TextW div 2) ,Round(3*300) ,Title ); end;} bmp.SaveToFile(ExtractFilePath(FileName)+'tmp.bmp'); //ISB.Graphic.Canvas.Assign(bmp.Canvas); ISB.LoadFromFile(ExtractFilePath(FileName)+'tmp.bmp',1); DeleteFile(ExtractFilePath(FileName)+'tmp.bmp'); //showmessage(ViewPath+'note.bmp'); ISB.Graphic.XDotsPerInch:=300; ISB.Graphic.YDotsPerInch:=300; ISB.SaveToFile(FileName); finally bmp.Free; ISB.Free; end; end; procedure CreateNote(FileName,Title:String); //產生便條紙 var i,v:integer; bmp:Tbitmap; s:string; ISB : TImageScrollBox; TextW : Integer; begin IF FileExists(FileName) Then DeleteFile(FileName); //開新影像檔 bmp := Tbitmap.Create; ISB := TImageScrollBox.Create(nil); try bmp.Width := 8 * 300; bmp.Height:= 11 * 300; bmp.Monochrome := true; bmp.Canvas.Font.Size := 60; bmp.Canvas.Brush.Color:= clwhite; bmp.Canvas.Rectangle(1,1,bmp.Width,bmp.Height); if Title <> '' then begin TextW := bmp.Canvas.TextWidth(Title); bmp.Canvas.TextOut((bmp.Width div 2) - (TextW div 2) ,Round(3*300) ,Title ); end; bmp.SaveToFile(ExtractFilePath(FileName)+'tmp.bmp'); //ISB.Graphic.Canvas.Assign(bmp.Canvas); ISB.LoadFromFile(ExtractFilePath(FileName)+'tmp.bmp' ,1); DeleteFile(ExtractFilePath(FileName)+'tmp.bmp'); //showmessage(ViewPath+'note.bmp'); ISB.Graphic.XDotsPerInch:=300; ISB.Graphic.YDotsPerInch:=300; ISB.SaveToFile(FileName); finally bmp.Free; ISB.Free; end; end; procedure CreateDraft(FileName,Title:String); //產生便條紙 var i,v:integer; bmp:Tbitmap; s:string; ISB : TImageScrollBox; TextW : Integer; begin IF FileExists(FileName) Then DeleteFile(FileName); //開新影像檔 bmp := Tbitmap.Create; ISB := TImageScrollBox.Create(nil); try bmp.Width := 8 * 300; bmp.Height:= 11 * 300; bmp.Monochrome := False; bmp.Canvas.Font.Size := 60; bmp.Canvas.Brush.Color:= clwhite; bmp.Canvas.Rectangle(1,1,bmp.Width,bmp.Height); if Title <> '' then begin TextW := bmp.Canvas.TextWidth(Title); bmp.Canvas.TextOut((bmp.Width div 2) - (TextW div 2) ,Round(0.5*300) ,Title ); end; bmp.SaveToFile(ExtractFilePath(FileName)+'tmp.bmp'); //ISB.Graphic.Canvas.Assign(bmp.Canvas); ISB.LoadFromFile(ExtractFilePath(FileName)+'tmp.bmp' ,1); DeleteFile(ExtractFilePath(FileName)+'tmp.bmp'); //showmessage(ViewPath+'note.bmp'); ISB.Graphic.XDotsPerInch:=300; ISB.Graphic.YDotsPerInch:=300; ISB.SaveToFile(FileName); finally bmp.Free; ISB.Free; end; end; procedure PrintBarcode(const FileName, Content: WideString; L, T, Width, Height: Integer); Var Rect : TRect; AsBarCode : TAsBarCode; ISB : TImageScrollBox; TextW : Integer; begin AsBarCode := TAsBarCode.Create(nil); ISB := TImageScrollBox.Create(nil); try Rect.Left := L-40; Rect.Top := T-40; Rect.Right := L+Width+40; Rect.Bottom := T+Height+40; ISB.LoadFromFile(FileName,1); ISB.Graphic.Canvas.Brush.Color := clWhite; ISB.Graphic.Canvas.FillRect(Rect); AsBarcode.Typ := bcCode39; AsBarCode.ShowText := bcoNone; AsBarcode.Text := Content; AsBarcode.Left := L; AsBarcode.Top := T; AsBarcode.Width := Width; AsBarcode.Height := Height; AsBarCode.DrawBarcode(ISB.Graphic.Canvas); ISB.Graphic.Canvas.Font.Size := 28; TextW := ISB.Graphic.Canvas.TextWidth(Content); AsBarcode.Left := L + Round(Width Div 2)-(Textw div 2); AsBarcode.Top := T + Height; //AsBarcode.Top := Round(0.1/2.54*ISB.Graphic.XDotsPerInch); AsBarCode.ShowText := bcoCode; AsBarCode.DrawText(ISB.Graphic.Canvas); ISB.SaveToFile(FileName); finally AsBarCode.Free; ISB.Free; end; end; Procedure CreateReportImg(FileName,BarCode,Memo,BGFileName:String;DataList,ItemList:TStringlist); //產生補件清單影像 var i,v,v1:integer; bmp:Tbitmap; s:string; ISB,ISB1 : TImageScrollBox; TextW,TextH,NowX,NowY : Integer; MemoList : TStringlist; DRect,SRect:TRect; begin IF FileExists(FileName) Then DeleteFile(FileName); //開新影像檔 bmp := Tbitmap.Create; MemoList := TStringlist.Create; ISB := TImageScrollBox.Create(nil); ISB1 := TImageScrollBox.Create(nil); try bmp.Width := 8 * 300; bmp.Height:= 11 * 300; bmp.Monochrome := False; bmp.Canvas.Font.Size := 24; bmp.Canvas.Font.Name := '標楷體'; bmp.Canvas.Brush.Color:= clwhite; bmp.Canvas.Rectangle(1,1,bmp.Width,bmp.Height); TextW := bmp.Canvas.TextWidth('測試'); TextH := bmp.Canvas.TextHeight('測試'); NowY := 600; NowX := bmp.Width Div 2; for i := 0 to DataList.Count - 1 do begin NowX := ((bmp.Width Div 2) * (i mod 2)) + 100; bmp.Canvas.TextOut(NowX,NowY,DataList.Strings[i]); NowY := NowY+ ((TextH * (i mod 2))+ (100*(i mod 2))); end; NowY := NowY +TextH+ 100; bmp.Canvas.TextOut(100,NowY,'說明:'); NowY := NowY + TextH+20; v:=1; v1:=1; for i := 1 to Length(Memo) do //計算要換行字數 begin TextW := bmp.Canvas.TextWidth(Copy(Memo,v,v1)); if TextW >= (bmp.Width - 250) then begin MemoList.Add(Copy(Memo,v,v1)); v := i+1; v1:=0; end; inc(v1); end; if v <= length(Memo) then MemoList.Add(Copy(Memo,v,length(Memo))); for i := 0 to MemoList.Count - 1 do begin bmp.Canvas.TextOut(150,NowY,MemoList.Strings[i]); NowY := NowY+TextH+20; end; //TextW := bmp.Canvas.TextHeight(Memo); //bmp.Canvas.TextOut(150,NowY,Memo); NowY := NowY + 100; bmp.Canvas.TextOut(100,NowY,'補件項目:'); NowY := NowY +TextH+20; for i := 0 to ItemList.Count - 1 do begin bmp.Canvas.TextOut(150,NowY,ItemList.Strings[i]); NowY := NowY+TextH+50; end; bmp.SaveToFile(ExtractFilePath(FileName)+'tmp.bmp'); PrintBarcode(ExtractFilePath(FileName)+'tmp.bmp',BarCode,150,150,1600,150); //ISB.Graphic.Canvas.Assign(bmp.Canvas); ISB.LoadFromFile(ExtractFilePath(FileName)+'tmp.bmp' ,1); DeleteFile(ExtractFilePath(FileName)+'tmp.bmp'); ISB1.LoadFromFile(BGFileName,1); Srect := Rect(1,1,ISB.Graphic.Width,ISB.Graphic.Height); DRect := Rect(1,1,ISB1.Graphic.Width,ISB1.Graphic.Height); ISB1.Graphic.Canvas.CopyMode := SRCAND; ISB1.Graphic.Canvas.CopyRect(DRect,ISB.Graphic.Canvas,SRect); ISB1.Graphic.XDotsPerInch:=300; ISB1.Graphic.YDotsPerInch:=300; ISB1.SaveToFile(FileName); //showmessage(ViewPath+'note.bmp'); {ISB.Graphic.XDotsPerInch:=300; ISB.Graphic.YDotsPerInch:=300; ISB.SaveToFile(FileName);} finally bmp.Free; ISB.Free; ISB1.Free; MemoList.Free; end; end; Procedure CreateReportImg_JSON(FileName,BGFileName,BarCode,JSONStr:String); var i,n,v,v1:integer; bmp:Tbitmap; s:string; ISB,ISB1 : TImageScrollBox; TextW,TextH,NowX,NowY : Integer; MemoList,ItemList,PrtList : TStringlist; DRect,SRect:TRect; begin IF FileExists(FileName) Then DeleteFile(FileName); //開新影像檔 bmp := Tbitmap.Create; MemoList := TStringlist.Create; PrtList := TStringlist.Create; ItemList := TStringlist.Create; ISB := TImageScrollBox.Create(nil); ISB1 := TImageScrollBox.Create(nil); try bmp.Width := 8 * 300; bmp.Height:= 11 * 300; bmp.Monochrome := False; bmp.Canvas.Font.PixelsPerInch := 300; bmp.Canvas.Font.Size := 12; bmp.Canvas.Font.Name := '標楷體'; bmp.Canvas.Brush.Color:= clwhite; bmp.Canvas.Rectangle(1,1,bmp.Width,bmp.Height); TextW := bmp.Canvas.TextWidth('測試'); TextH := bmp.Canvas.TextHeight('測試'); NowY := 600; NowX := bmp.Width Div 2; ////////Title/////// PrtList := Getjsonlist(JSONStr,'Title/Content'); for i := 0 to PrtList.Count - 1 do begin TextW := bmp.Canvas.TextWidth(PrtList.Strings[i]); NowX := 300; if UpperCase(Getjsondata(JSONStr,'Title/Align')) = 'CENTER' Then NowX := (bmp.Width Div 2) - (TextW Div 2); bmp.Canvas.TextOut(NowX,NowY,PrtList.Strings[i]); NowY := NowY +TextH+ 20; end; ////////Prefix/////// NowY := NowY + 80; PrtList := Getjsonlist(JSONStr,'Prefix/Content'); for i := 0 to PrtList.Count - 1 do begin TextW := bmp.Canvas.TextWidth(PrtList.Strings[i]); NowX := 300; if UpperCase(Getjsondata(JSONStr,'Prefix/Align')) = 'CENTER' Then NowX := (bmp.Width Div 2) - (TextW Div 2); bmp.Canvas.TextOut(NowX,NowY,PrtList.Strings[i]); NowY := NowY +TextH+ 20; end; ////////Data///////// NowY := NowY + 80; ItemList := GetJsonObjList(JSONStr,'Data/Content'); for i := 0 to ItemList.Count - 1 do begin NowX := 300; TextW := bmp.Canvas.TextWidth(ItemList.Strings[i]); if UpperCase(Getjsondata(JSONStr,'Data/Align')) = 'CENTER' Then NowX := (bmp.Width Div 2) - (TextW Div 2); bmp.Canvas.TextOut(NowX,NowY,ItemList.Strings[i]); NowX := NowX +TextW; PrtList := Getjsonlist(JSONStr,'Data/Content/'+ItemList.Strings[i]); for n := 0 to PrtList.Count - 1 do begin TextW := bmp.Canvas.TextWidth(PrtList.Strings[n]); bmp.Canvas.TextOut(NowX,NowY,PrtList.Strings[n]); NowY := NowY +TextH+ 20; end; end; ///////Memo//////// NowY := NowY + 80; PrtList := Getjsonlist(JSONStr,'Memo/Content'); for i := 0 to PrtList.Count - 1 do begin TextW := bmp.Canvas.TextWidth(PrtList.Strings[i]); NowX := 300; if UpperCase(Getjsondata(JSONStr,'Memo/Align')) = 'CENTER' Then NowX := (bmp.Width Div 2) - (TextW Div 2); bmp.Canvas.TextOut(NowX,NowY,PrtList.Strings[i]); NowY := NowY +TextH+ 20; end; ///////Suffix/////// NowY := NowY + 80; PrtList := Getjsonlist(JSONStr,'Suffix/Content'); for i := 0 to PrtList.Count - 1 do begin TextW := bmp.Canvas.TextWidth(PrtList.Strings[i]); NowX := 300; if UpperCase(Getjsondata(JSONStr,'Suffix/Align')) = 'CENTER' Then NowX := (bmp.Width Div 2) - (TextW Div 2); bmp.Canvas.TextOut(NowX,NowY,PrtList.Strings[i]); NowY := NowY +TextH+ 20; end; bmp.SaveToFile(ExtractFilePath(FileName)+'tmp.bmp'); PrintBarcode(ExtractFilePath(FileName)+'tmp.bmp',BarCode,150,150,1600,150); //ISB.Graphic.Canvas.Assign(bmp.Canvas); ISB.LoadFromFile(ExtractFilePath(FileName)+'tmp.bmp' ,1); DeleteFile(ExtractFilePath(FileName)+'tmp.bmp'); ISB1.LoadFromFile(BGFileName,1); Srect := Rect(1,1,ISB.Graphic.Width,ISB.Graphic.Height); DRect := Rect(1,1,ISB1.Graphic.Width,ISB1.Graphic.Height); ISB1.Graphic.Canvas.CopyMode := SRCAND; ISB1.Graphic.Canvas.CopyRect(DRect,ISB.Graphic.Canvas,SRect); ISB1.Graphic.XDotsPerInch:=300; ISB1.Graphic.YDotsPerInch:=300; ISB1.SaveToFile(FileName); //showmessage(ViewPath+'note.bmp'); {ISB.Graphic.XDotsPerInch:=300; ISB.Graphic.YDotsPerInch:=300; ISB.SaveToFile(FileName);} finally bmp.Free; ISB.Free; ISB1.Free; MemoList.Free; PrtList.Free; ItemList.Free; end; end; procedure Watermark(logoBmp:TBitmap;Opacity:Byte;Content:String;Graphic:TDibGraphic); Var WatermarkTransform:TWatermarkTransform; WatermarkImage:TDibGraphic; WatermarkImage1:TDibGraphic; S : String; PW,PH : Integer; x,y : Integer; WH,WW : Integer; destrect,sourRect : Trect; WaterH,WaterW : Integer; begin // Allows user to select a file (the watermark) // Create the graphics specific for the selected extension WatermarkImage1:=TDibGraphic.Create; WatermarkImage:=TDibGraphic.Create; try // Load the watermark WatermarkImage1.Assign(logoBmp); IF (Graphic.Height > Graphic.Width) Then begin WaterW := (Graphic.Width div 3); WaterH := Round( WatermarkImage1.Height * (WaterW / WatermarkImage1.Width)); end Else begin WaterH := (Graphic.Height div 3); WaterW := Round( WatermarkImage1.Width * (WaterH / WatermarkImage1.Height)); end; WatermarkImage.NewImage(WaterW,WaterH+30,ifTrueColor, nil, 0, 0); WatermarkImage.Canvas.Brush.Color := clWhite; WatermarkImage.Canvas.FillRect(Rect(0,0,WatermarkImage.width,WatermarkImage.Height)); // Create the watermark transform sourrect.Left := 0; sourrect.Top := 0; sourrect.Right := WatermarkImage1.Width; sourrect.Bottom := WatermarkImage1.Height; destrect.Left := 0; destrect.Top := 0; destrect.Right := WaterW; destrect.Bottom := WaterH; WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage1.Canvas,sourrect); WH := Graphic.Height div 2; WW := Graphic.Width div 2; WatermarkTransform:=TWatermarkTransform.Create; try // Set the watermark to use WatermarkTransform.Watermark:=WatermarkImage; // Select the position where place the watermark: centered ! WatermarkTransform.Position:=Point(WW -(WatermarkImage.Width div 2), WH -(WatermarkImage.Height div 2)); //WatermarkTransform.Position:=Point((ImageScrollBox.DisplayedGraphic.Width-WatermarkImage.Width) div 2, // (ImageScrollBox.DisplayedGraphic.Height-WatermarkImage.Height) div 2); IF Content <> '' Then begin WatermarkTransform.Watermark.Canvas.Font.Style := [fsBold]; WatermarkTransform.Watermark.Canvas.Font.Size := 36; S := Content; PW := WatermarkTransform.Watermark.Canvas.TextWidth(Content); PH := WatermarkTransform.Watermark.Canvas.TextHeight(Content); WatermarkTransform.Watermark.Canvas.TextOut((WatermarkTransform.Watermark.Width - PW) Div 2,WatermarkTransform.Watermark.Height-PH-10,Content); end; // Set the opacity % WatermarkTransform.Opacity:=Opacity; // Apply the watermark WatermarkTransform.Apply(Graphic); //ImageScrollBox.Redraw(False); //ShowMessage('Watermark applied at image center with 25% opacity !'); finally WatermarkTransform.Free; end; finally WatermarkImage.Free; WatermarkImage1.Free; end; end; procedure Watermark1(Opacity:Byte;Content,Content1:String;Graphic:TDibGraphic); Var WatermarkTransform:TWatermarkTransform; WatermarkImage:TDibGraphic; WatermarkImage1:TDibGraphic; WatermarkImage2:TDibGraphic; destrect,sourRect : Trect; WaterH,WaterW : Integer; Text_H,Text_W : Integer; begin // Allows user to select a file (the watermark) // Create the graphics specific for the selected extension if Content = '' then Exit; WatermarkImage1:=TDibGraphic.Create; WatermarkImage2:=TDibGraphic.Create; WatermarkImage:=TDibGraphic.Create; try // Load the watermark //WatermarkImage1.Assign(logoBmp); Graphic.Canvas.Font.Size := 20; Text_W := Graphic.Canvas.TextWidth(Content)+80; Text_H := Graphic.Canvas.TextHeight(Content); WaterW := Text_W; WaterH := Text_W div 6; WatermarkImage1.NewImage(WaterW,WaterH,ifTrueColor, nil, 0, 0); WatermarkImage1.Canvas.Brush.Color := clWhite; WatermarkImage1.Canvas.FillRect(Rect(0,0,WatermarkImage1.width,WatermarkImage1.Height)); WatermarkImage1.Canvas.Font.Size := 20; WatermarkImage1.Canvas.Font.Style := [fsBold]; WatermarkImage1.Canvas.Font.Name := 'Times New Roman'; WatermarkImage1.Canvas.TextOut(1,WaterH div 2,Content); WatermarkImage1.Canvas.TextOut(1,WaterH div 12,content1); Rotate(WatermarkImage1,330); //轉330度 WatermarkImage2.NewImage(WaterW,WaterH,ifTrueColor, nil, 0, 0); WatermarkImage2.Canvas.Brush.Color := clWhite; WatermarkImage2.Canvas.FillRect(Rect(0,0,WatermarkImage2.width,WatermarkImage2.Height)); WatermarkImage2.Canvas.Font.Size := 20; WatermarkImage2.Canvas.Font.Style := [fsBold]; WatermarkImage2.Canvas.Font.Name := 'Times New Roman'; WatermarkImage2.Canvas.TextOut(1,WaterH div 2,Content); WatermarkImage2.Canvas.TextOut(1,WaterH div 12,content1); Rotate(WatermarkImage2,225); //轉330度 WatermarkImage.NewImage(Graphic.Width,Graphic.Height,ifTrueColor, nil, 0, 0); WatermarkImage.Canvas.Brush.Color := clWhite; WatermarkImage.Canvas.FillRect(Rect(0,0,WatermarkImage.width,WatermarkImage.Height)); // Create the watermark transform sourrect.Left := 0; sourrect.Top := 0; sourrect.Right := WatermarkImage1.Width; sourrect.Bottom := WatermarkImage1.Height; destrect.Left := 0; destrect.Top := 0; destrect.Right := WatermarkImage1.Width; destrect.Bottom := WatermarkImage1.Height; WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage1.Canvas,sourrect); sourrect.Left := 0; sourrect.Top := 0; sourrect.Right := WatermarkImage2.Width; sourrect.Bottom := WatermarkImage2.Height; destrect.Left := 0; destrect.Top := WatermarkImage.Height-(WatermarkImage2.Height * 3 div 2); destrect.Right := WatermarkImage2.Width; destrect.Bottom := WatermarkImage.Height-WatermarkImage2.Height div 2; WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage2.Canvas,sourrect); {destrect.Left := WatermarkImage.Width-WatermarkImage1.Width; destrect.Top := WatermarkImage.Height-WatermarkImage1.Height; destrect.Right := WatermarkImage.Width; destrect.Bottom := WatermarkImage.Height; WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage1.Canvas,sourrect); } WatermarkTransform:=TWatermarkTransform.Create; try // Set the watermark to use WatermarkTransform.Watermark:=WatermarkImage; // Select the position where place the watermark: centered ! WatermarkTransform.Position:=Point(80,80); //WatermarkTransform.Position:=Point((ImageScrollBox.DisplayedGraphic.Width-WatermarkImage.Width) div 2, // (ImageScrollBox.DisplayedGraphic.Height-WatermarkImage.Height) div 2); // Set the opacity % WatermarkTransform.Opacity:=Opacity; // Apply the watermark WatermarkTransform.Apply(Graphic); //ImageScrollBox.Redraw(False); //ShowMessage('Watermark applied at image center with 25% opacity !'); finally WatermarkTransform.Free; end; finally WatermarkImage.Free; WatermarkImage1.Free; WatermarkImage2.Free; end; end; procedure Watermark1_Hong(Opacity:Byte;Content,Content1:String;Graphic:TDibGraphic;ImgH:Integer); Var WatermarkTransform:TWatermarkTransform; WatermarkImage:TDibGraphic; WatermarkImage1:TDibGraphic; WatermarkImage2:TDibGraphic; destrect,sourRect : Trect; WaterH,WaterW : Integer; Text_H,Text_W : Integer; i,pre : Integer; Zoompercent : Single; Water_SP : Integer; Constr : String; begin // Allows user to select a file (the watermark) // Create the graphics specific for the selected extension if Content = '' then Exit; Constr := Content; if length(Content1) > length(Content) then Constr := Content1; //Showmessage(inttostr(ImgH)+#13+inttostr(Graphic.Height)+#13+inttostr(Graphic.XDotsPerInch)); Zoompercent := Graphic.Height/ImgH *100; //Showmessage(floattostr(Zoompercent)); WatermarkImage1:=TDibGraphic.Create; WatermarkImage2:=TDibGraphic.Create; WatermarkImage:=TDibGraphic.Create; try // Load the watermark //WatermarkImage1.Assign(logoBmp); //showmessage(inttostr(Graphic.Width)+#13+inttostr(Graphic.Height)); Graphic.Canvas.Font.Style := [fsBold]; Graphic.Canvas.Font.Name := '標楷體'; Graphic.Canvas.Font.PixelsPerInch := Graphic.XDotsPerInch; Graphic.Canvas.Font.Size := Round(32*(Graphic.XDotsPerInch/300)*Zoompercent/100); {Pre := 16; for i in [36,32,28,26,24,22,20,18,16,14,12,10,8,6] do begin Graphic.Canvas.Font.Size := i; Text_W := Graphic.Canvas.TextWidth(Constr); //Showmessage(inttostr(DGraphic.Canvas.Font.Size)+#13+inttostr(Text_W)+#13+inttostr(DGraphic.Width div 2)); if Text_W > ((Graphic.Width div 3) * 2) then begin Graphic.Canvas.Font.Size := Pre; Break; end; Pre := i; end;} //Showmessage(inttostr(Graphic.Canvas.Font.Size)); Text_W := Graphic.Canvas.TextWidth(Constr)+Round(1.5/2.54*Graphic.XDotsPerInch*Zoompercent/100); //Showmessage(inttostr(Graphic.Canvas.Font.Size)+#13+inttostr(Graphic.Width)+#13+inttostr(Text_W)); While Text_W > Graphic.Width do begin Graphic.Canvas.Font.Size := Graphic.Canvas.Font.Size-1; Text_W := Graphic.Canvas.TextWidth(Constr)+Round(1.5/2.54*Graphic.XDotsPerInch*Zoompercent/100); //Showmessage(inttostr(Graphic.Canvas.Font.Size)+#13+inttostr(Graphic.Width)+#13+inttostr(Text_W)); end; //Showmessage(inttostr(Graphic.Canvas.Font.Size)); Text_H := Graphic.Canvas.TextHeight(Constr); Water_SP := Round(0.4/2.54*Graphic.XDotsPerInch*Zoompercent/100); WaterW := Text_W; WaterH := Text_H*2+Water_SP;// div 6; //Showmessage(inttostr(Text_W)+#13+inttostr(Text_H)+#13+inttostr(WaterH)); WatermarkImage1.NewImage(WaterW,WaterH,ifTrueColor, nil, Graphic.XDotsPerInch,Graphic.YDotsPerInch); WatermarkImage1.Canvas.Brush.Color := clWhite; WatermarkImage1.Canvas.FillRect(Rect(0,0,WatermarkImage1.width,WatermarkImage1.Height)); WatermarkImage1.Canvas.Font.PixelsPerInch := Graphic.XDotsPerInch; WatermarkImage1.Canvas.Font.Size := Graphic.Canvas.Font.Size; WatermarkImage1.Canvas.Font.Style := [fsBold]; WatermarkImage1.Canvas.Font.Name := '標楷體'; WatermarkImage1.Canvas.TextOut(1,1,Content); WatermarkImage1.Canvas.TextOut(1,Text_H div 2+Water_SP,content1); //Showmessage(inttostr(WatermarkImage1.Width)+#13+inttostr(WatermarkImage1.Height)); Rotate(WatermarkImage1,-30); //轉330度 //Showmessage(inttostr(WatermarkImage1.Width)+#13+inttostr(WatermarkImage1.Height)); WatermarkImage2.NewImage(WaterW,WaterH,ifTrueColor, nil, 0, 0); WatermarkImage2.Canvas.Brush.Color := clWhite; WatermarkImage2.Canvas.FillRect(Rect(0,0,WatermarkImage2.width,WatermarkImage2.Height)); WatermarkImage2.Canvas.Font.PixelsPerInch := Graphic.XDotsPerInch; WatermarkImage2.Canvas.Font.Size := Graphic.Canvas.Font.Size; WatermarkImage2.Canvas.Font.Style := [fsBold]; WatermarkImage2.Canvas.Font.Name := '標楷體'; WatermarkImage2.Canvas.TextOut(1,1,Content); WatermarkImage2.Canvas.TextOut(1,Text_H div 2+Water_SP,content1); //WatermarkImage2.Canvas.TextOut(1,WaterH div 2,Content); //WatermarkImage2.Canvas.TextOut(1,WaterH div 12,content1); Rotate(WatermarkImage2,40); //轉330度 WatermarkImage.NewImage(Graphic.Width,Graphic.Height,ifTrueColor, nil, 0, 0); WatermarkImage.Canvas.Brush.Color := clWhite; WatermarkImage.Canvas.FillRect(Rect(0,0,WatermarkImage.width,WatermarkImage.Height)); // Create the watermark transform sourrect.Left := 0; sourrect.Top := 0; sourrect.Right := WatermarkImage1.Width; sourrect.Bottom := WatermarkImage1.Height; //showmessage(inttostr(Zoompercent)+#13+inttostr(Round(1/2.54*Graphic.XDotsPerInch*Zoompercent/100))); destrect.Left := Round(3/2.54*Graphic.XDotsPerInch*Zoompercent/100); destrect.Top := (WatermarkImage.Height Div 4)-(WatermarkImage1.Height div 2); destrect.Right := destrect.Left+WatermarkImage1.Width; destrect.Bottom := destrect.Top + WatermarkImage1.Height; //Showmessage(inttostr(WatermarkImage.Height)+#13+inttostr(destrect.Top)+#13+inttostr(destrect.Bottom)+#13+inttostr(WatermarkImage1.Height)); WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage1.Canvas,sourrect); sourrect.Left := 0; sourrect.Top := 0; sourrect.Right := WatermarkImage2.Width; sourrect.Bottom := WatermarkImage2.Height; destrect.Left := Round(3/2.54*Graphic.XDotsPerInch*Zoompercent/100); destrect.Top := ((WatermarkImage.Height div 4) * 3) -(WatermarkImage2.Height div 2); destrect.Right := destrect.Left+WatermarkImage2.Width; destrect.Bottom := destrect.Top+WatermarkImage2.Height; WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage2.Canvas,sourrect); {destrect.Left := WatermarkImage.Width-WatermarkImage1.Width; destrect.Top := WatermarkImage.Height-WatermarkImage1.Height; destrect.Right := WatermarkImage.Width; destrect.Bottom := WatermarkImage.Height; WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage1.Canvas,sourrect); } WatermarkTransform:=TWatermarkTransform.Create; try // Set the watermark to use WatermarkTransform.Watermark:=WatermarkImage; // Select the position where place the watermark: centered ! WatermarkTransform.Position:=Point(0,0); //WatermarkTransform.Position:=Point((ImageScrollBox.DisplayedDGraphic.Width-WatermarkImage.Width) div 2, // (ImageScrollBox.DisplayedDGraphic.Height-WatermarkImage.Height) div 2); // Set the opacity % WatermarkTransform.Opacity:=Opacity; // Apply the watermark WatermarkTransform.Apply(Graphic); //ImageScrollBox.Redraw(False); //ShowMessage('Watermark applied at image center with 25% opacity !'); finally WatermarkTransform.Free; end; finally WatermarkImage.Free; WatermarkImage1.Free; WatermarkImage2.Free; end; end; procedure Watermark1_Hong_New(Opacity:Byte;Content,Content1:String;Graphic,DisGraphic:TDibGraphic;ImgH:Integer); //自行產生文字330度印在左上右下 Var WatermarkTransform:TWatermarkTransform; WatermarkImage:TDibGraphic; WatermarkImage1:TDibGraphic; WatermarkImage2:TDibGraphic; destrect,sourRect : Trect; WaterH,WaterW : Integer; Text_H,Text_W : Integer; i,pre : Integer; Zoompercent : Single; Water_SP : Integer; Constr : String; begin // Allows user to select a file (the watermark) // Create the graphics specific for the selected extension if Content = '' then Exit; Constr := Content; if length(Content1) > length(Content) then Constr := Content1; //Showmessage(inttostr(ImgH)+#13+inttostr(Graphic.Height)+#13+inttostr(Graphic.XDotsPerInch)); Zoompercent := DisGraphic.Height/ImgH *100; //Showmessage(floattostr(Zoompercent)); WatermarkImage1:=TDibGraphic.Create; WatermarkImage2:=TDibGraphic.Create; WatermarkImage:=TDibGraphic.Create; try // Load the watermark //WatermarkImage1.Assign(logoBmp); //showmessage(inttostr(Graphic.Width)+#13+inttostr(Graphic.Height)); Graphic.Canvas.Font.Style := [fsBold]; Graphic.Canvas.Font.Name := '標楷體'; Graphic.Canvas.Font.PixelsPerInch := Graphic.XDotsPerInch; Graphic.Canvas.Font.Size := 16; {Pre := 16; for i in [36,32,28,26,24,22,20,18,16,14,12,10,8,6] do begin Graphic.Canvas.Font.Size := i; Text_W := Graphic.Canvas.TextWidth(Constr); //Showmessage(inttostr(DGraphic.Canvas.Font.Size)+#13+inttostr(Text_W)+#13+inttostr(DGraphic.Width div 2)); if Text_W > ((Graphic.Width div 3) * 2) then begin Graphic.Canvas.Font.Size := Pre; Break; end; Pre := i; end;} //Showmessage(inttostr(DGraphic.Canvas.Font.Size)); Text_W := Graphic.Canvas.TextWidth(Constr)+Round(1.5/2.54*Graphic.XDotsPerInch); //Showmessage(inttostr(Graphic.Canvas.Font.Size)+#13+inttostr(Graphic.Width)+#13+inttostr(Text_W)); Text_H := Graphic.Canvas.TextHeight(Constr); Water_SP := Round(0.4/2.54*Graphic.XDotsPerInch*Zoompercent/100); WaterW := Text_W; WaterH := Text_H*2+Water_SP;// div 6; //Showmessage(inttostr(Text_W)+#13+inttostr(Text_H)+#13+inttostr(WaterH)); WatermarkImage1.NewImage(WaterW,WaterH,ifTrueColor, nil, Graphic.XDotsPerInch,Graphic.YDotsPerInch); WatermarkImage1.Canvas.Brush.Color := clWhite; WatermarkImage1.Canvas.FillRect(Rect(0,0,WatermarkImage1.width,WatermarkImage1.Height)); WatermarkImage1.Canvas.Font.PixelsPerInch := Graphic.XDotsPerInch; WatermarkImage1.Canvas.Font.Size := Graphic.Canvas.Font.Size; WatermarkImage1.Canvas.Font.Style := [fsBold]; WatermarkImage1.Canvas.Font.Name := '標楷體'; WatermarkImage1.Canvas.TextOut(1,1,Content); WatermarkImage1.Canvas.TextOut(1,Text_H div 2+Water_SP,content1); //Showmessage(inttostr(WatermarkImage1.Width)+#13+inttostr(WatermarkImage1.Height)); Rotate(WatermarkImage1,-30); //轉330度 //Showmessage(inttostr(WatermarkImage1.Width)+#13+inttostr(WatermarkImage1.Height)); WatermarkImage2.NewImage(WaterW,WaterH,ifTrueColor, nil, 0, 0); WatermarkImage2.Canvas.Brush.Color := clWhite; WatermarkImage2.Canvas.FillRect(Rect(0,0,WatermarkImage2.width,WatermarkImage2.Height)); WatermarkImage2.Canvas.Font.PixelsPerInch := Graphic.XDotsPerInch; WatermarkImage2.Canvas.Font.Size := Graphic.Canvas.Font.Size; WatermarkImage2.Canvas.Font.Style := [fsBold]; WatermarkImage2.Canvas.Font.Name := '標楷體'; WatermarkImage2.Canvas.TextOut(1,1,Content); WatermarkImage2.Canvas.TextOut(1,Text_H div 2+Water_SP,content1); //WatermarkImage2.Canvas.TextOut(1,WaterH div 2,Content); //WatermarkImage2.Canvas.TextOut(1,WaterH div 12,content1); Rotate(WatermarkImage2,-150); //轉330度 WatermarkImage.NewImage(DisGraphic.Width,DisGraphic.Height,ifTrueColor, nil, 0, 0); WatermarkImage.Canvas.Brush.Color := clWhite; WatermarkImage.Canvas.FillRect(Rect(0,0,WatermarkImage.width,WatermarkImage.Height)); // Create the watermark transform sourrect.Left := 0; sourrect.Top := 0; sourrect.Right := WatermarkImage1.Width; sourrect.Bottom := WatermarkImage1.Height; //showmessage(inttostr(Zoompercent)+#13+inttostr(Round(1/2.54*Graphic.XDotsPerInch*Zoompercent/100))); destrect.Left := Round(1/2.54*Graphic.XDotsPerInch*Zoompercent/100); destrect.Top := (WatermarkImage.Height Div 4)-(Round(WatermarkImage1.Height*Zoompercent/100) div 2); destrect.Right := destrect.Left+Round(WatermarkImage1.Width*Zoompercent/100); destrect.Bottom := destrect.Top + Round(WatermarkImage1.Height*Zoompercent/100); //Showmessage(inttostr(WatermarkImage.Height)+#13+inttostr(destrect.Top)+#13+inttostr(destrect.Bottom)+#13+inttostr(WatermarkImage1.Height)); WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage1.Canvas,sourrect); sourrect.Left := 0; sourrect.Top := 0; sourrect.Right := WatermarkImage2.Width; sourrect.Bottom := WatermarkImage2.Height; destrect.Left := Round(1/2.54*Graphic.XDotsPerInch*Zoompercent/100); destrect.Top := ((WatermarkImage.Height div 4) * 3) -(Round(WatermarkImage2.Height*Zoompercent/100) div 2); destrect.Right := destrect.Left+Round(WatermarkImage2.Width*Zoompercent/100); destrect.Bottom := destrect.Top+Round(WatermarkImage2.Height*Zoompercent/100); WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage2.Canvas,sourrect); {destrect.Left := WatermarkImage.Width-WatermarkImage1.Width; destrect.Top := WatermarkImage.Height-WatermarkImage1.Height; destrect.Right := WatermarkImage.Width; destrect.Bottom := WatermarkImage.Height; WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage1.Canvas,sourrect); } WatermarkTransform:=TWatermarkTransform.Create; try // Set the watermark to use WatermarkTransform.Watermark:=WatermarkImage; // Select the position where place the watermark: centered ! WatermarkTransform.Position:=Point(0,0); //WatermarkTransform.Position:=Point((ImageScrollBox.DisplayedDGraphic.Width-WatermarkImage.Width) div 2, // (ImageScrollBox.DisplayedDGraphic.Height-WatermarkImage.Height) div 2); // Set the opacity % WatermarkTransform.Opacity:=Opacity; // Apply the watermark WatermarkTransform.Apply(DisGraphic); //ImageScrollBox.Redraw(False); //ShowMessage('Watermark applied at image center with 25% opacity !'); finally WatermarkTransform.Free; end; finally WatermarkImage.Free; WatermarkImage1.Free; WatermarkImage2.Free; end; end; procedure Watermark2(logoBmp:TBitmap;Opacity:Byte;Content:String;Graphic:TDibGraphic); Var WatermarkTransform:TWatermarkTransform; WatermarkImage:TDibGraphic; WatermarkImage1:TDibGraphic; S : String; PW,PH : Integer; x,y : Integer; WH,WW : Integer; destrect,sourRect : Trect; WaterH,WaterW : Integer; begin // Allows user to select a file (the watermark) // Create the graphics specific for the selected extension WatermarkImage1:=TDibGraphic.Create; WatermarkImage:=TDibGraphic.Create; try // Load the watermark WatermarkImage1.Assign(logoBmp); IF (Graphic.Height > Graphic.Width) Then begin WaterW := Round((1.2 / 2.54) * Graphic.XDotsPerInch); WaterH := Round((5 / 2.54) * Graphic.XDotsPerInch); //WaterW := (Graphic.Width div 18); //WaterH := Round( WatermarkImage1.Height * (WaterW / WatermarkImage1.Width)); end Else begin WaterW := Round((1.2 / 2.54) * Graphic.XDotsPerInch); WaterH := Round((5 / 2.54) * Graphic.XDotsPerInch); //WaterH := (Graphic.Height div 18); //WaterW := Round( WatermarkImage1.Width * (WaterH / WatermarkImage1.Height)); end; WatermarkImage.NewImage(WaterW,WaterH+30,ifTrueColor, nil, 0, 0); WatermarkImage.Canvas.Brush.Color := clWhite; WatermarkImage.Canvas.FillRect(Rect(0,0,WatermarkImage.width,WatermarkImage.Height)); // Create the watermark transform sourrect.Left := 0; sourrect.Top := 0; sourrect.Right := WatermarkImage1.Width; sourrect.Bottom := WatermarkImage1.Height; destrect.Left := 0; destrect.Top := 0; destrect.Right := WaterW; destrect.Bottom := WaterH; WatermarkImage.Canvas.CopyRect(destrect,WatermarkImage1.Canvas,sourrect); WH := Graphic.Height div 2; WW := Graphic.Width div 2; WatermarkTransform:=TWatermarkTransform.Create; try // Set the watermark to use WatermarkTransform.Watermark:=WatermarkImage; // Select the position where place the watermark: centered ! {WatermarkTransform.Position:=Point(WW -(WatermarkImage.Width div 2), WH -(WatermarkImage.Height div 2));} WatermarkTransform.Position:=Point(20,20); //WatermarkTransform.Position:=Point((ImageScrollBox.DisplayedGraphic.Width-WatermarkImage.Width) div 2, // (ImageScrollBox.DisplayedGraphic.Height-WatermarkImage.Height) div 2); IF Content <> '' Then begin WatermarkTransform.Watermark.Canvas.Font.Style := [fsBold]; WatermarkTransform.Watermark.Canvas.Font.Size := 36; S := Content; PW := WatermarkTransform.Watermark.Canvas.TextWidth(Content); PH := WatermarkTransform.Watermark.Canvas.TextHeight(Content); WatermarkTransform.Watermark.Canvas.TextOut((WatermarkTransform.Watermark.Width - PW) Div 2,WatermarkTransform.Watermark.Height-PH-10,Content); end; // Set the opacity % WatermarkTransform.Opacity:=Opacity; // Apply the watermark WatermarkTransform.Apply(Graphic); //ImageScrollBox.Redraw(False); //ShowMessage('Watermark applied at image center with 25% opacity !'); finally WatermarkTransform.Free; end; finally WatermarkImage.Free; WatermarkImage1.Free; end; end; Procedure FindPoint(Graphic:TDibGraphic;Var UpPointL,UpPointR,DownPointL:TPoint;Var FormWidth,FormHeight:Integer;Anchor:String); var XDpi,YDpi : Integer; XLen,XLen1,YLen : Integer; LSeg,RSeg : Integer; compsize : Integer; begin XDpi := Graphic.XDotsPerInch; YDpi := Graphic.YDotsPerInch; XLen := Round(1 * XDpi); XLen1 := Round(4 * XDpi); YLen := Round(1 * XDpi); LSeg := 1;//Round(0.1 / 2.54 * XDpi); RSeg := 1; compsize := Round(0.15/2.54 * XDpi); //要找定位的長度 if Anchor <> 'NONE' then begin UpPointL := Checked_Start(Graphic,LSeg,LSeg,XLen,YLen ,compsize,1,Anchor); IF ((UpPointL.X=0) and (UpPointL.Y=0)) Then UpPointL := Checked_Start(Graphic,LSeg,LSeg,XLen1,YLen ,compsize,1,Anchor); DownPointL := Checked_Start(Graphic,Lseg,Graphic.Height- Lseg,XLen,Graphic.Height-YLen ,compsize,2,Anchor); //ToY必須>=compsize IF ((DownPointL.X=0) and (DownPointL.Y=Graphic.Height)) Then begin DownPointL := Checked_Start(Graphic,Lseg,Graphic.Height- Lseg,XLen1,Graphic.Height-YLen ,compsize,2,Anchor); end; UpPointR := Checked_Start(Graphic,Graphic.Width - Rseg,Rseg,Graphic.Width-XLen,YLen ,compsize,3,Anchor); //FromX必須>=compsize FormWidth := UpPointR.X - UpPointL.X; FormHeight := DownPointL.Y - UpPointL.Y; end Else begin UpPointL.X := 0; UpPointL.Y := 0; FormWidth := Graphic.Width; FormHeight := Graphic.Height; end; {IF ((UpPointR.X=ImageScrollBox1.Graphic.Width)and(UpPointR.Y=0)) Then UpPointR := Checked_Start(ISB_BW.Graphic,ImageScrollBox1.Graphic.Width - Rseg,Rseg,ImageScrollBox1.Graphic.Width-XLen1,YLen ,compsize,3,AnchorMode); //FromX必須>=compsize } //DownPointR := Checked_Start(ISB_BW.Graphic,ImageScrollBox1.Graphic.Width -Rseg,ImageScrollBox1.Graphic.Height- Rseg,ImageScrollBox1.Graphic.Width-XLen ,ImageScrollBox1.Graphic.Height-YLen ,compsize,4,AnchorMode); //FromX必須>=compsize end; Procedure FindPoint(Graphic:TDibGraphic;Var UpPointL,UpPointR,DownPointL:TPoint;Anchor:String);overload; var XDpi,YDpi : Integer; XLen,XLen1,YLen : Integer; LSeg,RSeg : Integer; compsize : Integer; begin XDpi := Graphic.XDotsPerInch; YDpi := Graphic.YDotsPerInch; XLen := Round(1 * XDpi); XLen1 := Round(4 * XDpi); YLen := Round(1 * XDpi); LSeg := 1;//Round(0.1 / 2.54 * XDpi); RSeg := 1; compsize := Round(0.15/2.54 * XDpi); //要找定位的長度 UpPointL := Checked_Start(Graphic,LSeg,LSeg,XLen,YLen ,compsize,1,Anchor); IF ((UpPointL.X=0) and (UpPointL.Y=0)) Then UpPointL := Checked_Start(Graphic,LSeg,LSeg,XLen1,YLen ,compsize,1,Anchor); DownPointL := Checked_Start(Graphic,Lseg,Graphic.Height- Lseg,XLen,Graphic.Height-YLen ,compsize,2,Anchor); //ToY必須>=compsize IF ((DownPointL.X=0) and (DownPointL.Y=Graphic.Height)) Then begin DownPointL := Checked_Start(Graphic,Lseg,Graphic.Height- Lseg,XLen1,Graphic.Height-YLen ,compsize,2,Anchor); end; UpPointR := Checked_Start(Graphic,Graphic.Width - Rseg,Rseg,Graphic.Width-XLen,YLen ,compsize,3,Anchor); //FromX必須>=compsize end; function GetBlackSpots(Graphic:TDibGraphic;L, T, R, B, Ratio: Integer): WideString; var S : TStringlist; i : Integer; begin Result := ''; IF Graphic.ImageFormat = ifBlackWhite Then begin S := TStringlist.Create; try DorwFindRect(Graphic,L,T,R,B,Ratio); for i := 1 to BlackSpotsCount do begin S.Add(Format('%d,%d,%d,%d',[BlackSpots[i].Left,BlackSpots[i].Top,BlackSpots[i].Right,BlackSpots[i].Bottom ])); end; Result := S.Text; Finally S.Free; end; end; end; Procedure FindBlackPoint(Graphic:TDibGraphic;Var BlackPoint:Tpoint); var Seg : Integer; W,H : Integer; BlackSpotList,SiteList : TStringlist; i : Integer; P : TPoint; begin BlackPoint.X := 0; BlackPoint.Y := 0; IF Graphic.ImageFormat = ifBlackWhite Then begin BlackSpotList := TStringlist.Create; SiteList := TStringlist.Create; try Seg := Round(1/2.54*Graphic.XDotsPerInch); //1公分的邊 W := Graphic.Width; H := Graphic.Height; BlackSpotList.Text := GetBlackSpots(Graphic,W-Seg,0,W,H,80); If BlackSpotList.Count > 0 Then begin BlackPoint := Str2Point(BlackSpotList.Strings[0]); end; For i:=1 to BlackSpotList.Count -1 do begin P := Str2Point(BlackSpotList.Strings[i]); If (p.X+p.Y) > (BlackPoint.X +BlackPoint.Y) Then begin BlackPoint := p; end; end; finally BlackSpotList.Free; SiteList.Free; end; end; end; Function Get_OMR(Graphic:TDibGraphic;iRect:Trect):integer; //取點數 var i,n,x,y:integer; begin i:=0; n:=0; for y := iRect.Top to iRect.Bottom -1 do for x := iRect.Left to iRect.Right -1 do begin if Graphic.Canvas.Pixels[x,y] = clBlack Then inc(n); end; result :=n; end; Function GetSelectRect(ISB:TImageScrollBox):TRect; //取出影像上的框選範圍 var Rt: TRect; XDpi,YDpi : single; ct : Integer; begin Result := Rect(0,0,0,0); XDpi:=ISB.Graphic.XDotsPerInch; YDpi:=ISB.Graphic.YDotsPerInch; if ISB.MouseHandler is TRubberBandMouseHandler then begin TRubberBandMouseHandler(ISB.MouseHandler).GetSourceSelection(Rt); Result := Rt; end; end; function GetSelectRect2String(ISB:TImageScrollBox;UpPointL:TPoint): WideString; var rt2: trect; XDpi,YDpi : single; ct : Integer; L,T,R,B : String; begin //IF (X1 = X2) and (Y1 = Y2) Then Exit; XDpi:=ISB.Graphic.XDotsPerInch; YDpi:=ISB.Graphic.YDotsPerInch; if ISB.MouseHandler is TRubberBandMouseHandler then begin TRubberBandMouseHandler(ISB.MouseHandler).GetSourceSelection(rt2); L := Format('%3.2f',[(rt2.Left - UpPointL.X) / Xdpi * 2.54 ]); T := Format('%3.2f',[(rt2.Top - UpPointL.Y) / Xdpi * 2.54]); R := Format('%3.2f',[(rt2.right - UpPointL.X) / Xdpi * 2.54]); B := Format('%3.2f',[(rt2.bottom - UpPointL.Y)/ Xdpi * 2.54]); Result := L+#13+T+#13+R+#13+B; end; end; Procedure SetSelectRect(ISB:TImageScrollBox;iRect:TRect); //顯示出指定的框 var Rt : TRect; XDpi,YDpi : single; XZoom : Single; YZoom : Single; begin XDpi:=ISB.Graphic.XDotsPerInch; YDpi:=ISB.Graphic.YDotsPerInch; rt.Left :=Round(iRect.Left*ISB.ZoomPercent/100); rt.Top :=Round(iRect.Top*ISB.ZoomPercent/100); rt.Right :=Round(iRect.Right*ISB.ZoomPercent/100); rt.Bottom :=Round(iRect.Bottom*ISB.ZoomPercent/100); //20200217 加這段讓運算後可能不到1的變1,才能順利畫出框 if rt.Left = 0 then Rt.Left := 1; if rt.Top = 0 then Rt.Top := 1; if rt.Right = isb.DisplayedGraphic.Width then rt.Right := isb.DisplayedGraphic.Width-1; if rt.Bottom = isb.DisplayedGraphic.Height then rt.Bottom := isb.DisplayedGraphic.Height-1; //20200217 加這段讓運算後可能不到1的變1,才能順利畫出框 if ISB.MouseHandler is TRubberBandMouseHandler then begin TRubberBandMouseHandler(ISB.MouseHandler).setselectrect(rt); end; ISB.HorzScrollBar.Position := rt.Left; ISB.VertScrollBar.Position := rt.Top-20; end; Procedure SetSelectRect_Original(ISB:TImageScrollBox;iRect:TRect); //顯示出指定的框(不縮放) var Rt : TRect; XDpi,YDpi : single; XZoom : Single; YZoom : Single; begin XDpi:=ISB.Graphic.XDotsPerInch; YDpi:=ISB.Graphic.YDotsPerInch; rt.Left :=Round(iRect.Left); rt.Top :=Round(iRect.Top); rt.Right :=Round(iRect.Right); rt.Bottom :=Round(iRect.Bottom); if ISB.MouseHandler is TRubberBandMouseHandler then begin TRubberBandMouseHandler(ISB.MouseHandler).setselectrect(rt); end; ISB.HorzScrollBar.Position := rt.Left; ISB.VertScrollBar.Position := rt.Top-20; end; Function GetSelectRect_Back(ISB:TImageScrollBox):TRect; //取出影像上的框選範圍(從右下回來) var rt2: trect; ct : Integer; L1,T1,R1,B1 : String; begin //IF (X1 = X2) and (Y1 = Y2) Then Exit; Result := Rect(0,0,0,0); if ISB.MouseHandler is TRubberBandMouseHandler then begin TRubberBandMouseHandler(ISB.MouseHandler).GetSourceSelection(rt2); rt2.Left := ISB.Graphic.Width - rt2.Left; rt2.Top := ISB.Graphic.Height - rt2.Top; rt2.Right := ISB.Graphic.Width - rt2.Right; rt2.Bottom := ISB.Graphic.Height - rt2.Bottom; Result := rt2; end; end; function GetSelectRect_Black2String(ISB:TImageScrollBox;BlackPoint:TPoint): WideString; var rt2: trect; XDpi,YDpi : single; ct : Integer; L1,T1,R1,B1 : String; begin //IF (X1 = X2) and (Y1 = Y2) Then Exit; Result := ''; XDpi:=ISB.Graphic.XDotsPerInch; YDpi:=ISB.Graphic.YDotsPerInch; if ISB.MouseHandler is TRubberBandMouseHandler then begin TRubberBandMouseHandler(ISB.MouseHandler).GetSourceSelection(rt2); IF (BlackPoint.X > 0) and (BlackPoint.Y > 0) Then begin L1 := Format('%3.2f',[(BlackPoint.X - rt2.Left) / Xdpi * 2.54 ]); T1 := Format('%3.2f',[(BlackPoint.Y - rt2.Top) / Xdpi * 2.54]); R1 := Format('%3.2f',[(BlackPoint.X - rt2.right) / Xdpi * 2.54]); B1 := Format('%3.2f',[(BlackPoint.Y - rt2.bottom)/ Xdpi * 2.54]); Result := L1+#13+T1+#13+R1+#13+B1; end; end; end; Procedure ShowKeyinRect(ISB:TImageScrollBox;iRect:TRect); //顯示登打位置 var XZoom : Single; YZoom : Single; newZoom : Single; x1,x2,y1,y2 : Integer; theRect : Trect; Bmp : TBitmap; FAnnotationCanvas : TCanvas; i : Integer; begin Therect:= iRect; XZoom := ( (ISB.Width-20)/(Therect.Right - Therect.Left + 1) ) * 100; YZoom := ( (ISB.Height-20)/(Therect.Bottom - Therect.Top + 1+40)) * 100; { limit the zoom value to 1000 % } newZoom := MinFloat(MinFloat(XZoom,100), YZoom) ; //NewZoom := ISB.ZoomPercent; ISB.ZoomPercent := newZoom ; ISB.HorzScrollBar.Position := SafeTrunc(Therect.Left* newZoom /100 ); ISB.VertScrollBar.Position := SafeTrunc((Therect.Top-20) * newZoom /100 ); //加入區域底色 x1 := SafeTrunc(Therect.Left* newZoom /100 )-ISB.HorzScrollBar.Position; x2 := SafeTrunc(Therect.Right* newZoom /100 )-ISB.HorzScrollBar.Position; y1 := SafeTrunc(Therect.Top* newZoom /100 )-ISB.VertScrollBar.Position; y2 := SafeTrunc(Therect.bottom* newZoom /100 )-ISB.VertScrollBar.Position; FAnnotationCanvas := TCanvas.Create; FAnnotationCanvas.Handle := GetDC( ISB.Handle ); FAnnotationCanvas.Pen.Style := psSolid; FAnnotationCanvas.Pen.Color := $00FEFAAD; //&H80000005//65535; FAnnotationCanvas.Pen.Width := 1; FAnnotationCanvas.Pen.Mode := pmMask; { Draw box on screen } for i := y1 to y2 do begin FAnnotationCanvas.MoveTo( x1, i ); FAnnotationCanvas.LineTo( x2, i ); end; ReleaseDC(0,FAnnotationCanvas.Handle); FAnnotationCanvas.Free; end; procedure ImageResize(Graphic:TDibGraphic;DesWidth,DesHeight:Integer); var Transform : TResizeTransform; FUndoGraphic : TDibGraphic; begin FUndoGraphic := TDibGraphic.Create; Transform := TResizeTransform.Create; try Transform.Width := DesWidth; Transform.Height := DesHeight; //Transform.Interpolated := True; //Transform.Filter := ifLanczos3; FUndoGraphic.Assign(Graphic); Transform.ApplyOnDest(FUndoGraphic,Graphic); finally Transform.Free; FUndoGraphic.Free; end; end; Procedure DpiResize(Graphic:TDibGraphic;DesDpi:Integer;CheckDpi:Boolean); //Dpi不足時放大Size Var NewWidth : Integer; NewHeight : Integer; begin if CheckDpi then //CUB 出現Dpi是1 要用這個才不會出現out of resource begin if (Graphic.XDotsPerInch > DesDpi) and (Graphic.YDotsPerInch> DesDpi) then begin NewWidth := Round(Graphic.Width * (DesDpi / Graphic.XDotsPerInch)); NewHeight := Round(Graphic.Height * (DesDpi / Graphic.YDotsPerInch)); Graphic.XDotsPerInch := DesDpi; Graphic.YDotsPerInch := DesDpi; ImageResize(Graphic,NewWidth,NewHeight); end; end Else //永豐傳真一定要用到這一段 begin NewWidth := Round(Graphic.Width * (DesDpi / Graphic.XDotsPerInch)); NewHeight := Round(Graphic.Height * (DesDpi / Graphic.YDotsPerInch)); Graphic.XDotsPerInch := DesDpi; Graphic.YDotsPerInch := DesDpi; ImageResize(Graphic,NewWidth,NewHeight); end; end; Procedure DrawPointLine(ISB:TImageScrollBox;UpPointL,UpPointR,DownPointL:TPoint); //畫十字位置 begin ISB.DisplayedGraphic.Canvas.pen.Color := clGreen; ISB.DisplayedGraphic.Canvas.Font.Size := 16; //左上 ISB.DisplayedGraphic.Canvas.MoveTo(0,0); ISB.DisplayedGraphic.Canvas.LineTo(Round(uppointL.X*ISB.ZoomPercent/100),Round(uppointL.y*ISB.ZoomPercent/100)); //左下 ISB.DisplayedGraphic.Canvas.MoveTo(0,Round(ISB.Graphic.Height*ISB.ZoomPercent/100)); ISB.DisplayedGraphic.Canvas.LineTo(Round(downpointL.X*ISB.ZoomPercent/100),Round(downpointL.y*ISB.ZoomPercent/100)); //右上 ISB.DisplayedGraphic.Canvas.MoveTo(Round(ISB.Graphic.Width*ISB.ZoomPercent/100),0); ISB.DisplayedGraphic.Canvas.LineTo(Round(uppointR.X*ISB.ZoomPercent/100),Round(uppointR.y*ISB.ZoomPercent/100)); //ISB.DisplayedGraphic.Canvas.MoveTo(Round(ImageScrollBox1.Graphic.Width*ImageScrollBox1.ZoomPercent/100),Round(ImageScrollBox1.Graphic.Height*ImageScrollBox1.ZoomPercent/100)); //ISB.DisplayedGraphic.Canvas.LineTo(Round(downpointR.X*ImageScrollBox1.ZoomPercent/100),Round(downpointR.y*ImageScrollBox1.ZoomPercent/100)); end; Procedure Color2BW_RTS(ISB:TImageScrollBox;Para1,Para2,Para3:Integer); //用RTS彩色轉黑白 var bmp:TBitmap; Xdpi,Ydpi : Integer; begin XDpi := ISB.Graphic.XDotsPerInch; YDpi := ISB.Graphic.YDotsPerInch; bmp := TBitmap.Create; try bmp.Assign(ISB.Graphic); BmpGoVrs_Color(bmp,Para1,para2,para3); ISB.Graphic.Assign(bmp); ISB.Graphic.XDotsPerInch := XDpi; ISB.Graphic.YDotsPerInch := YDpi; Finally bmp.Free; end; end; Procedure Color2BW_RTS(ISB:TImageScrollBox;Para1,Para2,Para3:Integer;Part:Trect); Overload; //用RTS彩色轉黑白 var bmp:TBitmap; Xdpi,Ydpi : Integer; begin XDpi := ISB.Graphic.XDotsPerInch; YDpi := ISB.Graphic.YDotsPerInch; bmp := TBitmap.Create; try bmp.Assign(ISB.Graphic); BmpGoVrs_Color(bmp,Para1,para2,para3); ISB.Graphic.Assign(bmp); ISB.Graphic.XDotsPerInch := XDpi; ISB.Graphic.YDotsPerInch := YDpi; Finally bmp.Free; end; end; Procedure Gray2BW_RTS(ISB:TImageScrollBox;Para1,Para2,Para3:Integer); var bmp:TBitmap; Xdpi,Ydpi : Integer; begin XDpi := ISB.Graphic.XDotsPerInch; YDpi := ISB.Graphic.YDotsPerInch; bmp := TBitmap.Create; try if ISB.Graphic.ImageFormat <> ifGray256 then Convertto256Gray(ISB.Graphic); bmp.Assign(ISB.Graphic); //bmp.PixelFormat := pf8bit; //這樣接影像會拿到 24bit if bmp.PixelFormat = pf8bit then BmpGoVrs(bmp,Para1,para2,para3); if bmp.PixelFormat = pf24bit then BmpGoVrs_Color(bmp,Para1,para2,para3); ISB.Graphic.Assign(bmp); ISB.Graphic.XDotsPerInch := XDpi; ISB.Graphic.YDotsPerInch := YDpi; Finally bmp.Free; end; end; Procedure Gray2BW_RTS(ISB:TImageScrollBox;Para1,Para2,Para3:Integer;Part:Trect); Overload; //用RTS灰階轉黑白 var bmp:TBitmap; Xdpi,Ydpi : Integer; begin XDpi := ISB.Graphic.XDotsPerInch; YDpi := ISB.Graphic.YDotsPerInch; bmp := TBitmap.Create; try bmp.Assign(ISB.Graphic); bmp.PixelFormat := pf8bit; BmpGoVrs(bmp,Para1,para2,para3,Part); ISB.Graphic.Assign(bmp); ISB.Graphic.XDotsPerInch := XDpi; ISB.Graphic.YDotsPerInch := YDpi; Finally bmp.Free; end; end; procedure Emboss(ISB:TImageScrollBox); var Transform : TEmbossTransform; FUndoGraphic : TDibGraphic; begin FUndoGraphic := TDibGraphic.Create; FUndoGraphic.Assign(ISB.Graphic); Transform := TEmbossTransform.Create; try Transform.ApplyOnDest(FUndoGraphic, ISB.Graphic); finally Transform.Free; FUndoGraphic.Free; end; //ISB.Redraw(True); end; Procedure BrightnessImg(ISB:TImageScrollBox;Precent:Integer); //調整亮度 var Transform : TBrightnessTransform; FUndoGraphic : TDibGraphic; begin FUndoGraphic := TDibGraphic.Create; FUndoGraphic.Assign(ISB.Graphic); Transform := TBrightnessTransform.Create; try Transform.Percent := Precent; Transform.ApplyOnDest(FUndoGraphic, ISB.Graphic); finally Transform.Free; FUndoGraphic.Free; end; //ImageScrollBox.Redraw(True); end; Procedure ConvertToBW(Graphic : TDibGraphic); //轉成黑白 var Transform : TImageFormatTransform; FUndoGraphic : TDibGraphic; begin Transform := TImageFormatTransform.Create; FUndoGraphic := TDibGraphic.Create; try FUndoGraphic.Assign(Graphic); Transform.ImageFormat := ifBlackWhite; Transform.Quantize := True; Transform.Dither := False; Transform.ApplyOnDest(FUndoGraphic, Graphic); finally Transform.Free; FUndoGraphic.Free; end; end; Procedure ConvertTo256Gray(Graphic : TDibGraphic); //轉成256灰階 var Transform : TImageFormatTransform; FUndoGraphic : TDibGraphic; begin Transform := TImageFormatTransform.Create; FUndoGraphic := TDibGraphic.Create; try FUndoGraphic.Assign(Graphic); Transform.ImageFormat := ifGray256; Transform.Quantize := True; Transform.Dither := False; Transform.ApplyOnDest(FUndoGraphic, Graphic); finally Transform.Free; FUndoGraphic.Free; end; end; Procedure ClearLine(Graphic : TDibGraphic;bt:Integer); //清影像上的線條 Var GraphicA : TTiffGraphic; i:integer; begin GraphicA := TTiffGraphic.create; Try GraphicA.Assign(Graphic); For i:=8 to GraphicA.height-8 do MpsClearLineV(Graphic, GraphicA , i, 1,GraphicA.Width-1,bt ); For i:=8 to GraphicA.Width-8 do MpsClearLineH(Graphic, GraphicA , i, 1,GraphicA.Height-1,bt ); Graphic.Assign(GraphicA); Finally GraphicA.Free; end; end; procedure CropImg(Graphic : TDibGraphic;iRect:TRect); var Transform : TCropTransform; FUndoGraphic : TDibGraphic; begin FUndoGraphic := TDibGraphic.Create; FUndoGraphic.Assign(Graphic); Transform := TCropTransform.Create; Transform.CropMode := cmExtractRect; try Transform.Left := iRect.Left; Transform.Right := iRect.Right; Transform.Top := iRect.Top; Transform.Bottom := iRect.Bottom; Transform.ApplyOnDest(FUndoGraphic, Graphic); finally Transform.Free; FUndoGraphic.Free; end; end; Function GetPosAngle(UpL,DownL,UpR:TPoint):Single; //取二直線夾角角度 var angle1,angle2 : Single; Wseg,Lseg : Integer; begin Wseg := DownL.Y - UpL.Y; Lseg := UpL.X - DownL.X; Angle1 := (Arctan(Lseg/Wseg)*180/pi); Wseg := UpL.Y - UpR.Y; Lseg := UpR.X - UpL.X; Angle2 := (Arctan(Wseg/Lseg)*180/pi); Result := 90 +(Angle1)+(Angle2); end; function CheckSize(ISB:TImageScrollBox;UpL,UpR,DownL:TPoint;DefWidth,DefHeight:String): WideString; //檢查Size並縮放 var NowW,NowH : Integer; DefW,DefH : Integer; SizeW,SizeH : Integer; ReSizeW,ReSizeH : Integer; XDpi,YDpi : Integer; begin Result := ''; XDpi := ISB.Graphic.XDotsPerInch; YDpi := ISB.Graphic.YDotsPerInch; DefW := Round(strtofloat(DefWidth)/2.54*XDpi); DefH := Round(strtofloat(DefHeight)/2.54*XDpi); SizeW := ISB.Graphic.Width; SizeH :=ISB.Graphic.Height; IF (DefW > 0) and (DefH > 0) and ((GetPosAngle(UpL,DownL,UpR) > 89) and (GetPosAngle(UpL,DownL,UpR) < 91)) Then begin NowW := UpR.X - UpL.X; NowH := DownL.Y - UpL.Y; If (NowW <> ISB.Graphic.Width) and (NowH <> ISB.Graphic.Height) and ((NowW <> DefW) or (NowH <> DefH)) then begin ReSizeW := Round(ISB.Graphic.Width * DefW / NowW); ReSizeH := Round(ISB.Graphic.Height * DefH /NowH); ImageResize(ISB.Graphic,ReSizeW,ReSizeH); ISB.Redraw(True); Result := '原長'+inttostr(SizeH)+',原寬'+inttostr(SizeW)+',長變動'+inttostr(ReSizeH)+',寬變動'+inttostr(ReSizeW); end; end; end; Function GetPixBW( srcGraphic : TDibGraphic; x,y:integer ):integer; {******************************************************************************} { 取點的顏色 要用黑白的 } {******************************************************************************} var pSrcByte : ^Byte; srcBit : Byte; begin result := 1; pSrcByte := Addr( srcGraphic.ScanLine[ y ] ^ [ x div 8 ] ); srcBit := $80 shr ( x mod 8 ); result := (pSrcByte^ and srcBit); if result > 0 Then result := 0 else result := 1; end; Procedure BMPConverJpg(Source,SaveFileName:STring); //Bmp轉jpeg var ConvertJpg :TTiffGraphic; BMP : TBitMap ; begin ConvertJpg:=TTiffGraphic.Create; BMP :=TBitmap.Create; try BMP.LoadFromFile(source); ConvertJpg.Assign(BMP); ConvertJpg.Compression := tcNone; ConvertJpg.SaveToFile(SaveFileName); finally convertjpg.Free; Bmp.Free; end; end; Procedure BWTif2Jpg(Graphic:TDibGraphic); //黑白Tif轉彩色jpg var JpgGraphic : TJpegGraphic; FUndoGraphic : TDibGraphic; Transform : TImageFormatTransform; begin JpgGraphic := TJpegGraphic.Create; FUndoGraphic := TDibGraphic.Create; FUndoGraphic.Assign(Graphic); Transform := TImageFormatTransform.Create; try Transform.ImageFormat := ifTrueColor; Transform.ApplyOnDest(FUndoGraphic, Graphic); finally Transform.Free; end; FUndoGraphic.Free; end; Procedure Convert2Jpg(Graphic:TDibGraphic); //黑白Tif轉彩色jpg var FUndoGraphic : TDibGraphic; Transform : TImageFormatTransform; begin FUndoGraphic := TDibGraphic.Create; FUndoGraphic.Assign(Graphic); Transform := TImageFormatTransform.Create; try Transform.ImageFormat := ifTrueColor; Transform.ApplyOnDest(FUndoGraphic, Graphic); finally Transform.Free; end; FUndoGraphic.Free; end; Procedure FieldMask(ISB:TImageScrollBox;SiteList,Mode: WideString;UpPointL:TPoint); //遮罩 Mode:mark mask var i,Dpi : integer; Site_List,SiteStr : TStringlist; L,T,R,B :String; TB,LR : Integer; Ann : String; FixB : integer; begin ISB.AlwaysShowAnnotations:= false; ISB.MouseMode := mmuser; ISB.MouseMode := mmselect; Dpi := ISB.Graphic.XDotsPerInch; FixB := Round(1/2.54*Dpi); Site_List := TStringlist.Create; SiteStr := TStringlist.Create; try Ann := ''; Site_List.Text:=SiteList; For i := 0 to Site_List.Count -1 do begin SiteStr.CommaText := Site_List.Strings[i]; L := inttostr(Round(Strtofloat(SiteStr[0])/2.54*Dpi)+UpPointL.x); T := inttostr(Round(Strtofloat(SiteStr[1])/2.54*Dpi)+UpPointL.y); R := inttostr(Round(Strtofloat(SiteStr[2])/2.54*Dpi)+UpPointL.x); B := inttostr(Round(Strtofloat(SiteStr[3])/2.54*Dpi)+UpPointL.y); TB := strtoint(B) - strtoint(T); LR := strtoint(R) - strtoint(L); If strtoint(L) < 0 then //因為十字損壞,抓不到正確的位置,另外做判斷 begin L := '0'; R := inttostr(LR); end; if strtoint(T) < 0 then begin T := '0'; B := inttostr(TB); end; if strtoint(R) > ISB.Graphic.Width then begin R := inttostr(ISB.Graphic.Width); L := inttostr(ISB.Graphic.Width-LR); end; if strtoint(B) > ISB.Graphic.Height then begin B := inttostr(ISB.Graphic.Height-FixB); T := inttostr(ISB.Graphic.Height-FixB-TB); end; if Mode = 'Mask' then Ann := Ann+'(2)('+L+')('+T+')('+R+')('+B+')(1)($FFFFFF)(0)(1)(4)' Else if Mode = 'Mark' Then Ann := Ann+'(2)('+L+')('+T+')('+R+')('+B+')(1)($00FEFAAD)(1)(1)(4)' end; If Ann <> '' Then Ann := '('+inttostr(Site_List.Count)+')'+Ann; ISB.Annotations := Ann; If Ann <> '' Then ISB.AlwaysShowAnnotations:= true; Finally Site_List.Free; SiteStr.Free; end; end; procedure SaveAnnotation(ISB:TImageScrollBox;FileName: WideString); //遮罩存檔 Var iISB : TImageScrollBox; begin iISB := TImageScrollBox.Create(nil); iISB.Graphic := ISB.Graphic; iISB.Annotations := ISB.Annotations; iISB.AlwaysShowAnnotations := True; iISB.MouseMode := mmAnnotate; iISB.BurnAnnotations; ConvertToBW(iISB.Graphic); iISB.SaveToFile(FileName); iISB.Free; end; Procedure FilterColor(SoISB,DeISB:TImageScrollBox;Ration:Integer); //濾掉顏色 留黑白 var x,y : integer; xrgb : Trgb; begin DeISB.Graphic.NewImage(SoISB.Graphic.Width,SoISB.Graphic.Height,ifTrueColor, SoISB.Graphic.PalettePtr ,SoISB.Graphic.XDotsPerInch,SoISB.Graphic.YDotsPerInch ); For y:= 0 to SoISB.Graphic.Height -1 do for x:=0 to SoISB.Graphic.Width -1 do begin xrgb := SoISB.Graphic.RGB[x,y]; if (xrgb.Red > Ration ) or (xrgb.Green > Ration) or (xrgb.Blue > Ration) then begin xrgb.Red := 255; xrgb.Green := 255; xrgb.Blue := 255; DeISB.Graphic.RGB[x,y] := xrgb; //ImageScrollBox3.Graphic.RGB[x,y] := ImageScrollBox2.Graphic.RGB[x,y]; end {else begin xrgb.Red := 255; xrgb.Green := 255; xrgb.Blue := 255; ImageScrollBox3.Graphic.RGB[x,y] := xrgb; end;} end; DeISB.Redraw(True); end; procedure JpgReSize_Exif(Maxlength,Quality:integer;OldFile,NewFile:String;WaterGraphic:TGraphic;PrintDate:Boolean); //照片縮放包含Exif var ImgData:TImgData; Orig,Smaller:tjpegimage; buffer:tbitmap; IH,IW,TH,TL : Integer; begin IH := 0; if WaterGraphic <> nil then begin IW := 80; IH := Round(WaterGraphic.Height*IW/WaterGraphic.Width); end; TH := IH + 5; TL := 5; Buffer := tbitmap.Create; Orig := tjpegImage.Create; Smaller := tjpegimage.create; ImgData := TimgData.Create; try //Orig.LoadFromFile(ExtractFilepath(ImgData.Filename)+'\222.jpg'); ImgData.BuildList := GenAll; // on by default anyway ImgData.ProcessFile(OldFile); Orig.LoadFromFile(ImgData.Filename); Orig.DIBNeeded; Buffer.PixelFormat := pf24bit; IF (Orig.Width >= Orig.Height) and (Orig.Width > MaxLength) Then begin Buffer.Width := MaxLength; Buffer.Height := Round(Orig.Height * MaxLength / Orig.Width); end Else IF (Orig.Height > Orig.Width) and (Orig.Width > MaxLength) Then begin Buffer.Height := MaxLength; Buffer.Width := Round(Orig.Width * MaxLength / Orig.Height); end Else begin Buffer.Height := Orig.Height; Buffer.Width := Orig.Width; end; // Simple resize Buffer.Canvas.StretchDraw(rect(0,0,Buffer.Width,Buffer.Height),Orig); Buffer.Canvas.CopyMode := SRCAND; if WaterGraphic <> nil then begin WaterGraphic.Transparent := True; Buffer.Canvas.StretchDraw(Rect(0,0,IW,IH),WaterGraphic); end; //image1.Picture.Graphic.Transparent := True; //Buffer.Canvas.StretchDraw(Rect(0,0,IW,IH),image1.Picture.Graphic); IF PrintDate and ImgData.HasExif then begin Buffer.Canvas.Font.Size := 16; Buffer.Canvas.Font.Color := clRed; Buffer.Canvas.Pen.Mode := pmMerge; Buffer.Canvas.Pen.Style := psClear; Buffer.Canvas.Brush.Style := bsClear; Buffer.Canvas.TextOut(TL,TH,imgdata.ExifObj.DateTime); end; Smaller.Assign(Buffer); Smaller.CompressionQuality := Quality; //75; Smaller.Compress; IF ImgData.HasExif then begin imgdata.WriteEXIFJpeg(Smaller,NewFile); end Else begin Smaller.SaveToFile(NewFile); end; finally // Cleanup Buffer.free; Orig.Free; SMaller.Free; ImgData.Free; end; end; Function GetExif_CaptureDateTime(FileName : String):String; //取出檔案裡的Exif拍攝日期 var ImgData:TImgData; begin Result := ''; ImgData := TimgData.Create; try ImgData.BuildList := GenAll; // on by default anyway ImgData.ProcessFile(FileName); if ImgData.HasExif then Result := ImgData.ExifObj.DateTime; finally ImgData.Free; end; end; procedure SetKeyinRect_New( ISB:TImageScrollBox; SiteStr, SiteStr_Black,FormHeight: String; UpPointL,UpPointR:TPoint); var Rt:Trect; XDpi,YDpi : single; x1,y1,x2,y2 : Integer; XZoom : Single; YZoom : Single; newZoom : Single; theRect,ckRect : Trect; Bmp : TBitmap; FAnnotationCanvas : TCanvas; i : Integer; L,T,R,B : String; L1,T1,R1,B1 : String; S,S1 : TStringlist; FormH : Integer; IngronDis : Integer; begin S := TStringlist.Create; S1 := TStringlist.Create; try S.CommaText := Sitestr; L := S.Strings[0]; T := S.Strings[1]; R := S.Strings[2]; B := S.Strings[3]; If SiteStr_Black <> '' Then begin S1.CommaText := SiteStr_Black; L1 := S1.Strings[0]; T1 := S1.Strings[1]; R1 := S1.Strings[2]; B1 := S1.Strings[3]; end; finally S.Free; end; //If ISB.FileName = '' Then Exit; If (ISB.Hint = '') and (ISB.FileName = '') Then Exit; //因玉山影像放在Memory裡需使用 hint 來記檔名 XDpi:=ISB.Graphic.XDotsPerInch; YDpi:=ISB.Graphic.YDotsPerInch; IngronDis := Round(0.8 /2.54 * Xdpi); //內容與十字最少要有的距離 先訂1公分 ISB.Refresh; If FormHeight <> '' Then FormH := Round(strtoFloat(FormHeight)/2.54*Xdpi)+UpPointL.Y Else FormH := 0; //Therect:=Rect(Round(strtoFloat(L)/2.54*Xdpi)+UpPointL.X,Round(strtoFloat(T)/2.54*Xdpi)+UpPointL.Y,Round(strtoFloat(R)/2.54*Xdpi)+UpPointL.X,Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y); //ckRect :=Rect(Round(strtoFloat(L)/2.54*Xdpi)+UpPointL.X-50,Round(strtoFloat(T)/2.54*Xdpi)+UpPointL.Y,Round(strtoFloat(R)/2.54*Xdpi)+UpPointL.X+50,Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y); ckRect :=Rect(UpPointL.X,Round(strtoFloat(T)/2.54*Xdpi)+UpPointL.Y+5,UpPointR.X,Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y); //showmessage(inttostr(ckrect.Left)+#13+inttostr(ckrect.Top)+#13+inttostr(ckrect.Right)+#13+inttostr(ckrect.Bottom)+#13+inttostr(Get_OMR(ckRect,ImageScrollBox1.Graphic))); //IF (BlackPoint.X >0) and (BlackPoint.Y >0) and (SiteStr_Black <>'') and (FormH > 0) and ((Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y+IngronDis >= FormH) or (Get_OMR(ckRect,ImageScrollBox1.Graphic)<100)) {(Round(strtoFloat(T)/2.54*Xdpi) >= (9.3*Xdpi))} Then //begin //Therect:=Rect(BlackPoint.X-Round(strtoFloat(L1)/2.54*Xdpi),BlackPoint.Y -Round(strtoFloat(T1)/2.54*Xdpi),BlackPoint.X-Round(strtoFloat(R1)/2.54*Xdpi),BlackPoint.Y-Round(strtoFloat(B1)/2.54*Xdpi)); //Showmessage(inttostr(BlackPoint.X)+#13+inttostr(BlackPoint.Y)+#13+inttostr(Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y)+'-->'+inttostr(IngronDis)+'-->'+inttostr(FormH)+#13+inttostr(Get_OMR(ckRect,ImageScrollBox1.Graphic))); {end else begin } Therect:=Rect(Round(strtoFloat(L)/2.54*Xdpi)+UpPointL.X,Round(strtoFloat(T)/2.54*Xdpi)+UpPointL.Y,Round(strtoFloat(R)/2.54*Xdpi)+UpPointL.X,Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y); //end; XZoom := ( (ISB.Width-20)/(Therect.Right - Therect.Left + 0.3*XDpi) ) * 100; YZoom := ( (ISB.Height-20)/(Therect.Bottom - Therect.Top + 0.3*YDpi)) * 100; { limit the zoom value to 1000 % } newZoom := MinFloat(MinFloat(XZoom,100), YZoom) ; ISB.ZoomPercent := newZoom ; ISB.HorzScrollBar.Position := SafeTrunc(Therect.Left* newZoom /100 )-SafeTrunc(0.3*XDpi* newZoom /100); ISB.VertScrollBar.Position := SafeTrunc((Therect.Top) * newZoom /100 )-SafeTrunc(0.2*YDpi* newZoom /100); //加入區域底色 x1 := SafeTrunc(Therect.Left* newZoom /100 )-ISB.HorzScrollBar.Position; x2 := SafeTrunc(Therect.Right* newZoom /100 )-ISB.HorzScrollBar.Position; y1 := SafeTrunc(Therect.Top* newZoom /100 )-ISB.VertScrollBar.Position; y2 := SafeTrunc(Therect.bottom* newZoom /100 )-ISB.VertScrollBar.Position; //Application.ProcessMessages; //當元件時不可亂用這個指令 ISB.Refresh; FAnnotationCanvas := TCanvas.Create; FAnnotationCanvas.Handle := GetDC( ISB.Handle ); FAnnotationCanvas.Pen.Style := psSolid; FAnnotationCanvas.Pen.Color := $00FEFAAD; //&H80000005//65535; FAnnotationCanvas.Pen.Width := 1; FAnnotationCanvas.Pen.Mode := pmMask; { Draw box on screen } for i := y1 to y2 do begin FAnnotationCanvas.MoveTo( x1, i ); FAnnotationCanvas.LineTo( x2, i ); end; ReleaseDC(0,FAnnotationCanvas.Handle); FAnnotationCanvas.Free; end; procedure SetKeyinRect_New( ISB:TImageScrollBox; SiteStr, SiteStr_Black,FormHeight: String; UpPointL,UpPointR:TPoint;SP:TShape); overload; var Rt:Trect; XDpi,YDpi : single; x1,y1,x2,y2 : Integer; XZoom : Single; YZoom : Single; newZoom : Single; theRect,ckRect : Trect; Bmp : TBitmap; FAnnotationCanvas : TCanvas; i : Integer; L,T,R,B : String; L1,T1,R1,B1 : String; S,S1 : TStringlist; FormH : Integer; IngronDis : Integer; begin S := TStringlist.Create; S1 := TStringlist.Create; try S.CommaText := Sitestr; L := S.Strings[0]; T := S.Strings[1]; R := S.Strings[2]; B := S.Strings[3]; If SiteStr_Black <> '' Then begin S1.CommaText := SiteStr_Black; L1 := S1.Strings[0]; T1 := S1.Strings[1]; R1 := S1.Strings[2]; B1 := S1.Strings[3]; end; finally S.Free; end; //If ISB.FileName = '' Then Exit; if (ISB.Hint = '') and (ISB.FileName = '') then Exit; //因玉山影像放在Memory裡需使用 hint 來記檔名 XDpi:=ISB.Graphic.XDotsPerInch; YDpi:=ISB.Graphic.YDotsPerInch; IngronDis := Round(0.8 /2.54 * Xdpi); //內容與十字最少要有的距離 先訂1公分 ISB.Refresh; If FormHeight <> '' Then FormH := Round(strtoFloat(FormHeight)/2.54*Xdpi)+UpPointL.Y Else FormH := 0; //Therect:=Rect(Round(strtoFloat(L)/2.54*Xdpi)+UpPointL.X,Round(strtoFloat(T)/2.54*Xdpi)+UpPointL.Y,Round(strtoFloat(R)/2.54*Xdpi)+UpPointL.X,Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y); //ckRect :=Rect(Round(strtoFloat(L)/2.54*Xdpi)+UpPointL.X-50,Round(strtoFloat(T)/2.54*Xdpi)+UpPointL.Y,Round(strtoFloat(R)/2.54*Xdpi)+UpPointL.X+50,Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y); ckRect :=Rect(UpPointL.X,Round(strtoFloat(T)/2.54*Xdpi)+UpPointL.Y+5,UpPointR.X,Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y); //showmessage(inttostr(ckrect.Left)+#13+inttostr(ckrect.Top)+#13+inttostr(ckrect.Right)+#13+inttostr(ckrect.Bottom)+#13+inttostr(Get_OMR(ckRect,ImageScrollBox1.Graphic))); //IF (BlackPoint.X >0) and (BlackPoint.Y >0) and (SiteStr_Black <>'') and (FormH > 0) and ((Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y+IngronDis >= FormH) or (Get_OMR(ckRect,ImageScrollBox1.Graphic)<100)) {(Round(strtoFloat(T)/2.54*Xdpi) >= (9.3*Xdpi))} Then //begin //Therect:=Rect(BlackPoint.X-Round(strtoFloat(L1)/2.54*Xdpi),BlackPoint.Y -Round(strtoFloat(T1)/2.54*Xdpi),BlackPoint.X-Round(strtoFloat(R1)/2.54*Xdpi),BlackPoint.Y-Round(strtoFloat(B1)/2.54*Xdpi)); //Showmessage(inttostr(BlackPoint.X)+#13+inttostr(BlackPoint.Y)+#13+inttostr(Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y)+'-->'+inttostr(IngronDis)+'-->'+inttostr(FormH)+#13+inttostr(Get_OMR(ckRect,ImageScrollBox1.Graphic))); {end else begin } Therect:=Rect(Round(strtoFloat(L)/2.54*Xdpi)+UpPointL.X,Round(strtoFloat(T)/2.54*Xdpi)+UpPointL.Y,Round(strtoFloat(R)/2.54*Xdpi)+UpPointL.X,Round(strtoFloat(B)/2.54*Xdpi)+UpPointL.Y); //end; XZoom := ( (ISB.Width-20)/(Therect.Right - Therect.Left + 0.3*XDpi) ) * 100; YZoom := ( (ISB.Height-20)/(Therect.Bottom - Therect.Top + 0.3*YDpi)) * 100; { limit the zoom value to 1000 % } newZoom := MinFloat(MinFloat(XZoom,100), YZoom) ; ISB.ZoomPercent := newZoom ; if ISB.ZoomPercent < 100 then ISB.AntiAliased := True; ISB.HorzScrollBar.Position := SafeTrunc(Therect.Left* newZoom /100 )-SafeTrunc(0.3*XDpi* newZoom /100); ISB.VertScrollBar.Position := SafeTrunc((Therect.Top) * newZoom /100 )-SafeTrunc(0.2*YDpi* newZoom /100); //加入區域底色 x1 := SafeTrunc(Therect.Left* newZoom /100 )-ISB.HorzScrollBar.Position; x2 := SafeTrunc(Therect.Right* newZoom /100 )-ISB.HorzScrollBar.Position; y1 := SafeTrunc(Therect.Top* newZoom /100 )-ISB.VertScrollBar.Position; y2 := SafeTrunc(Therect.bottom* newZoom /100 )-ISB.VertScrollBar.Position; //Application.ProcessMessages; //當元件時不可亂用這個指令 ISB.Refresh; sp.Brush.Color :=$00FEFAAD; sp.Parent := ISB; sp.Pen.Style := psSolid; sp.Pen.Color := $00FEFAAD; sp.Pen.Width := 1; sp.Pen.Mode := pmMask; sp.Left := x1; sp.Top := y1; sp.Width := x2-x1; sp.Height := y2-y1; {FAnnotationCanvas := TCanvas.Create; FAnnotationCanvas.Handle := GetDC( ISB.Handle ); FAnnotationCanvas.Pen.Style := psSolid; FAnnotationCanvas.Pen.Color := $00FEFAAD; //&H80000005//65535; FAnnotationCanvas.Pen.Width := 1; FAnnotationCanvas.Pen.Mode := pmMask;} { Draw box on screen } {for i := y1 to y2 do begin FAnnotationCanvas.MoveTo( x1, i ); FAnnotationCanvas.LineTo( x2, i ); end; ReleaseDC(0,FAnnotationCanvas.Handle); FAnnotationCanvas.Free; } end; Procedure Image_Smooth(Graphic:TDibGraphic); var Transform : TSmoothTransform; FUndoGraphic : TDibGraphic; begin FUndoGraphic := TDibGraphic.Create; FUndoGraphic.Assign(Graphic); Transform := TSmoothTransform.Create; try Transform.ApplyOnDest(FUndoGraphic,Graphic); finally Transform.Free; FUndoGraphic.Free; end; end; /// FileName 傳入多筆換行字串 procedure PrintImg(FileName, LoginID, Datetime,Path: WideString;WaterBmp:TBitmap); var PrintMode : TEnvisionPrintMode; GraphicPrinter : TDibGraphicPrinter; PrtDialog : TPrintDialog; S : TStringlist; i,Pages,Page : Integer; Prt_String : String; Prt_H : Integer; ISB : TImageScrollBox; procedure PrintWithManualPrintJob(LoginID,DateTime:String;Pages,Page:Integer); begin If Page = 1 Then begin { if UsePrintJob is False, Printer.BeginDoc and Printer.EndDoc must be called by the user. This allows printing multiple images in the same job (or page). } GraphicPrinter.UsePrintJob := False; { if UsePrintJob is False, the print job name that appears in the print manager must be specified in using the Title property of the Printer object. Otherwise, if UsePrintJob is True, the Title property of the TDibGraphicPrinter object is used to specify the job name. } Printer.Title := '影像列印'; end; IF (Page mod 2) = 1 Then Printer.BeginDoc Else Printer.NewPage; ISB.Graphic.Canvas.Font.PixelsPerInch := ISB.Graphic.XDotsPerInch; ISB.Graphic.Canvas.Font.Size := 10; ISB.Graphic.Canvas.TextOut(20,20, 'Print User:'+LoginID+' '+'Date:'+DateTime); GraphicPrinter.Print(ISB.Graphic); { this shows how to print text on a page. Printer.Canvas.TextOut(10,10, 'Envision Image Library'); } If ((Page mod 2) = 0) or (Page = pages) Then Printer.EndDoc; end; procedure PrintWithAutoPrintJob; begin GraphicPrinter.UsePrintJob := True; GraphicPrinter.Title := '影像列印'; GraphicPrinter.Print(ISB.Graphic); end; begin ISB := TImageScrollBox.Create(nil); S := TStringlist.Create; GraphicPrinter := TDibGraphicPrinter.Create; PrtDialog := TPrintDialog.Create(nil); try IF PrtDialog.Execute Then begin S.Text := FileName; Pages := S.Count; for i := 0 to S.Count -1 do begin ISB.LoadFromFile(Path+S.Strings[i],1); if WaterBmp <> nil then watermark2(WaterBmp,70,'',ISB.Graphic); PrintWithManualPrintJob(LoginID,DateTime,Pages,i+1); end; end; Finally ISB.Free; PrtDialog.Free; GraphicPrinter.Free; S.Free; end; end; // Spec_Page :指定分批頁數,傳0則所有影像一次傳送 procedure PrintImg(FileName, LoginID, Datetime,Path: WideString;WaterBmp:TBitmap;Spec_Page:Integer); var PrintMode : TEnvisionPrintMode; GraphicPrinter : TDibGraphicPrinter; PrtDialog : TPrintDialog; S : TStringlist; i,Pages,Page : Integer; Prt_String : String; Prt_H : Integer; ISB : TImageScrollBox; procedure PrintWithManualPrintJob(LoginID,DateTime:String;Pages,Page:Integer); begin If Page = 1 Then begin { if UsePrintJob is False, Printer.BeginDoc and Printer.EndDoc must be called by the user. This allows printing multiple images in the same job (or page). } GraphicPrinter.UsePrintJob := False; { if UsePrintJob is False, the print job name that appears in the print manager must be specified in using the Title property of the Printer object. Otherwise, if UsePrintJob is True, the Title property of the TDibGraphicPrinter object is used to specify the job name. } Printer.Title := '影像列印'; end; IF ((Spec_Page > 0) and ((Page mod Spec_Page) = 1)) or ((Spec_Page=0) and (page=1)) Then Printer.BeginDoc Else Printer.NewPage; ISB.Graphic.Canvas.Font.PixelsPerInch := ISB.Graphic.XDotsPerInch; ISB.Graphic.Canvas.Font.Size := 10; ISB.Graphic.Canvas.TextOut(20,20, 'Print User:'+LoginID+' '+'Date:'+DateTime); GraphicPrinter.Print(ISB.Graphic); { this shows how to print text on a page. Printer.Canvas.TextOut(10,10, 'Envision Image Library'); } If ((Spec_Page > 0) and ((Page mod Spec_Page) = 0)) or (Page = pages) Then Printer.EndDoc; end; procedure PrintWithAutoPrintJob; begin GraphicPrinter.UsePrintJob := True; GraphicPrinter.Title := '影像列印'; GraphicPrinter.Print(ISB.Graphic); end; begin ISB := TImageScrollBox.Create(nil); S := TStringlist.Create; GraphicPrinter := TDibGraphicPrinter.Create; PrtDialog := TPrintDialog.Create(nil); try IF PrtDialog.Execute Then begin S.Text := FileName; Pages := S.Count; for i := 0 to S.Count -1 do begin ISB.LoadFromFile(Path+S.Strings[i],1); if WaterBmp <> nil then watermark2(WaterBmp,70,'',ISB.Graphic); PrintWithManualPrintJob(LoginID,DateTime,Pages,i+1); end; end; Finally ISB.Free; PrtDialog.Free; GraphicPrinter.Free; S.Free; end; end; procedure PrintImg(FileName, LoginID, Datetime,Path: WideString;WaterBmp:TBitmap;Spec_Page:Integer;NeedSetup:Boolean); overload; var PrintMode : TEnvisionPrintMode; GraphicPrinter : TDibGraphicPrinter; PrtDialog : TPrintDialog; S : TStringlist; i,Pages,Page : Integer; Prt_String : String; Prt_H : Integer; ISB : TImageScrollBox; procedure PrintWithManualPrintJob(LoginID,DateTime:String;Pages,Page:Integer); begin If Page = 1 Then begin { if UsePrintJob is False, Printer.BeginDoc and Printer.EndDoc must be called by the user. This allows printing multiple images in the same job (or page). } GraphicPrinter.UsePrintJob := False; { if UsePrintJob is False, the print job name that appears in the print manager must be specified in using the Title property of the Printer object. Otherwise, if UsePrintJob is True, the Title property of the TDibGraphicPrinter object is used to specify the job name. } Printer.Title := '影像列印'; end; IF ((Spec_Page > 0) and ((Page mod Spec_Page) = 1)) or ((Spec_Page=0) and (page=1)) Then Printer.BeginDoc Else Printer.NewPage; ISB.Graphic.Canvas.Font.PixelsPerInch := ISB.Graphic.XDotsPerInch; ISB.Graphic.Canvas.Font.Size := 10; ISB.Graphic.Canvas.TextOut(20,20, 'Print User:'+LoginID+' '+'Date:'+DateTime); GraphicPrinter.Print(ISB.Graphic); { this shows how to print text on a page. Printer.Canvas.TextOut(10,10, 'Envision Image Library'); } If ((Spec_Page > 0) and ((Page mod Spec_Page) = 0)) or (Page = pages) Then Printer.EndDoc; end; procedure PrintWithAutoPrintJob; begin GraphicPrinter.UsePrintJob := True; GraphicPrinter.Title := '影像列印'; GraphicPrinter.Print(ISB.Graphic); end; begin ISB := TImageScrollBox.Create(nil); S := TStringlist.Create; GraphicPrinter := TDibGraphicPrinter.Create; PrtDialog := TPrintDialog.Create(nil); try IF (not NeedSetup) or (NeedSetup and PrtDialog.Execute) Then begin S.Text := FileName; Pages := S.Count; for i := 0 to S.Count -1 do begin ISB.LoadFromFile(Path+S.Strings[i],1); if WaterBmp <> nil then watermark2(WaterBmp,70,'',ISB.Graphic); PrintWithManualPrintJob(LoginID,DateTime,Pages,i+1); end; end; Finally ISB.Free; PrtDialog.Free; GraphicPrinter.Free; S.Free; end; end; Procedure Color2tif(Graphic:TObject;FileName:String); //彩色影像存Tif var TiffGraphic :TTiffGraphic; begin TiffGraphic := TTiffGraphic.Create; try if Graphic is TTiffGraphic then TiffGraphic.Assign(TTiffGraphic(Graphic)) Else if Graphic is TDibGraphic then TiffGraphic.Assign(TDibGraphic(Graphic)) else Showmessage('Format Error'); if TiffGraphic.ImageFormat = ifBlackWhite then begin TiffGraphic.SaveToFile(FileName); end else begin TiffGraphic.Compression := tcJPEG; TiffGraphic.JpegQuality := 30; TiffGraphic.SaveToFile(FileName); end finally TiffGraphic.Free; end; end; end.