⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainwork_ii.pas

📁 Delphi图像盖章程序源码,供大家参考。
💻 PAS
字号:
unit mainwork_II;

interface

uses Controls,Types,Graphics,Jpeg,SysUtils,ExtCtrls,T_course,T_file,DateCn_;

Type TM_type=record//程序用参数
       FileName:string;
      FFileName:string;
      FindLi:integer;
      IJPeg: TJPegImage;
      IBmp: TBitmap;
      DDrawFile:string;
      DDrawId:integer;

      Point_top:TPoint;//预设坐标
      Point_bott:TPoint;//预设坐标
      AllOption:boolean;//使用统一设置
end;

Type TM_InsterAdd = record//pho文件类型
       Iname:string;//文件名
       Itype:integer;//插入类型 0位图 1VDF格式 2字符串 3日期格式
       Ifilename:string;//文件名
       IvfdID:integer;//如果是vfd文件,记录类型号
       Istr:string;//如果是字符串,记录字符串内容,日期不是字符串
       IAddpoint_top:TPoint;//顶部坐标
       IAddpoint_bott:Tpoint;//底部坐标

       mIstrBrushStyle:TBrushStyle;
       mIstrBrushColor:Tcolor;
       mIstrFontName:string;
       mIstrFontSize:integer;
       mIstrFontColor:Tcolor;
       mIstrFontStyle:TFontStyle;

       mIdateformat:string;//日期格式
       mIdatestr:Tdate;
       mIdateType:integer;//日期类型

       SIFileSuf:string;//文件名加后缀
       SIjpgzip:integer;//jpg文件压缩比
end;
{
日期格式说明 用字体的格式
T标示头标
y,m,d表示年月日
c标示加汉字
0阳历 1农历
#表示空格

DateformatToStr('T##y###m##d\0',datetostr(now))
DateformatToStr('y###m##d\1',datetostr(now))
DateformatToStr('yc###mc##d\1',datetostr(now))

}

 function G_Bmptojpeg_fileII(bmpfilename,jpegfilename:string):String;
 procedure G_BMPToJPeg_file(bmpfilename,jpegfilename:string);
 procedure G_JPegToBMP_file(bmpfilename,jpegfilename:string);
 function G_BMPToJPeg(Bmp: TBitmap):TJPegImage;
 function  G_JPegToBMP(JPeg:TJPegImage ):TBitmap;
 procedure G_savejpeg(Bmp: TBitmap;filename:string;zipli:integer);

 procedure G_JpegZip_file(image:Timage;filename,saveFileName:string;zipli:integer);
 function G_JpegZip({image:Timage;}jpgstream:TJPEGImage;zipli:integer):TJPEGImage;

 Procedure G_eddy(bitmap_1,bitmap_2:Tbitmap);

  Function GSave_PHO(filename:string):boolean;
  Function GOpen_PHO(filename:string):boolean;

//c350相机日期格式,传递文件名
 Function Olympus_350(year,filaname:string;feng:char):string;
 function DateformatToStr(dateformat,dateString:string):string;

var M_PHO : TM_InsterAdd;

implementation

function DateformatToStr(dateformat,dateString:string):string;
var i,datali:integer;
    tmp,datestr:string;
begin
try
datali:=strtoint(GShow_title(dateformat,'\',4));
datestr:=dateString;
except datali:=0; end;
if uppercase(dateformat[1]) = uppercase('T')
   then begin
          if datali = 0
            then tmp:='农历'
            else tmp:='公元'
        end
   else tmp:='';

for i:=0 to length(dateformat) do begin
  if uppercase(dateformat[i]) = uppercase('y')
     then case datali of
          //0:tmp:=tmp+CnInttohz(inttofengin(GShow_title(datestr,'-',3),'-'),'-',1)+'年';
          1:begin
             tmp:=tmp+GShow_title(datestr,'-',3);
             if uppercase(dateformat[i+1]) = uppercase('c')
               then tmp:=tmp+'年';
            end;
          end;//case

  if uppercase(dateformat[i]) = uppercase('m')
     then case datali of
          0:tmp:=tmp+CnMonthOfDate(strtodate(dateString));
          1:begin
             tmp:=tmp+GShow_title(GShow_title(datestr,'-',4),'-',3);
          if uppercase(dateformat[i+1]) = uppercase('c')
             then tmp:=tmp+'月';
            end;
          end;//case
  if uppercase(dateformat[i]) = uppercase('d')
     then case datali of
          0:tmp:=tmp+CnDayOfDate(strtodate(dateString));
          1:begin
             tmp:=tmp+GShow_title(datestr,'-',1);
          if uppercase(dateformat[i+1]) = uppercase('c')
             then tmp:=tmp+'日';             
            end;
          end;//case
  if uppercase(dateformat[i]) = uppercase('#')
     then tmp:=tmp+' '
                                  end;
result:=tmp;
end;

Function GInsert(li:integer;tmps:TM_InsterAdd;im:Timage):boolean;
begin
case li of
0:begin
  end;//case o bmp
1:begin
GDraw_spis(im,M_PHO.Ifilename,M_PHO.IvfdID,GFileClass(M_PHO.Ifilename),nil,nil,3,M_PHO.IAddpoint_top.X,M_PHO.IAddpoint_bott.y)
  end;//case 1 vfd
2:begin
  end;//case 2 str
3:begin
  end;//case 3 date
end;
end;

Function GOpen_PHO(filename:string):boolean;
var tmp:string;
begin
try
result:=true;
M_PHO.Iname:=G_Read_IndexINI(filename,'index','iname',0);
tmp:=G_Read_IndexINI(filename,'index','Itype',0);
if tmp<>''
   then M_PHO.Itype:=strtoint(tmp);
M_PHO.Ifilename:=G_Read_IndexINI(filename,'index','Ifilename',0);
tmp:=G_Read_IndexINI(filename,'index','IvfdID',0);
if tmp<>''
   then M_PHO.IvfdID:=strtoint(tmp);
M_PHO.Istr:=G_Read_IndexINI(filename,'index','Istr',0);

M_PHO.IAddpoint_top.x:=strtoint(G_Read_IndexINI(filename,'index','IAddpoint_topx',0));
M_PHO.IAddpoint_top.y:=strtoint(G_Read_IndexINI(filename,'index','IAddpoint_topy',0));
M_PHO.IAddpoint_bott.x:=strtoint(G_Read_IndexINI(filename,'index','IAddpoint_bottx',0));
M_PHO.IAddpoint_bott.y:=strtoint(G_Read_IndexINI(filename,'index','IAddpoint_botty',0));
//G_Read_IndexINI(filename,'index','',0)
M_PHO.mIstrBrushStyle:=strtoBrushStyles(G_Read_IndexINI(filename,'index','mIstrBrushStyle',0));
M_PHO.mIstrBrushColor:=stringtocolor(G_Read_IndexINI(filename,'index','mIstrBrushColor',0));
M_PHO.mIstrFontName:=G_Read_IndexINI(filename,'index','mIstrFontName',0);
tmp:=G_Read_IndexINI(filename,'index','mIstrFontSize',0);
if tmp<>''
   then M_PHO.mIstrFontSize:=strtoint(tmp)
   else M_PHO.mIstrFontSize:=8;

M_PHO.mIstrFontColor:=stringtocolor(G_Read_IndexINI(filename,'index','mIstrFontColor',0));
M_PHO.mIstrFontStyle:=strtoFontStyle(G_Read_IndexINI(filename,'index','mIstrFontStyle',0));
M_PHO.mIdateformat:=G_Read_IndexINI(filename,'index','mIdateformat',0);

tmp:=G_Read_IndexINI(filename,'index','mIdateType',0);
if tmp<>''
   then M_PHO.mIdateType:=strtoint(tmp)
   else M_PHO.mIdateType:=0;
M_PHO.SIFileSuf:=G_Read_IndexINI(filename,'index','SIFileSuf',0);

tmp:=G_Read_IndexINI(filename,'index','SIjpgzip',0);
if tmp<>''
   then M_PHO.mIdateType:=strtoint(tmp)
   else M_PHO.mIdateType:=65;


except result:=false; end;
end;

Function GSave_PHO(filename:string):boolean;
begin
result:=true;
G_Write_IndexINI(filename,'index','NAME,','PHO,',',',1);
 if G_Write_IndexINI(filename,
                     'index',
                     'Iname*Itype*Ifilename*IvfdID*Istr*IAddpoint_topX*IAddpoint_topY*IAddpoint_bottX*IAddpoint_bottY*mIstrBrushStyle*mIstrBrushColor*mIstrFontName*mIstrFontSize*mIstrFontColor*mIstrFontStyle*mIdateformat*mIdateType*SIFileSuf*SIjpgzip*',
                      M_PHO.Iname+'*'+
                      inttostr(M_PHO.Itype)+'*'+
                      M_PHO.Ifilename+'*'+
                      inttostr(M_PHO.IvfdID)+'*'+
                      M_PHO.Istr+'*'+
                      inttostr(M_PHO.IAddpoint_top.x)+'*'+
                      inttostr(M_PHO.IAddpoint_top.y)+'*'+
                      inttostr(M_PHO.IAddpoint_bott.X)+'*'+
                      inttostr(M_PHO.IAddpoint_bott.Y)+'*'+
                      BrushStylestostr(M_PHO.mIstrBrushStyle)+'*'+
                      colortostring(M_PHO.mIstrBrushColor)+'*'+
                      M_PHO.mIstrFontName+'*'+
                      inttostr(M_PHO.mIstrFontSize)+'*'+
                      colortostring(M_PHO.mIstrFontColor)+'*'+
                      FontStyletostr(M_PHO.mIstrFontStyle)+'*'+
                      M_PHO.mIdateformat+'*'+
                      inttostr(M_PHO.mIdateType)+'*'+
                      M_PHO.SIFileSuf+'*'+
                      inttostr(M_PHO.SIjpgzip)+'*'
                      ,'*',18
                     ) = false
     then result:=false;
end;

function G_Bmptojpeg_fileII(bmpfilename,jpegfilename:string):String;
var
  Jpeg:TJpegimage;
  Bitmap:TBitmap;
begin
  result:='';
  try
  Jpeg:=TJpegimage.create;
  Bitmap:=TBitmap.create;
  Bitmap.LoadFromFile(Bmpfilename);
  Jpeg.Assign(Bitmap);
  if trim(jpegfilename)='' then
  begin
       jpegfilename:=copy(Bmpfilename,1,pos('.',Bmpfilename))+'jpg';
  end;
  //jpeg.PixelFormat:=jf8Bit;
  jpeg.SaveToFile(jpegfilename);
  result:=jpegfilename;
  finally
  Bitmap.Free;
  Jpeg.Free;
  end;
end;

function  G_JPegToBMP(JPeg:TJPegImage ):TBitmap;
var Bmp: TBitmap;
begin
//  JPeg := TJPegImage.Create;
//  JPeg.LoadFromFile(jpegfilename);
  Bmp := TBitmap.Create;
  Bmp.Width := JPeg.Width;
  Bmp.Height := JPeg.Height;
  Bmp.Canvas.Draw(0, 0, JPeg);
//  Bmp.SaveToFile(bmpfilename);
result:=Bmp;
//  Bmp.Free;
end;

procedure G_JPegToBMP_file(bmpfilename,jpegfilename:string);
var
  JPeg: TJPegImage;
  Bmp: TBitmap;
begin
  JPeg := TJPegImage.Create;
  JPeg.LoadFromFile(jpegfilename);
  Bmp := TBitmap.Create;
  Bmp.Width := JPeg.Width;
  Bmp.Height := JPeg.Height;
  Bmp.Canvas.Draw(0, 0, JPeg);
  Bmp.SaveToFile(bmpfilename);
  Bmp.Free;
  JPeg.Free;
end;

function G_BMPToJPeg(Bmp: TBitmap):TJPegImage;
var
  JPeg: TJPegImage;
//  Bmp: TBitmap;
begin
//  Bmp := TBitmap.Create;
//  Bmp.LoadFromFile(bmpfilename);
  JPeg := TJPegimage.Create;
  JPeg.Assign(Bmp);
//  JPeg.SaveToFile(jpegfilename);
result:=JPeg;
//  JPeg.Free;
end;

procedure G_savejpeg(Bmp: TBitmap;filename:string;zipli:integer);
var
  JPeg: TJPegImage;
begin
 JPeg := TJPegimage.Create;
 JPeg:=G_BMPToJPeg(Bmp);
 jpeg.CompressionQuality:=zipli;
 jpeg.Compress;
 jpeg.SaveToFile(filename);
 JPeg.Free;
end;

procedure G_BMPToJPeg_file(bmpfilename,jpegfilename:string);
var
  JPeg: TJPegImage;
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile(bmpfilename);
  JPeg := TJPegimage.Create;
  JPeg.Assign(Bmp);
  JPeg.SaveToFile(jpegfilename);
  JPeg.Free;
  Bmp.Free;
end;

function G_JpegZip({image:Timage;}jpgstream:TJPEGImage;zipli:integer):TJPEGImage;
begin
{
  with TJpegImage.Create do
    try
      CompressionQuality:=65;
      Assgin(Image1.Picture.Graphic);
      SaveToFile('c:\demo.jpg');
    finally
      Free;
    end;
end;
}
     //JPG? //uses jpeg
//     jpgstream:= TJPEGImage.Create;
//     jpgstream.LoadFromFile(filename);
//     Image.Picture.Bitmap.Assign(jpgstream);
     //jpgstream.Assign(image1.picture.bitmap);
     jpgstream.CompressionQuality:=zipli;//????
     jpgstream.Compress;
     result:=jpgstream;
//     jpgstream.SaveToFile(saveFileName);
     //jpgstream.SaveToStream(memoryStream);//???JPG?
     //??JPG? image.Picture.Assign(jpgstream);
     jpgstream.free;
end;

procedure G_JpegZip_file(image:Timage;filename,saveFileName:string;zipli:integer);
var jpgstream:TJPEGImage;
begin
{
  with TJpegImage.Create do
    try
      CompressionQuality:=65;
      Assgin(Image1.Picture.Graphic);
      SaveToFile('c:\demo.jpg');
    finally
      Free;
    end;
end;
}
     //JPG? //uses jpeg
     jpgstream:= TJPEGImage.Create;

     jpgstream.LoadFromFile(filename);
     if image <> nil
        then Image.Picture.Bitmap.Assign(jpgstream);
     //jpgstream.Assign(image1.picture.bitmap);
     jpgstream.CompressionQuality:=zipli;//????
     jpgstream.Compress;
     jpgstream.SaveToFile(saveFileName);
     //jpgstream.SaveToStream(memoryStream);//???JPG?
     //??JPG? image.Picture.Assign(jpgstream);
     jpgstream.free;
end;

Procedure G_eddy(bitmap_1,bitmap_2:Tbitmap);
var x,y:integer;
    New,Current:PByteArray;
begin
    bitmap_1.Height := Bitmap_2.Width;
    bitmap_1.Width := Bitmap_2.Height;
    for y := 0 to Bitmap_2.Width - 1 do
        begin
            New := bitmap_1.ScanLine[y];
            for x := 0 to Bitmap_2.Height - 1 do
            begin
              Current := Bitmap_2.ScanLine[x];
              New[x] := Current[y];
            end;
        end;
end;


////////////////////////////////////////////////////////////////////////////////
Function Olympus_350(year,filaname:string;feng:char):string;
var tmp,datastr:string;
begin
//PA080001
filaname:=copy(filaname,2,3); //PA080001  A08

if trim(year) <> ''
   then tmp:=year+feng
   else tmp:=Gshow_title(datetostr(now),'-',3)+feng;

case ord(filaname[1]) of
65,97:tmp:=tmp+'10'+feng;
66,98:tmp:=tmp+'11'+feng;
67,99:tmp:=tmp+'12'+feng;
else tmp:=tmp+filaname[1]+feng;
end;//case

result:=tmp+filaname[2]+filaname[3];
end;


////////////////////////////////////////////////////////////////////////////////

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -