2012年8月31日星期五

转：Delphi 磁性窗体

Delphi 磁性窗体

FORM1

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation
uses unit2;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
form2.Show;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

end.

下边是测试用的form2

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm2 = class(TForm)
private
procedure WMWINDOWPOSCHANGING(Var Msg: TWMWINDOWPOSCHANGING);message WM_WINDOWPOSCHANGING;
    { Private declarations }
public
    { Public declarations }
end;

var
Form2: TForm2;

implementation
uses Unit1;
{$R *.dfm}

{ TForm2 }

procedure TForm2.WMWINDOWPOSCHANGING(var Msg: TWMWINDOWPOSCHANGING);
var
WorkDound: TRect;
remove : Word;
begin
remove :=50; //可随意设置，是磁性的范围大小。
WorkDound.Left:=form1.left;
WorkDound.Top:=form1.Top;
WorkDound.Right:=form1.left+form1.Width;
WorkDound.Bottom:=form1.Top+form1.Height;
with Msg.WindowPos^ do
begin
    if (x+cx<WorkDound.Left+remove) then    //左方具有磁性
      if (x+cx>WorkDound.Left-remove)or((x+cx>WorkDound.Left) and (x+cx<WorkDound.Left+remove)) then
        begin
          x:=WorkDound.Left-cx;
        end;
    if (x>WorkDound.Right-remove) then   //右方具有磁性
      if (x<WorkDound.Right+remove)or((x<WorkDound.Right) and (x>WorkDound.Right-remove)) then
        begin
          x:=WorkDound.Right;
        end;
    if (y+cy<WorkDound.Top+remove) then    //上方具有磁性
      if (y+cy>WorkDound.Top-remove)or((y+cy>WorkDound.Top) and (y+cy<WorkDound.Top+remove)) then
        begin
          y:= WorkDound.Top-cy;
        end;
    if (y>WorkDound.Bottom-remove) then   //下方具有磁性
      if (y<WorkDound.Bottom+remove)or((y<WorkDound.Bottom) and (y>WorkDound.Bottom-remove)) then
        begin
          y:= WorkDound.Bottom;
        end;
end;
inherited;
end;

end.

摘自：http://hi.baidu.com/32881/item/f39f36f53673e30dd89e72c6

发帖者 时间： 没有评论:

转： 窗体间相互连动

窗体间相互连动

设其中一个为主窗体，另一个为子窗体。    在Delphi程序设计中，窗体(Form)的Position特性取值为poDesigned，则窗体的显示位置和大小以特性Left、Top、 Width、Height的取值为依据来决定。这样在创建子窗体时，以获得主窗体的显示位置和大小（主窗体的Left、Top、Width、Height 的特性值）为基准，然后确定子窗体的位置和大小即可。    
   　    窗体的初始显示位置，可用CreateParams方法进行设置，之后用重载子窗体(Form1)的CreateParams方法，来改变子窗体的显示位 置和大小。主窗体和子窗体之间是怎样互相引用的呢？首先设置窗体（Form1）的单元文件名为unit1.pas，子窗体（Form2）的单元文件名为 unit2.pas。通常要引用某窗体单元文件的特性和内容时，应该在interface的uses处插入其窗体(Form)的单元名(unit)。本实 例中根据主窗体动态生成子窗体，因此在主窗体（Form1）的interface的uses处插入子窗体的单元名（unit2）。这样主窗体即可引用子窗 体的各种特性值。另一方面要实现子窗体引用主窗体的各种特性值又怎么办呢？由于Pascal语言不允许相互循环引用，即A到B，并且B到A。这时，必须在 imptementation的uses处插入主窗体的单位名（unit1），这样即可对主窗体（Form１）的特性值进行引用。    
   　    引用方法如下：    
   implementation    
   {$R    *.DFM}      
   uses　Unit1;//主窗体单元名    
   ｛生成窗体时参考数的初始化｝    
   procedure    TForm2.CreateParams(var    Params:    TCreateParams);    
   begin    
   　    inherited    CreateParams(Params);    
   　    //当没有窗体题目时，添加细框    
   　　if    BorderStyle    =    bsNone    then      
   　　    Params.Style    :=    Params.Style    or    WS_THICKFRAME;      
   　    //根据主窗体的显示位置和大小决定子窗体的显示位置和大小      
   　　    with    Form1    do      
   　　    begin      
   　　　    Params.X    :=    Left    +    Width;      
   　　　    Params.Y    :=    Top;      
   　　　    Params.Height    :=    Height;      
   　　　    Params.Width    :=    100;      
   　　    end;    
   end;    
   　    这样即完成了对应主窗体的子窗体在其右侧显示的程序设计。现在当我们移动主窗体时，子窗体并不随之移动，自然，移动子窗体时，主窗体也不会移动。虽然通常的Windows的应用程序则到此为止，但是我们的主题是要讨论连动，下面我们继续介绍这一问题。    
   　    首先要搞清楚，怎样把握自身窗体的移动和大小变化。在窗体的移动和大小变化时Windows系统要送出WINDOWSPOSCHANGED消息，为了捕捉此消息，对以下方法(Method)进行说明：    
   type      
   　    Tform1    =    class(Tform)      
   　protected      
   　procedure    WMWindowPosChanged(vax    Msg：TWMWindowPosChanged）；    
   　    message    WM_WINDOWPOSCHANGED；    
   　    WM_WINDOWPOSCHANGED消息是在窗体的位置和大小变化后送出的。上面是对WM_WONDOWPOSCHANGED消息句柄的说明，接着是TWMWindowsPosChanged消息记录型和TWindowPos记录内容的定义。    
   type      
   　    TWMWindowPosMsg    =    record      
   　    Msg：Cardind；      
   　    Unused：Integer；      
   　    WindowPos：PwindowPos；      
   　    Resukt：Longint；      
   end；      
   PwindowPos    =    ∧TWindowPos；    
   TwindowPos    =    packed    record      
   　    hwnd：HWND；    //自身的窗体句柄      
   　    hwndInsertAfeer：HWND；//变更Ｚ的顺序时，最上层窗体句柄      
   　    ｘ：Integer//新窗体左端的位置      
   　    ｙ：Integer//新窗体上端的位置      
   　    cx：Integer//新窗体上端的宽    
   　    cy：Integer//新窗体上端的高      
   　    flags：UINT//变更内容（移动、大小    、Ｚ顺序等）      
   end；    
   　    下面具体介绍此方法的使用，首先要确认子窗体是否存在，而后确认自身的显示位置，一旦发生变更就使用WindowSAPI的SetWindowPos，以变更子窗体的显示位置和大小。要注意的是只是主窗体发生变更时才使用。    
   　    这样即可使子窗体随主窗体的变更而变更。接着我们还希望主窗体随子窗体的变更而变更。以下先是主窗体变更使子窗体变更的处理过程。    
   const      
   　    uFlag    =    SWP_NOACTIVATE    or    SWP_NOZORDER    or    SWP_NOMOVE    orSWP_NOSIZE；      
   　　    //大小变更、位置移动结束通知      
   　    porcedure    TForm1．WMWindowPosChanged(var    Msg：TWMWindowPosChanged)；      
   　　    var    Rect：TRect；    
   　　　    x,y,cx,cy：Integer；    
   　　　    uFlag2：UINT；    
   　    begin      
   　    inherited；    
   　　    if    Form2    <>    nil    then      
   　　　    //如果子窗体存在      
   　　　    begin      
   　　　　    GetWindowRoct（Form2.Handle，Rect）；    //获取子窗体的位置      
   　　　　　    With    Msg    do      
   　　　　　    begin      
   　　　　　　ｘ：=    WindowPos＾.x    +    WindowPos＾.cx；    //新x坐标      
   　　　　　　ｙ：=    Window＾.y；    //新y坐标    
   　　　　　　    cx：=    100；    //宽固定在100      
   　　　　　　    cy：=    WindowPos＾.cy    //新高度    
   　　　　　    end；    
   　　　　    uFlag2：=    uFlag；    //需要移动时      
   　　　　    if（Rect.Top    <>    Y）    or(Rect.Left<>X)    then      
   　　　　　　    uFlag2：=    uFlag2    and(not    SWP_NOMOVE)；    
   　　　　    if(Rect.Bottom    -Rect.Top    <>cy)    or    
   　　　　　    //需要变更大小时    
   　　　　　    (Rect.Right    -Rect.Left<>cx)    then      
   　　　　　    uFlag2：=    uFlag2    and(not    SWP_NOSIZE)；    
   　　　　    if    uFlag    <>    uFlag2    then      
   　　　　    //对子窗体(Form)进行变更      
   　　　　　    setWindowPos(Form2.Handle，0,x,y,cx,cy,uFlag2)；    
   　　    以上处理是从主窗体的新位置来计算子窗体的新位置，然后与现

发帖者 时间： 没有评论:

2012年8月24日星期五

转：基于Delphi的融合DLL中的窗口

基于Delphi的融合DLL中的窗口
 
　摘 　要 ：提出了一种简单的方法将DLL中的窗口融合（嵌入）到其他应用程序或DLL的窗口中，使用本方法可以简便地实现具有强扩展性和升级能力的软件系统。
　　

1　引言 
　　在开发一个大型通用控制系统时曾遇到这么一个问题：该系统软件包由若干个可执行文件和动态链接库组成，因为扩展性和兼容性的要求，需要将系统划分为若干个可执行文件和动态链接库，并且在大部分DLL中封装各自的操作界面，在调用DLL时将其中包含的部分界面嵌入地显示在主界面的某个区域或某个窗口内，与主界面的其他部分浑然一体。这样主程序与DLL在功能操作上各司其职，在外部界面上又彼此交融，使用户可以通过增加和修改DLL来实现对系统内部、外部的扩展和升级；同时因为DLL的跨语言特性，内部包含操作界面的DLL可以更为方便地在以后的不同工作、不同语言环境中更好地重复使用。
　　这一问题的应用较为广泛，但没有充分的资料来帮助解决，经过不断的试验，笔者将初步体会总结出来，用以抛砖引玉。本文中涉及的主程序和DLL都是在Delphi5．0下实现的，但因为其中所依赖的基础还是Windows本身的窗口机制，所以对于其他的语言平台也有实际意义。
　　在Delphi中如何创建DLL及输出DLL中的函数有较多资料进行过介绍，在本文中不再赘述，本文只针对DLL中的窗口部分做重点介绍。

2　DLL中自带窗口的创建和显示 
　　DLL和普通EXE一样，可以自带窗口，用Delphi设 计包含窗口的DLL较其他语言更为方便。在Delphi的DLL工程中，窗口的生成和编程与普通的EXE工程基本相同，但与EXE文件不同的是：在Delphi的EXE工程中所包含的窗口是自动创建的，而DLL工程中所包含的窗口需要显示创建。
　　在通常的应用中，DLL将所包含的窗口的创建和显示函数（或过程）输出，由宿主程序根据情况调用将DLL中的窗口显示出来（如点击宿主程序中的某个按钮时显示DLL中的窗口），其窗口创建和显示的过程如下：
　　首先，创建一个DLL工程，并新建一个名为DllForm的Form，可以在该Form上放置任何控件。
　　窗体设计完成后，在该窗口的Unit中添加如下代码：
　 
　　

procedure ShowDllForm:stdcall;export;

begin

if DllForm = nil then

DllForm := TDllForm.Create(Application);

DllForm.Show;

end;

在上面的代码片断中，ShowDllForm即为DLL输出的窗口创建和显示过程，宿主程序通过调用该过程来创建并显示DLL中包含的窗口。TDllForm为DLL中窗口类的类型，DllForm为该窗口类型的变量，Delphi虽然不会为DLL自动创建窗口，但会为DLL中包含的窗口类型自动建立默认的变量（如：var DllForm：TDllForm）。
　　在宿主程序的某个窗口中放置一个按钮，在按钮的OnClick事件中添加ShowDllForm调用（有关方法请参阅口被显示出来。
　　至此，DLL中所包含的窗口已经可以正常显示，但该窗口与宿主程序的窗口互相独立和游离，还没有融合为一体。
　　注：上面的代码中用Show来显示DLL中的窗口，该函数显示的窗口为非模态形式；实际上DLL中的窗口也可以使用ShowModal函数来显示成模态的，本文阐述的是如何将DLL中的窗口与宿主程序的窗口融为一体，模态窗口显然不符合这一要求。

3　DLL中自带窗口与主程序中窗口的融合 
　　DLL中的窗口与宿主窗口的融合是通过Windows的子窗口机制来实现的，即把DLL中的窗口设置为宿主窗口或宿主窗口中的某一部分的子窗口，DLL中的窗口即能和宿主程序中的窗口融为一体了。
　　在Windows的窗口机制中对窗口的操作依靠窗口句柄（Handle）来进行；Delphi中的可视化控件分为两种，其中一种TwinControl继承而来的控件，包括TForm，TPanel，TGroup等都是标准的Windows窗口，其Handle属性即代表其窗口句柄。这些控件都可以作为DLL中窗口融合于宿主窗口的容器，即DLL窗口可以在这些控件所在的范围内显示，宛如通过这些控件“嵌入”宿主窗口一样。
　　这时DLL必须知道这些容器的窗口句柄，并将自身窗口作为容器的子窗口，ShowDllForm必须改写如下：

procedure ShowDllForm:stdcall(Parent:THandle);stdcall;export;

begin

Application.handle:=parent;

//将容器设为应用程序句柄

//以非模态创建并显示窗口

if DllForm = nil then

DllForm := TDllForm.Create(Application);

DllForm.PParentWindow:=Parent;//将容器设置为父窗口

DllForm.Show;

end;

 

 


　 　为了实现与宿主窗口的融合，在ShowDllForm过程中增加了以下内容：
　　（1）增加了Parent入口参数，该参数为Thandle类型，是宿主程序传来的容器句柄。
　　（2）增加了DllForm．ParentWindow：＝Parent，该代码将DLL中窗口设为宿主窗口中容器的子窗口。
　　同样，在宿主窗口中可以添加一个Panel作为DLL窗口显示的容器，并将按钮的OnClick时间中的代码修改为ShowDllForm（Panel1．Handle），将容器Panel的句柄传到DLL。
　　此时运行宿主程序并点击该按钮，可以发现DLL中 的窗口显示在宿主窗口的Panel中，但仍然具有标题条，可以在Panel中进行移动；如果要解决这一问题，只需将DLL中窗口的BorderStyle属性设为bsNone即可。
　　此时，DLL中窗口已经与宿主程序的窗口融为一体，只是还有一个问题，DLL窗口不能获得输入焦点，按Tab和光标键时输入焦点不会进入到DLL窗口中去，即使用鼠标将焦点强制切换到DLL窗口中，一使用Tab键焦点又会回到主程序窗口。

4　DLL中自带窗口的焦点控制 
　　DLL没有自己的消息循环，焦点问题的出现可能与此有关。经笔者反复试验，焦点问题可以这么解决：
　　 （1）宿主程序转发DLL窗口的消息
　　首先，需要把ShowDllForm由procedure改为Functiion
　　 

 

function ShowDllForm:stdcall(Parent:THandle);stdcall;export;

begin

Application.handle:=parent;

//将容器设为应用程序句柄

//以非模态创建并显示窗口

if DllForm = nil then

DllForm := TDllForm.Create(Application);

DllForm.PParentWindow:=Parent;//将容器设置为父窗口

DllForm.Show;

Result := DllForm.Handle; //返回DllForm的句柄

end;

 

其次，在宿主程序中设置储存DLL窗口句柄的变量DllFormHandle，并在按钮的OnClick事件中利用ShowDllForm返回的句柄为其赋值。即：
　　DllFormHandle：＝ShowDllForm（Panel1．Handle）；
　　最后，在宿主程序中添加AppEvent控件，并在其OnMessage事件中增加如下代码：
　　if IsDialogMessage（ExternMonitorHandle，Msg）then　　
　　Handled：＝True；
　　 通过该代码转发DLL窗口的消息。
　　在做了上面的改动后，可以用鼠标将输入焦点送给DLL窗口，并用Tab和光标键在DLL窗口内移动焦点，但是还不能用Tab键将焦点从宿主窗口中移到DLL窗口中。
　　（2）在焦点进入容器时转换焦点到DLL窗口　　为了能用Tab键将焦点从宿主窗口中移到DLL窗口中，可以在焦点进入DLL窗口容器（如Panel）时强制将焦点传送给DLL窗口；
　　如，在Panel的OnEnter事件中添加如下代码：　
　　SetForegroundWindow（DllFormHandle）；
　　//将DLL窗口设置为前景窗口　
　　Windows．SetFocus（DllFormHandle）；
　　//将焦点交给DLL窗口
　　现在，可以通过Tab键将焦点从宿主窗口中移到DLL窗口中，但是一旦焦点进入DLL窗口中后无法再回到宿主窗口。
　　 （3）焦点从DLL窗口的返回
　　为了能使焦点从DLL窗口返回到宿主窗口，需要利 用一个“Wrap”手段，即在DLL窗口放置一个无用的WinControl控件来实现Wrap，例如一个Width，Height都
为0的Button，当焦点传递到该Button时强制返回焦点到宿主窗口；即，在Button的OnEnter事件中添加如下代码：　
　　SetForegroundWindow（Application．Handle）；　
　　Windows．SetFocus（Application．Handle）；
　　因为Application．Handle中存贮着宿主窗口的句柄，这两句调用可以强制把焦点返回给宿主窗口。至此，DLL中的窗口已经可以与宿主程序的窗口完全融合到一起，并
且可以和宿主程序一起使用输入焦点。经笔者试验，可以将多个DLL中的窗口在宿主程序窗口、其他DLL窗口中嵌入显示，可以和Panel，GroupBoxM，TabControl等控
件结合起来进行DLL窗口嵌入和嵌套，实现灵活多变的、浑然一体的窗口组合。

摘自：http://blog.csdn.net/meiqingxin/article/details/6106555

发帖者 时间： 没有评论:

转：Delphi中高级DLL的编写和调用-窗体

Delphi中高级DLL的编写和调用-窗体

Delphi中高级DLL的编写和调用-窗体

根据Delphi提供的有关 DLL编写和调用的帮助信息，你可以很快完成一般的 DLL编写和调用的 应用程序。本文介绍的主题是如何编写和调用能够传递各种参数（包括对象实例）的 DLL。例如， 主叫程序传递给 DLL一个ADOConnection 对象示例作为参数， DLL中的函数和过程调用通过该对象 实例访问数据库。

需要明确一些基本概念。对于 DLL，需要在主程序中包含 exports子句，用于向外界提供调用 接口，子句中就是一系列函数或过程的名字。对于主叫方（调用 DLL的应用程序或其它的 DLL）， 则需要在调用之前进行外部声明，即external保留字指示的声明。这些是编写 DLL和调用 DLL必须 具备的要素。

另外需要了解Object Pascal 中有关调用协议的内容。在Object Pascal 中，对于过程和函数 有以下五种调用协议：

指示字 参数传递顺序 参数清除者 参数是否使用寄存器
register 自左向右 被调例程 是
pascal 自左向右 被调例程 否
cdecl 自右向左 调用者 否
stdcall 自右向左 被调例程 否
safecall 自右向左 被调例程 否

这里的指示字就是在声明函数或过程时附加在例程标题之后的保留字，默认为register，即是 唯一使用 CPU寄存器的参数传递方式，也是传递速度最快的方式；

pascal: 调用协议仅用于向后兼容，即向旧的版本兼容；
cdecl: 多用于 C和 C++语言编写的例程，也用于需要由调用者清除参数的例程；
stdcall: 和safecall主要用于调用Windows API 函数；其中safecall还用于双重接口。
在本例中，将使用调用协议cdecl ，因为被调用的 DLL中，使用的数据库连接是由主叫方传递 得到的，并且需要由主叫方处理连接的关闭和销毁。

下面是 DLL完整源程序和主叫程序完整源程序。包括以下四个文件：

Project1.DPR {主叫程序}
Unit1.PAS {主叫程序单元}
Project2.DPR {DLL}
Unit2.PAS {DLL单元}

view plaincopy to clipboardprint?
{---------- DLL 主程序 Project2.DPR ----------} 
library Project2;  
uses 
SysUtils,  
Classes,  
Unit2 in 'Unit2.pas' {Form1};  
{$R *.RES} 
{ 下面的语句用于向调用该 DLL的程序提供调用接口 } 
exports 
DoTest; { 过程来自单元Unit2 } 
begin 
end.  
 
{---------- DLL中的单元 Unit2.PAS ----------} 
unit Unit2;  
interface 
uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  
Db, ADODB, StdCtrls, Menus;  
type 
TForm1 = class(TForm)  
ADOConnection1: TADOConnection;{ 本地数据库连接 } 
Memo1: TMemo; { 用于显示信息 } 
private 
public 
end;  
{ 该过程向外提供 } 
procedure DoTest(H: THandle; { 获得调用者的句柄 } 
AConn: TADOConnection;{ 获得调用者的数据库连接 } 
S: string; { 获得一些文本信息 } 
N: Integer); { 获得一些数值信息 } 
cdecl; { 指定调用协议 } 
implementation 
{$R *.DFM} 
procedure DoTest(H: THandle; AConn: TADOConnection; S: string; N: Integer);  
begin 
Application.Handle := H; { 将过程的句柄赋值为调用者的句柄 } 
{ 上面语句的作用在于， DLL的句柄和调用者的句柄相同，在任务栏中就不会 } 
{ 各自出现一个任务标题了。 } 
with TForm1.Create(Application) do try{ 创建窗体 } 
Memo1.Lines.Append('成功调用'); { 显示一行信息 } 
ADOConnection1 := AConn; { 获得数据库连接的实例 } 
Memo1.Lines.Append(  
ADOConnection1.ConnectionString +  
' - ' + S + ' - ' + IntToStr(N)); { 根据得到的参数显示另一行信息 } 
ShowModal; { 模式化显示窗体 } 
finally 
Free; { 调用结束时销毁窗口 } 
end;  
end;  
end.  
 
{---------- 调用者 Project1.DPR，很普通的工程文件 ----------} 
program Project1;  
uses 
Forms,  
Unit1 in 'Unit1.pas' {Form1};  
{$R *.RES} 
begin 
Application.Initialize;  
Application.CreateForm(TForm1, Form1);  
Application.Run;  
end.  
 
{---------- 调用者单元Unit1.PAS ----------} 
unit Unit1;  
interface 
uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  
StdCtrls, Db, ADODB;  
type 
TForm1 = class(TForm)  
Button1: TButton; { 按此按钮进行调用 } 
ADOConnection1: TADOConnection; { 本地数据库连接，将传递给 DLL } 
procedure Button1Click(Sender: TObject);{ 调用 DLL} 
private 
public 
end;  
var 
Form1: TForm1;  
implementation 
{$R *.DFM} 
{ 外部声明必须和 DLL中的参数列表一致，否则会运行时错误 } 
procedure DoTest(H: THandle; { 传递句柄 } 
AConn: TADOConnection; { 传递数据库连接 } 
S: string; { 传递文本信息 } 
N: Integer); { 传递数值信息 } 
cdecl; { 指定调用协议 } 
external 'Project2.dll';{ 指定过程来源 } 
{ 调用过程 } 
procedure TForm1.Button1Click(Sender: TObject);  
begin 
DoTest(Application.Handle,  
ADOConnection1,  
'Call OK',  
256);  
end;  
end.  
   1. procedure TForm1.Button1Click(Sender: TObject);     
   2. type    
   3. TIntFunc=function(i:integer):integer;stdcall;     
   4. var    
   5. Th:Thandle;     
   6. Tf:TIntFunc;     
   7. Tp:TFarProc;     
   8. begin    
   9. Th:=LoadLibrary(’Cpp.dll’); {装载DLL}    
  10. if Th>0 then    
  11. try    
  12. Tp:=GetProcAddress(Th,PChar(’TestC’));     
  13. if Tp<>nil    
  14. then begin    
  15. Tf:=TIntFunc(Tp);     
  16. Edit1.Text:=IntToStr(Tf(1)); {调用TestC函数}    
  17. end    
  18. else    
  19. ShowMessage(’TestC函数没有找到’);     
  20. finally    
  21. FreeLibrary(Th); {释放DLL}    
  22. end    
  23. else    
  24. ShowMessage(’Cpp.dll没有找到’);     
  25. end;    
  26.  
  27.  
  28.  
  29.  
      {---------- DLL中的单元 Unit2.PAS ----------} 
      　　unit Unit2;  
      　　interface 
      　　uses 
      　　 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  
      　　 Db, ADODB, StdCtrls, Menus;  
      　　type 
      　　 TForm1 = class(TForm)  
      　　 ADOConnection1: TADOConnection;{ 本地数据库连接 } 
      　　 Memo1: TMemo; { 用于显示信息 } 
      　　 private 
      　　 public 
      　　 end;  
      　　{ 该过程向外提供 } 
      　　procedure DoTest(H: THandle; { 获得调用者的句柄 } 
      　　 AConn: TADOConnection;{ 获得调用者的数据库连接 } 
      　　 S: string; { 获得一些文本信息 } 
      　　 N: Integer); { 获得一些数值信息 } 
      　　 cdecl; { 指定调用协议 }    
      　　implementation 
      　　{$R *.DFM} 
      　　procedure DoTest(H: THandle; AConn: TADOConnection; S: string; N: Integer);  
      　　begin 
      　　 Application.Handle := H; { 将过程的句柄赋值为调用者的句柄 } 
      　　 { 上面语句的作用在于， DLL的句柄和调用者的句柄相同，在任务栏中就不会 } 
      　　 { 各自出现一个任务标题了。 } 
      　　 with TForm1.Create(Application) do try{ 创建窗体 } 
      　　 Memo1.Lines.Append(‘成功调用‘); { 显示一行信息 } 
      　　 ADOConnection1 := AConn; { 获得数据库连接的实例 } 
      　　 Memo1.Lines.Append(  
      　　 ADOConnection1.ConnectionString +  
      　　 ‘ - ‘ + S + ‘ - ‘ + IntToStr(N)); { 根据得到的参数显示另一行信息 } 
      　　 ShowModal; { 模式化显示窗体 } 
      　　 finally 
      　　 Free; { 调用结束时销毁窗口 } 
      　　 end;  
      　　end;  
      　　end.  
 
      　　{---------- 调用者 Project1.DPR，很普通的工程文件 ----------} 
      　　program Project1;  
      　　uses    
      Forms,  
      　　 Unit1 in ‘Unit1.pas‘ {Form1};  
      　　{$R *.RES} 
      　　begin 
      　　 Application.Initialize;  
      　　 Application.CreateForm(TForm1, Form1);  
      　　 Application.Run;  
      　　end.  
 
      　　{---------- 调用者单元Unit1.PAS ----------} 
      　　unit Unit1;  
      　　interface 
      　　uses 
      　　 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  
      　　 StdCtrls, Db, ADODB;  
      　　type 
      　　 TForm1 = class(TForm)  
      　　 Button1: TButton; { 按此按钮进行调用 } 
      　　 ADOConnection1: TADOConnection; { 本地数据库连接，将传递给 DLL } 
      　　 procedure Button1Click(Sender: TObject);{ 调用 DLL} 
      　　 private 
      　　 public 
      　　 end;  
      　　var 
      　　 Form1: TForm1;  
      　　implementation 
      　　{$R *.DFM} 
      　　{ 外部声明必须和 DLL中的参数列表一致，否则会运行时错误 } 
      　　procedure DoTest(H: THandle; { 传递句柄 } 
      　　 AConn: TADOConnection; { 传递数据库连接 } 
      　　 S: string; { 传递文本信息 } 
      　　 N: Integer); { 传递数值信息 } 
      　　 cdecl; { 指定调用协议 } 
      　　 external ‘Project2.dll‘;{ 指定过程来源 } 
      　　{ 调用过程 } 
      　　procedure TForm1.Button1Click(Sender: TObject);  
      　　begin 
      　　 DoTest(Application.Handle,  
      　　 ADOConnection1,  
      　　 ‘Call OK‘,  
      　　 256);  
      　　end;  
      　　end. 

摘自：http://blog.sina.com.cn/s/blog_732d14b50100q5ip.html

发帖者 时间： 没有评论:

2012年8月23日星期四

转：Excel文件导入StringGrid

Excel文件导入StringGrid

EXCEL电子表格作为办公软件OFFICE中的重要组成部份，是日常办公系统的主要助手，因此许多日常所需的业务方面的数据通常是通过电子表格存取。有时我们需要从日常工作中创建的EXCEL中取得数据进行操作、打印、查询，统计等工作。在这里我将介绍如何利用delphi完成EXCEL电子表格中数据的操作。

一、 新建一项目，从控件栏servers中分别选取控件：excelapplication、excelworkbook1、excelworksheet，放到主窗体from1中，并加入stringgrid、三个按钮、五个显示字段内容的EDIT、二个操作显示记录的label、一个用于打开EXCEL电子表格的控件opendialog等，如下图所示：



二、选择excel表'按钮，用于打开EXCEL文件,其代码如下：
procedure TForm1.Button1Click(Sender: TObject);
var i,j:integer;
begin
opendialog1.InitialDir:=ExtractFileDir(paramstr(0));//文件的打存放初始路径
opendialog1.Execute;
Try
ExcelApplication1.Connect;//EXCEL应用程序
Except
MessageDlg('Excel may not be installed',mtError, [mbOk], 0);
Abort;
End;
ExcelApplication1.Visible[0]:=True;
ExcelApplication1.Caption:='Excel Application';
try 
excelapplication1.Workbooks.Open(opendialog1.FileName,
null,null,null,null,null,null,null,null,null,null,null,null,0);//打开指定的EXCEL 文件
except
begin
ExcelApplication1.Disconnect;//出现异常情况时关闭
ExcelApplication1.Quit;showmessage('请选择EXCEL电子表格!');
exit;
end;
end;
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);//ExcelWorkbook1与Eexcelapplication1建立连接
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);//Excelworksheet1与Excelworkbook1建立连接 
//开始从EXCEL中取数，放到stringgrid1中，取完数后关闭EXCEL
for i:=1 to 1000 do//最大取值1000
for j:=1 to 6 do
begin
if trim(excelworksheet1.cells.item[i+1,1])<>'' then
begin
stringgrid1.rowCount:=i+1;
stringgrid1.Cells[j,i]:=ExcelWorksheet1.Cells.Item[i+1,j];
end
else
begin
label3.caption:=inttostr(i-1);
ExcelApplication1.Disconnect;
ExcelApplication1.Quit;
//将第一条数据赋给编辑框
edit2.text:=stringgrid1.Cells[1,1];
edit1.text:=stringgrid1.Cells[2,1];
edit3.text:=stringgrid1.Cells[3,1];
edit4.text:=stringgrid1.Cells[4,1];
edit5.text:=stringgrid1.Cells[5,1];
exit;
end;
end;
end;
　　
三、'下一条记录'按钮，完成记录向下移动，代码如下：
procedure TForm1.Button2Click(Sender: TObject);
var x:integer;
begin
x:=stringgrid1.row+1;
if x<> stringgrid1.RowCount then
begin
stringgrid1.row:=stringgrid1.row+1;
label1.caption:=inttostr(x);
edit2.text:=stringgrid1.Cells[1,x];
edit1.text:=stringgrid1.Cells[2,x];
edit3.text:=stringgrid1.Cells[3,x];
edit4.text:=stringgrid1.Cells[4,x];
edit5.text:=stringgrid1.Cells[5,x];
exit;
end
else
showmessage('已到第一条记录!');
end;

四、'上一条记录'，完成记录上移，代码如下：
var x:integer;
begin
x:=stringgrid1.row-1;
if x<>0 then
begin
stringgrid1.row:=stringgrid1.row-1;
label1.caption:=inttostr(x);
edit2.text:=stringgrid1.Cells[1,x];
edit1.text:=stringgrid1.Cells[2,x];
edit3.text:=stringgrid1.Cells[3,x];
edit4.text:=stringgrid1.Cells[4,x];
edit5.text:=stringgrid1.Cells[5,x];
exit;
end
else
showmessage('已到最后一条记录!');
end;


五、stringgrid中上下移动时代码：
procedure TForm1.StringGrid1Click(Sender: TObject);
var i:integer;
begin
i:=stringgrid1.Row;
label1.caption:=inttostr(i);
edit1.text:=stringgrid1.Cells[2,i];
edit2.text:=stringgrid1.Cells[1,i];
edit3.text:=stringgrid1.Cells[3,i];
edit4.text:=stringgrid1.Cells[4,i];
edit5.text:=stringgrid1.Cells[5,i];
end;


六、运行程序，点击按钮1打开excel表格。程序将启动EXCEL，并打开了选择的电子表格，这时请不要关闭EXCEL，当程序从EXCEL取数完毕将自动关闭EXCEL程序，应用程序取出了EXCEL数据，显示在stringgrid中，并将第一笔数据各字段的值赋给了左边的对应的edit字段。点击按钮2、按钮3可以查看下一条或上一条记录。也可以使用光标在stringgrid1上移动。


　　同时我们也可以对stringgrid中的记录进行查询、定位。相反，也可以将数据库中的数据输入到EXCEL中。 总之，只要我们从EXCEL提取出数据，并保存到stringgrid中，我们就可以进行相应操作，如统计、查询、重新输出，使平进的EXCEL电子表格中的数据在应用程序中得到利用。

（出处：Delphi园地）

摘自：http://www.delphifans.com/infoview/Article_443.html

发帖者 时间： 没有评论:

转：在delphi中判断字符串是否数字，以及精度处理函数

在delphi中判断字符串是否数字，以及精度处理函数

// 判断是否是数值型   By yangxiao  2007.7.21
function isNumeric(strText: WideString): Boolean;
var
  s: string;
  i, l, p: Integer;
begin
  Result := False;
  l := Length(strText);
  if l = 0 then Exit;

  s := '';
  for i:=1 to l do
  begin
    case strText[i] of
      '0'..'9':
        s := s + strText[i];

      'E', 'e', '+', '-', '.':
      begin
        p := PosEx(strText[i], strText, i+1);
        if p = 0 then
        begin
          case strText[i] of
            'E', 'e':
              if (i=1) or (i=l) then Exit;

            '+', '-':
              if i > 1 then
                case strText[i-1] of
                  'E', 'e':
                    s := s + strText[i];
                else
                  Exit;
                end;
          end;
        end
        else
        begin
          case strText[p-1] of
            'E', 'e':
              s := s + strText[i];
          else
            Exit;
          end;
        end;
      end;
    else
      Exit;
    end;
  end;

  Result := True;
end;

{---------------------------------------- by YangXiao 2007.10.31-------------------------------
四舍六入五单双的修约准则：

  当有效位数后面的第一位数 ≤ 4 时，则舍去
  当有效位数后面的第一位数 ≥ 6 时，则进一
  当有效位数后面的第一位数 ＝ 5 时，而 5 后面的数全都为 0 时，5 前面为偶数则舍，5 前面为奇数则进
                                    若 5 后面的数不全都为 0 时，无论5前面是奇或是偶都进一

 例：x = 1.6451 保留 3 位有效位应该为：1.65
--------------------------------------- by YangXiao 2007.10.31--------------------------------}
function RoundToEx(AValue: string; const ADigit: TRoundToRange; strJDFL: string = '0'): string;
var
  i, p, n, lp, rp, srcLen, intLen, decLen: Integer;
  strValue, strInt, strDecimal, strSign, strScience, strResult: string;
begin
  if not isNumeric(AValue) then
  begin
    Result := AValue;
    Exit;
  end;

  // 第一位是小数点，自动在前加 0
  if AValue[1] = '.' then AValue := '0' + AValue;

  strSign := '';
  strScience := '';
  strValue := AValue;

  if StrToFloat(AValue) < 0 then
    strSign := '-';

  p := PosEx('E', AValue, 1);
  if p <= 0 then
    p := PosEx('e', AValue, 1);
  if p > 0 then
  begin
    strValue := Copy(AValue, 1, p-1);
    strScience := Copy(AValue, p, Length(AValue));
  end;

  if strValue[1] in ['+', '-'] then
    strValue := Copy(strValue, 2, Length(strValue));
  srcLen := Length(strValue);

  p := Pos('.', strValue);
  if p > 0 then
  begin
    strInt := Copy(strValue, 1, p-1);
    strDecimal := Copy(strValue, p+1, srcLen);
  end
  else
  begin
    strInt := strValue;
    strDecimal := '';
  end;

  for i:=1 to Length(strInt) do
    if strInt[i] <> '0' then
    begin
      strInt := Copy(strInt, i, Length(strInt));
      Break;
    end;

  // 整数部分是 0 的处理
  if StrToFloat(strInt) < 1 then
  begin
    if strDecimal <> '' then
    begin
      decLen := Length(strDecimal);

      n := 0;
      for i:=1 to decLen do
        if strDecimal[i] <> '0' then
          Break
        else
          Inc(n);

      n := n + ADigit + 1;
      if n < decLen then
      begin
        if strDecimal[n] = '5' then
        begin
          lp := n - 1;
          rp := n + 1;

          if strDecimal[rp] = '0' then
          begin
            p := 0;
            for i:=rp+1 to decLen do
              if strDecimal[i] <> '0' then
              begin
                p := 1;
                Break;
              end;

            if p = 0 then
            begin
              if strDecimal[lp] in ['0', '2', '4', '6', '8'] then
                strDecimal[n] := '4';
            end;
          end;
        end;
      end
      else if n = decLen then
      begin
        if strDecimal[n] = '5' then
        begin
          lp := n - 1;
          if strDecimal[lp] in ['0', '2', '4', '6', '8'] then
            strDecimal[n] := '4';
        end;
      end;
    end;

    strResult := RoundToFxIntO(strDecimal, strJDFL, ADigit);
    Result := strSign + strResult + strScience;
  end

  // 整数部分不是 0 的处理
  else
  begin
    intLen := Length(strInt);

    if strJDFL = '1' then
      if intLen > ADigit then
        n := ADigit + 1
      else
        n := ADigit + 2
    else
      n := intLen + ADigit + 2;

    if strValue[n] = '5' then
    begin
      lp := n - 1;
      if strValue[lp] = '.' then Dec(lp);

      rp := n + 1;
      if strValue[rp] = '.' then Inc(rp);

      p := 0;
      for i:=rp to srcLen do
        if strValue[i] <> '0' then
        begin
          p := 1;
          Break;
        end;

      if p = 0 then
      begin
        if strValue[lp] in ['0', '2', '4', '6', '8'] then
          strValue[n] := '4';
      end;
    end;

    strResult := RoundToFxIntX(strValue, strScience, strJDFL, ADigit);
    Result := strSign + strResult;
  end;
end;

function RoundToFxIntO(strDecimal, strDigitType: string; const iDigit: TRoundToRange): string;
var
  i, n, m, d, p, decLen, iLen: Integer;
  strInt, strFormat, strValue, strResult: string;
begin
  if isNumeric(strDecimal) then
  begin
    if StrToFloat(strDecimal) > 0 then
      decLen := Length(strDecimal)
    else
    begin
      strDecimal := '';
      decLen := 0;
    end;
  end
  else
  begin
    strDecimal := '';
    decLen := 0;
  end;

  // 如果小数部分是 0， 既全为 0
  if strDecimal = '' then
  begin
    d := iDigit;
    if strDigitType = '1' then    // 是有效数字
      d := iDigit - 1;

    strFormat := '0.';
    for i:=1 to d do
      strFormat := strFormat + '0';
    Result := strFormat;
  end
  else
  begin
    if strDigitType = '1' then
    begin
      // 得到有效数字前的 0 数
      n := 0;
      for i:=1 to decLen do
        if strDecimal[i] <> '0' then
          Break
        else
          Inc(n);
      m := n;   // 保留前 0 数

      n := n + iDigit;  // 得到定义的有效数字最后一位的下标和小数点后的总位数

      strFormat := '0.';
      for i:=1 to n do
        strFormat := strFormat + '0';
      strValue := '0.' + strDecimal;
      strResult := FormatFloat(strFormat, StrToFloat(strValue));

      p := Pos('.', strResult);
      strInt := Copy(strResult, 1, p-1);  // 得到修约后的结果中，整数的部分
      strDecimal := Copy(strResult, p+1, Length(strResult));  // 得到修约后的结果中，小数的部分
      iLen := Length(strDecimal); // 得到结果小数部分的长度

      // 得到结果的有效数字前的 0 数
      n := 0;
      for i:=1 to iLen do
        if strDecimal[i] <> '0' then
          Break
        else
          Inc(n);

      // 如果小数部分有进位， 或者整数部分有进位，去掉一个 0
      if (n < m) or (StrToInt(strInt)>0) then
      begin
        iLen := Length(strResult);
        strResult[iLen] := ' ';
        strResult := Trim(strResult);
      end;
    end
    else
    begin
      strFormat := '0.';
      for i:=1 to iDigit do
        strFormat := strFormat + '0';
      strValue := '0.' + strDecimal;  // 整数是 0，直接加“0.”还原数字
      strResult := FormatFloat(strFormat, StrToFloat(strValue));
    end;

    Result := strResult;
  end;
end;

 

function RoundToFxIntX(strValue, strScience, strDigitType: string;

                        const iDigit: TRoundToRange): string;
var
  i, p, intLen, iLen: Integer;
  strInt, strPower, strFormat, strResult: string;
begin
  // 如果精度要求是 0，按原数返回
  if iDigit = 0 then
  begin
    if strDigitType = '1' then
      Result := strValue + strScience
    else
      Result := FormatFloat('0', RoundTo(StrToFloat(strValue), 0)) + strScience;

    Exit;
  end;

  p := Pos('.', strValue);
  if p > 0 then
    strInt := Copy(strValue, 1, p-1)
  else
    strInt := strValue;
  intLen := Length(strInt);

  if strDigitType = '1' then
  begin
    if intLen > iDigit then
    begin
      strFormat := '0.';
      for i:=1 to iDigit-1 do
        strFormat := strFormat + '0';
      strFormat := strFormat + 'E+0';

      Result := FormatFloat(strFormat, StrToFloat(strValue));
    end
    else  // intLen <= iDigit
    begin
      strFormat := '0.';
      for i:=1 to iDigit-intLen do
        strFormat := strFormat + '0';
      strResult := FormatFloat(strFormat, StrToFloat(strValue));

      iLen := Length(strResult) - 1;    // 去掉小数点占的位数
      if iLen > iDigit then
      begin
        if strScience <> '' then
        begin
          strPower := Copy(strScience, 2, Length(strScience));

          strResult[2] := '.';
          strResult[3] := '0';

          i := StrToInt(strPower);
          i := i + 1;
          strPower := IntToStr(i);
          if i > 0 then
            strScience := 'E+' + strPower
          else
            strScience := 'E' + strPower;
        end;

        strResult[iLen+1] := ' ';
        if strResult[iLen] = '.' then
          strResult[iLen] := ' ';
        strResult := Trim(strResult);
      end;

      Result := strResult + strScience;
    end;
  end
  else
  begin
    strFormat := '0.';
    for i:=1 to iDigit do
      strFormat := strFormat + '0';
    strResult := FormatFloat(strFormat, StrToFloat(strValue));

    if strScience <> '' then
    begin
      strPower := Copy(strScience, 2, Length(strScience));

      p := Pos('.', strResult);
      iLen := Length(Copy(strResult, 1, p-1));

      if iLen > intLen then
      begin
        iLen := Length(strResult);

        strResult[2] := '.';
        strResult[3] := '0';

        i := StrToInt(strPower);
        i := i + 1;
        strPower := IntToStr(i);
        if i > 0 then
          strScience := 'E+' + strPower
        else
          strScience := 'E' + strPower;

        strResult[iLen] := ' ';
        strResult := Trim(strResult);
      end;
    end;

    Result := strResult + strScience;
  end;
end;

摘自：http://blog.csdn.net/seekmyself/article/details/5636211

发帖者 时间： 没有评论:

转：delphi 判断字符串是否是数字方法

delphi 判断字符串是否是数字方法

最简单方法：

var
  i: LongInt;
  f: Double;
begin
  if TryStrToInt(Edit1.Text,i) or TryStrToFloat(Edit1.Text, f) then
    ShowMessage('是数字')
  else
    ShowMessage('不是数字');
end;

 

Delphi判断字符串是否是数字、字母、大小写字母

 

超级无敌简单 但是还是贴上：

function IsNumberic(Vaule:String):Boolean; //判断Vaule是不是数字

var

i:integer;

begin

result:=true; //设置返回值为 是（真）

Vaule:=trim(Vaule); //去空格

for i:=1 to length(Vaule) do //准备循环

begin

if not Vaule[i] in ['0'..'9'] then //如果Vaule的第i个字不是0-9中的任一个

begin

result:=false; //返回值 不是（假）

exit; //退出函数

end;

end;

end;

function IsUpperCase(Vaule:String):Boolean; //判断Vaule 是不是大写字母

var

i:integer;

begin

result:=true; //设置返回值为 是

Vaule:=trim(Vaule); //去空格

for i:=1 to length(Vaule) do //准备循环

begin

if not Vaule[i] in ['A'..'Z'] then //如果Vaule的第i个字不是A-Z中的任一个

begin

result:=false; //返回值 不是

exit; //退出函数

end;

end;

end;

function IsLowerCase(Vaule:String):Boolean; //判断Vaule 是不是小写字母

var

i:integer;

begin

result:=true; //设置返回值为 是

Vaule:=trim(Vaule); //去空格

for i:=1 to length(Vaule) do //准备循环

begin

if not Vaule[i] in ['a'..'z'] then //如果Vaule的第i个字不是a-z中的任一个

begin

result:=false; //返回值 不是

exit; //退出函数

end;

end;

end;

同理 如果想判断是不是字母的话

function IsEnCase(Vaule:String):boolean; //判断Vaule 是不是字母

var

i:integer;

begin

result:=true; //设置返回值为 是

Vaule:=trim(Vaule); //去空格

for i:=1 to length(Vaule) do //准备循环

begin

if (not Vaule[i] in ['A'..'Z']) or

(not Vaule[i] in ['a'..'z']) then //如果Vaule的第i个字不是A-Z或者a-z中的任一个

begin

result:=false; //返回值 不是

exit; //退出函数

end;

end;

end;

下面是调用方法：

if IsNumberic('嘿嘿') then showmessage('是数字') else showmessage('我不是数字'); //返回 “我不是数字”

if IsUpperCase('HAHA') then showmessage('是大写字母') else showmessage('不大写字母'); //返回 “是大写字母”

if IsLowerCase('abcdEfg') then showmessage('是小写字母') else showmessage('不是小写字母'); //返回 “不是小写字母”

if IsEnCase('abcdEfg') then showmessage('是英文 ') else showmessage('不是英文'); //返回 “是英文”


摘自：http://hi.baidu.com/lchuai/item/47e24514deb361cd39cb30b5

发帖者 时间： 没有评论:
订阅： 博文 (Atom)