富翁笔记 - Delphibbs.com Blogs

MTreeView 增加Delphi自带的 treeview的checkbox

yujinxin — 2009-7-2 8:30:49

////////////////////////////////////////////////////////
//
// 2006.3创建 iamy
// 2006.11 修订增加OnCheck OnQueryCheck事件
//
////////////////////////////////////////////////////////
unit MTreeView;

interface
uses
Windows, Classes, SysUtils, Messages, ComCtrls, Controls, CommCtrl;

Const
TVIS_CHECKED = $2000;

type

TMTreeViewQueryCheckEvent = procedure(Sender: TObject;Node: TTreeNode;var Cancheck: Boolean) of object;
TMTreeViewCheckEvent = procedure(Sender: TObject;Node: TTreeNode) of object;

TMTreeView = Class (TCustomTreeView)
private
FCheckBoxes: Boolean;
FEdting : Boolean;
FOnQueryCheck: TMTreeViewQueryCheckEvent;
FOnCheck: TMTreeViewCheckEvent;
procedure SetCheckBoxes(const Value: Boolean);
procedure SetComCtlStyle(Ctl: TWinControl; Value: Integer; UseStyle: Boolean);
procedure SetOnQueryCheck(const Value: TMTreeViewQueryCheckEvent);
procedure DoCheckNode(Node : TTreeNode;Checked: Boolean);
procedure DoCheck(X,Y:Integer);
procedure DoQueryNCheck(Node: TTreeNode);
procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
procedure SetOnCheck(const Value: TMTreeViewCheckEvent);
protected
procedure Loaded;override;
public
function NodeChecked(Node: TTreeNode):Boolean;
procedure CheckNode(Node: TTreeNode; Checked: Boolean;CallBackEvent : Boolean);
procedure CheckAllNode(Checked: Boolean;CallBackEvent : Boolean);
published
property CheckBoxes :Boolean read FCheckBoxes write SetCheckBoxes;
property OnQueryCheck : TMTreeViewQueryCheckEvent read FOnQueryCheck write SetOnQueryCheck;
property OnCheck: TMTreeViewCheckEvent read FOnCheck write SetOnCheck;
property Align;
property Anchors;
property AutoExpand;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind default bkNone;
property BevelWidth;
property BiDiMode;
property BorderStyle;
property BorderWidth;
property ChangeDelay;
property Color;
property Ctl3D;
property Constraints;
property DragKind;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property HotTrack;
property Images;
property Indent;
property MultiSelect;
property MultiSelectStyle;
property ParentBiDiMode;
property ParentColor default False;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property RightClickSelect;
property RowSelect;
property ShowButtons;
property ShowHint;
property ShowLines;
property ShowRoot;
property SortType;
property StateImages;
property TabOrder;
property TabStop default True;
property ToolTips;
property Visible;
property OnAddition;
property OnAdvancedCustomDraw;
property OnAdvancedCustomDrawItem;
property OnChange;
property OnChanging;
property OnClick;
property OnCollapsed;
property OnCollapsing;
property OnCompare;
property OnContextPopup;
property OnCreateNodeClass;
property OnCustomDraw;
property OnCustomDrawItem;
property OnDblClick;
property OnDeletion;
property OnDragDrop;
property OnDragOver;
property OnEdited;
property OnEditing;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnExpanding;
property OnExpanded;
property OnGetImageIndex;
property OnGetSelectedIndex;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
{ Items must be published after OnGetImageIndex and OnGetSelectedIndex }
property Items;

end;

implementation

{ TMTreeView }

procedure TMTreeView.CheckNode(Node: TTreeNode; Checked: Boolean;CallBackEvent : Boolean);
var
Cancheck : Boolean;
begin
CanCheck := True;
if CallBackEvent then
if Assigned(Self.FOnQueryCheck) then
Self.FOnQueryCheck(Self,Node,CanCheck);

if CanCheck then
begin
Self.DoCheckNode(Node,Checked);
if CallBackEvent then
if Assigned(Self.FOnCheck) then
Self.FOnCheck(Self,Node);
end;
end;

procedure TMTreeView.CheckAllNode(Checked: Boolean;CallBackEvent : Boolean);
var
i : Integer;
begin
for i := 0 to Self.Items.Count -1 do
begin
Self.CheckNode(Self.Items[i],Checked,CallBackEvent);
end;
end;

procedure TMTreeView.DoCheck(X,Y:Integer);
var
Node: TTreeNode;
RectAll : TRect;
RectTxt : TRect;
CheckBoxOffSet : Integer;
CheckWidth : Integer;
begin
if Self.CheckBoxes then
begin
Node := GetNodeAt(X,Y);
if Node <> nil then
begin
RectAll := Node.DisplayRect(False);
RectTxt := Node.DisplayRect(True);
if Assigned(Self.Images) then
begin
CheckBoxOffset := Self.Images.Width + 4;
CheckWidth := Self.Images.Width ;
end else
begin
CheckBoxOffset := 1;
CheckWidth := 16;
end;

if (X <= RectTxt.Left - CheckBoxOffset) and (X > RectTxt.Left - CheckWidth - CheckBoxOffSet) and (Y >= RectAll.Top) and (Y < RectAll.Bottom) then
begin
Self.DoQueryNCheck(Node);
end;
end;
end;
end;

procedure TMTreeView.Loaded;
begin
inherited;
SetComCtlStyle(Self,TVS_CHECKBOXES,FCheckBoxes);
end;

function TMTreeView.NodeChecked(Node: TTreeNode): Boolean;
var
TvItem :TTVItem;
begin
TvItem.Mask := TVIF_STATE;
TvItem.hItem := Node.ItemId;
TreeView_GetItem(Node.TreeView.Handle, TvItem);
Result := (TvItem.State and TVIS_CHECKED) = TVIS_CHECKED;
end;

procedure TMTreeView.SetCheckBoxes(const Value: Boolean);
begin
if Value<>Self.FCheckBoxes then
begin
FCheckBoxes := Value;
SetComCtlStyle(Self,TVS_CHECKBOXES,Value);
if not value then Self.Perform(CM_RECREATEWND,0,0);
end;
end;

procedure TMTreeView.SetComCtlStyle(Ctl: TWinControl; Value: Integer;
UseStyle: Boolean);
var
Style: Integer;
begin
if Ctl.HandleAllocated then
begin
Style := GetWindowLong(Ctl.Handle, GWL_STYLE);
if not UseStyle then Style := Style and not Value
else Style := Style or Value;
SetWindowLong(Ctl.Handle, GWL_STYLE, Style);
end;
end;

procedure TMTreeView.SetOnQueryCheck(const Value: TMTreeViewQueryCheckEvent);
begin
FOnQueryCheck := Value;
end;

procedure TMTreeView.WMLButtonDown(var Message: TWMLButtonDown);
begin
Inherited;
DoCheck(Message.XPos,Message.YPos);
end;

procedure TMTreeView.DoCheckNode(Node: TTreeNode; Checked: Boolean);
var
TvItem :TTVItem;
begin
FillChar(TvItem, SizeOf(TvItem), 0);
with TvItem do begin
hItem := Node.ItemId;
Mask := TVIF_STATE;
StateMask := TVIS_STATEIMAGEMASK;
if Checked then
TvItem.State :=TVIS_CHECKED
else
TvItem.State :=TVIS_CHECKED shr 1;
TreeView_SetItem(Node.TreeView.Handle, TvItem);
end;
end;

procedure TMTreeView.CNNotify(var Message: TWMNotify);
var
Pt : TPoint;
Node : TTreeNode;
begin
Inherited;
with Message do
begin
PostMessage(TWinControl(Owner).Handle,WM_User,NMHdr^.code,0);
case NMHdr^.code of
-410 :
begin
Self.FEdting := True;
end;
-411 :
begin
Self.FEdting := False;
GetCursorPos(Pt);
Pt := Self.ScreenToClient(Pt);
Node := Self.GetNodeAt(Pt.X,Pt.Y);
Self.DoCheckNode(Node,not Self.NodeChecked(Node));
end;
end;
end;
end;

procedure TMTreeView.SetOnCheck(const Value: TMTreeViewCheckEvent);
begin
FOnCheck := Value;
end;

procedure TMTreeView.DoQueryNCheck(Node: TTreeNode);
begin
Self.DoCheckNode(Node,Not Self.NodeChecked(Node));
Self.CheckNode(Node,Not Self.NodeChecked(Node),True);
end;

procedure TMTreeView.CNKeyDown(var Message: TWMKeyDown);
begin
inherited;
if Message.CharCode = VK_SPACE then
if Assigned(Self.Selected) then
begin
Self.DoCheckNode(Self.Selected,Not Self.NodeChecked(Self.Selected));
Self.DoQueryNCheck(Self.Selected);
Self.DoCheckNode(Self.Selected,Not Self.NodeChecked(Self.Selected));
end;

end;

end.

copy from keylife

zhengrong117 — 2009-7-1 19:17:11

http://www.delphibbs.com/keylife/iblog_show.asp?xid=16004

复制web内容

zhengrong117 — 2009-7-1 19:12:43

javascript:document.body.contentEditable='true'; document.designMode='on';!msn1dai

将字符串分隔

de410 — 2009-7-1 10:38:09

procedure Split (S: string; SplitChar: string; R: TStrings); //将字符串分隔
var
P, L, C: Integer;
begin
R.Clear;
L := Length (S);
//确定分隔符的长度，以便删除字符串中的相应字符
C := Length (SplitChar);
//循环分隔字符串
repeat
P := Pos (SplitChar, S);
//如果在字符串中没有找到分隔符，说明为最后一个
if P = 0 then C := 1;
R.Add (Copy (S, P C, L));
Delete(S, P, L);
until P = 0;
end;

治肾结石不用开刀

彭柏林 — 2009-7-1 9:47:36

朋友,如你有肾结石只要石头不超绿豆大小,本人只要帮你配10付家传中草药包好,QQ:408628408,祝你早日康复.

WINDOWS常用命令行工具

luoyanqing119 — 2009-6-30 14:27:16

http://topic.csdn.net/u/20090628/01/8F6A8FF4-AFE1-4B14-AB78-E5442E7004B9.html
WINDOWS常用命令行工具

play Red free games

kaixin9628 — 2009-6-30 7:40:40

Keep the falling balls from hitting your base.
How to play Red free games:
Mouse = Aim & Shoot small bullets Spacebar = Shoot larger bullets

让stringgrid的fixedcols、fixedrows文字居中，内容居右

de410 — 2009-6-29 19:42:03

procedure Tmain.StGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
//StGrid1.Canvas.Brush.Color:=clBtnFace;//co即为你所需要的颜色
//StGrid1.Canvas.FrameRect(Rect);
StGrid1.Canvas.FillRect(Rect);
if ( ARow = 0 ) or (ACol=0)then
begin
//StGrid1.Canvas.FillRect(Rect);
DrawText(StGrid1.Canvas.Handle,
pChar(StGrid1.Cells[ACol,ARow]),
Length(StGrid1.Cells[ACol,ARow]),
Rect, // 包含文字的矩形
DT_CENTER or // 水平居中 DT_RIGHT 水平居右
DT_SINGLELINE or // 不折行
DT_VCENTER) // 垂直居中 ;
end
else
//StGrid1.Canvas.FillRect(Rect);
DrawText(StGrid1.Canvas.Handle,
pChar(StGrid1.Cells[ACol,ARow]),
Length(StGrid1.Cells[ACol,ARow]),
Rect, // 包含文字的矩形
DT_Right or // 水平居右 DT_CENTER 水平居中
DT_SINGLELINE or // 不折行
DT_VCENTER) // 垂直居中 ;
end;

Tennis Game

kaixin9628 — 2009-6-29 7:40:31

Step onto the court with the top female tennis players of the world!

How to play Tennis flash Games:
Arrows = Move
Space = Swing Racket

111111111111111111111111111

kaixin9628 — 2009-6-28 17:39:55

33333333333333333333333333333333333

D11的帮助

Kisber — 2009-6-28 16:08:28

　　对于 Borland 的帮助文档，应该不止我一个人觉得好。当你有什么不明白的时候，按个 F1，总能找到你想要的东西，对于一些重要的内容，帮助文档里，还会举例给你看，接受 Borland 的文档帮助，真是一个愉悦过程；这也是我常常向使用 VC 的朋友炫耀，他们却没办法反驳的。
　　可惜，这都是 D5D7 年代的事了。如今到了 D11，查帮助文档，简直能把你气死。
　　举过例子，我们要查找 AS_RowRequest，D7 的帮助文档结果是：
//--------------D7-------------------------
Returns information from a specified record of the provider抯 dataset.

Delphi syntax:

function AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant; safecall;

C++ syntax:

virtual HRESULT __safecall AS_RowRequest(const WideString: ProviderName, OleVariant Row, int RequestType, OleVariant: &OwnerData, OleVariant &RowRequest_result) = 0 ;

Description

Client datasets call AS_RowRequest automatically to implement their FetchBlobs, FetchDetails , or RefreshRecord method.

The ProviderName parameter indicates the provider associated with the dataset from which information should be fetched.

The Row parameter is an OleVariant that describes the current record on the client dataset.

The RequestType parameter indicates the type of information required. It is an integer version of the TFetchOptions type. (An integer because the value may be marshaled to a remote application server). To create a value for RequestType, take the corresponding TFetchOptions value, cast it to a Byte, and cast the result to an Integer:

Integer(Byte([foBlobs, foDetails]));
(int) (Byte) (TFetchOptions() << foBlobs << foDetails);

OwnerData contains custom information that is supplied by a client dataset抯 BeforeRowRequest event handler. This information is passed to the provider抯 BeforeRowRequest event handler. OwnerData returns custom information supplied by the provider抯 AfterRowRequest event handler.

The requested data is returned as a delta packet in RowRequest_result (C++).
//-------------------------------------------------------
　　 D11呢？你看：
//-------------------D11---------------------------------
Pascal
function AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant; safecall;
Description
This is AS_RowRequest, a member of class IAppServer.
//-------------------------------------------------------
　　 Fu.ck !

创维26L16SW 孔距液晶电视支架旋转电视支架

液晶电视支架 — 2009-6-28 1:18:36

创维26L16SW特性

    ● 六基色图像处理技术
    ● V12数字引擎
    ● Blue wave无线蓝波
    ● 高清USB流媒体技术
    ● 画中画、双视窗
    ● 高亮度600cd/m2
    ● 超高对比度1200:1
    ● 超快响应时间8ms
    ● 超宽可视角度178°
    ● 物理分辨率1366x768
    ● HDMI高清晰多媒体端口

查看创维26L16SW详细特性>>

创维26L16SW主要参数

液晶电视尺寸：26英寸

亮度：600cd/㎡

对比度：1200:1

分辨率：1366×768

响应时间：8ms

分量端子：支持

D-Sub接口：1组

TV端子：1组

AV端子：支持

比例：16:9

机身尺寸：692×557×225m...

机身净重：11.500kg

快速定位：

面板规格影像参数音效参数输入输出外观参数

创维26L16SW面板规格

26英寸

16:9

1366×768

600cd/㎡

1200:1

178°/178°

8ms

创维26L16SW影像参数

其他特色功能

六基色图像处理技术 V12数字引擎 Blue wave无线蓝波多画面浏览

挑错

创维26L16SW音效参数

SRS环绕

多音效模式

立体声

创维26L16SW输入输出

AV端子

分量端子

TV端子

1组

挑错

D-Sub接口

1组

挑错

创维26L16SW外观参数

机身尺寸

692×557×225mm

挑错

机身净重

11.500kg

挑错

旋转液晶电视支架液晶显示器支架 LCD显示器架液晶壁挂架三星

旋转液晶电视支架液晶显示器支架 LCD显示器摆动支架 LCD挂架 LG

旋转液晶电视支架液晶显示器支架液晶活动支架显示器挂架 SONY

旋转液晶电视支架液晶显示器支架显示器壁挂架 LCD活动支架

壁挂式液晶电视支架液晶显示器支架液晶壁挂支架 LCD电视挂架

壁挂式液晶电视支架液晶显示器支架液晶显示器活动支架夏普

壁挂式液晶电视支架液晶显示器支架显示器活动支架翰士奇

壁挂式液晶电视支架液晶显示器支架 LCD电视机架液晶挂墙支架

旋转液晶电视支架液晶显示器支架 LCD电视机挂墙支架冠捷 AOC

旋转液晶电视支架液晶显示器支架 LCD电视壁挂支架 LCD摆动支架

旋转液晶电视支架液晶显示器支架 LCD挂墙支架显示器背景墙支架

你想让电视动起来吗？

你用电脑久了，肩膀会痛吗？颈椎还好吗？

你在为机顶盒的安装位置烦恼吗？

X支架之家--视界因我而动

全国支架专卖

http://www.xzjzj.cn/

QQ:4646746

电话：13726233858

经典支架应用视频

http://player.youku.com/player.php/sid/XNzczMjcwOTY=/v.swf

http://player.youku.com/player.php/sid/XNzM1NjMzNzY=/v.swf

孔距支架液晶等离子 LCD 电视 LED 电视机 X支架之家投影机投影仪
吊架壁挂架移动旋转万向万能 360度旋转夹具锁孔落地推车
电视柜笔记本液晶屏

打印机相关

yeszhang — 2009-6-27 18:57:32

1、检测当前打印机状态
用内嵌汇编调用中断INT 17H,读取打印机的状态字节加以分析,即可得到其当前状态.
例：输入参数：如果有3个打印端口LPT1、LPT2、LPT3，那么输入参数LPTPort就是1、2、3。
function TestPrinterStatus(LPTPort : word):byte;
var status : byte;
CheckLPT : word;
begin
status := 0;
if (LPTPort >=1) and (LPTPort <=3) then
begin
CheckLPT := LPTPort -1;
asm
mov dx,CheckLPT;
mov al,0;
mov ah,2;
int 17H;
mov &status,ah;
end;
end;
result := status;
end;
返回值有以下几种：
01H：超时
08H：I/O错误
10H：打印机未联机
20H：打印机缺纸
80H：打印机空闲。

IE神奇的代码---通杀各种网站-可随意修改复制页面内容

yeszhang — 2009-6-27 18:43:36

神奇的代码---通杀各种网站-可随意修改复制页面内容
在地址栏输入这一行代码，然后回车，就发现整个页面都可以随意编辑了。仅仅是一行很短的代码。

页面上的所有内容都可以修改了，就像在word中编辑一样。那些不让拷贝的网站可以被这招通杀了。以后谁还会傻乎乎地分析页面代码，然后修改，保存，刷新，再拷贝呢？

javascript:document.body.contentEditable='true'; document.designMode='on';!msn1dai

ADO 使用这个连接串不会产生ldb

yeszhang — 2009-6-27 18:40:43

Provider=Microsoft.Jet.OLEDB.4.0;Data Source=你的数据库路径 ;Mode=Share Deny Read|Share Deny Write;Persist Security Info=False;Jet OLEDB:Database Password=你的数据库密码

后台调用外部程序的完美实现（收藏)

yeszhang — 2009-6-27 18:36:23

最近在做的一个软件，其中有一部分功能需要调用其它的软件来完成，而那个软件只有可执行文件，根本没有源代码，幸好，我要做的事不难，只需要在我的程序启动后，将那个软件打开，在需要的时候，对其中的一个文本矿设置一些文字，再点击一个按钮就可以了。

说到这里，相信你也有了对该功能的一些初步设想了，没错，其基本思路就是：
1）调用CreateProcess（）打开目标程序。
2）用FindWindow（）找到目标程序的窗口Handle。
3）找到文本框的Handle，以及按钮的MessageID，用SendMessage（）方法设置文字，并触发事件。

好了，这样确实很简单吧，但是当我实现它后，却发现这样做的结果则是：当我的程序启动并打开目标程序时，它的Splash窗口，以及主窗口都将显示出来，即使当我用FindWindow（）找到主窗口Handle后，调用SendMessage（WindowHandle， SW_HIDE）来隐藏该窗口，还是会有一瞬主窗口被显示出来的，这样的效果实在是最求完美的我不忍心看到的。

那么怎么解决这个问题呢，首先我当然在CreateProcess（）上面寻找方法，可惜，它只有一个参数可以设置窗口的默认显示方式，但是一旦这个窗口自己重设了显示方式，它就没有任何作用了。。。。继续查找文档，这时我看到CreateProcess（）的一个参数TStartupInfo中有 lpDesktop这么一个属性，按照MSDN的说法，如果该指针为NULL，那么新建的Process将在当前Desktop上启动，而如果对其赋了一个Desktop的名称后，Process将在指定的Desktop上启动，恩，看来不错，就从它入手了：

1）首先，建立一个虚拟的Desktop，
const
DesktopName = 'MYDESK';

FDesktop:=CreateDesktop(DesktopName,nil,nil,0,GENERIC_ALL,nil);
Windows中可以建立多个Desktop，可以使用SwitchDesktop（）来切换哪个Desktop被显示出来，以前有过将Windows模拟成Linux的形式，可以在多个虚拟Desktop中切换的程序，其实那种程序也是用的Windows本身的虚拟Desktop功能来实现的，另外 Windows的启动画面，以及屏保画面也都是用虚拟Desktop实现的，好了，关于这方面不多介绍了，感兴趣的话，可以到MSDN中查看更详细资料：
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dllproc/base/enumdesktops.asp

2）在CreateProcess的时候，指定程序在我新生成的Desktop上运行：
var
StartInfo:TStartupInfo;

FillChar(StartInfo, sizeof(StartInfo), 0);
StartInfo.cb:=sizeof(StartInfo);
StartInfo.lpDesktop:=PChar(DesktopName); //指定Desktop的名称即可
StartInfo.wShowWindow:=SW_HIDE;
StartInfo.dwFlags:=STARTF_USESHOWWINDOW;
StartInfo.hStdError:=0;
StartInfo.hStdInput:=0;
StartInfo.hStdOutput:=0;
if not CreateProcess(PChar(FileName),nil,nil,nil,true,CREATE_NEW_CONSOLE+HIGH_PRIORITY_CLASS,nil,PChar(ExtractFilePath(FilePath)),StartInfo,FProceInfo) then begin
MessageBox(Application.Handle,'Error when init voice (5).',PChar(Application.Title),MB_ICONWARNING);
exit;
end;

3）用FindWindow去找程序的主窗口
开始我直接写下了这样的代码：
for I:=0 to 60 do begin //wait 30 seconds for open the main window
WindowHandle:=FindWindow(nil,'WindowCaption');
if WindowHandle<>0 then begin
break;
end;
Sleep(500);
end;
但是，实践证明，这样是找不到不在当前Desktop中的Window的，那怎么办呢：
答案是，可以用SetThreadDesktop（）函数，这个函数可以设置当前Thread工作所在的Desktop，于是我在以上代码前又加了一句：
if not SetThreadDesktop(FDesktop) then begin
exit;
end;
但是，程序运行后，该函数却返回了false，说明方法调用失败了，再仔细看MSDN，发现有这么一句话：

The SetThreadDesktop function will fail if the calling thread has any windows or hooks on its current desktop (unless the hDesktop parameter is a handle to the current desktop).

哦，原来需要切换Desktop的线程中不能有任何UI方面的东西，而我是在程序的主线程中调用该方法的，当然会失败拉，知道了这点就好办了，我只需要用一个“干净”的线程，让它绑定到新的Desktop上，再让它用FindWindow（）方法找到我要找的WindowHandle，不就可以了吗，于是，这一步就需要借助一个线程了，线程的代码如下：

TFindWindowThread = class(TThread)
private
FDesktop:THandle;
FWindowHandle:THandle;
protected
procedure Execute();override;
public
constructor Create(ACreateSuspended:Boolean;const ADesktop:THandle);reintroduce;
property WindowHandle:THandle read FWindowHandle;
end;

{ TFindWindowThread }

procedure TFindWindowThread.Execute();
var
I:Integer;
begin
//make the current thread find window on the new desktop!
if not SetThreadDesktop(FDesktop) then begin
exit;
end;
for I:=0 to 60 do begin //wait 30 seconds for open the main window
FWindowHandle:=FindWindow(nil,PChar('WindowCaption'));
if FWindowHandle<>0 then begin
break;
end;
Sleep(500);
end;
end;

constructor TFindWindowThread.Create(ACreateSuspended:Boolean;const ADesktop:THandle);
begin
inherited Create(ACreateSuspended);
FDesktop:=ADesktop;
end;

而主程序中的代码变成这样：
FindWindowThread:=TFindWindowThread.Create(false,FDesktop);
try
FindWindowThread.WaitFor;
FMainWindowHandle:=FindWindowThread.WindowHandle;
finally
FindWindowThread.Free;
end;
if FMainWindowHandle=0 then begin
MessageBox(Application.Handle,'Error when init voice (6).',PChar(Application.Title),MB_ICONWARNING);
exit;
end;

呵呵，成功，这样果然可以顺利的找到窗口Handle了。

4）最后，再用这个主窗口Handle，找出里面的EditBox的Handle，如这样：
FEditWindow:=FindWindowEx(FMainWindowHandle,0,PChar('Edit'),nil);
我在这里指定了这个文本框的ClassName，这个名称可以用Spy＋＋得到。

初始化的工作就到此结束了，如果顺利，程序就真正在后台被运行了起来。那么功能调用呢，还是和一般的做法一样：

if (FMainWindowHandle=0) or (FEditWindow=0) then begin
exit;
end;
SendMessage(FEditWindow,WM_SETTEXT,0,LongInt(@AText[1]));
SendMessage(FMainWindowHandle,WM_COMMAND,$8012,$0);
其中$8012这个数字，也是用Spy＋＋来得到的资源ID。

最后，别忘了关闭程序，以及释放虚拟Desktop：
if FProceInfo.hProcess<>0 then begin
TerminateProcess(FProceInfo.hProcess,0);
end;
if FDesktop<>0 then begin
CloseDesktop(FDesktop);
end;

好了，这样就几乎完美的实现了一个后台调用程序的功能，它对最终客户来说将是完全透明的，客户根本感觉不到后台还有另一个程序在工作。是不是很爽啊，这样别人的很多程序我们都可以直接拿来用了（当然了，得在遵守版权的基础上才行拉）。

TClientDataSet使用

yeszhang — 2009-6-27 18:30:55

TClientDataSet
　　与TTable、TQuery一样，TClientDataSet也是从TDataSet继承下来的，它通常用于多层体系结构的客户端。 TClientDataSet最大的特点是它不依赖于BDE(Borland Database Engine)，但它需要一个动态链接库的支持，这个动态链接库叫DBCLIENT.DLL。在客户端，也不需要用TDatabase构件，因为客户端并不直接连接数据库。
　　由于TClientDataSet是从TDataSet继承下来的，所以，它支持诸如编辑、搜索、浏览、纠错、过滤等功能。由于 TClientDataSet在内存中建立了数据的本地副本，上述操作的执行速度很快。也正是由于TClientDataSet并不直接连接数据库，因此，客户程序必须提供获取数据的机制。在Delphi 4中，TClientDataSet有三种途径获取数据：
.从文件中存取数据。
.从本地的另一个数据集中获取数据。
.通过IProvider接口从远程数据库服务器获取数据。
　　在一个客户程序中，可以同时运用上述三种机制获取数据。
11.1 浏览和编辑数据
　　和其他数据集构件一样，可以用标准的数据控件显示由TClientDataSet引入的数据集，当然，这需要借助于TDataSource构件。
　　由于TClientDataSet是从TDataSet继承下来的，所以，凡是其他数据集构件支持的功能，TClientDataSet构件也大致具备。不同的是，TClientDataSet能够在内存中建立数据的副本，因此，TClientDataSet比其他数据集构件增加了一些特殊的功能。
11.1.1 浏览数据
　　可以用标准的数据控件显示由TClientDataSet引入的数据集。在运行期，可以调用诸如First、GotoKey、Last、Next和Prior等函数来浏览数据。
　　TClientDataSet也支持书签功能，可以用书签来标记某条记录，以后就可以方便地找到这条记录。
　　对于TTable、TQuery等数据集构件来说，只能读RecNo属性来判断当前记录的序号。对于TClientDataSet构件来说，还可以写RecNo属性，使某一序号的记录成为当前记录。
11.1.2 CanModify属性
　　TDataSet的CanModify属性用于判断数据集中的数据是否可以修改。CanModify属性本身是只读的，也就是说，数据是否能够修改不取决于应用程序。
　　不过，TClientDataSet构件有其特殊性，因为TClientDataSet已经把数据在内存中建立了副本，因此，应用程序可以决定是否允许修改数据。如果不允许用户修改数据，只要把ReadOnly属性设为True，此时，CanModify属性肯定返回False。
　　与其他数据集构件不同，修改TClientDataSet构件的ReadOnly属性时，不需要事先把Active属性设为True。
11.1.3 取消修改
　　TClientDataSet传输数据的基本单位称为数据包，当前的数据包可以由Data属性来访问。不过，用户对数据的修改并不直接反映到Data属性中，而是临时写到一个日志即Delta属性中，这样做的好处是以后随时可以取消修改。
　　不过，这里要说明一点，尽管用户的修改并没有反映到Data，当用户在数据控件中看到的却是最新修改的数据。如果一条记录被反复修改了多次，用户看到的只是最新的数据，但日志中却记载了多次。
　　要取消上一次的修改，调用UndoLastChange函数。UndoLastChange需要传递一个布尔类型的参数叫FollowChange，如果FollowChange参数设为True，光标就移到被恢复的记录上，如果FollowChange参数设为False，光标仍然在当前记录上。
　　ChangeCount属性返回日志中记载的修改次数。如果一条记录被反复修改了多次，每调用一次UndoLastChange能够逐级取消上一次的修改。
　　UndoLastChange只能取消上一次的修改，如果想一下子取消所有的修改，首先要选择一个记录，然后调用RevertRecord。RevertRecord将从日志中取消所有对当前记录的修改。
　　TClientDataSet还有一个SavePoint属性，它能把当前的编辑状态保存起来，以后随时可以返回当时的状态。例如，可以这样保存当前的状态：
　　BeforeChanges := ClientDataSet1.SavePoint;
　　以后，可以这样来恢复当时的状态：
　　ClientDataSet1.SavePoint := BeforeChanges;
　　应用程序可以保存多处状态，可以恢复其中一个状态，不过，一旦某个状态被恢复，在其之后的状态就无效。
　　如果要一下子取消日志中记载的所有修改，可以调用CancelUpdates函数。CancelUpdates将把日志清空，取消所有的修改。
　　如果LogChanges属性设为False，用户对数据的修改就会直接反映到Data属性中。
11.1.4 合并修改
　　要把日志中记载的修改合并到Data属性中，有两种方式，具体使用哪一种方式，取决于应用程序获取数据的机制。不过，不管是哪种机制，合并后，日志自动被清空。
　　对于一个从文件中获取数据的程序来说，只要调用MergeChangeLog函数，就把日志中记载的修改合并到Data属性中。不用担心其他用户同时修改了数据。
　　对于一个从应用服务器获取数据的程序来说，就不能调用MergeChangeLog来合并数据，而要调用ApplyUpdates函数， ApplyUpdates会把日志中记载的修改传递给应用服务器，待应用服务器成功地把数据更新了数据库服务器后，才会合并到Data属性中。
11.1.5 纠错
　　TClientDataSet支持纠错功能。一般情况下，需要自己建立纠错规则，以便对用户输入的数据进行纠错。
　　此外，如果获得了IProvider接口的话，还可以从远程服务器引入纠错规则。
　　有时候，客户端可能需要暂时禁止纠错，因为客户端从应用服务器检索数据是分阶段进行的，在所有的数据检索完毕之前，有些纠错规则很可能会报错。
要暂时禁止纠错，可以调用DisableConstraints，要重新允许纠错，可以调用EnableConstraints函数。DisableConstraints和EnableConstraints实际上都是作用于一个内部的计数。
11.2 索引
　　使用索引有这么几个好处：
.在数据集中定位记录比较快。
.能够在两个数据集之间建立Lookup或Master/Detail关系。
.可以对记录排序。
　　在多层体系结构中，当客户程序从应用服务器检索数据时，它同时获得了默认的索引。默认的索引叫DEFAULT_ORDER，可以使用这个索引排序，但不能修改或删除这个索引。
　　除了默认的索引外，TClientDataSet还对日志中记载的记录自动建立了一个副索引叫CHANGEINDEX。与DEFAULT_ORDER一样，不能修改或删除这个副索引。
　　另外，还可以使用数据集中已建立的其他索引，或者自己建立索引。
11.2.1 创建一个新的索引
　　要创建一个新的索引，可以调用AddIndex。AddIndex需要传递若干个参数：
　　一是Name参数，用于指定索引名。在运行期切换索引时需要用到索引的名称。
　　二是Fields参数，它是一个字符串，用于指定索引中的字段名，彼此之间用分号隔开。
　　三是Options参数，用于设置索引的选项，包含ixDescending元素表示按降序排列，包含ixCaseInsensitive元素表示大小写不敏感。
　　四是DescFields参数，它也是一个字符串，用于指定若干个字段名，这些字段将按照降序排列。
　　五是CaseInsFields参数，它的作用与DescFields参数类似，包含在CaseInsFields参数中的字段将对大小写不敏感。
　　六是GroupingLevel参数，用于指定分组级别，其值不能超过索引中的字段数。
　下面的代码创建了一个索引：
If Edit1.Text <> '' and ClientDataSet1.Fields.FindField(Edit1.Text) then
Begin
ClientDataSet1.AddIndex(Edit1.Text+'Index',Edit1.Text, 　
　 [ixCaseInsensitive],'','',0);
ClientDataSet1.IndexName := Edit1.Text + 'Index';
End;
为了避免创建一个索引，可以临时用IndexFieldNames属性来指定若干个字段，让数据集按这些字段排序。
11.2.2 删除和切换索引
　　要删除一个先前创建的索引，可以调用DeleteIndex并指定要删除的索引名称。注意：DEFAULT_ORDER和CHANGEINDEX不能删除。
　　如果建立了多个索引，可以任意选择其中的一个索引，这就要用到IndexName属性。
11.2.3 用索引把数据分组
　　选择了一个索引后，数据集将自动按其中的字段进行排序。这样，临近的记录往往在关键字段上含有相同的值。例如，假设有一个表是这样的：
SalesRep　Customer　OrderNo　Amount
1　　　　　　1 　　　　5 　　　100
1　　　　　　1　　　　 2　　　 50
1　　　　　　2　　　　 3 　　　200
1 　　　　　2　　　　6　　　75
2　　　　　　1　　　　1　　　10
2　　　　　　3　　　　4　　　200
　　可以看出，SalesRep字段的值有重复的。对于SalesRep字段的值为1的来说，Customer字段的值也有重复的。这就是说，可以按 SalesRep字段分组，进而再按Customer字段分组。显然，这里的分组级别是不同的，按SalesRep字段建立的分组属于第一级，按 Customer字段建立的分组属于第二级。实际上，分组级别取决于字段在索引中的顺序。
　　TClientDataSet可以决定是否按照分组级别来显示记录的值。例如，也许想以下面这种形式显示数据：
SalesRep　Customer　OrderNo　Amount
1　　　　　　1　　　　5　　　　100
　　　　　　　　　　　2　　　　50
　　　　　　 2　　　　3　　　　200
　　　　　　　　　　　6　　　　75
2　　　　　　1　　　　1　　　　10
2　　　　　　3　　　　4　　　　200
　　要判断当前记录某一级的什么位置，可以调用GetGroupState函数。GetGroupState函数需要传递一个参数，用于指定分组级别。
11.3 计算字段
　　与其他数据集一样，也可以在TClientDataSet建立的数据集中增加计算字段。计算字段的值是基于同一个记录中的其他字段计算出来的。
　　在其他数据集中，只要用户修改了数据或当前记录发生改变，就会触发OnCalcFields事件，换句话说，计算字段的值就被计算一次。
　　TClientDataSet引入了“内部计算字段”的概念。与一般的计算字段不同的是，内部计算字段的值将随其他字段的值一起存取，这样，只有当用户修改了数据才会触发OnCalcFields事件，如果仅仅改变了当前记录，不会触发OnCalcFields事件。也就是说，内部计算字段的值需要重新计算的机会大大减少。
　　在处理OnCalcFields事件的句柄中，首先要判断State属性。如果State属性返回dsInternalCalc，此时需要计算内部计算字段的值。如果State属性返回dsCalcFields，此时需要计算一般的计算字段的值。
11.4 统计值
　　TClientDataSet增加了统计的功能，它可以基于分组自动计算总和、平均、计数、最大、最小值。当用户编辑数据时，这些统计值会自动跟着变化。
11.4.1 指定统计方式
　　要指定怎样进行统计，就要用到Aggregates属性。这个属性是一个TAggregates对象，它用于管理一组TAggregate对象。
　　在设计期，可以单击Aggregates属性边上的省略号按钮打开如图11.1所示
的编辑器。
　　图11.1 管理一组TAggregate对象
　　单击按钮可以增加一个TAggregate对象，单击按钮可以删减一个TAggregate对象，单击按钮可以把TAggregate对象前移，单击按钮可以把TAggregate对象后移。
　　可以用字段编辑器专门创建一个用于表达统计值的字段，该字段的类型必须是“Aggregate”。Delphi 4会自动创建一个 TAggregate对象，并加到Aggregates属性中。选择一个TAggregate对象，Object Inpector将显示该对象的属性。
　　其中，Expression属性用于指定统计表达式，例如：
Sum(Field1)
　　也可以是比较复杂的表达式：
Sum(Qty * Price) - Sum(AmountPaid)
　　在表达式中，可以使用下列统计运算符：
.Sum计算一组数据的总和。
.Avg计算一组数据的平均值。
.Count计算一组数据中的非空值的个数。
.Min计算一组数据的最小值。
.Max计算一组数据的最大值。
　　除了上述几个统计运算符外，还可以使用过滤条件中所能使用的运算符，但不能嵌套。在一个表达式中，可以混合出现几个统计值或常量，但不能混合出现统计值和字段。
　　Sum(Qty * Price){合法}
　　Max(Field1) - Max(Field2){合法}
　　Avg(DiscountRate) * 100{合法}
　　Min(Sum(Field1)){非法，不能嵌套}
　　Count(Field1) - Field2{非法，统计值和字段不能混合出现在一个表达式中}
11.4.2 指定分组
　　默认情况下，统计值是基于数据集中所有的记录计算出来的。不过，也可以针对一部分记录计算统计值，这就需要事先建立分组。
　　前面在介绍索引时已经提到分组的概念。可以通过IndexName属性和GroupingLevel属性来选择使用哪个索引以及最大的分组级别。
　　例如，假设有一个表是这样的：
SalesRep　Customer　OrderNo　Amount
1　　　　　　1 　　　　5 　　　100
1　　　　　　1　　　　 2　　　 50
1　　　　　　2　　　　 3 　　　200
1 　　　　　2　　　　6　　　75
2　　　　　　1　　　　1　　　10
2　　　　　　3　　　　4　　　200
　　如果要按SalesRep字段分组，并且指定其中的第一级，程序代码应当这样写：
Agg.Expression := 'Sum(Amount)';
Agg.IndexName := 'SalesCust';
Agg.GroupingLevel := 1;
Agg.AggregateName := 'Total for Rep';
11.4.3 怎样获取统计值
　　要获取统计值，可以调用TAggregate对象的value函数。如果统计值是基于数据集中所有的记录计算出来的，随时可以调用value函数。如果统计值是基于分组计算出来的，必须保证当前记录正好位于该分组内。因此，在调用value之前，最好先调用GetGroupState函数看看当前记录是否位于该分组内。
　　要在数据控件中显示统计值，必须事先在字段编辑器中创建一个永久字段对象，该字段的类型必须是Aggregate。
11.5 数据包
　　通过Data属性可以访问客户程序从应用服务器检索到的数据。程序示例如下：
Procedure TForm1.Button1Click(Sender: TObject);
Begin
ClientDataSet1.Data := ClientDataSet1.Provider.DataRequest(FilterEdit.Text);
End;
11.5.1 直接对Data属性赋值
　　前面讲过，客户程序既可以通过IProvider接口获取数据，也可以从另一个数据集获取数据，后者就是通过Data属性赋值的。程序示例如下：
　　ClientDataSet1.Data := ClientDataSet2.Data;
　　一旦Data被赋值，就可以用标准的数据控件显示这些数据。
　　注意：当从另一个数据集获取数据时，另一个数据集的日志也将被复制过来，但不包括原来的范围和过滤条件。
　　如果要从另一个基于BDE的数据集中获取数据，可以通过数据集构件的Provider属性，程序示例如下：
　　ClientDataSet1.Data := Table1.Provider.Data;
　　如果要从一个自定义的数据集获取数据，首先要创建一个临时的TProvider构件，然后设置其DataSet属性指定这个自定义的数据集。程序示例如下：
TempProvider := TDataSetProvider.Create(Form1);
TempProvider.DataSet := SourceDataSet;
ClientDataSet1.Data := TempProvider.Data;
TempProvider.Free;
11.5.2 在数据包中加入自定义的信息
　　可以把自定义的信息加到数据包中。当把数据保存到文件或流中时，这些自定义的信息也将保存到文件或流中。如果把数据包直接赋值给另一个数据集的话，这些自定义的信息也将被复制。
　　要把自定义的信息加到数据包中，可以调用SetOptionalParam函数。要从数据包中检索自定义的信息，可以调用GetOptionalParam。程序示例如下：
Procedure TAppServer.Provider1UpdateData(Sender: TObject; DataSet: TClientDataSet);
var
WhenProvided: TDateTime;
Begin
WhenProvided := DataSet.GetOptionalParam('TimeProvided');
...
End;
11.5.3 克隆另一个数据集
　　调用TClientDataSet的CloneCursor函数可以获得一个数据集的完全相同的副本。它与直接通过Data属性赋值是有区别的。
　　区别之一：数据在两个数据集之间是共享的，修改其中一个将同时修改另一个。
　　区别之二：除了数据外，CloneCursor函数还复制了一些属性和事件，这取决于Reset和KeepSettings参数怎样设置。
　　　CloneCursor函数需要传递三个参数，其中，Source参数指定源数据集，Reset参数和KeepSettings参数用于设置除了数据外是否还要复制下列属性和事件：Filter、Filtered、FilterOptions、OnFilterRecord、IndexName、 MasterSource、MasterFields、ReadOnly、RemoteServer、ProviderName、Provider。
　　如果Reset和KeepSettings参数都设为False，源数据集的上述属性和事件都将被复制给目标数据集。如果Reset参数设为True，目标数据集的上述属性和事件都将被清空。如果Reset参数设为False，而KeepSettings参数设为True，目标数据集的上述属性和事件不变，不过，必须保证这些属性和事件与克隆后的数据相容。
11.6 与应用服务器通讯
　　在多层体系结构中，客户程序通过IProvider接口与应用服务器交换数据。这一章介绍怎样在客户端获得IProvider接口、怎样向应用服务器传递参数、怎样向应用服务器请求数据、怎样把用户对数据的修改写到数据库中。
11.6.1 怎样在客户端获得IProvider接口
　　在单层应用程序以及工作在“公文包”模式下的多层应用程序中，不需要用到IProvider接口。而在多层体系结构中，客户程序要与应用服务器交换数据，首先必须获得IProvider接口，这就要用到RemoteServer属性和ProviderName属性。
　　RemoteServer属性用于指定客户端的MIDAS连接构件。MIDAS连接构件又称Data Broker，用于建立和维护与应用服务器的连接。
　　在设计期，正确设置了RemoteServer属性后，就可以在对象观察器中为ProviderName属性选择一个值，实际上就是选择应用服务器上的一个TProvider构件。
11.6.2 向应用服务器传递参数
　　客户程序可以向应用服务器传递参数，这些参数实际上是传递给应用服务器上的TQuery构件或TStoredProc构件。既可以在设计期也可以在运行期设置参数。
　　在设计期，可以单击Params属性边上的省略号按钮，打开一个如图11.2所示的编辑器。
　　图11.2 设置参数
　　单击按钮可以增加一个参数，单击按钮可以删减一个参数，单击按钮可以把一个参数前移，单击按钮可以把一个参数后移。
　　选择一个参数，对象观察器将显示该参数(TParam对象)的属性。
　　在运行期可以调用TParams的CreateParam函数来创建一个参数。例如，下面的代码创建了一个参数叫CustNo，它的使用类型是ptInput，数据类型是ftInteger，它的值设为605。
With ClientDataSet1.Params.CreateParam(ftInteger, 'CustNo', ptInput) Do
AsInteger := 605;
　　设置好参数以后，如果TClientDataset的Active属性是False，只要把Active属性设为True，这些参数将被自动传递给应用服务器。如果Active属性已经为True，就要调用SendParams函数把参数传递给应用服务器。
　　注意：传递给应用服务器的参数必须与TQuery构件或TStoredProc构件的参数匹配，包括名称、数据类型和参数类型。
11.6.3 怎样向应用服务器请求数据
　　TClientDataSet提供了两个属性和三个方法，用于怎样向应用服务器请求数据：
　　一是FetchOnDemand属性。如果这个属性设为True，TClientDataSet会根据需要自动检索附加的数据包，例如BLOB字段的值或者嵌套表的内容。如果这个属性设为False，程序需要显式地调用GetNextPacket才能获得这些附加的数据包。
　　二是PacketRecords属性，用于设置一个数据包中最多可容纳的记录数，设为-1表示一个数据包可以容纳数据集的所有记录。
　　三是GetNextPacket函数，用于向应用服务器检索下一个数据包，并把检索到的数据包添加到前一次检索到的数据包的后面。这个函数返回实际检索到的记录数。
　　四是FetchBlobs过程，用于从应用服务器检索BLOB字段的值。如果FetchOnDemand属性设为True，就没必要调用FetchBlobs函数。
　　五是FetchDetails过程，用于检索嵌套表中的数据。如果FetchOnDemand属性设为True，就没必要调用FetchDetails函数。
11.6.4 更新数据库
　　在多层体系结构中，用户在客户端修改了数据后，需要把最新的数据写到数据库中，这就要调用TClientDataSet的ApplyUpdates函数。
　　ApplyUpdates只需要传递一个参数叫MaxErrors，用于指定一个整数，当遇到无法更新的记录超过这个数时，此次更新就中止。如果 MaxErrors参数设为0，表示只要遇到一个错误更新就中止，客户端的日志保持不变。如果MaxErrors参数设为-1，当应用服务器发现有错误的记录，就尝试更新下一个记录，等所有的记录都尝试过以后才返回。
　　ApplyUpdates会自动调用Reconcile函数，进而调用应用服务器上的TProvider构件的ApplyUpdates函数去更新远程的数据库服务器。没有被DBMS服务器认可的记录通过Reconcile返回给客户端，此时将在客户端触发OnReconcileError事件让您更正错误。最后，ApplyUpdates函数返回仍然没有被认可的记录数。
11.7 在文件中存取数据
　　要从文件中读取数据，可以调用LoadFromFile函数。LoadFromFile函数需要传递一个参数，用于指定文件名。文件名应包含完整的路径。如果客户程序总是从一个固定的文件中读取数据，可以设置FileName属性指定一个文件名，以后，当TClientDataSet引入的数据集打开时，就自动从这个文件中读取数据，不需要调用LoadFromFile。
　　要从流中读取数据，可以调用LoadFromStream。LoadFromStream需要传递一个参数，用于指定一个流对象。
　　注意：LoadFromFile(LoadFromStream)只能从先前用SaveToFile(SaveToStream)保存的文件中读取数据。
　　要把数据保存到文件中，可以调用SaveToFile函数。SaveToFile需要传递一个参数，用于指定文件名。如果指定的文件已存在，文件中的数据将被覆盖。如果客户程序总是把数据保存到一个固定的文件中，可以设置FileName属性指定一个文件名，当TClientDataSet引入的数据集关闭时，就自动把数据保存到这个文件中，不需要调用SaveToFile。
　　要把数据保存到流中，可以调用SaveToStream。SaveToStream需要传递一个参数，指定一个流对象。
　　注意：当把数据保存到文件或流中时，日志中记载的修改仍然保留。这样，当下次调用LoadFromFile或LoadFromStream读取数据时，仍然可以恢复原来的数据

一个完整身份证效验程序

yeszhang — 2009-6-27 18:29:55

一个完整身份证效验程序

根据〖中华人民共和国国家标准 GB 11643-1999〗中有关公民身份号码的规定，
公民身份号码是特征组合码18位：由十七位数字本体码和一位数字校验码组成。排列顺序从左至右依次为：六位数字地址码，八位数字出生日期码，三位数字顺序码和一位数字校验码。
地址码表示编码对象常住户口所在县(市、旗、区)的行政区划代码。生日期码表示编码对象出生的年、月、日，其中年份用四位数字表示，年、月、日之间不用分隔符。顺序码表示同一地址码所标识的区域范围内，对同年、月、日出生的人员编定的顺序号。顺序码的奇数分给男性，偶数分给女性。
15位：六位数字地址码，六位数字出生日期码，三位数字顺序码和一位数字校验码。
var
codeInfoTst: Tstrings; //总
codeTst: Tstrings; //代码
InfoTst: Tstrings; //地址信息

function identityInfo(identitycode: string): string;
//由年月日判断是否为有效日期
function IsDate(Year, Month, Day: string): Boolean;
var
st: string;
begin

st := Year + '-' + Month + '-' + day;
try
StrToDate(st);
Result := True;
except

Result := False;

end;
end;

function getdetailedFromCode(code: string): string; //由身份证的前六位获得省份县市信息
var
Index: integer;
St: string;
begin
index := codeTst.IndexOf(code);
if index = -1 then
begin
Result := '';
exit;
end;
st := infoTst[index]; //县
code := copy(code, 1, 4) + '00';
index := codeTst.IndexOf(code);
if index = -1 then
begin
Result := st;
exit;
end;
st := infoTst[index] + st; //市

code := copy(code, 1, 2) + '0000';
index := codeTst.IndexOf(code);
if index = -1 then
begin
Result := st;
exit;
end;
st := infoTst[index] + st; //省
Result := st;

end;

var
YLYear, YLMonth, YlDay, id, sex, code: string;
E: integer;
St: string;

begin

e := Length(identitycode);
if (e <> 18) or (e <> 15) then result := '';
if (e = 18) then
begin
YLYear := copy(identitycode, 7, 4);
YlMonth := copy(identitycode, 11, 2);
YLday := copy(identitycode, 13, 2);
id := copy(identitycode, 18,1);
end;
if (e = 15) then
begin
YLYear := '19' + copy(identitycode, 7, 2);
YlMonth := copy(identitycode, 9, 2);
YLday := copy(identitycode, 11, 2);
id := copy(identitycode, 15, 1);
end;
st := '';
if IsDate(YlYear, YlMonth, Ylday) then
begin
st := YLYear + '年' + YlMonth + '月' + YLday + '日生'
end;
code := copy(identitycode, 1, 6);
st := getdetailedFromCode(code) + ':' + st;

if (StrToInt(id) mod 2 = 1) then
begin
sex := '男';
end
else
begin
sex := '女';
end;
st := st + ':' + sex + '性！' + Trim(IntToStr(e)) + '位证号！';
Result := st;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
i, num: integer;
code, info: string;
begin

codeInfoTst := Tstringlist.Create;
CodeTst := Tstringlist.Create;
infotst := Tstringlist.Create;
try
codeInfoTst.LoadFromFile('c:\code.txt');
//分解代码地址信息
num := Codeinfotst.Count;
for i := 0 to num - 1 do
begin
code := copy(Codeinfotst[i], 1, 6);
Info := copy(Codeinfotst[i], 8, length(Codeinfotst[i]) - 7);
codetst.Add(code);
infotst.Add(info);

end;
showmessage(identityInfo('530101700205379'));

finally
codeTst.Free;
infotst.Free;
CodeinfoTst.Free;
end;

end;

end.

Delphi实现窗体控件自由摆布

yeszhang — 2009-6-27 18:28:51

Delphi实现窗体控件自由摆布
在做Mis项目过程中，有时需要让用户自己来实现窗体控件的布局，比如酒店管理中就需要对餐厅餐桌位置进行布局。要实现这种功能，必须做好三件事：
　　1、设置进入控件边缘的光标形状；

　　2、改变控件的大小及位置；

　　3、保存窗体控件的位置及状态，窗体下次启动时重新设置它们的这些信息。具体步骤如下：

　　1、修改控件光标。只需要在进入控件的时候，将screen的cursor属性设置成对应形状即可，控件都有一个OnMouseMove事件，在这个事件中调用它就可以实现。我已经将它封装成函数如下：

procedure CursorControl(Control: TControl; Shift: TShiftState; X, Y, Prec: integer);
　begin
　　//光标在控件的最左侧
　　if (X<=Prec) and (Y>Prec) and (Y　　// 光标在控件的最右侧
　　else if (X>=Control.Width-Prec) and (Y>Prec) and (Y　　// 光标在控件的最上侧
　　else if (X>Prec) and (X　　　// 光标在控件的左上角
　　else if (X<=Prec) and (Y<=Prec) then Control.Cursor := crSizeNWSE
　　　// 光标在控件的右上角
　　else if (X>=Control.Width-Prec) and (Y<=Prec) then Control.Cursor := crSizeNESW
　　// 光标在控件的最下侧
　　else if (X>Prec) and (X=Control.Height-Prec) then Control.Cursor := crSizeNS
　　// 光标在控件的左下角
　　else if (X<=Prec) and (Y>=Control.Height-Prec) then Control.Cursor := crSizeNESW
// 光标在控件的右下角
　　else if (X>=Control.Width-Prec) and (Y>=Control.Height-Prec) then
　　　Control.Cursor := crSizeNWSE
　　　// 光标在控件的客户区(移动整个控件)
　　else if (X>5) and (Y>5) and (X　　else Control.Cursor := crDefault;//恢复默认光标
end;

　　2、修改窗体控件的大小和位置。其实有一种最简便的方法那就是向控件发送相应的消息即可。我也已将它封装成一个函数，在控件的OnMouseDown事件中调用即可。函数如下：

procedure ManipulateControl(Control: TControl; Shift: TShiftState; X, Y, Prec: integer);
　var
　　SC_MANIPULATE: Word;//保存对应消息值
　begin
　　// 光标在控件的最左侧
　　if (X<=Prec) and (Y>Prec) and (Y　　　// 光标在控件的最右侧
　　else if (X>=Control.Width-Prec) and (Y>Prec) and (Y　　　// 光标在控件的最上侧
　　else if (X>Prec) and (X　　　SC_MANIPULATE := $F003
　　　// 光标在控件的左上角
　　else if (X<=Prec) and (Y<=Prec) then SC_MANIPULATE := $F004
　　　// 光标在控件的右上角
　　else if (X>=Control.Width-Prec) and (Y<=Prec) then SC_MANIPULATE := $F005
　　　// 光标在控件的最下侧
　　else if (X>Prec) and (X=Control.Height-Prec) then SC_MANIPULATE := $F006
　　　// 光标在控件的左下角
　　else if (X<=Prec) and (Y>=Control.Height-Prec) then SC_MANIPULATE := $F007
　　　// 光标在控件的右下角
　　else if (X>=Control.Width-Prec) and (Y>=Control.Height-Prec) then SC_MANIPULATE := $F008
　　　// 光标在控件的客户区 ( 移动整个控件 )
　　else if (X>5) and (Y>5) and (X　　else SC_MANIPULATE := $F000;
　　　if Shift=[ssLeft] then
　　　begin
　　　　ReleaseCapture;
　　　　Control.Perform(WM_SYSCOMMAND, SC_MANIPULATE, 0);//向控件发送改变光标消息
　　end;
end;

　　3、保存和恢复窗体控件的大小及位置。通过对窗体的Component元件进行遍历，然后将它们的位置及大小属性值写入INI文件中，窗体下次启动时再通过读取INI文件恢复窗体控件的这些属性即可。关于这个解决办法网上有很多，还有现成的控件不用写一行代码就可实现的，限于篇幅在此我就不再累述了。有兴趣的朋友不防一试。所有代码在WIN2000/Delphi7下测试通过。