Delphi函数总结

Delphi函数总结

一、文件操作函数

1、 TextToFile

原型：function TextToFile(text, fname)

功能：保存内容到文件中

参数列表：

text 文本内容

fname 文本内容存放的文件名

返回结果：

暂无返回

源码：

var G_CS_TEXT_TO_FILE : TRTLCriticalSection;

function TextToFile(strText, strFileName: string): string;

var

v, Path: string;

lineList: TStrings;

begin

EnterCriticalSection(G_CS_TEXT_TO_FILE);

//ShowMessage(strFileName);

//2015-04-16 17:43 tig 处理了js传过来的诸如\\\180.214.162.86\\McServer\奇怪的问题

//2015-04-17 05:09 HTS 马勒戈壁 这个问题处理了好久

//if copy(strFileName, 1, 3)='\\\' then strFileName:= copy(strFileName, 2, length(strFileName)-1);

if copy(strFileName, 1, 4)='\\\\' then strFileName:= StringReplace(strFileName,'\\','\',[rfReplaceAll,rfIgnoreCase]);

//ShowMessage(strFileName);

//2011-04-03 13:08 tig 判断所在目录是否存在, 如否则创建之

strFileName:= StringReplace(strFileName,'/','\',[rfReplaceAll,rfIgnoreCase]);

Path:= GetFilePath(strFileName);

if not DirectoryExists(Path) then ForceDirectories(Path);

try

//更改为普通文件

if FileExists(strFileName) then

FileSetAttr(strFileName, FILE_ATTRIBUTE_NORMAL);

lineList:= TStringList.Create;

lineList.Text:= strText;

lineList.SaveToFile(strFileName);

FreeAndNil(lineList);

finally

LeaveCriticalSection(G_CS_TEXT_TO_FILE);

end;

end;

//=============================================================================================================

2、 TextFromFile

原型：function TextFromFile(fname)

功能：从文件中读取内容

参数列表：

fname 文本内容存放的文件名

返回结果：

返回文件内文本内容

源码：

//从文件中读取内容

function TextFromFile(strFileName: string): string;

var

lineList: TStrings;

begin

result:= '';

strFileName := StringReplace(strFileName,'/','\',[rfReplaceAll,rfIgnoreCase]);

if not FileExists(strFileName) then

exit;

lineList:= TStringList.Create;

lineList.LoadFromFile(strFileName);

result:= lineList.Text;

lineList.Free;

end;

//==========================================================================

3、 GetFileExt

原型：function GetFileExt(fname)

功能：获取文件后缀

参数列表：

fname 文件名称

返回结果：

返回文件后缀

源码（javascript）：

function GetFileExt(fname)

{

var items = new Array();

items = fname.split(".");

return items[items.length-1];

}

//==========================================================================

4、Mc_GetImgSize

原型：functionMc_GetImgSize(fimage)

功能：获取图片尺寸

参数列表：

fimage 图片文件名

返回结果：

返回结果对象RET

RET.code

0 //取得图片尺寸

其他 //取图片尺寸错误

RET.desc

RET.code=0 //图片的长和宽,格式为：

<Width>宽</Width><Height>高</Height>

RET.code=其他值 //存储错误信息

源码：

//获取图片尺寸

function GetPictureSize(FPicture: string; var Width: integer; var Height: integer): TRESULT;

var

aBitmap :Graphics.TBitmap;

aGif :TGIFImage;

aJpeg :Tjpegimage;

aPng :TPNGObject;

strPicType :string;

Width1, Height1: word;

Begin

Width:= 0;

Height:= 0;

strPicType := GetPicType(FPicture);

if strPicType='error' then

begin

Exit;

end;

aBitmap := Graphics.Tbitmap.Create;

aGif := TGIFImage.Create;

aJpeg := TJPEGImage.Create;

aPng := TPNGObject.Create;

try

//...1、针对不同的类型进行转换，全部转换成 bmp

if strPicType='gif' then

begin

GetGIFSize(FPicture,Width1, Height1);

Width:= Width1;

Height:= Height1;

Exit;

end else

if (strPicType='jpg') or (strPicType='jpeg') then

begin

aJpeg.LoadFromFile(FPicture);

aBitmap.Assign(aJpeg);

end else

if strPicType='bmp' then

begin

aBitmap.LoadFromFile(FPicture);

end else

if strPicType='png' then

begin

aPng.LoadFromFile(FPicture);

aBitmap.Assign(aPng);

end else

begin

;

end;

Width:= aBitmap.Width;

Height:= aBitmap.Height;

finally

//...6、释放相关变量

FreeAndNil(aBitmap);

FreeAndNil(aGif);

FreeAndNil(aJpeg);

FreeAndNil(aPng);

end;

End;

//==========================================================================

5、Mc_MarkPicture

原型：functionMc_MarkPicture(markedPic, waterPic,ileft,itop)

功能：图片打水印

参数列表：

markedPic 待打水印图片路径

waterPic 水印图片路径

ileft 打水印区域的左边距

itop 打水印区域的上边距

返回结果：

打完水印后的图片路径

源码：

//改为不覆盖原图

//水印图片缩放比例改为自动判断

//支持网络水印图片(url)

function MarkPicture(FBmpWater : string; //bmp格式水印图文件名称

FPicture : string; //待处理的图片(目前需要支持的格式: bmp, jpg/jpeg, gif)

Left : Integer=-1;

Top : Integer=-1;

AlphaValue : Integer=100;

TransColor : TColor=0;

ZoomScale : Integer=-1 //缩放比例： 10 表示 10%，水印是图片的10%

): TRESULT;

var

x ,y :Integer;

R ,Rs ,Rw ,G ,Gs ,Gw ,B ,Bs ,Bw:Integer;

Wcl ,Scl :TColor;

aBitmap :Graphics.TBitmap;

aGif :TGIFImage;

aJpeg :Tjpegimage;

aPng :TPNGObject;

picBitmap , Waterbmp :Graphics.TBitmap;

strPicType,strPicWaterType, v, v1 :string;

newWidth, newHeight, WidthScale:Integer;

Begin

result.Code:= 999;

//支持网络水印图片(url)

if trim(LowerCase(copy(FBmpWater, 1, 7)))='http://' then

begin

//是否有缓存

v:= GetAppPath()+'data\CONFIG.INI';

v:= IniItemRead(v, 'COMMON', 'McServer', '');

if v='' then

v:= GetAppPath()+'\data\Temp\waterimg\'

else

v:= v+'\waterimg\';

v1:= GetFileNameFromUrl(FBmpWater);

v1:= FieldValue('.', v1, 1);

v:= v+TrackDomain(FBmpWater)+'.'+v1;

//不存在则下载

if not FileExists(v) then

begin

result:= SmartDown(FBmpWater, nil);

if result.Code<>0 then exit;

CopyFile(PChar(result.Desc), PChar(v), TRUE);

end;

FBmpWater:=v;

end;

if not FileExists(FBmpWater) then

begin

result.Desc:= '水印图片不存在: '+FBmpWater;

Exit;

end;

if not FileExists(FPicture) then

begin

result.Desc:= '来源图片不存在: '+FPicture;

Exit;

end;

strPicType := GetPicType(FPicture);

if strPicType='error' then

begin

result.Desc:= 'GetPicType() 失败!';

Exit;

end else

if strPicType='gif' then

begin

result.Desc:= '暂不支持gif格式!';

exit;

end;

aBitmap := Graphics.Tbitmap.Create;

picBitmap := Graphics.Tbitmap.Create;

Waterbmp := Graphics.Tbitmap.Create;

aGif := TGIFImage.Create;

aJpeg := TJPEGImage.Create;

aPng := TPNGObject.Create;

//...1、针对不同的类型进行转换，全部转换成 bmp

if strPicType='gif' then

begin

aGif.LoadFromFile(FPicture);

aBitmap.Assign(aGif);

end else

if (strPicType='jpg') or (strPicType='jpeg') then

begin

aJpeg.LoadFromFile(FPicture);

aBitmap.Assign(aJpeg);

end else

if strPicType='bmp' then

begin

aBitmap.LoadFromFile(FPicture);

end else

if strPicType='png' then

begin

aPng.LoadFromFile(FPicture);

aBitmap.Assign(aPng);

end else

begin

//G.Log.WriteToFile('MarkPicture() 不支持的格式: '+FPicture);

//G.Log.WriteToHandle('MarkPicture() 不支持的格式: '+FPicture, G_MainHanlde);

end;

picBitmap.Assign(aBitmap); //图片

Waterbmp.LoadFromFile(FBmpWater);//水印

//...2、按比例进行缩放

//ZoomWaterBmp(Waterbmp,picBitmap,ZoomScale);

//先计算宽度, 在同等缩放高度, 避免变形

//HeightScale:= round(((aBitmap.Width/10)/Waterbmp.Width)*100);

//(aBitmap.Width/10)

//ZoomWaterBmp2(Waterbmp,picBitmap,WidthScale, WidthScale);

if ZoomScale=-1 then

begin

ZoomScale:=round(Waterbmp.Width/aBitmap.Width*100);

end;

newWidth:= round(aBitmap.Width*(ZoomScale/100));

newHeight:= round(Waterbmp.Height*(newWidth/Waterbmp.Width));

ZoomBmp(Waterbmp, newWidth, newHeight,Waterbmp);

//...3、生成默认水印位置

if (Left=-1) and (top=-1) then

begin

Left := picBitmap.Width - Waterbmp.Width;

Top := picBitmap.Height - Waterbmp.Height;

end;

//...4、打水印

For x:=0 to Waterbmp.Width-1 do

Begin

For y:=0 to Waterbmp.Height-1 do

Begin

Wcl:=Waterbmp.Canvas.Pixels[x,y];

//ShowMessage(FloatToStr(wcl)); //通过这句话找到那个 TransColor ，10进制的

IF (TransColor<>0) and (Wcl=TransColor) then Continue;

Rw:=GetRValue(ColorToRGB(Wcl));

Gw:=GetGValue(ColorToRGB(Wcl));

Bw:=GetBValue(ColorToRGB(Wcl));

Scl:=picBitmap.Canvas.Pixels[x+Left,y+Top];

Rs:=GetRValue(ColorToRGB(Scl));

Gs:=GetGValue(ColorToRGB(Scl));

Bs:=GetBValue(ColorToRGB(Scl));

R:=((AlphaValue*Rw)+((255-AlphaValue)*Rs))div 256;

G:=((AlphaValue*Gw)+((255-AlphaValue)*Gs))div 256;

B:=((AlphaValue*Bw)+((255-AlphaValue)*Bs))div 256;

picBitmap.Canvas.Pixels[x+Left,y+Top]:=RGB(R,G,B);

End;

End;

//...5、转换成对应的格式并存储到指定位置

//2010-03-27 18:51 改为不覆盖原图

FPicture:= GetAppPath()+'DATA\TEMP\'+ExtractFileName(FPicture);

if Pos('.gif',LowerCase(FPicture))>0 then

begin

aGif.Assign(picBitmap);

aGif.SaveToFile(FPicture);

end else

if (Pos('.jpeg',LowerCase(FPicture))>0) or (Pos('.jpg',LowerCase(FPicture))>0) then

begin

aJpeg.Assign(picBitmap);

aJpeg.SaveToFile(FPicture);

end else

if Pos('.bmp',LowerCase(FPicture))>0 then

begin

aBitmap.Assign(picBitmap);

aBitmap.SaveToFile(FPicture);

end else

if Pos('.png',LowerCase(FPicture))>0 then

begin

aPng.Assign(picBitmap);

aPng.SaveToFile(FPicture);

end;

//...6、释放相关变量

FreeAndNil(picBitmap);

FreeAndNil(aBitmap);

FreeAndNil(Waterbmp);

FreeAndNil(aGif);

FreeAndNil(aJpeg);

FreeAndNil(aPng);

result.Code:= 0;

result.Desc:= FPicture;

End;

//==========================================================================

6、Mc_ListFiles

原型：functionMc_ListFiles(path, key, fullName, childDir, max)

功能：根据给定的参数列出文件

参数列表：

path 指定路径

key 'txt', 'htm', 'xxx', or '*'(任意文件), 如为空, 表示目录/文件夹

fullName 列出的文件名称是否需要加上全路径

childDir 是否搜索子目录

max 最大数量

返回结果：

code 0=操作成功, 非0=操作失败

desc 返回相关信息或描述

调用例子：

//DEMO: var ret=ListFiles('Z:\\远程桌面\\', '*', true,true, 10); WriteLog(ret);

//DEMO:var ret=ListFiles('Z:\\', 'txt|xml'); WriteLog(ret);

源码：

procedure ListFiles(strPath : string;

//FileType : string;

sKey : string;

Files : TStrings;

bFullName : boolean=true;

bChildDir : boolean=false;

iMaxFiles : integer=99999);

var

F : TSearchRec;

Found : Boolean;

NowFileType: string;

begin

if strPath='' then exit;

if not DirectoryExists(strPath) then exit;

ChDir(strPath);

if G.LogLevel>0 then G.Log.WriteAppLog('ListFiles(): '+GetCurrentDir, G.MainHanlde);

Found := (FindFirst('*.*', faAnyFile, F) = 0);

while Found do

begin

if (F.Name = '.') or (F.Name = '..') then

begin

Found := (FindNext(F) = 0);

Continue;

end;

if (F.Attr and faDirectory)>0 then

begin

if sKey = '' then

begin

if bFullName = true then

Files.Add(GetCurrentDir+'\'+F.Name)

else

Files.Add(F.Name);

end;

if bChildDir=true then

begin

Application.ProcessMessages;

ListFiles(F.Name, sKey, Files, bFullName, bChildDir);

end else

begin

Found:= (FindNext(F) = 0);

continue;

end;

end;

//插入你的代码，F.Name就是文件名，GetCurrentDir可以得到当前目录

NowFileType:= GetFileSuffix(F.Name);

if sKey = '*' then

begin

if bFullName = true then

Files.Add(GetCurrentDir+'\'+F.Name)

else

Files.Add(F.Name);

end else

if sKey <> '*' then

begin

//if ncpos(NowFileType, sKey)>0 then

if GetMatch(F.Name, sKey)<>'' then

begin

if bFullName = true then

Files.Add(GetCurrentDir+'\'+F.Name)

else

Files.Add(F.Name);

end

end;

Application.ProcessMessages;

Found := (FindNext(F) = 0);

//2009-06-01 增加

if Files.Count>= iMaxFiles then break;

end;

SysUtils.FindClose(F);

ChDir('..\');

end;

//==========================================================================

//.获取文件大小

function GetFileSize(const FileName: string):LongInt;

var

DataFile: TFileStream;

begin

if FileExists(FileName) then

//FileSetReadOnly(FileName, False)

else

begin

Result := 0;

Exit;

end;

Result := 0;

try

DataFile := TFileStream.Create(FileName, fmShareDenyNone);

Result := DataFile.Size;

finally

DataFile.Free;

end;

end;

二、数据库操作函数

三、字符串处理函数

function StreamToString(mStream: TStream): string;

var

I: Integer;

begin

Result := '';

if not Assigned(mStream) then

Exit;

SetLength(Result, mStream.Size);

for I := 0 to Pred(mStream.Size) do

try

mStream.Position := I;

mStream.Read(Result[Succ(I)], 1);

except

Result := '';

end;

end;

procedure StringToStream(s:string; mStream:TStream);

var

ssm:TStringStream;

begin

ssm:=TStringStream.create(s);

mStream.copyfrom(ssm, ssm.size);

ssm.Free;

end;

四、网络通信函数