delphifunction

合集下载

delphi数学模块函数、过程大全

Delphi函数大全

Delphi函数大全首部function Languages: TLanguages; $[功能返回系统语言对象说明通过此函数可以得到系统的语言环境参考type例子12a12c12a12c.参考<NULL>例子:= IsValidIdent;━━━━━━━━━━━━━━━━━━━━━首部function IntToStr(Value: Integer): string; overload; $[首部function IntToStr(Value: Int64): string; overload; $[功能返回整数Value转换成字符串说明Format('%d', [Value])参考function例子:= IntToStr;━━━━━━━━━━━━━━━━━━━━━首部function IntToHex(V alue: Integer; Digits: Integer): string; overload; $[首部function IntToHex(V alue: Int64; Digits: Integer): string; overload; $[功能返回整数Value转换成十六进制表现结果;Format('%.*x', [Digits, Value]) 说明参数Digits指定字符最小宽度;最小宽度不足时将用0填充参考function例子:= IntToHex, ;━━━━━━━━━━━━━━━━━━━━━首部function StrToInt(const S: string): Integer; $[功能返回字符串S转换成整数说明字符串非整数表达时将引起异常参考procedure例子:= StrToInt;━━━━━━━━━━━━━━━━━━━━━首部function StrToIntDef(const S: string; Default: Integer): Integer; $[功能返回字符串S转换成整数说明字符串非整数表达时则返回默认值Default参考procedure例子:= StrToIntDef, 0);━━━━━━━━━━━━━━━━━━━━━首部function TryStrToInt(const S: string; out Value: Integer): Boolean; $[功能返回字符串S转换成整数V alue是否成功说明字符串非整数表达时返回False并且Value将输出为0参考procedure例子..);打开失败则返回负数参考function例子xe'参考function ;function例子:= ExtractFileExt;━━━━━━━━━━━━━━━━━━━━━首部function ExpandFileName(const FileName: string): string; $[功能返回文件名的完整表示说明ExpandFileName('')='C:\Program Files\Borland\Delphi6\Projects\'参考function例子:= ExpandFileName;━━━━━━━━━━━━━━━━━━━━━首部function ExpandFileNameCase(const FileName: string; out MatchFound: TFilenameCaseMatch): string; $[功能分情况返回文件名的完整表示说明type TFilenameCaseMatch = (mkNone, mkExactMatch, mkSingleMatch, mkAmbiguous); 参考function ;function ;function例子.;获取失败则返回-1参考function例子:= DiskFree;━━━━━━━━━━━━━━━━━━━━━首部function DiskSize(Drive: Byte): Int64; $[功能返回驱动器全部空间说明参数Drive为0表示当前路径,为1表示=A驱,为2表示=B驱...;获取失败则返回-1参考function例子:= DiskSize;━━━━━━━━━━━━━━━━━━━━━首部function FileDateToDateTime(FileDate: Integer): TDateTime; $[功能返回将文件日期时间类型转换日期时间类型说明FileDate非法是将触发异常参考function ;function例子<参见FileAge>━━━━━━━━━━━━━━━━━━━━━首部function DateTimeToFileDate(DateTime: TDateTime): Integer; $[功能返回将日期时间类型转换文件日期时间类型说明年份在1980到2107之外则返回0参考function ;function例子<参见FileSetDate>━━━━━━━━━━━━━━━━━━━━━首部function GetCurrentDir: string; $[功能返回当前操作目录说明[注意]调用文件对话框会改变当前操作目录参考function例子:= GetCurrentDir;━━━━━━━━━━━━━━━━━━━━━首部function SetCurrentDir(const Dir: string): Boolean; $[功能返回设置当前操作目录是否成功说明[注意]调用文件对话框会改变当前操作目录参考function例子:= SetCurrentDir;━━━━━━━━━━━━━━━━━━━━━首部function CreateDir(const Dir: string): Boolean; $[功能返回创建目录是否成功说明不支持多级目录;已经存在则返回False参考function例子:= CreateDir;━━━━━━━━━━━━━━━━━━━━━首部function RemoveDir(const Dir: string): Boolean; $[功能返回删除目录是否成功说明必须是空目录参考function例子:= RemoveDir;━━━━━━━━━━━━━━━━━━━━━首部function StrLen(const Str: PChar): Cardinal; $[功能返回指针字符串的长度说明当指针字符串Str为nil时将触发异常参考<NULL>例子:= StrLen(PChar);━━━━━━━━━━━━━━━━━━━━━首部function StrEnd(const Str: PChar): PChar; $[功能返回指针字符串的结尾说明当指针字符串Str为nil时将触发异常参考<NULL>例子:= StrEnd(PChar) - ;━━━━━━━━━━━━━━━━━━━━━首部function StrMove(Dest: PChar; const Source: PChar; Count: Cardinal): PChar; $[ 功能返回将指针字符串Source指定内存数量Count复制覆盖到指针字符串Dest中说明Dest没有分配资源将触发异常s参考function例子255] of Char;beginStrECopy(StrECopy(vBuffer, PChar), PChar);:= vBuffer;end;255] of Char;beginStrLCopy(vBuffer, PChar, ;:= vBuffer;end;255] of Char;beginStrPCopy(vBuffer, PChar);:= vBuffer;end;255] of Char;beginStrPLCopy(vBuffer, , ;:= vBuffer;end;255] of Char;beginStrPCopy(vBuffer, ;StrCat(vBuffer, PChar);:= vBuffer;end;255] of Char;beginStrPCopy(vBuffer, ;StrLCat(vBuffer, PChar, ;:= vBuffer;end;2005-7-26 摘要] 类型Format('x=%d', [12]); 3f, []); f', [5, ]); d', [12]); x', [12]); 0000C255] of Char;E: Extended;beginE := StrToFloatDef, 0);:= FloatToText(vBuffer, E,fvExtended, ffNumber, , ;:= Copy(vBuffer, 1, ;end;0', 90) = '1,234,567,'参考function例子:= FormatFloat, StrToFloatDef, 0));━━━━━━━━━━━━━━━━━━━━━首部function FormatCurr(const Format: string; Value: Currency): string; $[功能返回货币类型以指定格式字符串Format转换成字符串说明FormatCurr(',.00', 90) = '1,234,567,'参考function例子:= FormatCurr, StrToCurrDef, 0));━━━━━━━━━━━━━━━━━━━━━首部function FloatToTextFmt(Buf: PChar; const Value; ValueType: TFloatValue; Format:PChar): Integer; $[功能返回浮点数以指定格式字符串Format转换成指针字符串的内存大小说明ValueType指定无类型参数Value的类型参考<NULL>例子255] of Char;E: Extended;beginE := StrToFloatDef, 0);:= FloatToTextFmt(vBuffer, E,fvExtended, PChar);:= Copy(vBuffer, 1, ;end;7] of string =('星期天', '星期一', '星期二', '星期三', '星期四', '星期五', '星期六');begin:= cWeekCn[DayOfWeek(Now)];end;2002-03-092002年03月09日255] of Char;beginExceptionErrorMessage(Self, Self, vBuffer, 255);Caption := vBuffer;end;, '') = 16参考function ;function例子:= LastDelimiter, ;━━━━━━━━━━━━━━━━━━━━━首部function AnsiCompareFileName(const S1, S2: string): Integer; $[功能返回比较两个文件名说明当S1>S2返回值>0;当S1<S2返回值<0;当S1=S2返回值=0;区分大小写参考function例子:= AnsiCompareFileName, ;━━━━━━━━━━━━━━━━━━━━━首部function SameFileName(const S1, S2: string): Boolean; $[功能返回两个文件名是否相等说明区分大小写参考function例子:= SameFileName, ;━━━━━━━━━━━━━━━━━━━━━首部function AnsiLowerCaseFileName(const S: string): string; $[功能返回小写文件名说明在非多字节字符系统上相当于AnsiLowerCase参考function例子:= AnsiLowerCaseFileName;━━━━━━━━━━━━━━━━━━━━━首部function AnsiUpperCaseFileName(const S: string): string; $[功能返回大写文件名说明在非多字节字符系统上相当于AnsiUpperCase参考function例子:= AnsiUpperCaseFileName;━━━━━━━━━━━━━━━━━━━━━首部function AnsiPos(const Substr, S: string): Integer; $[功能返回子串Substr在字符中第一次出现的位置说明不存在则返回0参考例子:= AnsiPos, ;━━━━━━━━━━━━━━━━━━━━━首部function AnsiStrPos(Str, SubStr: PChar): PChar; $[功能返回指针子串Substr在指针字符中第一次出现的指针位置说明不存在则返回nil参考function例子:= AnsiStrPos(PChar, PChar);━━━━━━━━━━━━━━━━━━━━━首部function AnsiStrRScan(Str: PChar; Chr: Char): PChar; $[功能返回在指针字符串Str搜索字符Chr最后一个出现的地址说明支持多字节字符系统;AnsiStrRScan('', '.') = ''参考function例子:= AnsiStrScan(PChar, '.');━━━━━━━━━━━━━━━━━━━━━首部function AnsiStrScan(Str: PChar; Chr: Char): PChar; $[功能返回在指针字符串Str搜索字符Chr第一个出现的地址说明支持多字节字符系统;AnsiStrRScan('', '.') = '.'参考function例子:= AnsiStrScan(PChar, '.');━━━━━━━━━━━━━━━━━━━━━首部function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string; $[功能返回替换后的字符串说明rfReplaceAll为替换全部内容;rfIgnoreCase为忽略大小写参考function ;function ;function例子///////Begin StringReplaceprocedure (Sender: TObject);begin'[]'] :=StringReplace, , , []);'[rfReplaceAll]'] :=StringReplace, , , [rfReplaceAll]);'[rfIgnoreCase]'] :=StringReplace, , , [rfIgnoreCase]);'[rfReplaceAll, rfIgnoreCase]'] :=StringReplace, , , [rfReplaceAll, rfIgnoreCase]);end;///////End StringReplace━━━━━━━━━━━━━━━━━━━━━首部function WrapText(const Line, BreakStr: string; const BreakChars: TSysCharSet; MaxCol: Integer): string; overload; $[首部function WrapText(const Line: string; MaxCol: Integer = 45): string; overload; $[功能返回对字符串自动换行说明Result := WrapText(Line, sLineBreak, [' ', '-', #9], MaxCol);参考function ;function例子:= WrapText, ;━━━━━━━━━━━━━━━━━━━━━首部function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet; IgnoreCase: Boolean): Boolean; overload; $[首部function FindCmdLineSwitch(const Switch: string): Boolean; overload; $[首部function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean; overload; $[功能返回程序命令参数是否找到说明Result := FindCmdLineSwitch(Switch, SwitchChars, True);参考function ;function ;function例子:= FindCmdLineSwitch;━━━━━━━━━━━━━━━━━━━━━首部procedure FreeAndNil(var Obj); $[功能释放对象Obj并赋为空说明如果对象已经释放资源将触发异常参考type例子///////Begin FreeAndNilprocedure (Sender: TObject);varTemp: TObject;beginTemp := ;;ShowMessage(Format('%p', [Pointer(Temp)]));Temp := ;FreeAndNil(Temp);ShowMessage(Format('%p', [Pointer(Temp)]));end;///////End FreeAndNil━━━━━━━━━━━━━━━━━━━━━首部function Supports(const Instance: IInterface; const IID: TGUID; out Intf): Boolean; overload; $[首部function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload; $[首部function Supports(const Instance: IInterface; const IID: TGUID): Boolean; overload; $[首部function Supports(const Instance: TObject; const IID: TGUID): Boolean; overload; $[首部function Supports(const AClass: TClass; const IID: TGUID): Boolean; overload; $[功能返回对象是否支持指定的接口说明Result := (IID) <> nil;参考type例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部function CreateGUID(out Guid: TGUID): HResult; $[功能返回创建全局标识是否成功说明返回S_OK表示成功参考function例子///////Begin CreateGUIDprocedure (Sender: TObject);varvGUID: TGUID;beginCreateGUID(vGUID);:= GUIDToString(vGUID);end;///////End CreateGUID━━━━━━━━━━━━━━━━━━━━━首部function StringToGUID(const S: string): TGUID; $[功能返回字符串S转换成全局标识说明如果字符串非法将触发异常参考fuction例子:= GUIDToString(StringToGUID);━━━━━━━━━━━━━━━━━━━━━首部function GUIDToString(const GUID: TGUID): string; $[功能返回全局标识GUID转换成字符串说明<NULL>参考fuction例子:= GUIDToString(StringToGUID);━━━━━━━━━━━━━━━━━━━━━首部function IsEqualGUID(const guid1, guid2: TGUID): Boolean; $[功能返回两个全局标识是否相同说明function IsEqualGUID; external '' name 'IsEqualGUID';参考<NULL>例子:= IsEqualGUID(StringToGUID, StringToGUID);━━━━━━━━━━━━━━━━━━━━━首部function LoadPackage(const Name: string): HMODULE; $[功能返回载入包资源说明<NULL>参考function ;function ;function例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部procedure UnloadPackage(Module: HMODULE); $[功能取消载入包资源说明<NULL>参考function ;function例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部procedure GetPackageInfo(Module: HMODULE; Param: Pointer; var Flags: Integer; InfoProc: TPackageInfoProc); $[功能返回包的信息说明<NULL>参考<NULL>例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部function GetPackageDescription(ModuleName: PChar): string; $[功能返回包的描述说明<NULL>参考function ;function例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部procedure InitializePackage(Module: HMODULE); $[功能初始化包说明<NULL>参考function例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部procedure FinalizePackage(Module: HMODULE); $[功能终止化包说明<NULL>参考function例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部procedure RaiseLastOSError; $[功能触发操作系统的最后一个异常说明如果没有出现异常则默认调用Api函数异常参考function例子RaiseLastOSError;━━━━━━━━━━━━━━━━━━━━━首部procedure RaiseLastWin32Error; deprecated; $[功能触发Win32系统的最后一个异常说明如果没有出现异常则默认调用Api函数异常参考function ;例子RaiseLastWin32Error;━━━━━━━━━━━━━━━━━━━━━首部function Win32Check(RetVal: BOOL): BOOL; platform; $[ 功能返回检测调用系统Api函数返回结果说明如果RetVal为False则触发异常参考function例子:= Win32Check;━━━━━━━━━━━━━━━━━━━━━首部procedure AddTerminateProc(TermProc: TTerminateProc); $[ 功能添加一个退出过程到系统中说明执行AddTerminateProc(nil)将导致系统异常参考const例子///////Begin AddTerminateProcfunction NewTerminateProc: Boolean;beginResult := True;ShowMessage('NewTerminateProc');end;procedure (Sender: TObject);beginAddTerminateProc(NewTerminateProc);end;///////End AddTerminateProc━━━━━━━━━━━━━━━━━━━━━首部function CallTerminateProcs: Boolean; $[功能返回调用退出过程是否成功说明不建议调用参考const例子CallTerminateProcs;━━━━━━━━━━━━━━━━━━━━━首部function GDAL: LongWord; $[功能<NULL>说明<NULL>参考<NULL>例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部procedure RCS; $[说明<NULL>参考<NULL>例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部procedure RPR; $[功能<NULL>说明<NULL>参考<NULL>例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部function SafeLoadLibrary(const Filename: string; ErrorMode: UINT = SEM_NOOPENFILEERRORBOX): HMODULE; $[功能返回安全方式载入动态连接库资源说明<参见LoadLibrary>参考function例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部function GetEnvironmentVariable(const Name: string): string; overload; $[功能返回过程环境变量说明配合SetEnvironmentVariable函数使用参考function例子:= GetEnvironmentVariable;///////Begin GetEnvironmentVariableprocedure (Sender: TObject);beginSetEnvironmentVariable(PChar, PChar);:= GetEnvironmentVariable;end;///////End GetEnvironmentVariable━━━━━━━━━━━━━━━━━━━━━首部function InterlockedIncrement(var I: Integer): Integer; $[功能<NULL>说明Kylix函数参考<NULL>例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部function InterlockedDecrement(var I: Integer): Integer; $[功能<NULL>说明Kylix函数参考<NULL>例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部function InterlockedExchange(var A: Integer; B: Integer): Integer; $[说明Kylix函数参考<NULL>例子<NULL>━━━━━━━━━━━━━━━━━━━━━首部function InterlockedExchangeAdd(var A: Integer; B: Integer): Integer; $[ 功能<NULL>说明Kylix函数参考<NULL>例子<NULL>━━━━━━━━━━━━━━━━━━━━━。

Delphi文件名操作常用函数

Delphi⽂件名操作常⽤函数Delphi⽂件名操作常⽤函数通过下⾯的函数，可以⽅便地对⽂件名进⾏操作：1. ExpandFileName将当前驱动器名(盘符)、路径名和指定的⽂件名合成⼀个绝对⽂件名。

函数原型如下：function ExpandFileName(const FileName: string): string;返回值为合成的绝对⽂件名。

2. ExpandUNCFileName获取⼀个以U N C格式的包括⽹络驱动器名的绝对⽂件名。

函数原型如下：function ExpandUNCFileName(const FileName: string): string;3. ExtractFileDir从绝对⽂件名中获取⽬录名。

函数原型如下：function ExtractFileDir(const FileName: string): string;4. ExtractFileDrive从绝对⽂件名中获取驱动器号(盘号)。

函数原型如下：function ExtractFileDrive(const FileName: string): string;5. ExtractFileExt从绝对⽂件名中获取⽂件名的扩展名。

函数原型如下：function ExtractFileExt(const FileName: string): string;6. ExtractFileName从绝对⽂件名中获取⽂件名。

函数原型如下：function ExtractFileName(const FileName: string): string;7. ExtractFilePath从绝对⽂件名中获取路径名。

函数原型如下：function ExtractFilePath(const FileName: string): string;8. ExtractRelativePath从绝对⽂件名中获取相对于某⼀个路径的相对路径名。

delphi源码

Delphi源码1. 简介Delphi是一种面向对象的编程语言，由Borland公司于1995年推出。

它基于Object Pascal语言，并结合了图形化用户界面设计和RAD（快速应用程序开发）工具。

Delphi主要用于Windows平台上的应用程序开发，特别适用于快速构建桌面应用程序。

Delphi的源码是指Delphi程序的源代码文件。

在Delphi 中，我们可以通过源码文件来编写程序的逻辑和功能。

这些源码文件包含了程序的各个模块和单元的实现代码，以及相应的声明和定义。

2. Delphi源码文件格式Delphi源码文件通常以.pas为扩展名，表示Pascal源码文件。

每个源码文件通常对应一个单元（Unit），用于实现一个代码模块。

在Delphi中，一个工程可以由多个单元组成，这些单元可以相互引用和调用。

Delphi源码文件以UTF-8编码保存，可以使用任何文本编辑器打开和编辑。

在Delphi的集成开发环境（IDE）中，我们可以使用Delphi自带的代码编辑器来编写和编辑源码文件，它提供了丰富的代码提示和自动补全功能，以提高开发效率。

3. Delphi源码的语法Delphi的源码是基于Object Pascal语言的，具有类似于其他编程语言的基本语法。

以下是一些Delphi源码的语法特点：3.1 变量声明在Delphi中，我们可以使用var关键字来声明变量。

例如：vari: Integer;s: string;3.2 过程和函数Delphi中可以定义过程（Procedure）和函数（Function）来实现一段可复用的代码逻辑。

过程和函数可以有参数和返回值。

例如：procedure ShowMessage(message: string);beginMessageBox(0, PChar(message), '提示', MB_OK); end;function Add(x, y: Integer): Integer;beginResult := x + y;end;3.3 类和对象Delphi是一种面向对象的编程语言，支持类和对象的概念。

delphi 位操作函数

delphi 位操作函数Delphi 位操作函数在Delphi编程中，位操作函数是一种非常重要且常用的函数，它们可以帮助我们对二进制数据进行各种位级别的操作。

本文将为大家介绍几个常用的Delphi位操作函数及其使用方法。

一、位操作函数简介位操作函数是一类用于处理位级数据的函数，它们可以对二进制数据的位进行读取、设置、清除和翻转等操作。

在Delphi中，位操作函数主要包括以下几个：1.1 TestBit函数TestBit函数主要用于检查指定位置上的位是否为1。

它的语法如下：function TestBit(const Value: Integer; Bit: Integer): Boolean;其中，Value是要检查的整数值，Bit是要检查的位的位置。

该函数返回一个Boolean值，如果指定位置上的位为1，则返回True；否则返回False。

1.2 SetBit函数SetBit函数用于将指定位置上的位设置为1。

它的语法如下：function SetBit(const Value: Integer; Bit: Integer): Integer;其中，Value是要设置的整数值，Bit是要设置的位的位置。

该函数返回一个新的整数值，其中指定位置上的位已被设置为1。

1.3 ClearBit函数ClearBit函数用于将指定位置上的位清除为0。

它的语法如下：function ClearBit(const Value: Integer; Bit: Integer): Integer;其中，Value是要清除的整数值，Bit是要清除的位的位置。

该函数返回一个新的整数值，其中指定位置上的位已被清除为0。

1.4 ToggleBit函数ToggleBit函数用于将指定位置上的位翻转，即从0变成1，或从1变成0。

它的语法如下：function ToggleBit(const Value: Integer; Bit: Integer): Integer;其中，Value是要翻转的整数值，Bit是要翻转的位的位置。

delphi 函数里面调用窗口的方法

delphi 函数里面调用窗口的方法（最新版3篇）《delphi 函数里面调用窗口的方法》篇1在Delphi 中，如果在函数内部需要调用窗口的方法，可以使用以下两种方式：1. 使用窗体的方法名称直接调用：如果在函数内部需要调用窗口的方法，可以使用窗体的方法名称直接调用。

例如，如果窗体名为Form1，需要调用其方法Name1，则可以在函数内部使用以下代码进行调用：```1;```这种方式调用窗口方法时，需要保证窗体已经初始化，否则会出现异常。

2. 使用窗体的方法指针进行调用：如果在函数内部需要调用窗口的方法，可以使用窗体的方法指针进行调用。

例如，如果窗体名为Form1，需要调用其方法Name1，则可以在函数内部使用以下代码进行调用：```varMethod: TMethod;begin// 获取窗体Form1 的方法指针Method := Form1.MethodName1;// 调用方法Method();end;```这种方式调用窗口方法时，不需要保证窗体已经初始化，因为方法指针是在运行时获取的。

《delphi 函数里面调用窗口的方法》篇2在Delphi 中，如果在函数内部需要调用窗口的方法，可以使用以下方式：1. 在函数内部创建一个窗口对象，然后调用窗口的方法。

例如：```function CallWindowMethod(Window: TWindow): Boolean;varMethodName: string;Method: TMethod;begin// 获取窗口类的方法MethodName := "WindowMethod";Method := Window.GetType().GetMethod(MethodName);if Method = nil thenraise Exception.Create("Window method not found");// 调用窗口方法Method.Invoke(Window, []);// 返回布尔值表示是否成功调用Result := True;end;```2. 在函数内部使用全局变量或类变量保存窗口对象，然后调用窗口的方法。

delphi getdc函数的用法

delphi getdc函数的用法
GetDC函数是Delphi中的一个函数，用于获取指定窗口的设备上下文（Device Context）句柄。

函数原型如下：
function GetDC(hWnd: HWND): HDC; stdcall;
参数说明：
- hWnd：指定窗口的句柄。

可以是顶级窗口、子窗口或控件的句柄。

返回值：该函数返回指定窗口的设备上下文（Device Context）句柄（HDC）。

如果函数失败，则返回0。

拓展：
GetDC函数的用途是获取指定窗口的设备上下文，通过设备上下文可以进行绘图和操作显示设备的相关信息。

使用GetDC函数获取设备上下文后，可以使用GDI（Graphics Device Interface）函数进行绘图操作，如绘制线条、填充颜色、绘制文字等。

获取设备上下文后，需要在不再使用时调用ReleaseDC函数释放设备上下文句柄，以避免资源泄露。

需要注意的是，使用GetDC函数获取窗口的设备上下文是一种较底层的操作，可能会需要对底层绘图知识有一定了解。

对于简单的绘图需求，Delphi中提供了一些高层封装的绘图组件和控件，可以更加方便地进行图形绘制。

DELPHI中使用API函数详解

DELPHI中使用API函数详解在Delphi中，可以使用API函数来实现一些特定的功能或操作，这些API函数可以直接调用Windows操作系统提供的功能。

本文将详细介绍如何在Delphi中使用API函数。

在Delphi中，可以使用以下方法来调用API函数：1. 声明API函数：首先需要在Delphi中声明API函数，可以在程序中的任何地方声明。

声明API函数的语法如下：```delphifunction 函数名(参数列表): 返回值类型; stdcall; external '库名.dll';```其中，函数名是API函数的名称，参数列表包含了API函数需要接收的参数，返回值类型是API函数的返回值类型，stdcall表示使用标准调用规范，external后面的字符串表示API函数所在的动态链接库文件。

例如，要声明一个在user32.dll库中的MessageBox函数，可以写成以下代码：```delphifunction MessageBox(hWnd: HWND; lpText: LPCWSTR; lpCaption: LPCWSTR; uType: UINT): Integer; stdcall; external 'user32.dll';```2.调用API函数：声明完API函数后，就可以在程序中直接调用了。

调用API函数的方法与调用普通函数类似，只需传递相应的参数即可。

例如，使用之前声明的MessageBox函数来显示一个消息框，可以写成以下代码：```delphibeginMessageBox(0, 'Hello World', '提示', MB_OK);end;```上述代码中，第一个参数0表示消息框的父窗口句柄，'Hello World'表示要显示的消息文本，'提示'表示消息框的标题，MB_OK表示消息框的样式。

delphi常用函数速查手册

Delphi常用函数速查手册1. 概述本手册旨在帮助Delphi开发人员更高效地编写代码，提供了常见的Delphi函数的速查表。

通过查阅本手册，您可以快速找到所需函数的语法、用法和示例。

2. 字符串函数2.1 Length函数返回一个字符串的长度。

语法：function Length(s: string): Integer;示例：varstr: string;len: Integer;beginstr := 'Hello World';len := Length(str); // len 的值为 11end;2.2 Pos函数查找子串在字符串中的位置。

语法：function Pos(subStr: string; str: string): Integer;示例：varstr: string;pos: Integer;beginstr := 'Hello World';pos := Pos('World', str); // pos 的值为 7end;2.3 Copy函数从字符串中复制指定长度的子串。

语法：function Copy(str: string; index, count: Integer): string;示例：varsrcStr, destStr: string;beginsrcStr := 'Hello World';destStr := Copy(srcStr, 7, 5); // destStr 的值为'World'end;2.4 Concat函数将两个字符串连接成一个新的字符串。

语法：function Concat(str1: string; str2: string): string;示例：varstr1, str2, newStr: string;beginstr1 := 'Hello';str2 := 'World';newStr := Concat(str1, str2); // newStr 的值为'HelloWorld'end;3. 数值函数3.1 IntToStr函数将整数转换为字符串。

delphi大端转小端字符串函数

delphi大端转小端字符串函数如何编写delphi大端转小端字符串函数。

首先，让我们明确一下什么是大端字节顺序和小端字节顺序。

在计算机系统中，字节是最小的数据单位。

在大端字节顺序中，最高有效字节存储在最低的内存地址中，而最低有效字节存储在最高的内存地址中。

而在小端字节顺序中，情况正好相反，最低有效字节存储在最低的内存地址中，最高有效字节存储在最高的内存地址中。

在Delphi中，我们可以使用一些内置函数来处理字节顺序的转换。

下面是一步一步的指南，演示如何编写一个Delphi函数来实现大端转小端字符串的转换。

第一步：创建一个新的Delphi工程打开Delphi集成开发环境（IDE），创建一个新的Delphi工程。

选择“文件”菜单中的“新建”选项，然后选择“应用程序”下的“VCL应用程序”。

选择一个适合你的项目的名称和位置，并点击“确定”按钮。

第二步：定义函数原型在项目中的主单位中，定义一个函数原型。

在“interface”部分中添加以下代码：delphifunction BigEndianToLittleEndianStr(const BigEndianStr: string): string;第三步：实现函数在“implementation”部分中，实现上面定义的函数。

下面是一个示例实现：delphifunction BigEndianToLittleEndianStr(const BigEndianStr: string): string;vari: Integer;begin将字符串转换为字节数组SetLength(Result, Length(BigEndianStr));Move(BigEndianStr[1], Result[1], Length(BigEndianStr));逆转字节数组的顺序for i := 1 to Length(Result) div 2 dobeginSwap(Result[i], Result[Length(Result) - i + 1]);end;end;在上面的代码中，我们使用了Delphi的内置函数`Swap`来逆转字节数组的顺序。

delphi函数定义及实现

delphi函数定义及实现Delphi函数定义及实现Delphi是一种面向对象的编程语言，它的函数定义和实现是非常重要的部分。

在Delphi中，函数是一种可重用的代码块，它可以接受参数并返回一个值。

在本文中，我们将讨论Delphi函数的定义和实现。

在Delphi中，函数定义由函数名、参数列表和返回类型组成。

下面是一个简单的函数定义示例：function AddNumbers(a, b: Integer): Integer;在这个函数定义中，函数名是AddNumbers，它接受两个整数参数a和b，并返回一个整数值。

在函数定义中，参数列表用括号括起来，参数之间用逗号分隔。

返回类型在函数名后面用冒号指定。

函数实现函数实现是函数定义的具体实现。

在Delphi中，函数实现由函数体组成。

函数体是一组语句，它们定义了函数的操作。

下面是一个简单的函数实现示例：function AddNumbers(a, b: Integer): Integer;beginResult := a + b;end;在这个函数实现中，函数体由一个begin和end语句块组成。

在begin和end之间，我们定义了一个操作，它将a和b相加，并将结果存储在Result变量中。

最后，函数返回Result变量的值。

函数调用函数调用是使用函数的过程。

在Delphi中，函数调用由函数名和参数列表组成。

下面是一个简单的函数调用示例：vara, b, c: Integer;begina := 1;b := 2;c := AddNumbers(a, b);end;在这个函数调用中，我们定义了三个整数变量a、b和c。

然后，我们将a和b的值分别设置为1和2。

最后，我们调用AddNumbers函数，并将a和b作为参数传递。

函数返回的结果存储在c变量中。

总结在Delphi中，函数定义和实现是非常重要的部分。

函数定义由函数名、参数列表和返回类型组成，而函数实现由函数体组成。

delphidll函数调用方法

delphidll函数调用方法Delphi是一种高级编程语言，用于开发Windows操作系统上的应用程序。

它具有强大的功能，可以创建各种类型的应用程序，包括动态链接库（DLL）。

DLL是一个包含可执行代码和数据的文件，它可以由多个应用程序同时使用。

通过使用DLL，我们可以将通用的代码保存在一个地方，并在多个应用程序中复用。

在Delphi中调用DLL函数的方法如下：```function MyDLLFunction: ReturnType; stdcall; external'MyDLL.dll';```这里，MyDLL.dll是DLL文件的名称，MyDLLFunction是DLL函数的名称，ReturnType是函数的返回类型，stdcall是函数调用约定。

```function MyDLLFunction: ReturnType; stdcall;```在这里，ReturnType是函数的返回类型，stdcall是函数调用约定。

3. 调用DLL函数：一旦导入DLL函数并声明其函数原型，我们就可以在Delphi代码中直接调用该函数。

```varreturnValue: ReturnType;beginreturnValue := MyDLLFunction;// 使用returnValue执行其他操作end;```这里，returnValue是一个变量，用于存储DLL函数的返回值。

使用上述代码，我们可以调用DLL函数并将返回值存储在returnValue变量中，以便进一步处理。

在一些情况下，DLL函数可能需要参数。

在这种情况下，我们需要在声明和调用函数时指定这些参数。

```function MyDLLFunction(param1: Type1; param2: Type2): ReturnType; stdcall;...varreturnValue: ReturnType;beginreturnValue := MyDLLFunction(value1, value2);// 使用returnValue执行其他操作end;```这里，param1和param2是DLL函数所需的参数，Type1和Type2是参数的类型，value1和value2是实际的参数值。

delphi中的常用数学函数【转载】

delphi中的常⽤数学函数【转载】delphi中的常⽤数学函数定义：function Power(X，Y): (Same type as parameter);说明：X可以是整型，也可以是实型；返回值实型例⼦：vari:integer;begini := Power(3,4); { 81}end.求绝对值函数abs(x)定义：function Abs(X): (Same type as parameter);说明：X可以是整型，也可以是实型；返回值和X的类型⼀致例⼦：varr: Real;i: Integer;beginr := Abs(-2.3); { 2.3 }i := Abs(-157); { 157 }end.取整函数int(x)定义：function Int(X: Real): Real; 注意：X是实型数，返回值也是实型的；返回的是X的整数部分，也就是说，X被截尾了（⽽不是四舍五⼊）例⼦：var R: Real;beginR := Int(123.567); { 123.0 }R := Int(-123.456); { -123.0 }end.截尾函数trunc(x)定义：function Trunc(X: Real): Longint; 注意：X是实型表达式. Trunc 返回Longint型的X的整数部分例⼦：beginWriteln(1.4, ' becomes ', Trunc(1.4)); { 1 }Writeln(1.5, ' becomes ', Trunc(1.5)); { 1 }Writeln(-1.4, 'becomes ', Trunc(-1.4)); { -1 }Writeln(-1.5, 'becomes ', Trunc(-1.5)); { -1 }end.四舍五⼊函数round(x)定义：function Round(X: Real): Longint; 注意：X是实型表达式. Round 返回Longint型的X的四舍五⼊值.如果返回值超出了Longint的表⽰范围，则出错. 例⼦：beginWriteln(1.4, ' rounds to ', Round(1.4)); { 1 }Writeln(1.5, ' rounds to ', Round(1.5)); { 2 }Writeln(-1.4, 'rounds to ', Round(-1.4));{ -1 }Writeln(-1.5, 'rounds to ', Round(-1.5));{ -2 }end.取⼩数函数frac(x)定义：function Frac(X: Real): Real; 注意：X 是实型表达式. 结果返回 X 的⼩数部分; 也就是说，Frac(X) = X - Int(_X). 例⼦：varR: Real;beginR := Frac(123.456); { 0.456 }R := Frac(-123.456); { -0.456 }end.求平⽅根函数sqrt(x)和平⽅函数sqr(x)定义：平⽅根：function Sqrt(X: Real): Real;注意：X 是实型表达式. 返回实型的X的平⽅根. 平⽅：function Sqr(X): (Same type as parameter);注意：X 是实型或整型表达式.返回值的类型和X的类型⼀致，⼤⼩是X的平⽅，即X*X.例⼦：beginWriteln('5 squared is ', Sqr(5)); { 25 }Writeln('The square root of 2 is ',Sqrt(2.0)); { 1.414 }Pascal函数实例标准数据类型的含义及符号(1)整型数的取值范围：-32768<=n<=32768;整型运算操作:+、-、*、div、mod;整型关系操作：=、<>、>=、<=，结果为布尔型；有关整型的标准函数：整型函数函数名函数值例前接函数 pred(x) x-1 pred(4)=3后继函数 succ(x) x+1 succ(-3)=-2绝对值函数abs(x) |x| abs(-1)=1平⽅函数sqr(x) x^2 sqr(-5)=25奇函数 odd(x) x为奇数时值为True odd(1)=truex为偶数时值为False odd(16)=false字符函数chr(x) 序号为x的ASCII字符 chr(65)=\'\'a\'\'a对应的序号65(2)实型数的绝对值取值范围：1E-38~1E+38;计算机实数的表⽰标准形式往往类如1.2E-8,-1234.56E+3等形式；实数范围⽐整数⼤，但实型数的运算速度⽐整形数慢，另外实型数在存储时会出现⼩的误差；实型的运算操作：+、-、*、/。

Delphi时间函数全集

Delphi时间函数全集function StartOfTheYear(const AValue: TDateTime): TDateTime;function EndOfTheYear(const AValue: TDateTime): TDateTime;function StartOfAYear(const AYear: Word): TDateTime;function EndOfAYear(const AYear: Word): TDateTime;function StartOfTheMonth(const AValue: TDateTime): TDateTime;function EndOfTheMonth(const AValue: TDateTime): TDateTime;function StartOfAMonth(const AYear, AMonth: Word): TDateTime;function EndOfAMonth(const AYear, AMonth: Word): TDateTime;function StartOfTheWeek(const AValue: TDateTime): TDateTime; {ISO 8601}function EndOfTheWeek(const AValue: TDateTime): TDateTime; {ISO 8601}function StartOfAWeek(const AYear, AWeekOfYear: Word; {ISO 8601}const ADayOfWeek: Word = 1): TDateTime;function EndOfAWeek(const AYear, AWeekOfYear: Word; {ISO 8601}const ADayOfWeek: Word = 7): TDateTime;所在单元：Unit DateUtils1、function DateOf(const AValue: TDateTime): TDateTime; 描述使⽤ DateOf 函数⽤来把⼀个 TDateTime 类型的变量转变成⼀个只带有⽇期的 TDateTime 类型变量。

Delphi中三种回调函数形式解析

Delphi中三种回调函数形式解析--[教程]Delphi 中三种回调函数形式解析 – QDAC数据访问组件⽹站 /?p=4595Delphi ⽀持三种形式的回调函数：全局函数这种⽅式⼏乎是所有的语⾔都⽀持的，类的静态函数也可以归为此类，它保存的只是⼀个函数的代码起始地址指针（ Pointer ）。

在Delphi 中声明⼀般为：1TXXX=procedure/function (参数列表);类的成员函数类的成员函数作为回调函数，与全局函数相⽐，需要关联具体的类的实例，所以它是由两部分组成，⼀个是对象的实例地址，⼀个是代码地址，两个指针，构成⼀个记录（结构体），参考 Delphi 中 TMethod 的声明：1 2 3TMethod = recordCode, Data: Pointer; end;在 Delphi 中的声明⼀般为：1TXXX=procedure/function (参数列表) of object;在实践中，你可以⽤ absolute 关键字来取出类的成员函数的 Code 和 Data 的值，Data 实际上就是对象的实例地址。

Delphi 中的事件⼀般来说都是此类回调，要求事件响应函数是类的成员函数。

匿名函数匿名函数 Delphi 实例上是通过接⼝来实现的，当你声明⼀个匿名函数类型时，实际上是声明了⼀个接⼝。

⽐如我们看 Delphi 下⾯的匿名函数声明：1TA=reference to procedure (x:Integer);实际上是声明了⼀个接⼝：1 2 3TA=interfaceprocedure Invoke(x:Integer); end;然后当你实现⼀个匿名函数时，实际上就是实现了这个接⼝，那个匿名函数遵守接⼝的⼀切规则。

Delphi 为你隐藏了内部的⼀切细节~~~。

delphi left函数

delphi left函数Delphi中的left函数是一个字符串处理函数，它用于返回字符串的左边指定个数的字符。

下面，我将一步一步回答关于Delphi中的left函数的问题。

首先，我们需要了解left函数的语法。

在Delphi中，left函数的语法如下：function LeftStr(const AText: string; const ACount: Integer): string;接下来，我将逐步解释语法中的各个部分。

1. function: 这个关键字表示我们正在定义一个函数。

2. LeftStr: 这个函数的名称为LeftStr。

3. const: 这个关键字表示我们传递给函数的参数是常量，即在函数中不会被修改。

4. AText: 这是传递给函数的第一个参数，是一个字符串，表示我们想要处理的字符串。

5. ACount: 这是传递给函数的第二个参数，是一个整数，表示我们想要将字符串中的左边多少个字符返回。

6. string: 这是函数的返回类型，表示函数将返回一个字符串。

接下来，我们将通过一个示例来展示left函数的用法。

假设我们有一个字符串"Hello, World!"，我们想要返回字符串的前5个字以下是使用left函数来实现这个需求的示例代码：varstr: string;beginstr := 'Hello, World!';str := LeftStr(str, 5);ShowMessage(str);end;在上述代码中，我们首先声明一个字符串变量str，并将其赋值为"Hello, World!"。

接下来，我们调用left函数，并将str和5作为参数传递给它。

函数将返回字符串的前5个字符，并将结果赋值给str变量。

最后，我们使用ShowMessage函数来显示str变量中的内容。

结果将是"Hello"。

delphi f三元运算符

delphi f三元运算符在Delphi中，虽然没有内置的三元运算符（例如C语言中的条件运算符），但是可以通过使用if语句来实现类似的功能。

三元运算符通常用于根据条件选择两个值中的一个。

在Delphi中，你可以使用if语句来模拟这种行为。

例如，你可以这样实现：pascal.var.A, B, C: Integer;begin.A := 10;B := 20;if A > B then.C := 100。

else.C := 200;// 现在C的值将根据A和B的大小关系被设定为100或200。

end;在这个例子中，根据A是否大于B，C的值将被设定为不同的结果。

这种方式虽然没有直接的三元运算符简洁，但能够实现类似的功能。

另外，有些Delphi开发者也会使用inline函数来模拟三元运算符的行为，例如：pascal.function IfThen(AExpression: Boolean; ATrue: Integer; AFalse: Integer): Integer; inline;begin.if AExpression then. Result := ATrue. else.Result := AFalse; end;var.A, B, C: Integer;begin.A := 10;B := 20;C := IfThen(A > B, 100, 200);// 现在C的值将根据A和B的大小关系被设定为100或200。

end;在这个例子中，我们定义了一个名为IfThen的inline函数，它接受一个布尔表达式和两个整数作为参数，根据布尔表达式的值返回不同的整数。

这种方式可以在一定程度上模拟三元运算符的行为，并且具有一定的简洁性。

总的来说，虽然Delphi没有内置的三元运算符，但是可以通过if语句或者自定义的inline函数来实现类似的功能。

delphi 泛型方法

delphi 泛型方法摘要：1.泛型概念介绍2.Delphi泛型特性概述3.泛型方法的定义与使用4.泛型方法的应用实例5.总结与展望正文：泛型是一种编程技术，允许程序员编写一段代码，同时适用于不同类型的数据。

在Delphi编程语言中，泛型提供了一种更加灵活和强大的方式来处理不同类型的数据。

本文将介绍Delphi泛型的基本概念，以及如何使用泛型方法实现代码的重用和提高程序的灵活性。

一、泛型概念介绍泛型是一种模板技术，它允许程序员在编写代码时，不需要为每个具体类型编写特定的代码。

通过使用泛型，我们可以编写一段处理数据的代码，而无需为每个数据类型创建单独的方法或函数。

这种代码重用方法可以提高程序的灵活性和可维护性。

二、Delphi泛型特性概述Delphi的泛型功能是基于泛型类型参数的。

泛型类型参数使用尖括号<>表示，可以用来定义泛型类、泛型函数和泛型方法。

在Delphi中，泛型类型参数可以定义为以下几种类型：1.原始类型：如整数、浮点数、布尔值等。

2.引用类型：如对象、数组、集合等。

3.类型别名：为已有的类型定义新的别名，以实现类型转换。

三、泛型方法的定义与使用泛型方法是在泛型类或泛型结构中定义的方法，它的参数和返回值可以是泛型类型。

泛型方法的定义和使用如下：1.定义泛型方法：使用关键字`generic` 定义泛型方法，后跟方法名、参数列表和返回类型。

例如：```delphigeneric function Process<T>(AInput: T; AOutput: T): Tbegin// 方法实现end;```2.使用泛型方法：在调用泛型方法时，需要指定具体的类型参数。

例如：```delphivarInput: Integer;Output: Integer;beginOutput := Process<Integer>(Input, Output);end;```四、泛型方法的应用实例下面是一个将整数数组转换为字符串数组的泛型方法示例：```delphigeneric function ConvertToStringArray<T>(AInput: T[]): string[] beginResult := [];for A in AInput dobeginif Assigned(A) thenResult := Result + [A.ToString];end;end;varIntArray: Integer[] = [1, 2, 3, 4, 5];StrArray: string[];beginStrArray := ConvertToStringArray<Integer>(IntArray);// 使用StrArrayend;```五、总结与展望Delphi的泛型功能为程序员提供了一种强大的代码重用方式。

delphi中的三角函数

Delphi中的三角函数一、概述在Delphi编程中，我们经常会遇到需要使用三角函数的情况。

三角函数包括正弦函数、余弦函数和正切函数，它们在几何、物理、信号处理等领域有着广泛的应用。

本文将介绍Delphi中常用的三角函数及其使用方法。

二、Sin函数Sin函数是正弦函数的缩写，它可以用于计算一个角度的正弦值。

在Delphi中，我们可以使用Sin函数来计算一个实数的正弦值。

1. 语法Sin函数的语法如下：function Sin(const X: Extended): Extended;其中，X为输入角度的值，Extended为实数类型。

2. 示例以下示例演示了如何使用Sin函数计算角度的正弦值：varAngle: Extended;SinValue: Extended;beginAngle := 45; // 角度为45度SinValue := Sin(DegToRad(Angle)); // 转换角度为弧度后，计算正弦值ShowMessage('Sin(45) = ' + FloatToStr(SinValue));end;运行上述代码将弹出一个消息框，显示正弦值的计算结果。

三、Cos函数Cos函数是余弦函数的缩写，它可以用于计算一个角度的余弦值。

在Delphi中，我们可以使用Cos函数来计算一个实数的余弦值。

1. 语法Cos函数的语法如下：function Cos(const X: Extended): Extended;其中，X为输入角度的值，Extended为实数类型。

2. 示例以下示例演示了如何使用Cos函数计算角度的余弦值：varAngle: Extended;CosValue: Extended;beginAngle := 60; // 角度为60度CosValue := Cos(DegToRad(Angle)); // 转换角度为弧度后，计算余弦值ShowMessage('Cos(60) = ' + FloatToStr(CosValue));end;运行上述代码将弹出一个消息框，显示余弦值的计算结果。

1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。

(*//标题:移动树节点说明:上、下、左、右移动设计:Zswang日期:2002-06-08支持:wjhu111@//*)///////Begin Sourcefunction TreeNodeMove(mTreeNode: TTreeNode; mAnchorKind: TAnchorKind; mIsTry: Boolean = False): Boolean;varvTreeNode: TTreeNode;beginResult := Assigned(mTreeNode);if not Result then Exit;case mAnchorKind ofakTop:beginvTreeNode := mTreeNode.GetPrev;while Assigned(vTreeNode)do beginif vTreeNode = mTreeNode.GetPrevSibling then beginif not mIsTry then mTreeNode.MoveTo(vTreeNode, naInsert);Exit;end else if(vTreeNode.Level = mTreeNode.Level)then begin if not mIsTry then mTreeNode.MoveTo(vTreeNode, naAdd);Exit;end else if(vTreeNode <> mTreeNode.Parent)and(vTreeNode.Level +1= mTreeNode.Level)then beginif not mIsTry then mTreeNode.MoveTo(vTreeNode, naAddChild); Exit;end;vTreeNode := vTreeNode.GetPrev;end;end;akBottom:beginvTreeNode := mTreeNode.GetNext;while Assigned(vTreeNode)do beginif vTreeNode = mTreeNode.GetNextSibling then beginif not mIsTry then vTreeNode.MoveTo(mTreeNode, naInsert);Exit;end else if(vTreeNode.Level = mTreeNode.Level)then begin if not mIsTry then mTreeNode.MoveTo(vTreeNode, naAddFirst); Exit;end else if vTreeNode.Level +1= mTreeNode.Level then beginif not mIsTry then mTreeNode.MoveTo(vTreeNode, naAddChildFirst);Exit;end;vTreeNode := vTreeNode.GetNext;end;end;akLeft:beginvTreeNode := mTreeNode.Parent;if Assigned(vTreeNode)then beginif not mIsTry then mTreeNode.MoveTo(vTreeNode, naInsert);Exit;end;end;akRight:beginvTreeNode := mTreeNode.GetNextSibling;if Assigned(vTreeNode)then beginif not mIsTry then mTreeNode.MoveTo(vTreeNode, naAddChildFirst); Exit;end;end;end;Result := False;end;{ TreeNodeMove }///////End Source///////Begin Demoprocedure TForm1.TreeView1KeyDown(Sender: TObject;var Key: Word;Shift: TShiftState);beginif not(ssCtrl in Shift)then Exit;case Key ofVK_UP: TreeNodeMove(TTreeView(Sender).Selected, akTop);VK_DOWN: TreeNodeMove(TTreeView(Sender).Selected, akBottom);VK_LEFT: TreeNodeMove(TTreeView(Sender).Selected, akLeft);VK_RIGHT: TreeNodeMove(TTreeView(Sender).Selected, akRight);end;end;procedure TForm1.TreeView1GetSelectedIndex(Sender: TObject;Node: TTreeNode);beginCheckBox1.Checked := TreeNodeMove(TTreeView(Sender).Selected, akTop, True);CheckBox2.Checked := TreeNodeMove(TTreeView(Sender).Selected, akBottom, True);CheckBox3.Checked := TreeNodeMove(TTreeView(Sender).Selected, akLeft, True);CheckBox4.Checked := TreeNodeMove(TTreeView(Sender).Selected, akRight, True);end;///////End Demo　(*//标题:显示超文本说明:在WebBrowser直接载入流，不通过文件设计:Zswang日期:2002-06-06支持:wjhu111@//*)///////Begin Sourceuses ActiveX;function ShowHtml(mWebBrowser: TWebBrowser; mStrings: TStrings): Boolean;varvMemoryStream: TMemoryStream;beginResult := False;if not(Assigned(mStrings)and Assigned(mWebBrowser))then Exit;mWebBrowser.Navigate('about:blank');if not Assigned(mWebBrowser.Document)then Exit;vMemoryStream := TMemoryStream.Create;trymStrings.SaveToStream(vMemoryStream);tryvMemoryStream.Position :=0;Application.ProcessMessages;// :)(mWebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(vMemoryStream));exceptExit;end;finallyvMemoryStream.Free;end;Result := True;end;{ ShowHtml }///////End Source///////Begin Demoprocedure TForm1.Button1Click(Sender: TObject);beginShowHtml(WebBrowser1, Memo1.Lines);end;procedure TForm1.FormCreate(Sender: TObject);beginMemo1.Text :='<html>'#13#10+'<body bkcolor=#FF00FF>Hello Worlds!</body>'#13#10+ '</html>'#13#10;end;///////End Demo　(*//标题:数据集处理成可视树说明:处理父节点标识字段、节点文本字段、节点标识字段这种表结构设计:Zswang日期:2002-05-20支持:wjhu111@//*)///////Begin Sourcefunction DataSetToTreeNode(mDataSet: TDataSet;mFieldNameParent:string;//父节点标识字段名mFieldNameTreeText:string;//节点文本字段名mFieldNameTreeId:string;//节点标识字段名mTreeView: TTreeView; mTreeNode: TTreeNode;mParentText:string): Boolean;varvTreeNode: TTreeNode;vFieldValues: Variant;vFieldNames:string;beginResult := False;if not Assigned(mDataSet)then Exit;if not Assigned(mTreeView)then Exit;if not mDataSet.Active then Exit;vFieldNames := Format('%s;%s;%s',[mFieldNameParent, mFieldNameTreeText, mFieldNameTreeId]);mDataSet.Filtered := False;mDataSet.Filter := Format('%s=%s',[mFieldNameParent,QuotedStr(mParentText)]);mDataSet.Filtered := True;if mDataSet.RecordCount =0then Exit;mDataSet.First;while not mDataSet.Eof do beginvTreeNode := mTreeView.Items.AddChild(mTreeNode,mDataSet.FieldByName(mFieldNameTreeText).AsString);vFieldValues := mDataSet[vFieldNames];DataSetToTreeNode(mDataSet, mFieldNameParent, mFieldNameTreeText, mFieldNameTreeId, mTreeView, vTreeNode,mDataSet.FieldByName(mFieldNameTreeId).AsString);///////Begin 恢复位置mDataSet.Filtered := False;mDataSet.Filter := Format('%s=%s',[mFieldNameParent,QuotedStr(mParentText)]);mDataSet.Filtered := True;mDataSet.Locate(vFieldNames, vFieldValues,[]);///////End 恢复位置mDataSet.Next;end;Result := True;end;///////End Source///////Begin Demoprocedure TForm1.Button1Click(Sender: TObject);beginTreeView1.Items.Clear;DataSetToTreeNode(Table1,'ParentTreeId','TreeText','TreeId',TreeView1,nil,'NULL');end;///////End Source　(*//标题:数据网格处理成超文本表格说明:支持对齐、字体、背景颜色;做打印又有一种新方法了！设计:Zswang日期:2002-05-19支持:wjhu111@//*)///////Begin Sourcefunction ColorToHtml(mColor: TColor):string;beginmColor := ColorToRGB(mColor);Result := Format('#%.2x%.2x%.2x',[GetRValue(mColor), GetGValue(mColor), GetBValue(mColor)]); end;{ ColorToHtml }function StrToHtml(mStr:string; mFont: TFont =nil):string;varvLeft, vRight:string;beginResult := mStr;Result := StringReplace(Result,'&','&AMP;',[rfReplaceAll]); Result := StringReplace(Result,'<','&LT;',[rfReplaceAll]); Result := StringReplace(Result,'>','&GT;',[rfReplaceAll]);if not Assigned(mFont)then Exit;vLeft := Format('',[, ColorToHtml(mFont.Color)]);vRight :='';if fsBold in mFont.Style then beginvLeft := vLeft +'';vRight :=''+ vRight;end;if fsItalic in mFont.Style then beginvLeft := vLeft +'';vRight :=''+ vRight;end;if fsUnderline in mFont.Style then beginvLeft := vLeft +'';vRight :=''+ vRight;end;if fsStrikeOut in mFont.Style then beginvLeft := vLeft +'<S>';vRight :='</S>'+ vRight;end;Result := vLeft + Result + vRight;end;{ StrToHtml }function DBGridToHtmlTable(mDBGrid: TDBGrid; mStrings: TStrings; mCaption: TCaption =''): Boolean;constcAlignText:array[TAlignment]of string=('LEFT','RIGHT','CENTER'); varvColFormat:string;vColText:string;vAllWidth: Integer;vWidths:array of Integer;vBookmark:string;I, J: Integer;beginResult := False;if not Assigned(mStrings)then Exit;if not Assigned(mDBGrid)then Exit;if not Assigned(mDBGrid.DataSource)then Exit;if not Assigned(mDBGrid.DataSource.DataSet)then Exit;if not mDBGrid.DataSource.DataSet.Active then Exit;vBookmark := mDBGrid.DataSource.DataSet.Bookmark;mDBGrid.DataSource.DataSet.DisableControls;tryJ :=0;vAllWidth :=0;for I :=0to mDBGrid.Columns.Count -1doif mDBGrid.Columns[I].Visible then beginInc(J);SetLength(vWidths, J);vWidths[J -1]:= mDBGrid.Columns[I].Width;Inc(vAllWidth, mDBGrid.Columns[I].Width);end;if J <=0then Exit;mStrings.Clear;mStrings.Add(Format('<TABLE BGCOLOR="%s" BORDER=1 WIDTH="100%%">', [ColorToHtml(mDBGrid.Color)]));if mCaption <>''thenmStrings.Add(Format('<CAPTION>%s</CAPTION>',[StrToHtml(mCaption)]));vColFormat :='';vColText :='';vColFormat := vColFormat +'<TR>'#13#10;vColText := vColText +'<TR>'#13#10;J :=0;for I :=0to mDBGrid.Columns.Count -1doif mDBGrid.Columns[I].Visible then beginvColFormat := vColFormat + Format(' <TD BGCOLOR="%s" ALIGN=%s WIDTH="%d%%">DisplayText%d</TD>'#13#10, [ColorToHtml(mDBGrid.Columns[I].Color),cAlignText[mDBGrid.Columns[I].Alignment],Round(vWidths[J]/ vAllWidth *100), J]);vColText := vColText + Format(' <TD BGCOLOR="%s" ALIGN=%s WIDTH="%d%%">%s</TD>'#13#10,[ColorToHtml(mDBGrid.Columns[I].Title.Color),cAlignText[mDBGrid.Columns[I].Alignment],Round(vWidths[J]/ vAllWidth *100),StrToHtml(mDBGrid.Columns[I].Title.Caption,mDBGrid.Columns[I].Title.Font)]);Inc(J);end;vColFormat := vColFormat +'</TR>'#13#10;vColText := vColText +'</TR>'#13#10;mStrings.Text := mStrings.Text + vColText;mDBGrid.DataSource.DataSet.First;while not mDBGrid.DataSource.DataSet.Eof do beginJ :=0;vColText := vColFormat;for I :=0to mDBGrid.Columns.Count -1doif mDBGrid.Columns[I].Visible then beginvColText := StringReplace(vColText, Format('>DisplayText%d<', [J]),Format('>%s<',[StrToHtml(mDBGrid.Columns[I].Field.DisplayText,mDBGrid.Columns[I].Font)]),[rfReplaceAll]);Inc(J);end;mStrings.Text := mStrings.Text + vColText;mDBGrid.DataSource.DataSet.Next;end;mStrings.Add('</TABLE>');finallymDBGrid.DataSource.DataSet.Bookmark := vBookmark;mDBGrid.DataSource.DataSet.EnableControls;vWidths :=nil;end;Result := True;end;{ DBGridToHtmlTable }///////End Source{ uses ShellApi; }///////Begin Demoprocedure TForm1.Button1Click(Sender: TObject);beginDBGridToHtmlTable(DBGrid1, Memo1.Lines, Caption);Memo1.Lines.SaveToFile('c:\temp.htm');ShellExecute(Handle,nil,'c:\temp.htm',nil,nil, SW_SHOW);end;///////End Demo　(*//标题:树和路径间转换说明:比如这样的路径:“C:\Windows\System\user32.dll”设计:Zswang日期:2002-05-02支持:wjhu111@//*)///////Begin Sourcefunction StrLeft(const mStr:string; mDelimiter:string):string; beginResult := Copy(mStr,1, Pos(mDelimiter, mStr)-1);end;{ StrLeft }function ListCount(mList:string; mDelimiter:string=','): Integer; varI, L: Integer;beginResult :=0;if mList =''then Exit;L := Length(mList);I := Pos(mDelimiter, mList);while I >0do beginmList := Copy(mList, I + Length(mDelimiter), L);I := Pos(mDelimiter, mList);Inc(Result);end;Inc(Result);end;{ ListCount }function ListValue(mList:string; mIndex: Integer; mDelimiter:string= ','):string;varI, L, K: Integer;beginL := Length(mList);I := Pos(mDelimiter, mList);K :=0;Result :='';while(I >0)and(K <> mIndex)do beginmList := Copy(mList, I + Length(mDelimiter), L);I := Pos(mDelimiter, mList);Inc(K);end;if K = mIndex then Result := StrLeft(mList + mDelimiter, mDelimiter); end;{ ListValue }function TreeNodeString(mTreeNode: TTreeNode; mDelimiter:string='\'): string;beginResult :='';while Assigned(mTreeNode)do beginResult := mTreeNode.Text + mDelimiter + Result;mTreeNode := mTreeNode.Parent;end;Delete(Result, Length(Result)- Length(mDelimiter)+1, MaxInt); end;{ TreeNodeString }function TreeViewToLineText(mTreeView: TTreeView; mStrings: TStrings; mDelimiter:string='\'): Boolean;varI: Integer;beginResult := False;if not(Assigned(mTreeView)and Assigned(mStrings))then Exit;mStrings.Clear;for I :=0to mTreeView.Items.Count -1doif mTreeView.Items[I].Count =0thenmStrings.Add(TreeNodeString(mTreeView.Items[I], mDelimiter));Result := True;end;{ TreeViewToLineText }function LineTextToTreeView(mStrings: TStrings; mTreeView: TTreeView; mDelimiter:string='\'): Boolean;varI, J, K: Integer;vStrPath:string;vStrText:string;vTreeNode: TTreeNode;vBoolFind: Boolean;beginResult := False;if not(Assigned(mTreeView)and Assigned(mStrings))then Exit;mTreeView.Items.Clear;for I :=0to mStrings.Count -1do beginvStrPath :='';vTreeNode :=nil;for J :=0to ListCount(mStrings[I], mDelimiter)-1do beginvStrText := ListValue(mStrings[I], J, mDelimiter);vStrPath := vStrPath + mDelimiter + vStrText;vBoolFind := False;for K :=0to mTreeView.Items.Count -1doif mDelimiter + TreeNodeString(mTreeView.Items[K], mDelimiter)= vStrPath then beginvTreeNode := mTreeView.Items[K];vBoolFind := True;Break;end;if vBoolFind then Continue;vTreeNode := mTreeView.Items.AddChild(vTreeNode, vStrText);end;end;Result := True;end;{ LineTextToTreeView }///////End Source///////Begin Demoprocedure TForm1.Button1Click(Sender: TObject);beginLineTextToTreeView(Memo1.Lines, TreeView1);end;procedure TForm1.Button2Click(Sender: TObject);beginTreeViewToLineText(TreeView1, Memo1.Lines);end;///////End Demo　(*//标题:排列组合说明:只处理可视字符;使用时可以替换一下设计:Zswang日期:2002-04-30支持:wjhu111@//*)///////Begin Sourcefunction PermutationCombination(mArr:array of string; mStrings: TStrings): Boolean;varI, J: Integer;T:string;S:string;beginResult := False;if not Assigned(mStrings)then Exit;mStrings.Clear;T :='';for I := Low(mArr)to High(mArr)doif mArr[I]<>''then beginT := T + mArr[I][1];S := S + mArr[I][Length(mArr[I])];end else Exit;while T <> S do trymStrings.Add(T);J := Length(S);for I := High(mArr)downto Low(mArr)do beginif Pos(T[J], mArr[I])>= Length(mArr[I])thenT[J]:= mArr[I][1]else beginT[J]:= mArr[I][Pos(T[J], mArr[I])+1];Break;end;Dec(J);end;mStrings.Add(S);exceptExit;end;Result := True;end;{ PermutationCombination }///////End Source///////Begin Demoprocedure TForm1.Button1Click(Sender: TObject);beginPermutationCombination(['ACDE','FGH','IJKL','MNO','PQRST'], Memo1.Lines)end;///////End Demo　(*//标题:字符网格排序说明:升序、降序;示例点击标题排序设计:Zswang日期:2002-04-27支持:wjhu111@//*)///////Begin Sourcefunction StringGridRowSwap(mStringGrid: TStringGrid;mFromRow, mToRow: Integer): Boolean;varS:string;beginResult := False;if(mToRow = mFromRow)then Exit;if not Assigned(mStringGrid)then Exit;if(mFromRow <0)or(mFromRow >= mStringGrid.RowCount)then Exit;if(mToRow <0)or(mToRow >= mStringGrid.RowCount)then Exit;tryS := mStringGrid.Rows[mFromRow].Text;mStringGrid.Rows[mFromRow].Text := mStringGrid.Rows[mToRow].Text; mStringGrid.Rows[mToRow].Text := S;exceptExit;end;Result := True;end;{ StringGridRowSwap }function StringGridRowSort(mStringGrid: TStringGrid;mColIndex: Integer; mDesc: Boolean = False): Boolean;varI, J: Integer;beginResult := False;if not Assigned(mStringGrid)then Exit;if(mColIndex <0)or(mColIndex >= mStringGrid.ColCount)then Exit;for I := mStringGrid.FixedRows to mStringGrid.RowCount -2dofor J := I +1to mStringGrid.RowCount -1doif mDesc thenif mStringGrid.Cells[mColIndex,I]< mStringGrid.Cells[mColIndex, J]thenStringGridRowSwap(mStringGrid, I, J)elseelse if mStringGrid.Cells[mColIndex, I]>mStringGrid.Cells[mColIndex, J]thenStringGridRowSwap(mStringGrid, I, J);Result := True;end;{ StringGridRowSort }///////End Source///////Begin Demoprocedure TForm1.StringGrid1MouseDown(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);{$J+}constvOldCol: Integer =-1;{$J-}varvCol, vRow: Integer;beginif Button = mbRight then Exit;TStringGrid(Sender).MouseToCell(X, Y, vCol, vRow);if(vRow <0)or(vRow >= TStringGrid(Sender).FixedRows)then Exit; StringGridRowSort(TStringGrid(Sender), vCol, vOldCol = vCol);if vOldCol = vCol thenvOldCol :=- vOldColelse vOldCol := vCol;end;///////End Demo　(*//标题:处理IDE特殊字符说明:就算Borland公司的人看了也会下一跳！设计:Zswang日期:2002-04-18支持:wjhu111@//*)///////Begin SourceconstcIDEc:array[#0..#255]of string=('^'#64,'^'#97,'^'#98,'^'#99,'^'#100,'^'#101,'^'#102,'^'#103,'^'#104,'^'#105,'^'#106,'^'#107,'^'#108,'^'#109,'^'#110,'^'#111,'^'#112, '^'#113,'^'#114,'^'#115,'^'#116,'^'#117,'^'#118,'^'#119,'^'#120,'^'#121, '^'#122,'^'#91,'^'#92,'^'#93,'^'#94,'^'#95,'^'#96,'#33','#34','#35', '#36','#37','#38','#39','#40','#41','#42','#43','#44','#45','#46', '#47','#48','#49','#50','#51','#52','#53','#54','#55','#56','#57', '#58','^'#123,'^'#124,'^'#125,'^'#126,'^'#127,'#64','^'#1,'^'#2,'^'#3, '^'#4,'^'#5,'^'#6,'^'#7,'^'#8,'^'#9,'^'#10,'^'#11,'^'#12,'^'#13,'^'#14, '^'#15,'^'#16,'^'#17,'^'#18,'^'#19,'^'#20,'^'#21,'^'#22,'^'#23, '^'#24,'^'#25,'^'#26,'^'#27,'^'#28,'^'#29,'^'#30,'^'#31,'^'#32,'^'#33, '^'#34,'^'#35,'^'#36,'^'#37,'^'#38,'^'#39,'^'#40,'^'#41,'^'#42,'^'#43, '^'#44,'^'#45,'^'#46,'^'#47,'^'#48,'^'#49,'^'#50,'^'#51,'^'#52,'^'#53, '^'#54,'^'#55,'^'#56,'^'#57,'^'#58,'^'#59,'^'#60,'^'#61,'^'#62, '^'#63,'^'#192,'^'#193,'^'#194,'^'#195,'^'#196,'^'#197,'^'#198, '^'#199,'^'#200,'^'#201,'^'#202,'^'#203,'^'#204,'^'#205,'^'#206,'^'#207, '^'#208,'^'#209,'^'#210,'^'#211,'^'#212,'^'#213,'^'#214,'^'#215,'^'#216, '^'#217,'^'#218,'^'#219,'^'#220,'^'#221,'^'#222,'^'#223,'^'#224,'^'#225, '^'#226,'^'#227,'^'#228,'^'#229,'^'#230,'^'#231,'^'#232,'^'#233,'^'#234, '^'#235,'^'#236,'^'#237,'^'#238,'^'#239,'^'#240,'^'#241,'^'#242,'^'#243, '^'#244,'^'#245,'^'#246,'^'#247,'^'#248,'^'#249,'^'#250,'^'#251,'^'#252, '^'#253,'^'#254,'^'#255,'^'#128,'^'#129,'^'#130,'^'#131,'^'#132,'^'#133, '^'#134,'^'#135,'^'#136,'^'#137,'^'#138,'^'#139,'^'#140,'^'#141,'^'#142, '^'#143,'^'#144,'^'#145,'^'#146,'^'#147,'^'#148,'^'#149,'^'#150,'^'#151, '^'#152,'^'#153,'^'#154,'^'#155,'^'#156,'^'#157,'^'#158,'^'#159,'^'#160, '^'#161,'^'#162,'^'#163,'^'#164,'^'#165,'^'#166,'^'#167,'^'#168,'^'#169, '^'#170,'^'#171,'^'#172,'^'#173,'^'#174,'^'#175,'^'#176,'^'#177,'^'#178, '^'#179,'^'#180,'^'#181,'^'#182,'^'#183,'^'#184,'^'#185,'^'#186,'^'#187, '^'#188,'^'#189,'^'#190,'^'#191);function StrToIDEc(mStr:string):string;varI: Integer;beginResult :='';for I :=1to Length(mStr)doResult := Result + cIDEc[mStr[I]];end;{ StrToIDEc }function IDEcToStr(mIDEc:string):string;varC: Char;I, L: Integer;T:string;beginResult :='';I :=1;L := Length(mIDEc);mIDEc := LowerCase(mIDEc);while I <= L do beginif mIDEc[I]='^'then beginfor C :=#0to#255doif cIDEc[C]= Copy(mIDEc, I,2)then beginResult := Result + C;Inc(I,2);Break;end;end else if mIDEc[I]='#'then beginT :='';Inc(I);while mIDEc[I]in['0'..'9']do beginT := T + mIDEc[I];Inc(I);end;if T <>''then Result := Result + Chr(StrToIntDef(T,0));end else Inc(I);end;end;{ IDEcToStr }///////End Source///////Begin Demoprocedure TForm1.Button1Click(Sender: TObject);beginClipboard.AsText := StrToIDEc(Edit1.Text);Caption := IDEcToStr(Clipboard.AsText);ShowMessage(^^!^3^4^%);end;///////Edn Demo　(*//标题:处理IDE特殊字符说明:就算Borland公司的人看了也会下一跳！设计:Zswang日期:2002-04-18支持:wjhu111@//*)///////Begin SourceconstcIDEc:array[#0..#255]of string=('^'#64,'^'#97,'^'#98,'^'#99,'^'#100,'^'#101,'^'#102,'^'#103,'^'#104,'^'#105,'^'#106,'^'#107,'^'#108,'^'#109,'^'#110,'^'#111,'^'#112, '^'#113,'^'#114,'^'#115,'^'#116,'^'#117,'^'#118,'^'#119,'^'#120,'^'#121, '^'#122,'^'#91,'^'#92,'^'#93,'^'#94,'^'#95,'^'#96,'#33','#34','#35', '#36','#37','#38','#39','#40','#41','#42','#43','#44','#45','#46', '#47','#48','#49','#50','#51','#52','#53','#54','#55','#56','#57', '#58','^'#123,'^'#124,'^'#125,'^'#126,'^'#127,'#64','^'#1,'^'#2,'^'#3, '^'#4,'^'#5,'^'#6,'^'#7,'^'#8,'^'#9,'^'#10,'^'#11,'^'#12,'^'#13,'^'#14,'^'#15,'^'#16,'^'#17,'^'#18,'^'#19,'^'#20,'^'#21,'^'#22,'^'#23, '^'#24,'^'#25,'^'#26,'^'#27,'^'#28,'^'#29,'^'#30,'^'#31,'^'#32,'^'#33, '^'#34,'^'#35,'^'#36,'^'#37,'^'#38,'^'#39,'^'#40,'^'#41,'^'#42,'^'#43, '^'#44,'^'#45,'^'#46,'^'#47,'^'#48,'^'#49,'^'#50,'^'#51,'^'#52,'^'#53, '^'#54,'^'#55,'^'#56,'^'#57,'^'#58,'^'#59,'^'#60,'^'#61,'^'#62, '^'#63,'^'#192,'^'#193,'^'#194,'^'#195,'^'#196,'^'#197,'^'#198, '^'#199,'^'#200,'^'#201,'^'#202,'^'#203,'^'#204,'^'#205,'^'#206,'^'#207, '^'#208,'^'#209,'^'#210,'^'#211,'^'#212,'^'#213,'^'#214,'^'#215,'^'#216, '^'#217,'^'#218,'^'#219,'^'#220,'^'#221,'^'#222,'^'#223,'^'#224,'^'#225, '^'#226,'^'#227,'^'#228,'^'#229,'^'#230,'^'#231,'^'#232,'^'#233,'^'#234, '^'#235,'^'#236,'^'#237,'^'#238,'^'#239,'^'#240,'^'#241,'^'#242,'^'#243, '^'#244,'^'#245,'^'#246,'^'#247,'^'#248,'^'#249,'^'#250,'^'#251,'^'#252, '^'#253,'^'#254,'^'#255,'^'#128,'^'#129,'^'#130,'^'#131,'^'#132,'^'#133, '^'#134,'^'#135,'^'#136,'^'#137,'^'#138,'^'#139,'^'#140,'^'#141,'^'#142, '^'#143,'^'#144,'^'#145,'^'#146,'^'#147,'^'#148,'^'#149,'^'#150,'^'#151, '^'#152,'^'#153,'^'#154,'^'#155,'^'#156,'^'#157,'^'#158,'^'#159,'^'#160, '^'#161,'^'#162,'^'#163,'^'#164,'^'#165,'^'#166,'^'#167,'^'#168,'^'#169, '^'#170,'^'#171,'^'#172,'^'#173,'^'#174,'^'#175,'^'#176,'^'#177,'^'#178, '^'#179,'^'#180,'^'#181,'^'#182,'^'#183,'^'#184,'^'#185,'^'#186,'^'#187, '^'#188,'^'#189,'^'#190,'^'#191);function StrToIDEc(mStr:string):string;varI: Integer;beginResult :='';for I :=1to Length(mStr)doResult := Result + cIDEc[mStr[I]];end;{ StrToIDEc }function IDEcToStr(mIDEc:string):string;varC: Char;I, L: Integer;T:string;beginResult :='';I :=1;L := Length(mIDEc);mIDEc := LowerCase(mIDEc);while I <= L do beginif mIDEc[I]='^'then beginfor C :=#0to#255doif cIDEc[C]= Copy(mIDEc, I,2)then beginResult := Result + C;Inc(I,2);Break;end;end else if mIDEc[I]='#'then beginT :='';Inc(I);while mIDEc[I]in['0'..'9']do beginT := T + mIDEc[I];Inc(I);end;if T <>''then Result := Result + Chr(StrToIntDef(T,0));end else Inc(I);end;end;{ IDEcToStr }///////End Source///////Begin Demoprocedure TForm1.Button1Click(Sender: TObject);beginClipboard.AsText := StrToIDEc(Edit1.Text);Caption := IDEcToStr(Clipboard.AsText);ShowMessage(^^!^3^4^%);end;///////Edn Demo　(*//标题:制作红绿眼镜三维立体画说明:算法虽然简单,但回味无穷;特别致谢Kiss2提出这个问题设计:Zswang日期:2002-04-05支持:wjhu111@//*)///////Begin Sourcefunction RedGreen3D(mBitmapLeft: TBitmap; mBitmapRight: TBitmap; mBitmap3D: TBitmap): Boolean;varvRect: TRect;vGreen, vRed: TColor;beginResult := False;if not Assigned(mBitmapLeft)then Exit;if not Assigned(mBitmapRight)then Exit;if not Assigned(mBitmap3D)then Exit;vRed := clRed;vGreen := vRed xor$FFFFFF;trymBitmap3D.Width := mBitmapLeft.Width;mBitmap3D.Height := mBitmapLeft.Height;vRect := Rect(0,0, mBitmap3D.Width, mBitmap3D.Height);mBitmap3D.Canvas.Brush.Color := vGreen;mBitmap3D.Canvas.FillRect(vRect);mBitmapLeft.Canvas.CopyMode := cmSrcPaint;mBitmapLeft.Canvas.CopyRect(vRect, mBitmap3D.Canvas, vRect);mBitmap3D.Canvas.Brush.Color := vRed;mBitmap3D.Canvas.FillRect(vRect);mBitmapRight.Canvas.CopyMode := cmSrcPaint;mBitmapRight.Canvas.CopyRect(vRect, mBitmap3D.Canvas, vRect);mBitmap3D.Canvas.CopyRect(vRect, mBitmapLeft.Canvas, vRect); mBitmap3D.Canvas.CopyMode := cmSrcAnd;mBitmap3D.Canvas.CopyRect(vRect, mBitmapRight.Canvas, vRect);exceptExit;end;Result := True;end;{ RedGreen3D }。