找传奇、传世资源到传世资源站！
Delphi数据库编程 正文
SEO 修复记录

图片裁剪缩小工具

    2 积分
如何获取积分
0赞

8.5玩家评分(1人评分)
下载后可评
介绍 评论 失效链接反馈

【例子介绍】裁剪指定大小图片
【相关图片】from clipboard
【源码结构】unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls,ActiveX,ComObj,ShlObj,FileCtrl, ExtDlgs;
const
  SELDIRHELP = 1000;
type
  TForm1 = class(TForm)
    Image2: TImage;
    Image1: TImage;
    Bevel1: TBevel;
    Panel1: TPanel;
    ButtonExit: TButton;
    Button_OK: TButton;
    GroupBox2: TGroupBox;
    EditCut_W: TEdit;
    EditCut_H: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    ButtonCourceDir0: TButton;
    ListBox1: TListBox;
    Label2: TLabel;
    GroupBox4: TGroupBox;
    Button5: TButton;
    Button3: TButton;
    Button6: TButton;
    Button1: TButton;
    Button4: TButton;
    Button2: TButton;
    GroupBox6: TGroupBox;
    GroupBox5: TGroupBox;
    Label5: TLabel;
    Label6: TLabel;
    EditCutW: TEdit;
    EditCutH: TEdit;
    Button_SETOK: TButton;
    ButtonDirCut: TButton;
    EditCutDir: TEdit;
    Label8: TLabel;
    Label7: TLabel;
    EditEXE: TEdit;
    ButtonEXE: TButton;
    Label9: TLabel;
    EditSourceDir: TEdit;
    Button1dirCource: TButton;
    Button12: TButton;
    Image3: TImage;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    GroupBox7: TGroupBox;
    Image4: TImage;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    LabelVer: TLabel;
    LabelDate: TLabel;
    Memo1: TMemo;
    Button15: TButton;
    Button16: TButton;
    Button17: TButton;
    ListBox2: TListBox;
    Image5: TImage;
    Image6: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button_OKClick(Sender: TObject);
    procedure ButtonExitClick(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button_SETOKClick(Sender: TObject);
    procedure EditCutWExit(Sender: TObject);
    procedure EditCutHExit(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button1dirCourceClick(Sender: TObject);
    procedure ButtonDirCutClick(Sender: TObject);
    procedure ButtonEXEClick(Sender: TObject);
    procedure ButtonCourceDir0Click(Sender: TObject);
    procedure Edit1DblClick(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Button17Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EditCut_WExit(Sender: TObject);
    procedure EditCut_HExit(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
    procedure Image5Click(Sender: TObject);
    procedure Image6Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  CW, CH : integer;     // 原文件宽和高
  W, H : integer;     // 裁剪文件宽和高
  Wstr, Hstr : string;     // 裁剪文件宽和高字符型
  TB,LB,WB,HB : integer; //裁剪框TOP Left W H
  SourceDir :string;           //原图片路径
  CutDir:string;              //剪后图片路径
  EXEDir :string;             //  调用程序目录
  EXEDirFlie00 :string;             //  调用程序目录和文件
  EXE01    :string;               //是否运行EXE
  Cut01    :string;               //是否同名

  F:TextFile;
  SearchRec:TSearchRec;          //显示文件时用
  Found:integer;                 // 显示文件时用
implementation

function Searchfile(path: string; ExtensionName: string): TStringList;   //显示目录文件函数
var
  SearchRec: TSearchRec;
  found: integer;
begin
  Result := TStringList.Create;
  found := FindFirst(path '\' ExtensionName , faAnyFile, SearchRec);
  while found = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') and
      (SearchRec.Attr <> faDirectory) then
      Result.Add(SearchRec.Name);
    found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

function GetApplicationVersion:String;  // Added  取得程序版本号
var FileName:String; 
   InfoSize,Wnd:DWORD; 
   VerBuf:Pointer; 
   VerInfo:^VS_FIXEDFILEINFO; 
 begin 
 Result:='0.0.0.0';
 FileName:=Application.ExeName; 
 InfoSize:=GetFileVersionInfoSize(PChar(FileName),Wnd); 
 if InfoSize<>0 then 
 begin 
   GetMem(VerBuf,InfoSize); 
   try 
     if GetFileVersionInfo(PChar(FileName),Wnd,InfoSize,VerBuf) then
     begin
       VerInfo:=nil;
       VerQueryValue(VerBuf,'\',Pointer(VerInfo),Wnd); 
       if VerInfo<>nil then Result:=Format('%d.%d.%d.%d',[VerInfo^.dwFileVersionMS shr 16,
                                                          VerInfo^.dwFileVersionMS and $0000ffff,
                                                          VerInfo^.dwFileVersionLS shr 16,
                                                          VerInfo^.dwFileVersionLS and  $0000ffff]);
     end; 
   finally
     FreeMem(VerBuf,InfoSize);
   end; 
 end;
 end;

  //获取文件修改时间

function filectime(filename:string):tdatetime;
 var
      vSearchRec:   TSearchRec;
      LocalFileTime:   TFileTime;
      I:   Integer;
  begin   
      if   FindFirst(filename,   faAnyFile,   vSearchRec)   =   0   then

      FileTimeToLocalFileTime(vSearchRec.FindData.ftLastWriteTime,   LocalFileTime);
      FileTimeToDosDateTime(LocalFileTime,   LongRec(I).Hi,   LongRec(I).Lo);
      FindClose(vSearchRec);
      result:=FileDateToDateTime(I);
end;

function ListRenovate(EditDir:string):string;           //列表刷新
begin
  Form1.Edit1.text:=EditDir;
  Form1.ListBox1.Clear;
  Found:=FindFirst(EditDir '\*.JPG',faAnyFile,SearchRec);
  while    Found=0    do
    begin
      if (SearchRec.Name<>'.')  and (SearchRec.Name<>'..')and(SearchRec.Attr<>faDirectory)then
              Form1.ListBox1.Items.Add(SearchRec.Name);Found:=FindNext(SearchRec);
    end;
  FindClose(SearchRec);
end;

function CutPane(PicW,PicH :integer) :integer;           //裁剪框大小及位置
var
  HW , PicHPicW :integer;
begin
  if PicW > PicH then
  begin
    Form1.image1.left:=8;
    Form1.image1.width:= 720;
    Form1.image1.Height:= Form1.image1.width * PicH div PicW ;
    Form1.image1.top:=(Form1.ClientHeight-Form1.image1.Height) div 2 ;
  end else begin
    Form1.image1.top:= 8;
    Form1.image1.Height:= 720;
    Form1.image1.width:= Form1.image1.Height * PicW div PicH  ;
    Form1.image1.left:=(Form1.Clientwidth -Form1.panel1.width-Form1.image1.width) div 2 ;
  end;

    HW:= H div W;
    PicHPicW:= PicH div PicW ;                      // * 1000 div 1000 (PicW > PicH) or (
  if 1 >= 2 then
  begin
    Form1.Bevel1.Height:= Form1.image1.Height - 16 ;
    Form1.Bevel1.Width := Form1.Bevel1.Height * W div H ;
  end else begin
    Form1.Bevel1.Width := Form1.image1.width - 16 ;
    Form1.Bevel1.Height:= Form1.Bevel1.Width * H div W ;
  end;
    Form1.Bevel1.top:=(Form1.ClientHeight -Form1.bevel1.Height) div 2;
    Form1.Bevel1.left:=(Form1.Clientwidth -Form1.panel1.width-Form1.bevel1.width) div 2;
    Form1.label2.Caption := '图片大小：' inttostr(PicW) ' x ' inttostr( PicH) ;
end;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin
Form1.Caption:='图片裁剪器    版本号(Ver):  ' GetApplicationVersion;

    AssignFile(F, 'C:\CutSet.ini');                   //读取其它设置
    Reset(F);
    While Not EOF(F) do
    begin
      Readln(F,WStr);
      Readln(F,HStr);
      Readln(F,SourceDir);
      Readln(F,CutDir);
      Readln(F,Cut01);
      Readln(F,EXEDir);
      Readln(F,EXE01);
    End;
    CloseFile(F);

  EditCut_W.Text:=WStr ;
  EditCut_H.Text:=HStr;
  W:=strtoint(WStr);
  H:=strtoint(HStr);
  CW:= 720;
  CH:= 720 ;
  CutPane(CW,CH);

  if Length(SourceDir)=3 then sourcedir:=Copy(sourcedir,1,2);
  if Length(CutDir)=3 then CutDir:=Copy(CutDir,1,2);

  Edit1.text:=sourcedir ;
  ListBox1.Clear;
  Found:=FindFirst(SourceDir '\*.JPG',faAnyFile,SearchRec);
  while    Found=0    do
    begin
      if (SearchRec.Name<>'.')  and (SearchRec.Name<>'..')and(SearchRec.Attr<>faDirectory)then
              ListBox1.Items.Add(SearchRec.Name);Found:=FindNext(SearchRec);
    end;
  FindClose(SearchRec);

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

  image2.Picture.LoadFromFile( edit1.Text '\' listbox1.Items[listbox1.ItemIndex]);
  CW:= image2.width;
  CH:= image2.Height;
  CutPane(CW,CH);
  image1.Picture.LoadFromFile(edit1.Text '\' listbox1.Items[listbox1.ItemIndex]);
  Button_ok.Enabled :=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Bevel1.Top:=Bevel1.Top-8;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Bevel1.Top:=Bevel1.Top 8;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Bevel1.Left:=Bevel1.Left-8;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Bevel1.Left:=Bevel1.Left 8;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  Bevel1.Height:=Bevel1.Height 8;
  Bevel1.Width:= Bevel1.Height* W div H ;
  Bevel1.top:= Bevel1.top  -4;
  Bevel1.left:= Bevel1.left  -4* W div H;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  Bevel1.Height:=Bevel1.Height-8;
  Bevel1.Width:= Bevel1.Height* w div h ;
  Bevel1.top:= Bevel1.top  4;
  Bevel1.left:= Bevel1.left 4* w div h;
end;

procedure TForm1.Button_OKClick(Sender: TObject);
var
    picOriginal: TPicture;
    Jpg , SrcJpG:  TJpegImage;           // Source
    bmp , CutBMP,CutSizeBMP: TBitmap;     //destination
begin

  LB:=(Bevel1.Left-image1.Left)*CW div image1.Width;
  TB:=(Bevel1.Top-image1.Top)*CH div image1.Height;
  WB:=Bevel1.Width*CW div image1.Width;
  HB:=Bevel1.Height*CH div image1.Height;

  SrcJpg :=   TJpegImage.Create;
  SrcJpg.LoadFromFile(edit1.text '\' listbox1.Items[listbox1.ItemIndex]);
  CutBMP :=   TBitmap.Create;
  CutBMP.Width   :=  WB;
  CutBMP.Height   :=  HB;
  bmp := TBitmap.Create;
  bmp.Assign(Srcjpg);
  CutBMP.Canvas.CopyRect(Rect(0, 0, WB , HB ), bmp.Canvas, Rect(LB,TB,LB WB,TB HB));

  CutSizeBMP := TBitmap.Create;
  if CutBMP.Width > W then
  begin
    CutSizeBMP.Width := W;
    CutSizeBMP.Height := H;
    CutSizeBMP.Canvas.StretchDraw(Rect(0, 0, CutSizeBMP.Width, CutSizeBMP.Height), CutBMP);
  end else begin
    CutSizeBMP.Assign(CutBMP);
  end;
  JPG :=   TJpegImage.Create;
  Jpg.Assign(CutSizeBMP);
  Jpg.SaveToFile(CutDir '\裁剪' listbox1.Items[listbox1.ItemIndex]);

  SrcJpg.Free;
  CutBMP.Free;
  CutSizeBMP.Free;
  Jpg.Free;
  BMP.Free;

  Image2.Picture.LoadFromFile(CutDir '\裁剪' listbox1.Items[listbox1.ItemIndex]);
  image1.Picture.LoadFromFile(CutDir '\裁剪' listbox1.Items[listbox1.ItemIndex]);

  CutPane(image2.width,image2.Height);

  if Cut01='1' then  DeleteFile( Edit1.Text '\' listbox1.Items[listbox1.ItemIndex] );
  ListRenovate(Edit1.text);
  Button_ok.Enabled :=false;
end;

procedure TForm1.ButtonExitClick(Sender: TObject);
begin
if EXE01='1' then WinExec(pChar(EXEDir), SW_SHOW);
Application.Terminate;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
   groupbox7.Visible :=False;
   Image6.Enabled := true;
   Groupbox6.Visible :=true;
   Editcutw.text:= inttostr(w);
   EditcutH.text:=  inttostr(h);
   EditSourceDir.text:= SourceDir ;
   EditCutDir.text:= CutDir  ;
   Checkbox2.Checked :=Boolean(strtoint(Cut01));
   Editexe.text:= EXEDir ;
   Checkbox1.Checked :=Boolean(strtoint(EXE01));
   Groupbox6.left := 32;
   Groupbox6.Top := 170;
   Image5.Enabled := false;
end;

procedure TForm1.Button_SETOKClick(Sender: TObject);

begin

    W := strtoint(Editcutw.text);
    H := strtoint(EditcutH.text);
    Editcut_w.text := Editcutw.text;
    Editcut_H.text := EditcutH.text;
    SourceDir :=EditSourceDir.text;
    Edit1.text :=EditSourceDir.text;
    CutDir :=EditCutDir.text;
    if Checkbox2.Checked=true then  Cut01 :='1';
    if Checkbox2.Checked=false then  Cut01 :='0';
    EXEDir :=EditEXE.text;
    if Checkbox1.Checked=true then  EXE01 :='1';
    if Checkbox1.Checked=false then  EXE01 :='0';

    if Length(SourceDir)=3 then sourcedir:=Copy(sourcedir,1,2);
    if Length(CutDir)=3 then CutDir:=Copy(CutDir,1,2);

    CutPane(CW,CH );

    AssignFile(F,'C:\CUTSET.ini' );
    Rewrite(F);

    writeln(F,Editcutw.text);
    writeln(F,EditcutH.text);
    writeln(F,SourceDir);
    writeln(F,CutDir);
    writeln(F,Cut01);
    writeln(F,EXEdiR);
    writeln(F,EXE01);
    CloseFile(F);
    ListRenovate(Edit1.text);
    Button12.Click;
end;

procedure TForm1.EditCutWExit(Sender: TObject);
begin
  try
    EditcutW.TEXT:=floattostr(abs(strtofloat(EditCutW.TEXT)));
  except
    Application.MessageBox('  [宽] 必须是大于或等于"0"的数。    ',  '错误',MB_ICONERROR);
    EditCutW.TEXT:='1280';
  end;
end;

procedure TForm1.EditCutHExit(Sender: TObject);
begin
  try
    EditcutH.TEXT:=floattostr(abs(strtofloat(EditcutH.TEXT)));
  except
    Application.MessageBox('  [高] 必须是大于或等于"0"的整数。    ',  '错误',MB_ICONERROR);
    Editcuth.TEXT:='720';
  end;
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
groupbox6.Visible :=False;
Image5.Enabled := true;
end;

procedure TForm1.Button1dirCourceClick(Sender: TObject);

begin

  if SelectDirectory(SourceDir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then  EditSourceDir.text:=SourceDir; // Dir返回选择的文件夹

end;

procedure TForm1.ButtonDirCutClick(Sender: TObject);
begin

  if SelectDirectory(CutDir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then  EditCutDir.text:=CutDir;

end;

procedure TForm1.ButtonEXEClick(Sender: TObject);

begin
  if SelectDirectory(EXEDir, [sdPerformCreate],SELDIRHELP) then  EditEXE.text := EXEDir; // Dir返回选择的文件夹
  if Length(EditEXE.text)=3 then EditEXE.text:=Copy(Edit1.text,1,2) ;
  ListBox2.visible:=true;
  ListBox2.Clear;
  Found:=FindFirst(EXEDir '\*.EXE',faAnyFile,SearchRec);
  while    Found=0    do
    begin
      if (SearchRec.Name<>'.')  and (SearchRec.Name<>'..')and(SearchRec.Attr<>faDirectory)then
              ListBox2.Items.Add(SearchRec.Name);Found:=FindNext(SearchRec);
    end;
  FindClose(SearchRec);

end;

procedure TForm1.ButtonCourceDir0Click(Sender: TObject);
var
dir,sStr:string;
jj,ll:   Integer;

begin
  {if SelectDirectory(Dir, [sdPerformCreate],SELDIRHELP) then  Edit1.text := Dir;
  if Length(Edit1.text)=3 then Edit1.text:=Copy(Edit1.text,1,2);
  ListRenovate(Edit1.text);}
  OpenPictureDialog1.Execute;
  dir := PChar(OpenPictureDialog1.FileName);
    ll:=length(dir);
    for jj:=ll downto 2  do
    begin
      sStr:=copy(dir,jj,1);
      if sStr='\' then
      begin
        Dir:=copy(dir,1,jj-1);
        Edit1.text := Dir;
        ListRenovate(Edit1.text);
        exit;
      end;
    end;
  if FileExists(OpenPictureDialog1.FileName) then
  begin
    image2.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    CW:= image2.width;
    CH:= image2.Height;
    CutPane(CW,CH);
    image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    Button_ok.Enabled :=true;
  end;

end;

procedure TForm1.Edit1DblClick(Sender: TObject);
begin
  ListRenovate(Sourcedir) ;
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
    WStr := '1280';
    HStr := '720';
    SourceDir :='C:';
    CutDir :='C:';
    Cut01:='0';
    EXEDir :='-';
    EXE01:='0';

    EditCut_W.Text:=WStr ;
    EditCut_H.Text:=HStr;
    W:=strtoint(WStr);
    H:=strtoint(HStr);

    AssignFile(F,'C:\CUTSET.ini' );
    Rewrite(F);

    writeln(F,Editcutw.text);
    writeln(F,EditcutH.text);
    writeln(F,EditSourceDir.text);
    writeln(F,editCutDir.text);
    writeln(F,Cut01);
    writeln(F,editexe.text);
    writeln(F,EXE01);

    CloseFile(F);

end;

procedure TForm1.Button17Click(Sender: TObject);
var
tmpObject : IUnknown;
tmpSLink : IShellLink;
tmpPFile : IPersistFile;
PIDL : PItemIDList;
StartupDirectory : array[0..MAX_PATH] of Char;
StartupFilename : String;
LinkFilename : WideString;
begin
//创建快捷方式到桌面
StartupFilename :=Application.ExeName;
tmpObject := CreateComObject(CLSID_ShellLink);//创建建立快捷方式的外壳扩展
tmpSLink := tmpObject as IShellLink;//取得接口
tmpPFile := tmpObject as IPersistFile;//用来储存*.lnk文件的接口
tmpSLink.SetPath(pChar(StartupFilename));//设定所在目录
tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename)));//设定工作目录
SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);//获得桌面的Itemidlist
tmpSLink.SetDescription('图片裁剪器，明丰科技出品。');
tmpSLink.SetIconLocation(Pchar(StartupFilename),0);
SHGetPathFromIDList(PIDL,StartupDirectory);//获得桌面目录
LinkFilename := StartupDirectory '\图片裁剪器.lnk';
tmpPFile.Save(pWChar(LinkFilename),FALSE);//保存*.lnk文件
Application.MessageBox(' 桌面快捷方式创建成功！' ,'提示', MB_ICONASTERISK);

end;

procedure TForm1.Button15Click(Sender: TObject);
begin
groupbox7.Visible :=False;
Image6.Enabled := true;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
 groupbox6.Visible :=False;
 Image5.Enabled := true;
 Groupbox7.Visible :=true;
 Groupbox7.left := 100;
 Groupbox7.Top := 170;
 Image6.Enabled := false;
 //LabelYH.Caption := ' 当前用户：' ZHMC;
 LabelVer.Caption := '版本号(Ver):  ' GetApplicationVersion;
 LabelDate.Caption := '生成时间:  ' DateToStr(filectime(ExtractFileDir(ParamStr(0)) '\' ExtractFileName(Application.ExeName))); //  '\yxgl.exe'

end;

procedure TForm1.ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  sText :string;
  R : integer;
   
begin

  if  (Button = mbRight) and (listbox1.ItemIndex > -1) then
  begin
    sText:=  '　您真的要删除图片 [ ' listbox1.Items[listbox1.ItemIndex] ' ] 吗？';
    R:=Application.MessageBox( PChar(sText) ,  '选择提示',MB_YESNO MB_ICONQUESTION MB_DEFBUTTON2);
    if R=6 then
    begin
      DeleteFile( Edit1.Text '\' listbox1.Items[listbox1.ItemIndex] );
      Edit1.text:=sourcedir ;
      ListBox1.Clear;
      Found:=FindFirst(SourceDir '\*.JPG',faAnyFile,SearchRec);
      while    Found=0    do
      begin
        if (SearchRec.Name<>'.')  and (SearchRec.Name<>'..')and(SearchRec.Attr<>faDirectory)then
              ListBox1.Items.Add(SearchRec.Name);Found:=FindNext(SearchRec);
      end;
      FindClose(SearchRec);
    end;
  end;
end;

procedure TForm1.EditCut_WExit(Sender: TObject);
begin
  try
    W:=abs(strtoint(EditCut_W.TEXT));
  except
    Application.MessageBox('  [宽] 必须是大于或等于"0"的整数。    ',  '错误',MB_ICONERROR);
    EditCutW.TEXT:='1280';
    W:=1280;
  end;
  CutPane(CW,CH);
end;

procedure TForm1.EditCut_HExit(Sender: TObject);
begin
  try
    H:=abs(strtoint(EditCut_H.TEXT));
  except
    Application.MessageBox('  [高] 必须是大于或等于"0"的整数。    ',  '错误',MB_ICONERROR);
    EditCutW.TEXT:='720';
    W:=720;
  end;
  CutPane(CW,CH);
end;

procedure TForm1.ListBox2Click(Sender: TObject);
begin
  EditEXE.Text:= EditEXE.Text '\' listbox2.Items[listbox2.ItemIndex];
  ListBox2.visible:=false;
end;

procedure TForm1.Image5Click(Sender: TObject);
begin
   groupbox7.Visible :=False;
   Image6.Enabled := true;
   Groupbox6.Visible :=true;
   Editcutw.text:= inttostr(w);
   EditcutH.text:=  inttostr(h);
   EditSourceDir.text:= SourceDir ;
   EditCutDir.text:= CutDir  ;
   Checkbox2.Checked :=Boolean(strtoint(Cut01));
   Editexe.text:= EXEDir ;
   Checkbox1.Checked :=Boolean(strtoint(EXE01));
   Groupbox6.left := 32;
   Groupbox6.Top := 170;
   Image5.Enabled := false;
end;

procedure TForm1.Image6Click(Sender: TObject);
begin
 groupbox6.Visible :=False;
 Image5.Enabled := true;
 Groupbox7.Visible :=true;
 Groupbox7.left := 100;
 Groupbox7.Top := 170;
 Image6.Enabled := false;
 //LabelYH.Caption := ' 当前用户：' ZHMC;
 LabelVer.Caption := '版本号(Ver):  ' GetApplicationVersion;
 LabelDate.Caption := '生成时间:  ' DateToStr(filectime(ExtractFileDir(ParamStr(0)) '\' ExtractFileName(Application.ExeName)));

end;

end.
.
├── 照片裁剪
│   ├── PictureCut.cfg
│   ├── PictureCut.dof
│   ├── PictureCut.dpr
│   ├── PictureCut.exe
│   ├── PictureCut.res
│   ├── PictureCut.~dpr
│   ├── Unit1.dcu
│   ├── Unit1.ddp
│   ├── Unit1.dfm
│   ├── Unit1.pas
│   ├── Unit1.~ddp
│   ├── Unit1.~dfm
│   ├── Unit1.~pas
│   └── rasadhlp.dll
└── 5t6t网_照片裁剪.zip

1 directory, 15 files

下载图片裁剪缩小工具用户还喜欢

评论

发表评论必须先登陆， 您可以 登陆 或者 注册新账号 !

上传资源 赚取积分
  • 18480 文章数
  • 500万+
     热度

作者专栏

编辑推荐

在线咨询： 问题反馈
客服QQ：174666394

有问题请留言，看到后及时答复

关注公众号领积分