delphi范例范文模板 28页.docx
《delphi范例范文模板 28页.docx》由会员分享，可在线阅读，更多相关《delphi范例范文模板 28页.docx（28页珍藏版）》请在冰点文库上搜索。
delphi范例范文模板28页
本文部分内容来自网络整理，本司不为其真实性负责，如有异议或侵权请及时联系，本司将立即删除！
==本文为word格式，下载后可方便编辑和修改！
==
delphi范例
篇一：
简单的delphi实例
unitmainfrm;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Forms,
Dialogs,StdCtrls,Mybutton,Controls;
type
TFrmMain=class（TForm）
BtnAddTButton;
BtnDeleteTButton;
procedureBtnAddClick（SenderTObject）;
procedureBtnDeleteClick（SenderTObject）;
procedureFormCreate（SenderTObject）;
private
procedureWMLBUTTONDOWN（varmessageTMessage）;messageWM_LBUTTONDOWN;procedureWMMOUSEMOVE（varmessageTMessage）;messageWM_MOUSEMOVE;
procedureWMLBUTTONDBLCLK（varmessageTMessage）;messageWM_LBUTTONDBLCLK;procedureWMLBUTTONUP（varmessageTMessage）;messageWM_LBUTTONUP;procedureWMPAINT（varmessageTMessage）;messageWM_PAINT;
procedureprocBtnMsg（varmessageTMessage）;
procedureallBtnUnfocused（listTList）;
proceduredelbtn（listTList）;
procedureaddBtn（listTList）;
public
multiFocusedinteger;多选
CanDrawRectboolean;是否启动复选矩形
focusedRectTRect;多选的矩形框
msDownPosTPoint;
prePosTPoint;鼠标上次移动的位置
multiFlaginteger;
mutiMoveboolean;是否多选移动
btnListTList;
countinteger;
end;
var
FrmMainTFrmMain;
implementation
{$R.dfm}
主界面模块初始化创建，新建按钮链表，主界面上所有的按钮都放入该链表
procedureTFrmMain.FormCreate（SenderTObject）;
begin
btnList=TList.Create;
count=0;
end;
添加按钮
procedureTFrmMain.BtnAddClick（SenderTObject）;
begin
addBtn（btnList）;
end;
主界面双击消息处理模块
procedureTFrmMain.WMLBUTTONDBLCLK（varmessageTMessage）;
begin
procBtnMsg（message）;
end;
鼠标按下时，进行复选预操作
procedureTFrmMain.WMLBUTTONDOWN（varmessageTMessage）;
begin
inherited;
CanDrawRect=false;鼠标按下不允许选中按钮
multiFlag=0;
mutiMove=false;不允许多个按钮移动
procBtnMsg（message）;所以按钮都要发送鼠标按下消息
if（multiFlag=0）then没有button被选中
begin
CanDrawRect=true;允许画多选框，从而允许多选
multiFocused=0;多选按钮数目设为0
allBtnUnfocused（btnList）;取消所有按钮的选中状态
msDownPos=Point（message.LParamLo,message.LParamHi）;记录下按下的坐标，作为复选起点坐标
focusedRect=Rect（msDownPos,msDownPos）;初始化复选框，设置它的起终点都是按下的坐标
end;
end;
鼠标移动消息处理
procedureTFrmMain.WMMOUSEMOVE（varmessageTMessage）;
var
tempbtnTMyButton;
begin
inherited;
if（CanDrawRect）then允许画多选框，则用链表中第一个按钮作为绘制边框
begin并使用它来构建多选框，完成多选任务
tempbtn=TMybutton（btnList.Items[0]）;
tempbtn.drawDragRect（focusedRect,clgreen）;绘制第一个按钮边框，由它完成多选获得多选框顶点按钮
focusedRect=tempbtn.getRect（msDownPos,Point（message.LParamLo,message.LParamHi））;tempbtn.drawDragRect（focusedRect,clgreen）;绘制多选框
end;
procBtnMsg（message）;向按钮传递消息
end;
procedureTFrmMain.WMLBUTTONUP（varmessageTMessage）;
var
tempbtnTMybutton;
begin
inherited;
if（CanDrawRect）then如何当前允许画矩形框
begin
tempbtn=TMybutton（btnList.Items[0]）;
tempbtn.drawDragRect（focusedRect,clgreen）;
CanDrawRect=false;
end;
procBtnMsg（message）;
end;
如何使重绘消息，直接转发给按钮
procedureTFrmMain.WMPAINT（varmessageTMessage）;
begin
inherited;
procBtnMsg（message）;
end;
遍历发送消息，针对所有按钮
procedureTFrmMain.procBtnMsg（varmessageTMessage）;
var
iinteger;
tempbtnTMybutton;
begin
fori=0tobtnList.Count-1do
begin
tempbtn=TMybutton（btnList.Items[i]）;
tempbtn.myWndProc（message）;
end;
end;
取消所有按钮的选中状态
procedureTFrmMain.allBtnUnfocused（listTList）;
var
tempbtnTMyButton;
iinteger;
begin
fori=0tolist.Count-1do
begin
tempbtn=TMyButton（list.Items[i]）;
tempbtn.focused=false;
end;
end;
删除选中按钮
procedureTFrmMain.BtnDeleteClick（SenderTObject）;
begin
delbtn（btnList）;
end;
删除模块，由删除按钮处理过程进行调用调用，实现删除功能
procedureTFrmMain.delbtn（listTList）;
var
iinteger;
tempbtnTMyButton;
begin
fori=list.Count-1downto0do
begin
tempbtn=TMyButton（list.Items[i]）;
if（tempbtn.focused）then
begin
list.Delete（i）;
tempbtn.Free;
end;
end;
end;
添加按钮，并对新添加按钮进行初始化，加入按钮链表
procedureTFrmMain.addBtn（listTList）;
var
ptPointer;
tempbtnTMybutton;
begin
inc（count）;
tempbtn=TMybutton.Create（Rect（100,100,200,150）,Handle,'button'+inttostr（count））;pt=Pointer（tempbtn）;
list.Add（pt）;
tempbtn.setzindex（tempbtn.curRect,tempbtn.zindex）;
end;
end.
unitMyButton;
{
authortaoxl201X-4-17
功能：
1用canvas实现可以随意拖动，伸缩的button
2可以响应双击事件
}
interface
uses
windows,messages,Graphics,Dialogs,SysUtils,Forms,Controls
classes;
type
CursorPos=（Coutside,Cleft,Ctop,Cright,Cbottom,Clefttop,Crighttop,Crightbottom,Cleftbottom,Ccenter）;
TMyButton=class（TObject）
private
FOnDblClickTNotifyEvent;
msPrePosTPoint;记录上次的鼠标位置在setPreMouse中使用
msStdCursorPos;鼠标相对于button的位置
ffocusedboolean;
canFocusedboolean;可以有焦点吗
muticheckedboolean;是否多选
消息处理
procedureLBUTTONDOWN（varmessageTMessage）;messageWM_LBUTTONDOWN;procedureMOUSEMOVE（varmessageTMessage）;messageWM_MOUSEMOVE;
procedureLBUTTONDBLICK（varmessageTMessage）;messageWM_LBUTTONDBLCLK;procedureLBUTTONUP（varmessageTMessage）;messageWM_LBUTTONUP;procedurePAINT（varmessageTMessage）;messageWM_PAINT;
篇二：
Delphi例子
征途上战鼓雷，条条战线捷报飞
unituspeciality;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,StdCtrls;
type
TSpecialityForm=class（TForm）
SpecialityMemo:
TMemo;
Label1:
TLabel;
Label2:
TLabel;
Label3:
TLabel;
Department:
TComboBox;
Label4:
TLabel;
StudyYear:
TEdit;
Label5:
TLabel;
SpecialityType:
TComboBox;
Label6:
TLabel;
Grade:
TEdit;
Label7:
TLabel;
AddRaBtn:
TRadioButton;
ChaRaBtn:
TRadioButton;
RemoveRaBtn:
TRadioButton;
OkBtn:
TButton;
ExitBtn:
TButton;
SpecialityName:
TComboBox;
procedureOkBtnClick（Sender:
TObject）;
procedureExitBtnClick（Sender:
TObject）;
private
{Privatedeclarations}
public
{Publicdeclarations}
end;
var
SpecialityForm:
TSpecialityForm;
implementation
{$R*.dfm}
procedureTSpecialityForm.OkBtnClick（Sender:
TObject）;
var
tmpstring,r:
string;
begin
ifAddRaBtn.checkedthen
r:
='新增专业'
elseifChaRaBtn.checkedthen
r:
='信息修改'
elseifRemoveRaBtn.checkedthen
征途上战鼓雷，条条战线捷报飞
r:
='删除专业';
SpecialityMemo.lines.Clear;
tmpstring:
=SpecialityName.items[SpecialityName.itemindex]+'专业所属院系为：
';tmpstring:
=tmpstring+Department.items[Department.itemindex];
tmpstring:
=tmpstring+SpecialityType.items[SpecialityType.itemindex]+'专业'+#13+#10;tmpstring:
=tmpstring+'学制为'+StudyYear.Text+'年.';
tmpstring:
=tmpstring+'所需修的学分为:
'+Grade.Text+'学分.'+#13+#10;
tmpstring:
=tmpstring+'操作类型为'+r;
specialitymemo.Lines.Add（tmpstring）;
end;
procedureTSpecialityForm.ExitBtnClick（Sender:
TObject）;
begin
close;
end;
end.
unitLoginUnit;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,StdCtrls;
type
TLoginForm=class（TForm）
Label1:
TLabel;
RadioButton1:
TRadioButton;
RadioButton2:
TRadioButton;
Label2:
TLabel;
Label3:
TLabel;
Edit1:
TEdit;
Edit2:
TEdit;
BtnConfirm:
TButton;
BtnQuit:
TButton;
procedureBtnConfirmClick（Sender:
TObject）;
procedureBtnQuitClick（Sender:
TObject）;
private
{Privatedeclarations}
public
{Publicdeclarations}
end;
var
LoginForm:
TLoginForm;
implementation
{$R*.dfm}
usesExamUnit;//ExamUnit是对话框Form2的单元文件
constglmm='ksxt';//定义管理员密码
procedureTLoginForm.BtnConfirmClick（Sender:
TObject）;
begin
if（notRadioButton1.checked）and（notRadioButton2.Checked）then
MessageDlg（'请选择用户身份！
',mtWarning,[mbOK],0）;//必须选择用户身份ifRadioButton1.checkedthen//用户身份为管理员
ifedit1.text=glmmthen
begin
ExamForm.caption:
='系统管理';
ExamForm.ShowModal;
close;
end
else
MessageDlg（'密码错误,请重新输入!
',mtError,[mbOK],0）;
ifRadioButton2.checkedthen//用户身份为考生
ifLength（Edit2.text）<>8then
MessageDlg（'重新输入准考号！
',mtWarning,[mbOK],0）
else
begin
ExamForm.caption:
='祝你成功';
ExamForm.ShowModal;
close;
end;
end;
procedureTLoginForm.BtnQuitClick（Sender:
TObject）;
begin
close;
end;end.
unitUnit1;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls,jpeg,ExtCtrls,DB,ADODB,unit2;
type
TForm1=class（TForm）
Image1:
TImage;
Label1:
TLabel;
Label2:
TLabel;
Edit2:
TEdit;
Button1:
TButton;
Button2:
TButton;
Label3:
TLabel;
Label4:
TLabel;
Label5:
TLabel;
Label6:
TLabel;
ADOQuery1:
TADOQuery;
ADOTable1:
TADOTable;
procedureButton1Click（Sender:
TObject）;
private
{Privatedeclarations}
public
{Publicdeclarations}
end;
var
Form1:
TForm1;
implementation
{$R*.dfm}
procedureTForm1.Button1Click（Sender:
TObject）;
begin
adoquery1.Close;
adoquery1.SQL.Clear;
adoquery1.SQL.Add（'select*frombiao1whereuser='''+edit1.Textpasswords='''+edit2.Text+''''）;
adoquery1.Open;
ifadoquery1.RecordCount=1then
begin
form1.Hide;
form2.Show;
end
else
begin
showmessage（'密码或部门名错误'）;
end;
end;
end.
unitSeleUnit;interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls;
type
TSeleForm=class（TForm）
Red:
TRadioButton;+'''and
Yellow:
TRadioButton;
Blue:
TRadioButton;
BtnOK:
TButton;
BtnQuit:
TButton;
procedureBtnOKClick（Sender:
TObject）;
procedureBtnQuitClick（Sender:
TObject）;
private
{Privatedeclarations}
public
{Publicdeclarations}
end;
var
SeleForm:
TSeleForm;
implementation
usesShowUnit;
{$R*.dfm}
procedureTSeleForm.BtnOKClick（Sender:
TObject）;
varys:
string;
begin
ifred.checked=truethen
ys:
='红色'
elseifyellow.checked=truethen
ys:
='黄色'
else
ys:
='蓝色';
ShowForm.label2.Caption:
=ys;//设置显示所选颜色的label2的标题ShowForm.showmodal;//显示"显示颜色"窗体
end;
procedureTSeleForm.BtnQuitClick（Sender:
TObject）;
begin
close;//关闭"选择颜色"窗体
end;
end.
unitUnit1;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls;
type
TForm1=class（TForm）
篇三：
delphi7.0的经典实例5
作为资源文件嵌入就可以解决这个问题。
用记事本写一个exe.rc,里面就一句;
MYEXEEXEFILEssl.exe
然后用brcc32编译exe.rc,生成exe.res文件
在你的单元中插入
{$Rexe.res}
至于提取出来也很简单
procedureTForm1.ExtractFile;
var
resStream:
TResourceStream;
begin
try
resStream:
=TResourceStream.Create（hinstance,PChar（'MYEXE'）,PChar（'EXEFILE'））;
resStream.SaveToFile（'c:
\e.exe'）;
resStream.Free;
........
except
ShowMessage（'提取文件错误'）;
end;
end;
把Delphi程序嵌入到其他程序中
把Delphi程序嵌入到其他程序中
作者：
佚名文章来源：
网络点击数：
193更新时间：
201X-4-29
16:
13:
15怎样把Delphi程序嵌入
升级会员 