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  //图片的长和宽,格式为:

        

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;

四、网络通信函数

你可能感兴趣的:(Delphi)