急！急！急！哪里有现成的公用函数集？

Question

大家好！
新接了一个项目，主要是C/S模式的程序，可能有几十个人月。小僧初学Delphi数天，领导让我列出一个需要编写的Delphi公用函数list,为项目后期的开发使用。需要的函数可能大家以后编码时会共同用到，主要目的是为了缩短编码时间，减少代码的冗余。估计主要是界面和数据库方面的东西，其他方面诸如通讯、多媒体、网络编程方面现在好像还没有......十分苦恼，不知道哪些功能是Delphi已经提供的，哪些需要自己编写。望大家提供一些自己写的公用函数（不是Delphi提供的函数），最好注释清晰。我的邮箱：[email protected]谢谢大家了！

Answer 1

网络函数集合：
unit Net;interface
  uses
      SysUtils
     ,Windows
     ,dialogs
     ,winsock
     ,Classes
     ,ComObj
     ,WinInet;  //得到本机的局域网Ip地址
  Function GetLocalIp(var LocalIp:string): Boolean;
  //通过Ip返回机器名
  Function GetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ;
  //获取网络中SQLServer列表
  Function GetSQLServerList(var List: Tstringlist): Boolean;
  //获取网络中的所有网络类型
  Function GetNetList(var List: Tstringlist): Boolean;
  //获取网络中的工作组
  Function GetGroupList(var List: TStringList): Boolean;
  //获取工作组中所有计算机
  Function GetUsers(GroupName: string; var List: TStringList): Boolean;
  //获取网络中的资源
  Function GetUserResource(IpAddr: string; var List: TStringList): Boolean;
  //映射网络驱动器
  Function NetAddConnection(NetPath: Pchar; PassWord: Pchar;LocalPath: Pchar): Boolean;
  //检测网络状态
  Function CheckNet(IpAddr:string): Boolean;
  //检测机器是否登入网络
  Function CheckMacAttachNet: Boolean;  //判断Ip协议有没有安装   这个函数有问题
  Function IsIPInstalled : boolean;
  //检测机器是否上网
  Function InternetConnected: Boolean;
implementation{=================================================================
  功  能: 检测机器是否登入网络
  参  数: 无
  返回值: 成功:  True  失败:  False
  备 注:
  版 本:
     1.0  2002/10/03 09:55:00
=================================================================}
Function CheckMacAttachNet: Boolean;
begin
  Result := False;
  if GetSystemMetrics(SM_NETWORK) <> 0 then
    Result := True;
end;{=================================================================
  功  能: 返回本机的局域网Ip地址
  参  数: 无
  返回值: 成功:  True, 并填充LocalIp   失败:  False
  备 注:
  版 本:
     1.0  2002/10/02 21:05:00
=================================================================}
function GetLocalIP(var LocalIp: string): Boolean;
var
    HostEnt: PHostEnt;
    Ip: string;
    addr: pchar;
    Buffer: array [0..63] of char;
    GInitData: TWSADATA;
begin
  Result := False;
  try
    WSAStartup(2, GInitData);
    GetHostName(Buffer, SizeOf(Buffer));
    HostEnt := GetHostByName(buffer);
    if HostEnt = nil then Exit;
    addr := HostEnt^.h_addr_list^;
    ip := Format('%d.%d.%d.%d', [byte(addr [0]),
          byte (addr [1]), byte (addr [2]), byte (addr [3])]);
    LocalIp := Ip;
    Result := True;
  finally
    WSACleanup;
  end;
end;{=================================================================
  功  能: 通过Ip返回机器名
  参  数:
          IpAddr: 想要得到名字的Ip
  返回值: 成功:  机器名   失败:  ''
  备 注:
    inet_addr function converts a string containing an Internet
    Protocol dotted address into an in_addr.
  版 本:
    1.0  2002/10/02 22:09:00
=================================================================}
function GetNameByIPAddr(IPAddr : String;var MacName:String): Boolean;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  WSAData: TWSAData;
begin
  Result := False;
  if IpAddr = '' then exit;
  try
    WSAStartup(2, WSAData);
    SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));
    HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
    if HostEnt <> nil then
      MacName := StrPas(Hostent^.h_name);
    Result := True;
  finally
    WSACleanup;
  end;
end;{=================================================================
  功  能: 返回网络中SQLServer列表
  参  数:
          List: 需要填充的List
  返回值: 成功:  True,并填充List  失败 False
  备 注:
  版 本:
    1.0  2002/10/02 22:44:00
=================================================================}
Function GetSQLServerList(var List: Tstringlist): boolean;
var
   i: integer;
   sRetValue: String;
   SQLServer: Variant;
   ServerList: Variant;
begin
  Result := False;
  List.Clear;
  try
    SQLServer := CreateOleObject('SQLDMO.Application');
    ServerList := SQLServer.ListAvailableSQLServers;
    for i := 1 to Serverlist.Count do
      list.Add (Serverlist.item(i));
    Result := True;
  Finally
    SQLServer := NULL;
    ServerList := NULL;
  end;
end;{=================================================================
  功  能: 判断Ip协议有没有安装
  参  数: 无
  返回值: 成功:  True 失败: False;
  备 注:   该函数还有问题
  版 本:
     1.0  2002/10/02 21:05:00
=================================================================}
Function IsIPInstalled : boolean;
var
  WSData: TWSAData;
  ProtoEnt: PProtoEnt;
begin
  Result := True;
  try
    if WSAStartup(2,WSData) = 0 then
    begin
      ProtoEnt := GetProtoByName('IP');
      if ProtoEnt = nil then
        Result := False
    end;
  finally
    WSACleanup;
  end;
end;
{=================================================================
  功  能: 返回网络中的共享资源
  参  数:
          IpAddr: 机器Ip
          List: 需要填充的List
  返回值: 成功:  True,并填充List 失败: False;
  备 注:
     WNetOpenEnum function starts an enumeration of network
     resources or existing connections.
     WNetEnumResource function continues a network-resource
     enumeration started by the WNetOpenEnum function.
  版 本:
     1.0  2002/10/03 07:30:00
=================================================================}
Function GetUserResource(IpAddr: string; var List: TStringList): Boolean;
type
  TNetResourceArray = ^TNetResource;//网络类型的数组
Var
  i: Integer;
  Buf: Pointer;
  Temp: TNetResourceArray;
  lphEnum: THandle;
  NetResource: TNetResource;
  Count,BufSize,Res: DWord;
Begin
  Result := False;
  List.Clear;
  if copy(Ipaddr,0,2) <> '\\' then
    IpAddr := '\\'+IpAddr;   //填充Ip地址信息
  FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息
  NetResource.lpRemoteName := @IpAddr[1];//指定计算机名称
  //获取指定计算机的网络资源句柄
  Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
                      RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum);
  if Res <> NO_ERROR then exit;//执行失败
  while True do//列举指定工作组的网络资源
  begin
    Count := $FFFFFFFF;//不限资源数目
    BufSize := 8192;//缓冲区大小设置为8K
    GetMem(Buf, BufSize);//申请内存，用于获取工作组信息
    //获取指定计算机的网络资源名称
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
    if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕
    if (Res <> NO_ERROR) then Exit;//执行失败
    Temp := TNetResourceArray(Buf);
    for i := 0 to Count - 1 do
    begin
       //获取指定计算机中的共享资源名称，+2表示删除"\\"，
       //如\\192.168.0.1 => 192.168.0.1
       List.Add(Temp^.lpRemoteName + 2);
       Inc(Temp);
    end;
  end;
  Res := WNetCloseEnum(lphEnum);//关闭一次列举
  if Res <> NO_ERROR then exit;//执行失败
  Result := True;
  FreeMem(Buf);
End;

Answer 2

{=================================================================
  功  能: 返回网络中的工作组
  参  数:
          List: 需要填充的List
  返回值: 成功:  True,并填充List 失败: False;
  备  注:
  版  本:
     1.0  2002/10/03 08:00:00
=================================================================}
Function GetGroupList( var List : TStringList ) : Boolean;
type
  TNetResourceArray = ^TNetResource;//网络类型的数组
Var
  NetResource: TNetResource;
  Buf: Pointer;
  Count,BufSize,Res: DWORD;
  lphEnum: THandle;
  p: TNetResourceArray;
  i,j: SmallInt;
  NetworkTypeList: TList;
Begin
  Result := False;
  NetworkTypeList := TList.Create;
  List.Clear;
  //获取整个网络中的文件资源的句柄，lphEnum为返回名柄
  Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
                       RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
  if Res <> NO_ERROR then exit;//Raise Exception(Res);//执行失败
  //获取整个网络中的网络类型信息
  Count := $FFFFFFFF;//不限资源数目
  BufSize := 8192;//缓冲区大小设置为8K
  GetMem(Buf, BufSize);//申请内存，用于获取工作组信息
  Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
     //资源列举完毕                    //执行失败
  if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit;
  P := TNetResourceArray(Buf);
  for i := 0 to Count - 1 do//记录各个网络类型的信息
  begin
    NetworkTypeList.Add(p);
    Inc(P);
  end;
  Res := WNetCloseEnum(lphEnum);//关闭一次列举
  if Res <> NO_ERROR then exit;
  for j := 0 to NetworkTypeList.Count-1 do //列出各个网络类型中的所有工作组名称
  begin//列出一个网络类型中的所有工作组名称
    NetResource := TNetResource(NetworkTypeList.Items[J]^);//网络类型信息
    //获取某个网络类型的文件资源的句柄，NetResource为网络类型信息，lphEnum为返回名柄
    Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
                        RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
    if Res <> NO_ERROR then break;//执行失败
    while true do//列举一个网络类型的所有工作组的信息
    begin
      Count := $FFFFFFFF;//不限资源数目
      BufSize := 8192;//缓冲区大小设置为8K
      GetMem(Buf, BufSize);//申请内存，用于获取工作组信息
      //获取一个网络类型的文件资源信息，
      Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
          //资源列举完毕                   //执行失败
      if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR)  then break;
      P := TNetResourceArray(Buf);
      for i := 0 to Count - 1 do//列举各个工作组的信息
      begin
        List.Add( StrPAS( P^.lpRemoteName ));//取得一个工作组的名称
        Inc(P);
      end;
    end;
    Res := WNetCloseEnum(lphEnum);//关闭一次列举
    if Res <> NO_ERROR then break;//执行失败
  end;
  Result := True;
  FreeMem(Buf);
  NetworkTypeList.Destroy;
End;{=================================================================
  功  能: 列举工作组中所有的计算机
  参  数:
          List: 需要填充的List
  返回值: 成功:  True,并填充List 失败: False;
  备  注:
  版  本:
     1.0  2002/10/03 08:00:00
=================================================================}
Function GetUsers(GroupName: string; var List: TStringList): Boolean;
type
  TNetResourceArray = ^TNetResource;//网络类型的数组
Var
  i: Integer;
  Buf: Pointer;
  Temp: TNetResourceArray;
  lphEnum: THandle;
  NetResource: TNetResource;
  Count,BufSize,Res: DWord;
begin
  Result := False;
  List.Clear;
  FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息
  NetResource.lpRemoteName := @GroupName[1];//指定工作组名称
  NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器（工作组）
  NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
  NetResource.dwScope := RESOURCETYPE_DISK;//列举文件资源信息
  //获取指定工作组的网络资源句柄
  Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
                        RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
  if Res <> NO_ERROR then Exit; //执行失败
  while True do//列举指定工作组的网络资源
  begin
    Count := $FFFFFFFF;//不限资源数目
    BufSize := 8192;//缓冲区大小设置为8K
    GetMem(Buf, BufSize);//申请内存，用于获取工作组信息
    //获取计算机名称
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
    if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕
    if (Res <> NO_ERROR) then Exit;//执行失败
    Temp := TNetResourceArray(Buf);
    for i := 0 to Count - 1 do//列举工作组的计算机名称
    begin
      //获取工作组的计算机名称，+2表示删除"\\"，如\\wangfajun=>wangfajun
      List.Add(Temp^.lpRemoteName + 2);
      inc(Temp);
    end;
  end;
  Res := WNetCloseEnum(lphEnum);//关闭一次列举
  if Res <> NO_ERROR then exit;//执行失败
  Result := True;
  FreeMem(Buf);
end;{=================================================================
  功  能: 列举所有网络类型
  参  数:
          List: 需要填充的List
  返回值: 成功:  True,并填充List 失败: False;
  备 注:
  版 本:
     1.0  2002/10/03 08:54:00
=================================================================}
Function GetNetList(var List: Tstringlist): Boolean;
type
  TNetResourceArray = ^TNetResource;//网络类型的数组
Var
  p: TNetResourceArray;
  Buf: Pointer;
  i: SmallInt;
  lphEnum: THandle;
  NetResource: TNetResource;
  Count,BufSize,Res: DWORD;
begin
  Result := False;
  List.Clear;
  Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
                      RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
  if Res <> NO_ERROR then exit;//执行失败
  Count := $FFFFFFFF;//不限资源数目
  BufSize := 8192;//缓冲区大小设置为8K
  GetMem(Buf, BufSize);//申请内存，用于获取工作组信息
  Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);//获取网络类型信息
      //资源列举完毕                    //执行失败
  if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit;
  P := TNetResourceArra
end;

Answer 3

{=================================================================
  功  能: 映射网络驱动器
  参  数:
          NetPath: 想要映射的网络路径
          Password: 访问密码
          Localpath 本地路径
  返回值: 成功:  True  失败: False;
  备 注:
  版 本:
     1.0  2002/10/03 09:24:00
=================================================================}
Function NetAddConnection(NetPath: Pchar; PassWord: Pchar
                          ;LocalPath: Pchar): Boolean;
var
  Res: Dword;
begin
  Result := False;
  Res := WNetAddConnection(NetPath,Password,LocalPath);
  if Res <> No_Error then exit;
  Result := True;
end;{=================================================================
  功  能:  检测网络状态
  参  数:
          IpAddr: 被测试网络上主机的IP地址或名称，建议使用Ip
  返回值: 成功:  True  失败: False;
  备 注:
  版 本:
     1.0  2002/10/03 09:40:00
=================================================================}
Function CheckNet(IpAddr: string): Boolean;
type
  PIPOptionInformation = ^TIPOptionInformation;
  TIPOptionInformation = packed record
     TTL:         Byte;      // Time To Live (used for traceroute)
     TOS:         Byte;      // Type Of Service (usually 0)
     Flags:       Byte;      // IP header flags (usually 0)
     OptionsSize: Byte;      // Size of options data (usually 0, max 40)
     OptionsData: PChar;     // Options data buffer
  end;  PIcmpEchoReply = ^TIcmpEchoReply;
  TIcmpEchoReply = packed record
     Address:       DWord;                // replying address
     Status:        DWord;                // IP status value (see below)
     RTT:           DWord;                // Round Trip Time in milliseconds
     DataSize:      Word;                 // reply data size
     Reserved:      Word;
     Data:          Pointer;              // pointer to reply data buffer
     Options:       TIPOptionInformation; // reply options
  end;  TIcmpCreateFile = function: THandle; stdcall;
  TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
  TIcmpSendEcho = function(
     IcmpHandle:          THandle;
     DestinationAddress:  DWord;
     RequestData:         Pointer;
     RequestSize:         Word;
     RequestOptions:      PIPOptionInformation;
     ReplyBuffer:         Pointer;
     ReplySize:           DWord;
     Timeout:             DWord
  ): DWord; stdcall;const
  Size = 32;
  TimeOut = 1000;
var
  wsadata: TWSAData;
  Address: DWord;                     // Address of host to contact
  HostName, HostIP: String;           // Name and dotted IP of host to contact
  Phe: PHostEnt;                      // HostEntry buffer for name lookup
  BufferSize, nPkts: Integer;
  pReqData, pData: Pointer;
  pIPE: PIcmpEchoReply;               // ICMP Echo reply buffer
  IPOpt: TIPOptionInformation;        // IP Options for packet to send
const
  IcmpDLL = 'icmp.dll';
var
  hICMPlib: HModule;
  IcmpCreateFile : TIcmpCreateFile;
  IcmpCloseHandle: TIcmpCloseHandle;
  IcmpSendEcho:    TIcmpSendEcho;
  hICMP: THandle;                     // Handle for the ICMP Calls
begin
  // initialise winsock
  Result:=True;
  if WSAStartup(2,wsadata) <> 0 then begin
     Result:=False;
     halt;
  end;
  // register the icmp.dll stuff
  hICMPlib := loadlibrary(icmpDLL);
  if hICMPlib <> null then begin
    @ICMPCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');
    @IcmpCloseHandle:= GetProcAddress(hICMPlib, 'IcmpCloseHandle');
    @IcmpSendEcho:= GetProcAddress(hICMPlib, 'IcmpSendEcho');
    if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then begin
        Result:=False;
        halt;
    end;
    hICMP := IcmpCreateFile;
    if hICMP = INVALID_HANDLE_VALUE then begin
      Result:=False;
      halt;
    end;
  end else begin
    Result:=False;
    halt;
  end;
// ------------------------------------------------------------
  Address := inet_addr(PChar(IpAddr));
  if (Address = INADDR_NONE) then begin
    Phe := GetHostByName(PChar(IpAddr));
    if Phe = Nil then Result:=False
    else begin
      Address := longint(plongint(Phe^.h_addr_list^)^);
      HostName := Phe^.h_name;
      HostIP := StrPas(inet_ntoa(TInAddr(Address)));
    end;
  end
  else begin
    Phe := GetHostByAddr(@Address, 4, PF_INET);
    if Phe = Nil then Result:=False;
  end;  if Address = INADDR_NONE then
  begin
     Result:=False;
  end;
  // Get some data buffer space and put something in the packet to send
  BufferSize := SizeOf(TICMPEchoReply) + Size;
  GetMem(pReqData, Size);
  GetMem(pData, Size);
  GetMem(pIPE, BufferSize);
  FillChar(pReqData^, Size, $AA);
  pIPE^.Data := pData;    // Finally Send the packet
  FillChar(IPOpt, SizeOf(IPOpt), 0);
  IPOpt.TTL := 64;
  NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,
                        @IPOpt, pIPE, BufferSize, TimeOut);
  if NPkts = 0 then Result:=False;  // Free those buffers
  FreeMem(pIPE); FreeMem(pData); FreeMem(pReqData);// --------------------------------------------------------------
  IcmpCloseHandle(hICMP);
  FreeLibrary(hICMPlib);
  // free winsock
  if WSACleanup <> 0 then Result:=False;
end;
{=================================================================
  功  能:  检测计算机是否上网
  参  数:  无
  返回值:  成功:  True  失败: False;
  备 注:   uses Wininet
  版 本:
     1.0  2002/10/07 13:33:00
=================================================================}
function InternetConnected: Boolean;
const
  // local system uses a modem to connect to the Internet.
  INTERNET_CONNECTION_MODEM      = 1;
  // local system uses a local area network to connect to the Internet.
  INTERNET_CONNECTION_LAN        = 2;
  // local system uses a proxy server to connect to the Internet.
  INTERNET_CONNECTION_PROXY      = 4;
  // local system's modem is busy with a non-Internet connection.
  INTERNET_CONNECTION_MODEM_BUSY = 8;
var
  dwConnectionTypes : DWORD;
begin
  dwConnectionTypes := INTERNET_CONNECTION_MODEM+ INTERNET_CONNECTION_LAN
  + INTERNET_CONNECTION_PROXY; 
  Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;end.

Answer 4

嘿嘿，我都有了......http://expert.csdn.net/Expert/topic/1656/1656068.xml?temp=.3495142
http://cnpack.cosoft.org.cn/technique/technique.php这两个版本我已经看过了，有没有其他不一样的公用函数集？

Answer 5

List，你从stringList继承不就得了。
或者就模范stringlist的实现，要是用cb就好了，有stl可用啊。

Answer 6

自己写吧！
这东西是自己慢慢收集整理的！function CapitalizeMoney(aMoney: Double; aIsUnit: Boolean; var oMoneyStr:
  string): string; //小写人民币转换成大写人民币
function IsExistForm(aFormObject: string): Boolean; //查询窗体是否存在
function CalcAmountOfField(aQry: TQuery; aFieldName: string; var oAmountStr:
  string): string; //计算合计
function ChangeChineseToPY(aChinese: string; aIsCapital: Boolean; var oPYStr:
  string): string; //汉字转换成拼音码
function TrimTextOfEdt(aFormObject: TForm): string; //清除Form上EDIT的前后空格
function ClearTextOfEdt(aFormObject: TForm): string; //清除Form上EDIT的内容
function ClearCaptionOfPnl(aFormObject: TForm): string; //清除Form上Panel的内容
function SetReadOnlyOfEdt(aFormObject: TForm; aIs: Boolean): string;
  // 使FORM上EDIT不可写
function FullItemOfCB(aQry: TQuery; aFieldName: string; aCBObject: TComBoBox):
  string; //填充ComBoBox中的内容
function FullItemOfLB(aQry: TQuery; aFieldName: string; aLBObject: TListBox):
  string; //填充ListBox中的内容
function FilterQry(aQry: TQuery; aFieldName: string; aFilterValue: string):
  string; //对单个字段的过滤
function FilterPiPeiMa(aQry: TQuery; aFilterValue: string): string;
  //对拼音码，五笔码，自定码的组合过滤
function FilterQryByDBG(aQry: TQuery; aDBGrid: TDBGrid; aFilterValue: string):
  string; //对DBGrid的指定列的过滤
function LocateQryByDBG(aQry: TQuery; aDBGrid: TDBGrid; aLocateValue: string):
  string; //对DBGrid的指定列的定位
function SetLocalTimeForServerTime(aQry: TQuery): string;
  //设置本机时间为服务器时间
function SwapQueryRecord(aIsUp: Boolean; var oQry: TQuery): string; //交换记录
//
function GetPaperSize(aPaperSizeStr: string): TQRPaperSize;
function GetQRBandType(aQRBandTypeStr: string): TQRBandType;
function GetAlignment(aAlignmentStr: string): TAlignment;
function GetBoolean(aBooleanStr: string): Boolean;
function GetColor(aColorStr: string): TColor;
function GetFontStyle(aFontStyleStr: string): TFontStyles;
function GetDataType(aDataTypeStr: string): TQRSysDataType;
function GetPageOptions(aOptionStr: string): TQuickReportOptions;
function GetPageOrientation(aOrientationStr: string): TPrinterOrientation;implementationfunction GetPageOptions(aOptionStr: string): TQuickReportOptions;
begin
  if aOptionStr = '[]' then
    Result := []
  else if aOptionStr = '[FirstPageHeader]' then
    Result := [FirstPageHeader]
  else if aOptionStr = '[LastPageFooter]' then
    Result := [LastPageFooter]
  else if aOptionStr = '[FirstPageHeader,LastPageFooter]' then
    Result := [FirstPageHeader, LastPageFooter]
  else
    raise MyException.Create('参数错误！');
end;function GetPageOrientation(aOrientationStr: string): TPrinterOrientation;
begin
  if aOrientationStr = 'poPortrait' then
    Result := poPortrait
  else if aOrientationStr = 'poLandscape' then
    Result := poLandscape
  else
    raise MyException.Create('参数错误！');
end;function GetDataType(aDataTypeStr: string): TQRSysDataType;
begin
  if aDataTypeStr = 'qrsDate' then
    Result := qrsDate
  else if aDataTypeStr = 'qrsTime' then
    Result := qrsTime
  else if aDataTypeStr = 'qrsDateTime' then
    Result := qrsDateTime
  else if aDataTypeStr = 'qrsDetailCount' then
    Result := qrsDetailCount
  else if aDataTypeStr = 'qrsDetailNo' then
    Result := qrsDetailNo
  else if aDataTypeStr = 'qrsPageNumber' then
    Result := qrsPageNumber
  else if aDataTypeStr = 'qrsReportTitle' then
    Result := qrsReportTitle
  else
    raise MyException.Create('参数错误！');
end;function GetFontStyle(aFontStyleStr: string): TFontStyles;
begin
  if aFontStyleStr = '[]' then
    Result := []
  else if aFontStyleStr = '[fsBold]' then
    Result := [fsBold]
  else
    raise MyException.Create('参数错误！');
end;function GetColor(aColorStr: string): TColor;
begin
  if aColorStr = 'clBlack' then
    Result := clBlack
  else
    raise MyException.Create('参数错误！');
end;function GetBoolean(aBooleanStr: string): Boolean;
begin
  if UpperCase(aBooleanStr) = 'TRUE' then
    Result := True
  else if UpperCase(aBooleanStr) = 'FALSE' then
    Result := False
  else
    raise MyException.Create('参数错误！');
end;function GetAlignment(aAlignmentStr: string): TAlignment;
begin
  if aAlignmentStr = 'taLeftJustify' then
    Result := taLeftJustify
  else if aAlignmentStr = 'taRightJustify' then
    Result := taRightJustify
  else if aAlignmentStr = 'taCenter' then
    Result := taCenter
  else
    raise MyException.Create('参数错误！');
end;

Answer 7

function GetQRBandType(aQRBandTypeStr: string): TQRBandType;
begin
  if aQRBandTypeStr = 'rbTitle' then
    Result := rbTitle
  else if aQRBandTypeStr = 'rbPageHeader' then
    Result := rbPageHeader
  else if aQRBandTypeStr = 'rbDetail' then
    Result := rbDetail
  else if aQRBandTypeStr = 'rbPageFooter' then
    Result := rbPageFooter
  else if aQRBandTypeStr = 'rbSummary' then
    Result := rbSummary
  else if aQRBandTypeStr = 'rbColumnHeader' then
    Result := rbColumnHeader
  else if aQRBandTypeStr = 'rbGroupHeader' then
    Result := rbGroupHeader
  else if aQRBandTypeStr = 'rbGroupFooter' then
    Result := rbGroupFooter
  else
    raise MyException.Create('参数错误！');
end;function GetPaperSize(aPaperSizeStr: string): TQRPaperSize;
begin
  if aPaperSizeStr = 'A3' then
    Result := A3
  else if aPaperSizeStr = 'A4' then
    Result := A4
  else if aPaperSizeStr = 'A5' then
    Result := A5
  else if aPaperSizeStr = 'B4' then
    Result := B4
  else if aPaperSizeStr = 'B5' then
    Result := B5
  else if aPaperSizeStr = 'Custom' then
    Result := Custom
  else
    raise MyException.Create('参数错误！');
end;
function CapitalizeMoney(aMoney: Double; aIsUnit: Boolean; var oMoneyStr:
  string): string; //小写人民币转换成大写人民币
  function InttoUpperCase(Xiao: string): string;
  begin
    case StrToInt(Xiao) of
      0: Result := '零';
      1: Result := '壹';
      2: Result := '贰';
      3: Result := '叁';
      4: Result := '肆';
      5: Result := '伍';
      6: Result := '陆';
      7: Result := '柒';
      8: Result := '捌';
      9: Result := '玖';
    end;
  end;var
  IntPart: string;
  DecPart: string;
  RMBDecAry: array[0..3] of string[2];
  RMBIntAry: array[0..17] of string[2];
  LenIntPart: Integer;
  i, j: Integer;
begin
  try
    if aMoney > 100000000 then
    begin
      Result := '数值超出范围！';
      Exit;
    end;
     //初始化
    for i := 0 to 3 do RMBDecAry[i] := '';
    for i := 0 to 17 do RMBIntAry[i] := '';
    RMBIntAry[0] := '元';
    RMBIntAry[2] := '拾';
    RMBIntAry[4] := '佰';
    RMBIntAry[6] := '仟';
    RMBIntAry[8] := '万';
    RMBIntAry[10] := '拾';
    RMBIntAry[12] := '佰';
    RMBIntAry[14] := '仟';
    RMBIntAry[16] := '亿';
    //分解数字
    IntPart := IntToStr(trunc(aMoney));
    DecPart := FormatFloat('0.00', aMoney);
    DecPart := Copy(DecPart, Length(DecPart) - 1, 2);
    //先判断小数位（角分）
    if aIsUnit then
    begin
      if DecPart = '00' then DecPart := ''
      else
      begin
        RMBDecAry[0] := InttoUpperCase(DecPart[1]);
        if DecPart[1] <> '0' then RMBDecAry[1] := '角';
        if Decpart[2] <> '0' then
        begin
          RMBDecAry[2] := InttoUpperCase(DecPart[2]);
          RMBDecAry[3] := '分';
        end;
        DecPart := '';
        for i := 0 to 3 do DecPart := DecPart + RmbDecAry[i];
      end;
    end
    else //分开
    begin
      DecPart := IntToUpperCase(DecPart[1]) + '  ' + IntToUpperCase(DecPart[2])
        +
        '  ';
    end;
     //判断整数位
    if IntPart = '0' then IntPart := ''
    else
    begin
      LenIntPart := Length(IntPart);
      for i := 0 to LenIntPart - 1 do
        RMBIntAry[i * 2 + 1] := InttoUpperCase(IntPart[LenIntPart - i]);
      if not aIsUnit then
      begin //分开
        IntPart := '';
        for i := LenIntPart - 1 downto 0 do
          IntPart := IntPart + RMBIntAry[i * 2 + 1] + '  ';
      end
      else
      begin
        i := 0;
        while IntPart[LenIntPart - i] = '0' do
        begin //判断10的倍数
          if (i <> 0) and (RMBIntAry[i * 2] <> '万') then
            RMBIntAry[i * 2] := '';
          RMBIntAry[i * 2 + 1] := '';
          i := i + 1;
        end;
        j := 0;
        //除零判断，第一位,最后一位不为零
        for i := 1 to LenIntPart * 2 - 1 do //从个位开始
          if (RMBIntAry[i] = '零') then
            if j = 0 then
            begin
              j := i; //第一个0
              if RMBIntAry[j - 1] <> '万' then RMBIntAry[j - 1] := '';
            end
            else //不是第一个零
            begin
              if i - j > 2 then
              begin
                j := i; //零中间有间隔
                if RMBIntAry[j - 1] <> '万' then RMBIntAry[j - 1] := '';
              end
              else //删除前一个零
              begin
                j := i;
                RMBIntAry[j] := '';
                if RMBIntAry[j - 1] <> '万' then RMBIntAry[j - 1] := '';
              end;
            end;
        if RMBIntAry[9] = '零' then RMBIntAry[9] := ''; //万前的零判断
        IntPart := '';
        for i := 0 to LenIntPart * 2 - 1 do IntPart := RMBIntAry[i] + IntPart;
        LenIntPart := Length(IntPart);
        if Copy(IntPart, 1, 4) = '壹拾' then
          Intpart := Copy(IntPart, 3, LenIntPart); //壹拾判断
      end;
    end;
    oMoneyStr := IntPart + DecPart;
  except
    Result := '错误';
  end;
end;function IsExistForm(aFormObject: string): Boolean; //查询窗体是否存在
var
  i: Integer;
begin
  Result := False;
  for i := 0 to Screen.Formcount - 1 do
    if Screen.Forms[i].Name = AFormObject then
    begin
      Result := True;
      Break;
    end;
end;function CalcAmountOfField(aQry: TQuery; aFieldName: string; var oAmountStr:
  string): string; //计算合计
var
  JinE: Double;
  MyBK: TBookMark;
begin
  with aQry do
  begin
    if not Active then
    begin
      Result := '数据集未打开';
      Exit;
    end;
    JinE := 0;
    DisableControls;
    MyBK := GetBookMark;
    try
      First;
      while not Eof do
      begin
        if not FieldByName(aFieldName).IsNull then
          JinE := Jine + StrToFloat(FormatFloat('0.00',FieldByName(AFieldName).AsFloat));
        Next;
      end;
    finally
      First;
      GotoBookMark(MyBK);
      FreeBookMark(MyBK);
      EnableControls;
    end;
  end;
  oAmountStr := FormatFloat('0.00', JinE);
end;

Answer 8

function ChangeChineseToPY(aChinese: string; aIsCapital: Boolean; var oPYStr:
  string): string; //汉字转换成拼音码
  function GetPYIndexChar(hzchar: string): Char;
  begin
    case Word(hzchar[1]) shl 8 + Word(hzchar[2]) of
      $B0A1..$B0C4: Result := 'a';
      $B0C5..$B2C0: Result := 'b';
      $B2C1..$B4ED: Result := 'c';
      $B4EE..$B6E9: Result := 'd';
      $B6EA..$B7A1: Result := 'e';
      $B7A2..$B8C0: Result := 'f';
      $B8C1..$B9FD: Result := 'g';
      $B9FE..$BBF6: Result := 'h';
      $BBF7..$BFA5: Result := 'j';
      $BFA6..$C0AB: Result := 'k';
      $C0AC..$C2E7: Result := 'l';
      $C2E8..$C4C2: Result := 'm';
      $C4C3..$C5B5: Result := 'n';
      $C5B6..$C5BD: Result := 'o';
      $C5BE..$C6D9: Result := 'p';
      $C6DA..$C8BA: Result := 'q';
      $C8BB..$C8F5: Result := 'r';
      $C8F6..$CBF9: Result := 's';
      $CBFA..$CDD9: Result := 't';
      $CDDA..$CEF3: Result := 'w';
      $CEF4..$D188: Result := 'x';
      $D1B9..$D4D0: Result := 'y';
      $D4D1..$D7F9: Result := 'z';
    else
      Result := Char(32);
    end;
  end;var
  i: Integer;
  C: Char;
begin
  oPYStr := '';
  i := 1;
  while i <= Length(aChinese) do
  begin
    if aChinese[i] <= Chr(127) then
    begin
      if aIsCapital then
        oPYStr := oPYStr + UpCase(aChinese[i])
      else
        oPYStr := oPYStr + aChinese[i];
      i := i + 1;
    end
    else
    begin
      C := GetPYIndexChar(Copy(aChinese, i, 2));
      if C <> Char(32) then
        if aIsCapital then
          oPYStr := oPYStr + UpCase(C)
        else
          oPYStr := oPYStr + C;
      i := i + 2;
    end;
  end;
end;function TrimTextOfEdt(aFormObject: TForm): string; //清除Form上EDIT的前后空格
var
  i: Integer;
begin
  for i := 0 to aFormObject.Componentcount - 1 do
    if aFormObject.Components[i] is TEdit then
      TEdit(aFormObject.Components[i]).Text :=
        Trim(TEdit(aFormObject.Components[i]).Text);
end;function ClearTextOfEdt(aFormObject: TForm): string; //清除Form上EDIT的内容
var
  i: Integer;
begin
  for i := 0 to aFormObject.Componentcount - 1 do
    if aFormObject.Components[i] is TEdit then
      TEdit(aFormObject.Components[i]).Text := '';
end;function ClearCaptionOfPnl(aFormObject: TForm): string;
var
  i: Integer;
begin
  for i := 0 to aFormObject.Componentcount - 1 do
    if aFormObject.Components[i] is TPanel then
      TPanel(aFormObject.Components[i]).Caption := '';
end;function SetReadOnlyOfEdt(aFormObject: TForm; aIs: Boolean): string;
  // 使FORM上EDIT不可写
var
  i: Integer;
begin
  for i := 0 to aFormObject.Componentcount - 1 do
    if aFormObject.Components[i] is TEdit then
      TEdit(aFormObject.Components[i]).ReadOnly := aIs;
end;
function FullItemOfCB(aQry: TQuery; aFieldName: string; aCBObject: TComBoBox):
  string; //填充ComBoBox中的内容
begin
  aCBObject.Clear;
  aQry.First;
  while not aQry.Eof do
  begin
    aCBobject.Items.Add(aQry.FieldByName(aFieldName).AsString);
    aQry.Next;
  end;
end;function FullItemOfLB(aQry: TQuery; aFieldName: string; aLBObject: TListBox):
  string; //填充ListBox中的内容
begin
  aLBObject.Clear;
  aQry.First;
  while not aQry.Eof do
  begin
    aLBObject.Items.Add(aQry.FieldByName(aFieldName).AsString);
    aQry.Next;
  end;
end;function FilterQry(aQry: TQuery; aFieldName: string; aFilterValue: string):
  string; //对单个字段的过滤
var
  Condition: string;
begin
  with aQry do
  begin
    if not Active then Exit;
    FilterOptions := [foCaseInsensitive];
    Filtered := False;
    if (aFilterValue = '') or (aFieldName='') then Exit;
    if (FieldByName(aFieldName).DataType = ftSmallint)
      or (FieldByName(aFieldName).DataType = ftInteger)
      or (FieldByName(aFieldName).DataType = ftfloat)
      or (FieldByName(aFieldName).DataType = ftCurrency)
      or (FieldByName(aFieldName).DataType = ftBCD) then
      Condition := aFieldName + '=' + Trim(aFilterValue);
    if (FieldByName(aFieldName).DataType = ftString)
      or (FieldByName(aFieldName).DataType = ftDateTime) then
      Condition := aFieldName + '=''' + Trim(aFilterValue) + '*' + '''';
    try
      Filter := Condition;
      Filtered := True;
    except
      Result := '条件设置不正确!';
      Exit;
    end;
  end;
end;

Answer 9

我给你。[email protected]的就是我。

Answer 10

打下F1，帮助文件里不是有很多吗？还有就是看windows单元中的api函数。