procedure TForm1
delphi实现屏幕截图
delphi实现屏幕截图（1）新建工程，设置主界面form1的BoardStyle为bsNone，FormStyle为fsStayOnTop，WindowState为wsMaximized。
（2）在form1中放置Image1，设置其AutoSize为True。
（3）在form1的OnCreate事件中截取全屏，并将截到的图片放置在image1中。
procedure TForm1.FormCreate(Sender: TObject);varbmp: TBitMap;beginbmp:= TBitMap.Create;GetScreen(bmp);image1.Picture:= TPicture(bmp);end;其中，截取全屏的过程GetScreen(var bmp: TBitMap)定义如下：procedure GetScreen(var bmp: TBitMap); //截取全屏varDC: HDC;MyCanvas: TCanvas;MyRect: TRect;beginDC:= GetWindowDC(0);MyCanvas:= TCanvas.Create;tryMyCanvas.Handle:= DC;MyRect:= Rect(0, 0, Screen.Width, Screen.Height);bmp:= TBitMap.Create;bmp.PixelFormat:= pf24bit;bmp.Width:= MyRect.Right;bmp.Height:= MyRect.Bottom;bmp.Canvas.CopyRect(MyRect, MyCanvas, MyRect);finallyMyCanvas.Handle:= 0;MyCanvas.Free;releaseDC(0, DC);end;end;（4）在image1的OnMouseDown事件里获取区域的初始值，并分别用全局变量pt，Endpt，rect_保存初始点，终止点和区域。
delphi操作系统编程
var
tmp: integer;
begin
tmp := 0;
//屏蔽 Alt-Tab
SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @tmp, 0);
//屏蔽 Ctrl-Alt-Del
{鼠标 属性}
x := winexec('rundll32.exe shell32.dll,Control_RunDLL Main.cpl', 9);
{多媒体 属性-音频}
x := winexec('rundll32.exe shell32.dll,Control_RunDLL Mmsys.cpl,,0', 9);
{显示 属性-屏幕保护程序}
x := winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1', 9);
{显示 属性-外观}
x := winexec('rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2', 9);
更改Windows95的墙纸。
在Delphi中你可以很方便地更改墙纸，请参考以下的程序。
procedureChangeIt;
var
Reg：TregIniFile;
begin
Reg：ΚTRegIniFile．Create（′ControlPanel′）;
{游戏控制器-一般}
x := winexec('rundll32.exe shell32.dll,Control_RunDLL Joy.cpl,,0', 9);
Delphi代码
{$R *.dfm}uses unit2;procedure TForm1.Button1Click(Sender: TObject); beginform2.Show;form1.Hide;end;end.登录界面:{$R *.dfm}uses unit3,unit4,unit5;procedure TForm2.Button1Click(Sender: TObject); beginform3.Show;form2.Hide;end;procedure TForm2.Button2Click(Sender: TObject); beginform4.Show;form2.Hide;end;procedure TForm2.Button3Click(Sender: TObject); beginform5.Show;form2.Hide;end;end.学生登录:{$R *.dfm}uses unit6;varxm:string;procedure TForm3.Button1Click(Sender: TObject);if edit2.text=xm thenform6.Show;form3.Hide;end;procedure TForm3.Edit2Exit(Sender: TObject); beginif edit2.text=xm thenbutton1.SetFocuselsebeginshowmessage('无此学生');edit1.Text:='';edit2.Text:='';edit1.SetFocus;end;end;procedure TForm3.Edit1Exit(Sender: TObject); beginadotable1.Open;if adotable1.Locate('学号',edit1.Text,[]) then beginxm:=adotable1['姓名'];edit2.SetFocus;endelsebeginshowmessage('无此学号的学生');edit1.Text:='';edit1.SetFocus;end;end;procedure TForm3.Button2Click(Sender: TObject); beginclose;end;end.教师登录:{$R *.dfm}uses unit8;varpsw:string;procedure TForm4.Edit1Exit(Sender: TObject); beginadotable1.Open;if adotable1.Locate('教师编号',edit1.Text,[]) then beginpsw:=adotable1['密码'];edit2.SetFocus;endelsebeginshowmessage('无此用户');edit1.Text:='';edit1.SetFocus;end;end;procedure TForm4.Edit2Exit(Sender: TObject); beginif edit2.Text=psw thenbutton1.SetFocuselsebeginshowmessage('密码错误');edit1.Text:='';edit2.Text:='';edit1.SetFocus;end;end;procedure TForm4.Button1Click(Sender: TObject); beginif edit2.text=psw thenform8.Show;form4.Hide;end;procedure TForm4.Button2Click(Sender: TObject); beginclose;end;end.管理员登录:{$R *.dfm}uses unit9;varpsw:string;procedure TForm5.Edit1Exit(Sender: TObject); beginadotable1.Open;if adotable1.Locate('管理员编号',edit1.Text,[]) then beginpsw:=adotable1['密码'];edit2.SetFocus;endelsebeginshowmessage('无此用户');edit1.Text:='';edit1.SetFocus;end;end;procedure TForm5.Edit2Exit(Sender: TObject); beginif edit2.Text=psw thenbutton1.SetFocuselsebeginshowmessage('密码错误');edit1.Text:='';edit2.Text:='';edit1.SetFocus;end;end;procedure TForm5.Button1Click(Sender: TObject); beginif edit2.Text=psw thenform9.Show;form5.hide;end;procedure TForm5.Button2Click(Sender: TObject);beginclose;end;end.学生查询界面:{$R *.dfm}uses unit7;procedure TForm6.Button1Click(Sender: TObject);beginform7.Show;form6.Hide;end;procedure TForm6.Button2Click(Sender: TObject);varstr,str1,str2,str3,str4:string;beginstr:=edit1.Text;str1:=edit2.Text;str2:='select * from 学生信息表where 学号='+''''+str+''' and 姓名='+''''+str1+''''; adoquery1.Close;adoquery1.SQL.Clear;adoquery1.SQL.Add(str2);adoquery1.Open;str3:='select * from 等级考试成绩表where 学号='+''''+str+''' and 姓名='+''''+str1+''''; adoquery3.Close;adoquery3.SQL.Clear;adoquery3.SQL.Add(str3);adoquery3.Open;str4:='select * from 等级考试报名表where 学号='+''''+str+''' and 姓名='+''''+str1+''''; adoquery4.Close;adoquery4.SQL.Clear;adoquery4.SQL.Add(str4);adoquery4.Open;end;procedure TForm6.Button3Click(Sender: TObject); beginclose;end;procedure TForm6.Button4Click(Sender: TObject); beginadoquery1.Active:=false;adoquery1.Active:=true;adoquery2.Active:=false;adoquery2.Active:=true;adoquery3.Active:=false;adoquery3.Active:=true;end;end.等级考试报名界面{$R *.dfm}uses unit6;procedure TForm7.Button1Click(Sender: TObject); beginadotable1.Insert;adotable1['系名']:=edit1.Text;adotable1['班级']:=edit2.Text;adotable1['学号']:=edit3.Text;adotable1['姓名']:=edit4.Text;adotable1['科目号']:=edit5.Text;adotable1.Post;showmessage('报名成功');end;procedure TForm7.Button2Click(Sender: TObject); beginedit1.Text:='';edit2.Text:='';edit3.Text:='';edit4.Text:='';edit5.Text:='';end;procedure TForm7.Button3Click(Sender: TObject); beginform6.Show;form7.Hide;end;end.教师查询界面:{$R *.dfm}procedure TForm8.Button1Click(Sender: TObject);varstr,str1,str2,str3,str4,str5:string;beginstr:=edit1.Text;str1:=edit2.Text;str2:=edit3.Text;str3:=edit4.Text;str4:='select * from 学生信息表where 系名='+''''+str+''' or 班级='+''''+str1+''' or 学号='+''''+str2+''' or 姓名='+''''+str3+'''';adoquery1.Close;adoquery1.SQL.Clear;adoquery1.SQL.Add(str4);adoquery1.Open;str5:='select * from 等级考试成绩表where 系名='+''''+str+''' or 班级='+''''+str1+''' or 学号='+''''+str2+''' or 姓名='+''''+str3+'''';adoquery2.Close;adoquery2.SQL.Clear;adoquery2.SQL.Add(str5);adoquery2.Open;end;procedure TForm8.Button2Click(Sender: TObject);beginedit1.Text:='';edit2.Text:='';edit3.Text:='';edit4.Text:='';end;end.管理员界面:{$R *.dfm}uses unit10,unit11,unit12,unit13;procedure TForm9.Button1Click(Sender: TObject); beginform10.Show;form9.Hide;end;procedure TForm9.Button2Click(Sender: TObject); beginform11.Show;form9.Hide;end;procedure TForm9.Button3Click(Sender: TObject); beginform12.Show;form9.Hide;end;procedure TForm9.Button4Click(Sender: TObject); beginform13.Show;form9.Hide;end;procedure TForm9.Button5Click(Sender: TObject); beginclose;end;end.学生信息维护:{$R *.dfm}uses unit14,unit9;procedure TForm10.Button1Click(Sender: TObject); beginform14.Show;form10.Hide;end;procedure TForm10.Button2Click(Sender: TObject);beginadotable1.Active:=false;adotable1.Active:=true;end;procedure TForm10.Button3Click(Sender: TObject); beginform9.Show;form10.Hide;end;end.科目信息维护:{$R *.dfm}uses unit9,unit15;procedure TForm11.Button1Click(Sender: TObject); beginform15.Show;form11.Hide;end;procedure TForm11.Button2Click(Sender: TObject); beginadotable1.Active:=false;adotable1.Active:=true;end;procedure TForm11.Button3Click(Sender: TObject); beginform9.Show;form11.Hide;end;end.报名信息处理:{$R *.dfm}uses unit16,unit9;procedure TForm12.Button1Click(Sender: TObject); beginform16.Show;form12.Hide;end;procedure TForm12.Button2Click(Sender: TObject); beginadotable1.Active:=false;adotable1.Active:=true;end;procedure TForm12.Button3Click(Sender: TObject); beginform9.Show;form12.Hide;end;end.学生成绩维护:{$R *.dfm}uses unit9,unit17;procedure TForm13.Button1Click(Sender: TObject); beginform17.Show;form13.Hide;end;procedure TForm13.Button2Click(Sender: TObject); beginadotable1.Active:=false;adotable1.Active:=true;end;procedure TForm13.Button3Click(Sender: TObject); beginform9.Show;form13.Hide;end;end.添加学生信息:{$R *.dfm}uses unit10;procedure TForm14.Button1Click(Sender: TObject); beginadotable1.Insert;adotable1['系名']:=edit1.Text;adotable1['班级']:=edit2.Text;adotable1['学号']:=edit3.Text;adotable1['姓名']:=edit4.Text;adotable1['性别']:=edit5.Text;adotable1['身份证号']:=edit6.Text;adotable1['出生日期']:=edit7.Text;adotable1['住址']:=edit8.Text;adotable1.Post;showmessage('添加成功');end;procedure TForm14.Button2Click(Sender: TObject); beginedit1.Text:='';edit2.Text:='';edit3.Text:='';edit4.Text:='';edit5.Text:='';edit6.Text:='';edit7.Text:='';edit8.Text:='';end;procedure TForm14.Button3Click(Sender: TObject); beginform10.Show;form14.Hide;end;end.添加考试科目:{$R *.dfm}uses unit11;procedure TForm15.Button1Click(Sender: TObject);beginadotable1.Insert;adotable1['科目号']:=edit1.Text;adotable1['科目名称']:=edit2.Text;adotable1['考试类型']:=edit3.Text;adotable1['考试语言']:=edit4.Text;adotable1['考试等级']:=edit5.Text;adotable1.Post;showmessage('添加成功');end;procedure TForm15.Button2Click(Sender: TObject); beginedit1.Text:='';edit2.Text:='';edit3.Text:='';edit4.Text:='';edit5.Text:='';end;procedure TForm15.Button3Click(Sender: TObject); beginform11.Show;form15.Hide;end;end.分配准考证号:{$R *.dfm}uses unit12;procedure TForm16.Button1Click(Sender: TObject); beginadotable1.Insert;adotable1['系名']:=edit1.Text;adotable1['班级']:=edit2.Text;adotable1['学号']:=edit3.Text;adotable1['科目号']:=edit4.Text;adotable1['姓名']:=edit5.Text;adotable1['准考证号']:=edit6.Text;adotable1.Post;showmessage('分配成功');end;procedure TForm16.Button2Click(Sender: TObject); beginedit1.Text:='';edit2.Text:='';edit3.Text:='';edit4.Text:='';edit5.Text:='';edit6.Text:='';end;procedure TForm16.Button3Click(Sender: TObject); beginform12.Show;form16.Hide;end;end.整理考试成绩:{$R *.dfm}uses unit13;procedure TForm17.Button1Click(Sender: TObject); beginadotable1.Insert;adotable1['系名']:=edit1.Text;adotable1['班级']:=edit2.Text;adotable1['准考证号']:=edit3.Text;adotable1['学号']:=edit4.Text;adotable1['姓名']:=edit5.Text;adotable1['科目号']:=edit6.Text;adotable1['成绩']:=edit7.Text;adotable1.Post;showmessage('整理成功');end;procedure TForm17.Button2Click(Sender: TObject); beginedit1.Text:='';edit2.Text:='';edit3.Text:='';edit4.Text:='';edit5.Text:='';edit6.Text:='';edit7.Text:='';end;procedure TForm17.Button3Click(Sender: TObject); beginform13.Show;form17.Hide;end;end.。
delphi之多线程编程（一）
delphi之多线程编程（⼀）本⽂的内容取⾃⽹络，并重新加以整理，在此留存仅仅是⽅便⾃⼰学习和查阅。
所有代码均亲⾃测试 delphi7下测试有效。
图⽚均为⾃⼰制作。
多线程应该是编程⼯作者的基础技能, 但这个基础我从来没学过，所以仅仅是看上去会⼀些，明⽩了2+2的时候，其实我还不知道1+1。
开始本应该是⼀篇洋洋洒洒的⽂字, 不过我还是提倡先做起来, 在尝试中去理解.先试试这个:procedure TForm1.Button1Click(Sender: TObject);vari: Integer;beginfor i := 0 to 500000 dobeginCanvas.TextOut(10, 10, IntToStr(i));end;end;上⾯程序运⾏时, 我们的窗体基本是 "死" 的, 可以在你在程序运⾏期间拖动窗体试试...Delphi 为我们提供了⼀个简单的办法(Application.ProcessMessages)来解决这个问题:procedure TForm1.Button1Click(Sender: TObject);vari: Integer;beginfor i := 0 to 500000 dobeginCanvas.TextOut(10, 10, IntToStr(i));Application.ProcessMessages;end;end;这个 Application.ProcessMessages; ⼀般⽤在⽐较费时的循环中, 它会检查并先处理消息队列中的其他消息.但这算不上多线程, 譬如: 运⾏中你拖动窗体, 循环会暂停下来...在使⽤多线程以前, 让我们先简单修改⼀下程序:function MyFun: Integer;vari: Integer;beginfor i := 0 to 500000 dobeginForm1.Canvas.Lock;Form1.Canvas.TextOut(10, 10, IntToStr(i));Form1.Canvas.Unlock;end;Result := 0;end;procedure TForm1.Button1Click(Sender: TObject);beginMyFun;end;细数上⾯程序的变化:1、⾸先这还不是多线程的, 也会让窗体假 "死" ⼀会;2、把执⾏代码写在了⼀个函数⾥, 但这个函数不属于 TForm1 的⽅法, 所以使⽤ Canvas 是必须冠以名称(Form1);3、既然是个函数, (不管是否必要)都应该有返回值;4、使⽤了 500001 次 Lock 和 Unlock.Canvas.Lock 好⽐在说: Canvas(绘图表⾯)正忙着呢, 其他想⽤ Canvas 的等会;Canvas.Unlock : ⽤完了, 解锁!在 Canvas 中使⽤ Lock 和 Unlock 是个好习惯, 在不使⽤多线程的情况下这⽆所谓, 但保不准哪天程序会扩展为多线程的; 我们现在学习多线程, 当然应该⽤.在 Delphi 中使⽤多线程有两种⽅法: 调⽤ API、使⽤ TThread 类; 使⽤ API 的代码更简单.function MyFun(p: Pointer): Integer; stdcall;vari: Integer;beginfor i := 0 to 500000 dobeginForm1.Canvas.Lock;Form1.Canvas.TextOut(10, 10, IntToStr(i));Form1.Canvas.Unlock;end;Result := 0;end;procedure TForm1.Button1Click(Sender: TObject);varID: THandle;beginCreateThread(nil, 0, @MyFun, nil, 0, ID);end;代码分析:CreateThread ⼀个线程后, 算上原来的主线程, 这样程序就有两个线程、是标准的多线程了;CreateThread 第三个参数是函数指针, 新线程建⽴后将⽴即执⾏该函数, 函数执⾏完毕, 系统将销毁此线程从⽽结束多线程的故事. CreateThread 要使⽤的函数是系统级别的, 不能是某个类(譬如: TForm1)的⽅法, 并且有严格的格式(参数、返回值)要求, 不管你暂时是不是需要都必须按格式来;因为是系统级调⽤, 还要缀上 stdcall, stdcall 是协调参数顺序的, 虽然这⾥只有⼀个参数没有顺序可⾔, 但这是使⽤系统函数的惯例. CreateThread 还需要⼀个 var 参数来接受新建线程的 ID, 尽管暂时没⽤, 但这也是格式; 其他参数以后再说吧.这样⼀个最简单的多线程程序就出来了, 咱们再⽤ TThread 类实现⼀次typeTMyThread = class(TThread)protectedprocedure Execute; override;end;procedure TMyThread.Execute;vari: Integer;beginFreeOnTerminate := True; {这可以让线程执⾏完毕后随即释放}for i := 0 to 500000 dobeginForm1.Canvas.Lock;Form1.Canvas.TextOut(10, 10, IntToStr(i));Form1.Canvas.Unlock;end;end;procedure TForm1.Button1Click(Sender: TObject);beginTMyThread.Create(False);end;TThread 类有⼀个抽象⽅法(Execute), 因⽽是个抽象类, 抽象类只能继承使⽤, 上⾯是继承为 TMyThread.继承 TThread 主要就是实现抽象⽅法 Execute(把我们的代码写在⾥⾯), 等我们的 TMyThread 实例化后, ⾸先就会执⾏ Execute ⽅法中的代码.按常规我们⼀般这样去实例化:procedure TForm1.Button1Click(Sender: TObject);varMyThread: TMyThread;beginMyThread := TMyThread.Create(False);end;因为 MyThread 变量在这⾥毫⽆⽤处(并且编译器还有提⽰), 所以不如直接写做 TMyThread.Create(False);我们还可以轻松解决⼀个问题, 如果: TMyThread.Create(True) ?这样线程建⽴后就不会⽴即调⽤ Execute, 可以在需要的时候再⽤ Resume ⽅法执⾏线程, 譬如:procedure TForm1.Button1Click(Sender: TObject);varMyThread: TMyThread;beginMyThread := TMyThread.Create(True);MyThread.Resume;end;//可简化为:procedure TForm1.Button1Click(Sender: TObject);beginwith TMyThread.Create(True) do Resume;end;⼀、⼊门㈠、function CreateThread(lpThreadAttributes: Pointer; {安全设置}dwStackSize: DWORD; {堆栈⼤⼩}lpStartAddress: TFNThreadStartRoutine; {⼊⼝函数}lpParameter: Pointer; {函数参数}dwCreationFlags: DWORD; {启动选项}var lpThreadId: DWORD {输出线程 ID }): THandle; stdcall; {返回线程句柄}在 Windows 上建⽴⼀个线程, 离不开 CreateThread 函数;TThread.Create 就是先调⽤了 BeginThread (Delphi ⾃定义的), BeginThread ⼜调⽤的 CreateThread.既然有建⽴, 就该有释放, CreateThread 对应的释放函数是: ExitThread, 譬如下⾯代码:procedure TForm1.Button1Click(Sender: TObject);beginExitThread(0); {此句即可退出当前程序, 但不建议这样使⽤}end;代码注释:当前程序是⼀个进程, 进程只是⼀个⼯作环境, 线程是⼯作者;每个进程都会有⼀个启动线程(或叫主线程), 也就是说: 我们之前⼤量的编码都是写给这个主线程的;上⾯的 ExitThread(0); 就是退出这个主线程;系统不允许⼀个没有线程的进程存在, 所以程序就退出了.另外: ExitThread 函数的参数是⼀个退出码, 这个退出码是给之后的其他函数⽤的, 这⾥随便给个⽆符号整数即可.或许你会说: 这个 ExitThread 挺好⽤的; 其实不管是⽤ API 还是⽤ TThread 类写多线程, 我们很少⽤到它; 因为:1、假如直接使⽤ API 的 CreateThread, 它执⾏完⼊⼝函数后会⾃动退出, ⽆需 ExitThread;2、⽤ TThread 类建⽴的线程⼜绝不能使⽤ ExitThread 退出; 因为使⽤ TThread 建⽴线程时会同时分配更多资源(譬如你⾃定义的成员、还有它的祖先类(TObject)分配的资源等等), 如果⽤ ExitThread 给草草退出了, 这些资源将得不到释放⽽导致内存泄露. 尽管 Delphi 提供了EndThread(其内部调⽤ ExitThread), 这也不需要我们⼿动操作(假如⾮要⼿动操作也是件很⿇烦的事情, 因为很多时候你不知道线程是什么时候执⾏完毕的).除了 CreateThread, 还有⼀个 CreateRemoteThread, 可在其他进程中建⽴线程, 这不应该是现在学习的重点;现在先集中精⼒把 CreateThread 的参数搞彻底.倒着来吧, 先谈谈 CreateThread 将要返回的 "线程句柄"."句柄" 类似指针, 但通过指针可读写对象, 通过句柄只是使⽤对象;有句柄的对象⼀般都是系统级别的对象(或叫内核对象); 之所以给我们的是句柄⽽不是指针, ⽬的只有⼀个: "安全";貌似通过句柄能做很多事情, 但⼀般把句柄提交到某个函数(⼀般是系统函数)后, 我们也就到此为⽌很难了解更多了; 事实上是系统并不相信我们.不管是指针还是句柄, 都不过是内存中的⼀⼩块数据(⼀般⽤结构描述), 微软并没有公开句柄的结构细节, 猜⼀下它应该包括: 真实的指针地址、访问权限设置、引⽤计数等等.既然 CreateThread 可以返回⼀个句柄, 说明线程属于 "内核对象".实际上不管线程属于哪个进程, 它们在系统的怀抱中是平等的; 在优先级(后⾯详谈)相同的情况下, 系统会在相同的时间间隔内来运⾏⼀下每个线程, 不过这个间隔很⼩很⼩, 以⾄于让我们误以为程序是在不间断地运⾏.这时你应该有⼀个疑问: 系统在去执⾏其他线程的时候, 是怎么记住前⼀个线程的数据状态的?有这样⼀个结构 TContext, 它基本上是⼀个 CPU 寄存器的集合, 线程是数据就是通过这个结构切换的, 我们也可以通过 GetThreadContext 函数读取寄存器看看.附上这个结构 TContext(或叫: CONTEXT、_CONTEXT) 的定义:PContext = ^TContext;_CONTEXT = recordContextFlags: DWORD;Dr0: DWORD;Dr1: DWORD;Dr2: DWORD;Dr3: DWORD;Dr6: DWORD;Dr7: DWORD;FloatSave: TFloatingSaveArea;SegGs: DWORD;SegFs: DWORD;SegEs: DWORD;SegDs: DWORD;Edi: DWORD;Esi: DWORD;Ebx: DWORD;Edx: DWORD;Ecx: DWORD;Eax: DWORD;Ebp: DWORD;Eip: DWORD;SegCs: DWORD;EFlags: DWORD;Esp: DWORD;SegSs: DWORD;end;CreateThread 的最后⼀个参数是 "线程的 ID";既然可以返回句柄, 为什么还要输出这个 ID? 现在我知道的是:1、线程的 ID 是唯⼀的; ⽽句柄可能不只⼀个, 譬如可以⽤ GetCurrentThread 获取⼀个伪句柄、可以⽤ DuplicateHandle 复制⼀个句柄等等.2、ID ⽐句柄更轻便.在主线程中 GetCurrentThreadId、MainThreadID、MainInstance 获取的都是主线程的 ID.㈡、启动选项function CreateThread(lpThreadAttributes: Pointer;dwStackSize: DWORD;lpStartAddress: TFNThreadStartRoutine;lpParameter: Pointer;dwCreationFlags: DWORD; {启动选项}var lpThreadId: DWORD): THandle; stdcall;CreateThread 的倒数第⼆个参数 dwCreationFlags(启动选项) 有两个可选值:0: 线程建⽴后⽴即执⾏⼊⼝函数;CREATE_SUSPENDED: 线程建⽴后会挂起等待.可⽤ ResumeThread 函数是恢复线程的运⾏; 可⽤ SuspendThread 再次挂起线程.这两个函数的参数都是线程句柄, 返回值是执⾏前的挂起计数.什么是挂起计数?SuspendThread 会给这个数 +1; ResumeThread 会给这个数 -1; 但这个数最⼩是 0.当这个数 = 0 时, 线程会运⾏; > 0 时会挂起.如果被 SuspendThread 多次, 同样需要 ResumeThread 多次才能恢复线程的运⾏.在下⾯的例⼦中, 有新线程不断给⼀个全局变量赋随机值;同时窗体上的 Timer 控件每隔 1/10 秒就把这个变量写在窗体标题;在这个过程中演⽰了 ResumeThread、SuspendThread 两个函数.//上⾯图⽚中演⽰的代码。
delphi关于窗口句柄，进程等操作
delphi关于窗口句柄，进程等操作转帖/ck85124/blog/item/d44ad17e9c1a163e0cd 7da9e.htmluses TLHelp32,PsAPI;(1)显示进程列表：procedure TForm1.Button1Click(Sender: TObject);varProcessName: string;ProcessID: integer;ListLoop: Boolean;FsnapShotHandle: Thandle;FProcessEntry32: TProcessEntry32;beginListBox1.Clear;Fsnapshothandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);FProcessEntry32.dwsize := SizeOF(FProcessEntry32);Listloop := Process32First(FSnapshotHandle, FProcessEntry32);while Listloop do beginProcessName := FprocessEntry32.szExeFile;ProcessID := FProcessEntry32.th32ProcessID;// 我写到列表框中了,你可以根据需要自己改listbox1.Items.Add(ProcessNAme+':'+IntToStr(ProcessID));ListLoop := Process32Next(FSnapshotHandle, FprocessEntry32);end;end;(2)杀死某进程：procedure TForm1.Button2Click(Sender: TObject);varlppe: TProcessEntry32;found : boolean;Hand : THandle;P:DWORD;ph: THandle;ExitCode: DWORD;sExeFile,sSelect:string;killed:boolean;begintemp:= ListBox1.Items.strings[ListBox1.itemindex];temp:=copy(temp,pos(':',temp)+1,length(temp));p :=DWORD(StrToInt(temp));if P<>0 thenbeginph:=OpenProcess(PROCESS_TERMINATE,False,P);GetExitCodeProcess(ph, ExitCode);killed := TerminateProcess(ph,ExitCode);if not killed thenmessagebox(self.handle,pchar(sExeFile+'无法杀死！'),'提示',MB_OK or MB_ICONWARNING)elseListBox1.Items.Delete(ListBox1.ItemIndex);end;end;(3)取得某进程EXE路径：procedure TForm1.Button3Click(Sender: TObject);varh:THandle; fileName:string;iLen:integer;hMod:HMODULE;cbNeeded,p:DWORD;begintemp:= ListBox1.Items.strings[ListBox1.itemindex];temp:=copy(temp,pos(':',temp)+1,length(temp));p :=DWORD(StrToInt(temp));h := OpenProcess(PROCESS_ALL_ACCESS, false, p); //p 为进程IDif h > 0 thenbeginif EnumProcessModules( h, @hMod, sizeof(hMod), cbNeeded) thenbeginSetLength(fileName, MAX_PATH);iLen := GetModuleFileNameEx(h, hMod, PCHAR(fileName), MAX_PATH);if iLen <> 0 thenbeginSetLength(fileName, StrLen(PCHAR(fileName)));Memo1.Lines.Add(fileName);end;end;CloseHandle(h);end;end;(4)取得窗口列表：procedure TForm1.Button4Click(Sender: TObject);varhCurrentWindow: HWnd;szText: array[0..254] of char;beginListbox1.Clear;//EnumWindows(@EnumWindowsProc, 0); 写了个回调EnumWindowsProc没效果hCurrentWindow := GetWindow(Handle, GW_HWNDFIRST);while hCurrentWindow <> 0 dobeginif GetWindowText(hCurrentWindow, @szText, 255) > 0 then listbox1.items.Add(StrPas(@szT ext));hCurrentWindow := GetWindow(hCurrentWindow, GW_HWNDNEXT);end;end;(5)杀死窗口进程：procedure TForm1.Button5Click(Sender: TObject);varH:THandle;P:DWORD;s:string;killed:boolean;begins := ListBox1.Items[ListBox1.ItemIndex];H:=FindWindow(nil,pchar(s));if H<>0 thenbeginGetWindowThreadProcessId(H,@P);if P<>0 thenkilled:=TerminateProcess(OpenProcess(PROCESS_TERMINAT E,False,P),$FFFFFFFF);if not killed thenmessagebox(self.handle,pchar(s+'无法杀死！'),'提示',MB_OK or MB_ICONWARNING)elseListBox1.Items.Delete(ListBox1.ItemIndex);end;end;(6)取得窗口进程路径：procedure TForm1.Button6Click(Sender: TObject);varH:THandle;P,cbNeeded:DWORD;s,fileName:string;iLen:integer;hMod:HMODULE;begins := ListBox1.Items[ListBox1.ItemIndex];H:=FindWindow(nil,pchar(s));if H<>0 thenbeginGetWindowThreadProcessId(H,@P);if P<>0 thenbeginh := OpenProcess(PROCESS_ALL_ACCESS, false, p); //p 为进程IDif h > 0 thenbeginif EnumProcessModules( h, @hMod, sizeof(hMod), cbNeeded) thenbeginSetLength(fileName, MAX_PATH);iLen := GetModuleFileNameEx(h, hMod, PCHAR(fileName), MAX_PATH);if iLen <> 0 thenbeginSetLength(fileName, StrLen(PCHAR(fileName)));end;end;CloseHandle(h);end;end;end;Memo1.Lines.Add(fileName);end;(7)文件属性：function CovFileDate(Fd:_FileTime):TDateTime;{ 转换文件的时间格式 }varTct:_SystemTime;Temp:_FileTime;beginFileTimeToLocalFileTime(Fd,Temp);FileTimeToSystemTime(Temp,T ct);CovFileDate:=SystemTimeT oDateTime(Tct);end;procedure TForm1.Button7Click(Sender: TObject);varSR: TSearchRec;V1, V2, V3, V4: integer ;constdtFmt:string = 'YYYY-MM-DD HH:NN:SS';begin// ============== 方法一==================== //if FindFirst(edit1.Text, faAnyFile, SR) = 0 thenbeginMemo1.Lines.Add('文件属性:' + intToStr(SR.Attr) ); //文件属性Memo1.Lines.Add('文件大小:' + intToStr(SR.Size) ); //文件大小Memo1.Lines.Add('创建时间:' + FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftCreationTime )) ); //创建时间Memo1.Lines.Add('最后修改时间:' + FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftLastWriteTim e)) ); //最后修改时间Memo1.Lines.Add('最后访问时间:' + FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftLastAccessTi me)) ); //最后访问时间if SR.Attr and faHidden <> 0 thenFileSetAttr(edit1.Text, SR.Attr-faHidden);FindClose(SR);end;end;procedure TForm1.Button8Click(Sender: TObject);// ============== 方法二==================== //varAttrs: Word;f: file of Byte; // 文件大小必须要定义为" file of byte" ,这样才能取出 bytessize: Longint;//文件属性begin//此方法是打开文件读取字节计算,测试exe的文件必须是未运行状态否则会报io 103错误Attrs:=FileGetAttr(edit1.text);Memo1.Lines.Add('文件属性:' + intToStr(Attrs));//文件大小tryAssignFile(f, edit1.text);Reset(f);size := FileSize(f);Memo1.Lines.Add('文件大小:' + intToStr(size));finallyCloseFile(f);end;end;(8)判断程序是否在运行：procedure TForm1.Button9Click(Sender: TObject);varPrevInstHandle:Thandle;AppTitle:pchar;beginAppTitle := pchar(edit2.Text);PrevInstHandle := FindWindow(nil, AppTitle);if PrevInstHandle <> 0 then beginif IsIconic(PrevInstHandle) thenShowWindow(PrevInstHandle, SW_RESTORE)elseBringWindowT oTop(PrevInstHandle);SetForegroundWindow(PrevInstHandle);end;end;{CreateToolhelp32Snapshot函数为指定的进程、进程使用的堆[HEAP]、模块[MODULE]、线程[THREAD]）建立一个快照[snapshot]。
delphi二级考试试题
2010年计算机等级考试Delphi模拟试题及答案解析（二）2010-07-20 10:52:43 作者：chong来源：就学网浏览次数：11 网友评论 0 条11.关于记录与类的说法错误的是：（）A.记录没有继承关系，而类有B.不能自动对记录的域初始化C.类可以使用with语句而记录不能D.记录没有任何保密性，所有细节从外部都是可见的，或者说是公用的11.关于记录与类的说法错误的是：（）A.记录没有继承关系，而类有B.不能自动对记录的域初始化C.类可以使用with语句而记录不能D.记录没有任何保密性，所有细节从外部都是可见的，或者说是公用的参考答案：C12.以下不合法的数组是：（）A.arr:Array of ClassB.arr:Array of TButtonC.arr:Array of byteD.arr:Array of string参考答案：A13.下列关于dfm文件的一些说明哪个是正确的？（）A.dfm文件中包含了对应Pascal单元文件的编译后中间代码B.dfm文件是文本文件，用于保存编译器需要用到的Pascal文件的符号表C.dfm文件保存着一个窗体和窗体拥有的对象的Published属性D.dfm文件是编译时产生的符号表，是为了使优化提高编译速度而产生的参考答案：C14.请判断下列代码在程序关闭时，正确的对象释放顺序（）TMybutton=class(Tbutton)ProtectedDestructor Destroy;override;End;………….destructor TMyButton.Destroy;Begininherited;Application.MessageBox(PChar(Name),’Destroy’,mb_ok);end;var AButton,BButton:TMyButton;procedure TForm1.FormCreate(Sender:TObject);beginAbutton:=TmyButton.Create(Nil);With AButton dobeginParent:=form1;Top:=100;Left:=100;Visible:=True;Name:=’ABtn’;end;BButton:=TMyButton.Create(Application);With BButton dobeginParent:=Form1;Top:=100;Left:=200;Visible:=True;Name:=’BBtn’;end;procedure TForm1.FormDestroy(Sender:TObject);begin……end;A.BButton.Destroy->Form1.Destroy->AButton.DestroyB.上述都不对，应该手工调用Abutton.free，否则会造成AButton没有释放的错误C.Form1.Destroy->AButton.Destroy->BButton.DestroyD.AButton.Destroy->Form1.Destroy->BButton.Destroy参考答案：B15.已知有说明var s:sting;下列程序段中的错误为：case s of‘book_A’:processSelectionA;‘book_B’:processSelectionB;‘book_C’:processSelectionC;end; （）A.用字符串作为Case值表元素B.case表达式中有常数C.case常量和case值表元素D.case表达式位关系表达式这道题我不知道它要说什么……Case String of 这个语法本身就是错误的！Case … of 中间的条件只能是整型，集合，枚举类型。
常用代码(Delphi 自我复制自我删除)
Delphi 自我复制源码这种方法的原理是程序运行时先查看自己是不是在特定目录下,如果是就继续运行,如果不是就把自己拷贝到特定目录下,然后运行新程序,再退出旧程序.打开Delphi,新建一个工程,在窗口的Create事件中写代码:procedure TForm1.FormCreate(Sender: TObject);var myname: string;beginmyname := ExtractFilename(Application.Exename); //获得文件名if application.Exename <> GetWindir + myname then //如果文件不是在Windows\System\那么..begincopyfile(pchar(application.Exename), pchar(GetWindir + myname), False);{将自己拷贝到Windows\System\下}Winexec(pchar(GetWindir + myname), sw_hide);//运行Windows\System\下的新文件application.Terminate;//退出end;end;其中GetWinDir是自定义函数,起功能是找出Windows\System\的路径.function GetWinDir: String;varBuf: array[0..MAX_PATH] of char;beginGetSystemDirectory(Buf, MAX_PATH);Result := Buf;if Result[Length(Result)]<>'\' then Result := Result + '\';end;Delphi 程序自删除.运行Delphi，新建一个工程，添加一个Button到窗体上，全部代码如下：unit Unit1;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls;typeTForm1 = class(TForm)Button1: TButton;procedure DeleteMe; //自定义程序自杀过程procedure Button1Click(Sender: TObject);private{ Private declarations }public{ Public declarations }end;varForm1: TForm1;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);beginDeleteMe;end;procedure TForm1.DeleteMe; //程序自杀//-----------------------------------------------------------function GetShortName(sLongName: string): string; //转换长文件名varsShortName: string;nShortNameLen: integer;beginSetLength(sShortName, MAX_PATH);nShortNameLen := GetShortPathName(PChar(sLongName),PChar(sShortName), MAX_PATH - 1);if (0 = nShortNameLen) thenbegin// handle errors...end;SetLength(sShortName, nShortNameLen);Result := sShortName;end;//-------------------------------------------------varBatchFile: TextFile;BatchFileName: string;ProcessInfo: TProcessInformation;StartUpInfo: TStartupInfo;beginBatchFileName := ExtractFilePath(ParamStr(0)) + '$$Delme$$.bat'; AssignFile(BatchFile, BatchFileName);Rewrite(BatchFile);Writeln(BatchFile, ':try');Writeln(BatchFile, 'del "' + GetShortName(ParamStr(0)) + '"');Writeln(BatchFile, 'if exist "' + GetShortName(ParamStr(0)) + '"' + ' goto try');Writeln(BatchFile, 'del %0');Writeln(BatchFile, 'cls');Writeln(BatchFile, 'exit');CloseFile(BatchFile);FillChar(StartUpInfo, SizeOf(StartUpInfo), $00); StartUpInfo.dwFlags := STARTF_USESHOWWINDOW; StartUpInfo.wShowWindow := SW_Hide;if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) thenbeginCloseHandle(ProcessInfo.hThread);CloseHandle(ProcessInfo.hProcess);end;Application.Terminate;end;end.。
delphi-radiogroup的应用
Use CopyRect to transfer part of the image on another canvas to the image of the TCanvas object. Dest specifies the rectangle on the canvas where the source image will be copied. The Canvas parameter specifies the canvas with the source image. Source specifies a rectangle bounding the portion of the source canvas that wi
begin
case RadioGroup1.ItemIndex of
0: str := 'one';
1: str := 'two';
2: str := 'three';
3: str := 'four';
end;
Text := str;
1.Copyrect(Dest:TRect;Canvas:Tcanvas;Source:TRect);
其中:
Dest:目标画布矩形Canvas:源画布Source:源矩形,
这是一个DELPHI内部的命令,它主要用于某些控件的画布操作,即CANVAS属性下支持的一个图像复制命令,
其功能是把图像从一个源RECT内,复制到目标RECT内,复制的图像具有自动伸缩性质,其功能类似于WINDOWSAPI函数的BITBLT,但操作相对简单;例如命令:
Rect (0, 0, Screen.Width, Screen.Height));
[VIP专享]delphi模拟试题10
![[VIP专享]delphi模拟试题10](https://img.taocdn.com/s3/m/37f28186650e52ea5418984f.png)
本试卷命题与审核：命题单位（盖章）教研室主任审核签名领导审核签名荆州职业技术学院×××学年度第××学期《delphi程序设计》期末考试试卷系班级姓名学号成绩一. 选择题（20*2）1. 用户开发程序时需要经常在窗体和编辑器窗口之间来回切换，可使用快捷键（）。
A、F12和F11B、F12和F13C、F12和Ctrl+F12D、F12和Alt+F12E、F12和Shift+F122. 某函数如下：Function check(n,k:Integer):Integer;Var m:Integer;BeginRepeatm:=n mod 10;n:=n div 10;K:=k-1Until k=0;Check:=mEnd;若调用语句y:=check(3725,3),运行后y值为：（）A、7B、5C、2D、03. 以下那个组件不可以由用户输入编辑文本（）A、TEditB、TcomboBoxC、TMaskEditD、TlabelE、TStringGrid4. 一个对象类可以继承和直接使用它的父类的所有成员，除了：（）A、public域B、private域C、protected域和private域D、protected域和方法E、private域和方法5. Delph没有用到的文件类型有（）。
A、.frmB、.pasC、.dfmD、.dprE、.res6. Query组件没有Table组件那样的( )属性。
A、DataSourceB、TableNameC、FilteredD、DatabaseE、UpdateObject7. 下面关于属性的论述正确的是（）。
A、属性能实现write方法B、属性能实现read方法C、属性可以只读或只写D、属性可以公开或非公开E、属性不能直接存取8. 调试程序时，需要执行执行点所在的源代码行，并停留在下一个源代码行。
可通过（）菜单项进行。
Delphi过程函数传递参数的几种方式
Delphi过程函数传递参数的⼏种⽅式转载⾄：在过程、函数中传递参数⼏个修饰符为Const、Var、Out。
另⼀种不加修饰符的为默认按值传递参数。
⼀、默认⽅式以值⽅式传递参数procedure TForm1.ProcNormal(Value: string);beginOrigNum:=Value+' Me';lblReturn.Caption:=OrigNum;//OrigNum为'Hello Me'lblOrig.Caption:=Value;//Value为'Hello'end;调⽤：OrigNum:='Hello';ProcNormal(OrigNum);⼆、以Const⽅式传递参数，这个参数在调⽤过程中不能改变，并且这种⽅式会被编译器优化，⼀般建议尽可能地使⽤这种⽅式。
procedure TForm1.ProcConst(const Value: string);beginOrigNum:=Value+' Me';lblReturn.Caption:=OrigNum;//为'Hello Me‘lblOrig.Caption:=Value;//为'Hello Me'end;三、按引⽤⽅式传递参数procedure TForm1.ProcRef(var value: string);beginOrigNum:=Value+' Me';lblReturn.Caption:=OrigNum;//为'Hello Me‘lblOrig.Caption:=Value;//为'Hello Me'end;四、按Out⽅式传递参数，这个⽅式传递参数时，参数可以不被初始化，即使有值也被忽视，它⼀般⽤于输出,它可以实现在⼀个过程中返回多个值,我们通常在分布式对象模型，如COM中使⽤它。
[DELPHI]关于定时运行
![[DELPHI]关于定时运行](https://img.taocdn.com/s3/m/c13d46cc51e2524de518964bcf84b9d528ea2c6b.png)
[DELPHI]关于定时运⾏定时运⾏这个问题其实⽼早就接触到了，不过在上次的程序中似乎没有很好的解决这个问题，并且没有深⼊下去。
这次再次碰到同样的问题，在查找了⽹上的资料以后，对这⼀问题有了⽐较深的理解。
在程序中实现定时运⾏的思路：1、由timer控件实现两个timer控件，其中timer1负责每⼀分钟检查⼀次系统时间和设定时间的差值，如果两者相差5分钟，则继续检查，直到当相差时间⼩于5分钟，触发timer2，timer2的定时器时间就是这个时间间隔。
当timer2到时以后，就触发主程序。
具体代码procedure TForm1.Button1Click(Sender: TObject);begintimer1.Interval:=60*1000; //启动监控，每1分钟检查⼀次设定时间和当前时间timer1.Enabled:=true;end;procedure TForm1.Timer1Timer(Sender: TObject);varl_time: TDateTime;h_time: TDateTime;ss:Int64;begintimer1.enabled:=false;h_time:= strtotime('10:30:00');l_Time := time; //now是取当前的⽇期加时间，time只取当前时间if (h_time>l_time) then beginss:=SecondsBetween(h_time,l_time); //求两个时间相差多少秒if ss<5*60 then begin //如果时间间隔⼩于5分钟定时启动timer2timer1.Enabled:=false;showmessage('Inteval seconds:'+inttostr(ss));timer2.Interval:=ss*1000;timer2.Enabled:=true;end;endelsetimer1.enabled:=true;end;procedure TForm1.Timer2Timer(Sender: TObject);begintimer2.enable:=false;showmessage('ok on time run the program');// start...timer1.Enabled:=true; //再次开始监控end;。
delphi-radiogroup的应用
delphi-radiogroup的应用procedure TForm1.RadioGroup1Click(Sender: TObject); beginText := RadioGroup1.Items[RadioGroup1.ItemIndex]; end;//当点击 RadioGroup 中的第几个选项时...procedure TForm1.RadioGroup1Click(Sender: TObject); varstr: string;begincase RadioGroup1.ItemIndex of0: str := 'one';1: str := 'two';2: str := 'three';3: str := 'four';end;Text := str;end;procedure TForm2.Button1Click(Sender: TObject);varC:TCanvas;B:TBitmap;beginB :=TBitmap.Create;C :=TCanvas.Create;try// 设置Bitmap的大小B.Width := Screen.Width;B.Height := Screen.Height;// 取屏幕的设备上下文句柄并拷贝C.Handle:=GetDC(0);B.Canvas.CopyRect(Rect(0,0,screen.Width,Screen.Height),C,Rect(0,0,screen.Width,Screen.Height));B.SaveToFile('d:\test.bmp');MessageBeep(1);finallyReleaseDC(0,C.Handle);B.Free;C.Free;end;end;Canvas.CopyRect 的用法Fullscreen.Canvas.CopyRect(Rect (0, 0, screen.Width, screen.Height), fullscreenCanvas,Rect (0, 0, Screen.Width, Screen.Height));主要是这些参数是什么意思--------------------------------------------------------------------------------ZT:CopyRect 方法：从其原型CopyRect(Dest: TRect; Canvas: TCanvas; Source: TRect)可看出，它将源画布某一矩形区域的图像复制到另一个画布的矩形区域。
Delphi中释放介绍
Delphi中释放介绍Delphi中释放介绍2012-04-30 20:37 509人阅读评论(0) 收藏举报在delphi中，有些函数或者设置会使对象自动释放，此时如果在次释放会发生野指针的现象，导致莫名的错误。
下面介绍几种经常见到的释放规则。
（一）、使用 TObjectList[delphi] view plaincopyprint?1.procedure TForm1.Button1Click(Sender: TObject);2.var3.list: TObjectList;4.i: Integer;5.btn: TButton;6.begin7.list := TObjectList.Create;8.for i := 0 to 6 do9.begin10.btn := TButton.Create(Self);11.with btn do begin12.Caption := Format('Btn %d', [i+1]);13.Parent := Self;14.end;15.list.Add(btn);16.end;17.ShowMessage('TObjectList 释放时, 会同时释放其中的对象');18.list.Free;19.end;20.21.procedure TForm1.Button2Click(Sender: TObject);22.var23.list: TList;24.i: Integer;25.btn: TButton;26.begin27.list := TList.Create;28.for i := 0 to 6 do29.begin30.btn := TButton.Create(Self);31.with btn do begin32.Caption := Format('Btn %d', [i+1]);33.Parent := Self;34.end;35.list.Add(btn);36.end;37.ShowMessage('TList 释放后, 其中的对象并未释放');38.list.Free;39.end;（二）使用 TObjectList<T>[delphi] view plaincopyprint?1.procedure TForm1.Button1Click(Sender: TObject);2.var3.list: TObjectList<TButton>;4.i: Integer;5.btn: TButton;6.begin7.list := TObjectList<TButton>.Create;8.for i := 0 to 6 do9.begin10.btn := TButton.Create(Self);11.with btn do begin12.Caption := Format('Btn %d', [i+1]);13.Parent := Self;14.end;15.list.Add(btn);16.end;17.ShowMessage('TObjectList 释放时, 会同时释放其中的对象');18.list.Free;19.end;20.21.procedure TForm1.Button2Click(Sender: TObject);22.var23.list: TList<TButton>;24.i: Integer;25.btn: TButton;26.begin27.list := TList<TButton>.Create;28.for i := 0 to 6 do29.begin30.btn := TButton.Create(Self);31.with btn do begin32.Caption := Format('Btn %d', [i+1]);33.Parent := Self;34.end;35.list.Add(btn);36.end;37.ShowMessage('TList 释放后, 其中的对象并未释放');38.list.Free;39.end;（三）使用记录而不是记录指针[delphi] view plaincopyprint?1.{假如某个函数的参数需要一个结构指针}2.function Area(rect: PRect): Integer;3.begin4.Result := rect.Width * rect.Height;5.end;6.7.{直接声明指针并分配空间后需手动释放}8.procedure TForm1.Button1Click(Sender: TObject);9.var10.P: PRect;11.begin12.New(P);13.P^ := Rect(10, 10, 60, 50);14.ShowMessage(IntT oStr(Area(P))); //200015.Dispose(P);16.end;17.18.procedure TForm1.Button2Click(Sender: TObject);19.var20.R: TRect;21.begin22.R := Rect(10, 10, 60, 50);23.ShowMessage(IntT oStr(Area(@R))); //200024.end;（四）使用动态数组[delphi] view plaincopyprint?1.procedure TForm1.Button1Click(Sender: TObject);2.var3.arr: Array of string;4.i: Integer;5.s: string;6.begin7.for i := 0 to 3 do8.begin9.SetLength(arr, Length(arr)+1);10.arr[High(arr)] := StringOfChar(Char(i + 1), 3);11.end;12.for s in arr do ShowMessage(s);13.end;14.15.procedure TForm1.Button2Click(Sender: TObject);16.var17.arr: TArray<string>;18.i: Integer;19.s: string;20.begin21.for i := 0 to 23 do22.begin23.SetLength(arr, Length(arr)+1);24.arr[High(arr)] := StringOfChar(Char(i + 1), 3);25.end;26.for s in arr do ShowMessage(s);27.end;（五）在 initialization 中建立、在 finalization 中释放[delphi] view plaincopyprint?1.type2.TForm1 = class(TForm)3.Button1: TButton;4.procedure Button1Click(Sender: TObject);5.end;6.7.var8.Form1: TForm1;9.10.implementation11.12.{$R *.dfm}13.14.var15.List: TStringList;16.17.procedure TForm1.Button1Click(Sender: TObject);18.begin19.List.Clear;20.List.Add('WanYi');21.ShowMessage(List.Text);22.end;23.24.initialization25.List := TStringList.Create;26.finalization27.List.Free;28.29.end.（六）使用记录（现在的记录支持使用方法）[delphi] view plaincopyprint?1.type2.TForm1 = class(TForm)3.Button1: TButton;4.procedure Button1Click(Sender: TObject);5.end;6.7.//8.TBase = record9.private10.FName: string;11.procedure SetName(const AName: string);12.public13.constructor Create(const AName: string);14.property Name: string read FName write SetName;15.end;16.17.var18.Form1: TForm1;19.20.implementation21.22.{$R *.dfm}23.24.procedure TForm1.Button1Click(Sender: TObject);25.var26.X: TBase;27.begin28.X := TBase.Create('Test');29.ShowMessage(); := 'Test1';31.ShowMessage();32.{X 在此自动释放}33.end;34.35.{ TBase }36.37.constructor TBase.Create(const AName: string);38.begin39.FName := AName;40.end;41.42.procedure TBase.SetName(const AName: string);43.begin44.FName := AName;45.end;46.47.end.（七）使用接口[delphi] view plaincopyprint?1.type2.TForm1 = class(TForm)3.Button1: TButton;4.procedure Button1Click(Sender: TObject);5.end;6.7.//8.IBase = Interface9.function GetName: string;10.procedure SetName(const AName: string);11.property Name: string read GetName write SetName;12.end;13.14.//15.TBase = class(TInterfacedObject, IBase)16.private17.FName: string;18.protected19.function GetName: string;20.procedure SetName(const AName: string);21.public22.constructor Create(const AName: string);23.end;24.25.var26.Form1: TForm1;27.28.implementation29.30.{$R *.dfm}31.32.procedure TForm1.Button1Click(Sender: TObject);33.var34.X: IBase;35.begin36.X := TBase.Create('Test');37.ShowMessage(); := 'Test1;39.ShowMessage();40.{X 在此自动释放}41.end;42.43.{ TBase }44.45.constructor TBase.Create(const AName: string);46.begin47.FName := AName;48.end;49.50.function TBase.GetName: string;51.begin52.Result := FName;53.end;54.55.procedure TBase.SetName(const AName: string);56.begin57.FName := AName;58.end;59.60.end.。
用Delphi编程模拟鼠标操作
下⾯以⿏标左键单击为例来说明如何模拟⿏标操作：procedure TForm1.btnLClickClick(Sender: TObject);begin SetCursorPos(10,10); mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0); mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);end; ⾸先需要通过SetCursorPos函数来设置需要单击的坐标。
然后通过mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0)语句在(10,10)坐标处按下⿏标左键。
最后不要忘了通过mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0)语句释放⿏标左键。
双击的操作可以通过两个连续的单击来实现；⿏标移动的操作可以通过指定mouse_event 函数的第1个参数MOUSEEVENTF_MOVE，第2个和第3个参数为左边来实现；右键单击和左键单击的原理⼀致，只不过mouse_event函数中的参数分别替换为MOUSEEVENTF_RIGHTDOWN和MOUSEEVENTF_RIGHTUP。
程序代码如下：unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) btnMove: TButton; btnLClick: TButton; btnLDClick: TButton; btnRClick: TButton; procedure btnMoveClick(Sender: TObject); procedure btnLClickClick(Sender: TObject); procedure btnLDClickClick(Sender: TObject); procedure btnRClickClick(Sender: TObject);private { Private declarations }public { Public declarations }end;var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.btnMoveClick(Sender: TObject); begin mouse_event(MOUSEEVENTF_MOVE,100,100,0,0); end; procedure TForm1.btnLClickClick(Sender: TObject); begin SetCursorPos(10,10); mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0); mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0); end; procedure TForm1.btnLDClickClick(Sender: TObject); begin SetCursorPos(200,200); mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0); mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0); mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0); mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0); end; procedure TForm1.btnRClickClick(Sender: TObject); begin SetCursorPos(200,200); mouse_event(MOUSEEVENTF_RIGHTDOWN,0,0,0,0); mouse_event(MOUSEEVENTF_RIGHTUP,0,0,0,0); end;end. 保存⽂件，然后按F9键运⾏程序。
delphi实现应用程序的文件拖放功能
delphi实现应用程序的文件拖放功能在Delphi中有许多控件支持拖放操作,但仅限于应用程序内部,而不能实现从Windows环境里向应用程序拖放文件,本文将要介绍的就是如何用Delphi编写支持文件拖放的应用程序,由于主要使用WindowsAPI函数,因此也可供其它语言使用者参考.首先要说明的是下面的三个API函数,为通用起见, 函数说明,1.DragAcceptFiles(HWNDhWnd,BOOLfAccept);DragAcceptFiles函数是用来为拖放文件作初始化, 它的第一个参数hWnd指明目标窗体的句柄,第二个参数fAccept是一个布尔型变量,为True时则hWnd所指向的窗体可以接受拖放的文件.2.DragQueryFile(HDROPhDrop,UINTiFile,LPTSTRlpszFile,UINTcch)DragQueryFile函数用来查询拖放文件的文件名,其本身的返回值是一个无符号整数,参数hDrop是一个存放所拖放文件名称的数据结构的句柄, 也就是文件名缓冲区的句柄,需要从Windows消息WM_DROPFILES中获得.iFile指明所要查询文件的序号,它有两种取值方式,1.值为十六进制数FFFFFFFF时,DragQueryFile的返回值为所拖放文件的数目;2.值在0到拖放文件总数之间时,DragQueryFile函数将相应序号的文件名放入参数lpszFile所指向的缓冲区内,若此时lpszFile的值为NULL,则DragQueryFile会返回相应文件名的长度.参数cch决定缓冲区的长度,由于Windows95支持长文件名,它的值不能设得太小.3.DragFinish(HDROPhDrop);使用DragFinish函数告诉Windows拖放操作结束,使其释放文件名缓冲区,它的参数hDrop与DragQueryFiles函数中的一样,也由Windows消息WM_DROPFILES 的hDrop参数获得.下面将结合一个我编写的例子来说明具体的编程步骤.本例中窗体上放置了一个Memo控件memo1,在Windows中选取数个文件拖至程序窗体放下,则memo1中便会显示所选文件的总数及每个文件的各自名称.程序代码如下:unit Unit1;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Contr ols, Forms, Dialogs,shellapi, StdCtrls;typeTForm1 = class(TForm)listbox1: TListBox;procedure FormCreate(Sender: TObject);private{ Private declarations }public{ Public declarations }procedure dropfile(var msg: tmessage);message wm_dr opfiles;end;varForm1: TForm1;implementation{$R *.dfm}procedure TForm1.dropfile(var msg: tmessage);vari,number:integer;filename:array[0..255] of char;pfilename:pchar;beginpfilename:=@filename;number:=dragqueryfile(msg.wParam,$ffffffff,nil,0);//或的文件的个数for i:=0 to number-1 do //穷举所有的文件begindragqueryfile(msg.wParam,i,pFileName,255);listbox1.Items.Add(pFileName);end;DragFinish(msg.wParam); //处理完毕end;procedure TForm1.FormCreate(Sender: TObject);beginDragAcceptFiles(handle,True);end;end.varForm1: TForm1;OldPannelDisplayWindowProc: TWndMethod;implementation{$R *.dfm}procedure TForm1.dropfile(var msg: tmessage);vari,number:integer;filename:array[0..255] of char;pfilename:pchar;beginpfilename:=@filename;number:=dragqueryfile(msg.wParam,$ffffffff,nil,0);//或的文件的个数for i:=0 to number-1 do //穷举所有的文件begindragqueryfile(msg.wParam,i,pFileName,255);listbox1.Items.Add(pFileName);end;DragFinish(msg.wParam); //处理完毕end;procedure TForm1.FormCreate(Sender: TObject);begin//DragAcceptFiles(handle,True);OldPannelDisplayWindowProc := Panel1.WindowProc;Panel1.WindowProc := PanelWindowProc;DragAcceptFiles(Panel1.Handle,True);DragAcceptFiles(Handle,True);end;procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;State: TDragState; var Accept: Boolean);beginAccept :=True;end;procedure TForm1.PanelWindowProc(var Message: TMessage);begintryif Message.Msg = WM_DROPFILES thendropfile(Message);OldPannelDisplayWindowProc(Message);finallyend;end;。
DELPHI获得系统当前时间日期和格式化时间
获得系统当前时间本例中主要应用了FormatDateTime函数，此函数主要用于将日期时间格式化为指定的字符串。
利用该函数可以输出许多形式的时间格式。
程序运行结果如图6.1所示主要代码如下：procedure TForm1.Button1Click(Sender: TObject);beginLabel1.Caption := FormatDateTime('hh:nn:ss',Now());end;获得系统当前日期当用户单击窗体中的按钮时，程序会利用DateTimeToStr函数将当前日期转换为一个字符串显示在标签上。
程序运行结果如图6.2所示。
图6.2 获得系统当前日期主要代码如下：procedure TForm1.Button1Click(Sender: TObject);beginLabel1.Caption := DateTimeToStr(Date());end;将日期时间格式化为指定格式本例将日期时间格式化为指定格式主要是应用了FormatDateTime函数。
使用该函数可以将当前日期时间格式化为自定义格式。
程序运行结果如图6.3所示。
图6.3 将日期时间格式化为指定格式主要代码如下：procedure TForm1.Timer1Timer(Sender: TObject);beginLabel1.Caption := DateTimeToStr(now());end;procedure TForm1.Button1Click(Sender: TObject);beginLabel2.Caption := FormatDateTime('yyyy年mm月dd日hh时nn分ss秒',now()); end;。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
procedure TForm1.Table1CalcFields(DataSet: TDataSet);
begin
table1JSFY.value:=table1FJ.Value*table1RZTS.Value;
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
edit2.Text:='';
edit3.Text:='';
end;
procedure TForm1.Edit2Change(Sender: TObject);
begin
edit1.Text:='';
edit3.Text:='';
end;
procedure TForm1.Edit3Change(Sender: TObject);
begin
edit1.Text:='';
edit2.Text:='';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
table1.Refresh;
with table1 do
try
disablecontrols;
filtered:=false;
if edit1.text<>'' then memo1.text:='客户姓名='+''''+edit1.text+'''';
if edit2.text<>'' then memo1.text:='房间号='+edit2.Text;
if edit3.text<>'' then memo1.text:='入住时间='+''''+edit3.text+'''';
filter:=memol.text;
filtered:=true;
finally
enablecontrlos;
if dbedit1.text='' then begin
messagebeep(1);
showmessage('没有符合的记录！');
if messageDlg('是否继续查询？',mtinformation,[mbYes,mbNo],0)=mrno then begin filtered:=false;
table1.Close;
table1.Open;
end;
end else begin
if messageDlg('是否继续查询？',mtinformation,[mbYes,mbNo],0)=mrno then begin filtered:=false;
table1.Close;
table1.Open;
end;
end;
end;
end;
procedure TForm1.Edit4Change(Sender: TObject);
begin
edit5.Text:='';
edit6.Text:='';
end;
procedure TForm1.Edit5Change(Sender: TObject);
begin
edit4.Text:='';
edit6.Text:='';
end;
procedure TForm1.Edit6Change(Sender: TObject);
begin
edit4.Text:='';
edit5.Text:='';
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
table1.Refresh;
with table1 do
try
disablecontrols;
filtered:=false;
if edit1.text<>'' then memo1.text:='客户姓名='+''''+edit1.text+'''';
if edit2.text<>'' then memo1.text:='房间号='+edit2.Text;
if edit3.text<>'' then memo1.text:='入住时间='+''''+edit3.text+'''';
filter:=memol.text;
filtered:=true;
finally
enablecontrlos;
if dbedit1.text='' then begin
messagebeep(1);
showmessage('没有符合的记录！');
if messageDlg('是否继续删除？',mtinformation,[mbYes,mbNo],0)=mrno then begin filtered:=false;
table1.Close;
table1.Open;
end;
end else begin
Table1.Delete;
if messageDlg('是否继续删除？',mtinformation,[mbYes,mbNo],0)=mrno then begin filtered:=false;
table1.Close;
table1.Open;
end;
end;
end;
end;。