delphi基本类的操作

最新推荐文章于 2024-08-06 17:28:02 发布
踏雪无痕
最新推荐文章于 2024-08-06 17:28:02 发布
阅读量1.7k
点赞数
分类专栏： Delphi程序实例
Delphi程序实例专栏收录该内容
44 篇文章 4 订阅
订阅专栏
unit CommonFunction;
interface
uses
Windows,DB,ADODB,Controls,Forms,SysUtils,StdCtrls, Classes, strUtils,
CommonConst, FormDataModule, ComCtrls, math, bsSkinBoxCtrls, CommonClass;
//数据库操作函数
function ExecQuery(SqlStr: string;vQuery: TADOQuery): boolean;
function OpenQuery(SqlStr: string;vQuery: TADOQuery): boolean;
//信息提示函数
function MsgBox(const Text, Caption: String; Flags: Longint): Integer;        //基础函数,是对函数Application.MessageBox()的直接包装。
procedure MsgHint(Const AMsg: String; Const ATitle: String = CHint);          //消息提示框,调用MsgBox()函数。
procedure MsgWarning(Const AMsg: String; Const ATitle: String = CWarning);    //警告消息提示框
procedure MsgError(Const AMsg: String; Const ATitle: String = CError);        //执行错误后的信息显示
function MsgYesNo(Const AMsg: String; Const ATitle: String = CQuestion): boolean;//询问显示框
function MsgYesNoCancel(Const AMsg: String; Const ATitle: String = CQuestion): TModalResult; //返回值：mrOK, mrNo, mrCancel.
//字符串处理函数
function GetLeftStr(const S, AFlag: string): string;
function GetRightStr(const S, AFlag: string): string;
function SubStrCount(AMain, ASub: string): Integer;
function ReplaceStr(Source,SouStr,ObjStr: string):string;
function GetGridModelPath(ASubPath: string = 'Grid'): string;
function CreateFullDir(ADir: string): Boolean;
//对部分控件的操作
function IsEditTextNull(AEdit: TEdit;AMsg: string):boolean; overload;   
function IsEditTextNull(AEdit: TbsSkinEdit;AMsg: string):boolean; overload; 
function IsEditTextNull(AEdit: TbsSkinPasswordEdit;AMsg: string):boolean; overload;
function IsEditNoLength(AEdit:TEdit; iFactLength: integer; AMsg:string; Flag: integer = 0): boolean; overload;
function IsEditNoLength(AEdit:TbsSkinEdit; iFactLength: integer; AMsg:string; Flag: integer = 0): boolean; overload;   
function IsCboNoSelected(AcboBox:TbsSkinComboBox; AMsg:string): boolean;
function addstr(Sourcestr,Beforestr:string;count:integer):string;
procedure LoadRichMemo(AList: TStrings; ABlobField: TBlobField);
procedure SaveRichMemo(AList: TStrings; AParameter: TParameter); overload;
procedure SaveRichMemo(sList: TStrings; dList: TStrings); overload;

function GetShowDemoString(SourceString: string; iMaxShow: integer): string;
procedure ShowCbo(cboObject: TComboBox; sql, ShowMsg: string);
procedure ShowCboString(cboObject: TComboBox; sql, ShowMsg: string); overload;
procedure ShowCboString(cboObject: TbsSkinComboBox; sql, ShowMsg: string; Flag: integer = 0; showFlag: integer = 0) overload;   
procedure ShowCboString(cboObject: TbsSkinComboBox; lines: Tstrings;sFind, ShowMsg: string; Flag: integer = 0); overload;
procedure ShowCboString(cboObject: TbsSkinComboBox; lines: Tstrings;ShowMsg: string; Flag: integer = 0); overload;
procedure SetLines(lines: TStrings; sql: string);
function GetNameByCode(lines: TStringList; strCode: string): string;
function GetTCodeItemByCode(lines: TStringList; strCode: string): TCOdeItem;
procedure FindCboItem(strCode: integer; Cbo: TComboBox); overload;
procedure FindCboItem(strCode: string; Cbo: TComboBox; Flag: integer = 0); overload;
procedure FindCboItem(strCode: string; Cbo: TbsSkinComboBox; Flag: integer = 0); overload;
function Get0FormatStr(iCount: integer): string;
procedure SeperateTerms(s:string;Separator:char;Terms:TStringList); //拆分类似split
//function SetDataTime(const Value: string): TDateTime;
procedure ShowTree(vTree: TTreeView);
function ListDirs(Path, strSuffix : string; strList: TstringList): Integer;
procedure CboKeyPress(cboName: TComboBox; var Key: Char);overload;      
procedure CboKeyPress(cboName: TbsSkinComboBox; var Key: Char);overload;
function XmlString(strXml: string): string;
function GetCode(strTable, strColumn, strWhere, strFormat: string): string;
function GetUserName(strCode: string): string;     
function GetPyIndexChar(strSource:string):string;    //得到拼音码
function GetWord(strSource: string): string; //去掉干扰词
function GetCurrentDate(iDate: integer = 0): string;
procedure SetUserQx(Lines: TStringList; sql: string);
function ShowInfo(i: integer; Flag: integer = 0):string;
//function GetUserQx(Lines: TStringList; str: string): integer;
implementation
{function GetUserQx(Lines: TStringList; str: string): integer;
var
iPos: integer;
begin
Result := -1;
if Lines.Find(str, iPos) then Result := iPos;
end; }
function IsCboNoSelected(AcboBox:TbsSkinComboBox; AMsg:string): boolean;
begin
result := False;
if AcboBox.ItemIndex = -1 then
begin
    msgHint(AMsg);
    AcboBox.SetFocus;
    Result := True;
end;
end;
function ShowInfo(i: integer; Flag: integer = 0): string;
begin
Result := '';
Case i of
1: Result := '一';
2: Result := '二';
3: Result := '三';
4: Result := '四';
5: Result := '五';
6: Result := '六';
7: if Flag = 1 then Result := '日' else Result := '七';
end;
end;
Procedure SetUserQx(Lines: TStringList; sql: string);
var
vItem: TXtFormItem;
iPos: integer;
begin
OpenQuery(Sql, dm.FQuery);
Lines.Clear;
while not dm.FQuery.Eof do
begin
    if Lines.Find(dm.FQuery.FieldByName('bdmc').AsString, iPos) then
       vItem := TXtFormItem(Lines.Objects[iPos])
    else
    begin
      vItem := TXtFormItem.Create(nil);
      Lines.AddObject(dm.FQuery.FieldByName('bdmc').AsString, vItem);
    end;
    vItem.FormName := dm.FQuery.FieldByName('bdmc').AsString;
    vItem.FormCodes := dm.FQuery.FieldByName('xtbm').AsString;
    vItem.IsLook := dm.FQuery.FieldByName('cxqx').AsString;
    vItem.IsSave := dm.FQuery.FieldByName('bjqx').AsString;
    vItem.IsDel := dm.FQuery.FieldByName('scqx').AsString;
    vItem.IsCheck := dm.FQuery.FieldByName('shqx').AsString;
    vItem.IsMod := dm.FQuery.FieldByName('sqxg').AsString;
    dm.FQuery.Next;
end;
end;
function GetNameByCode(lines: TStringList; strCode: string): string;
var
iPos: integer;
begin
Result := '';
if Not Lines.Find(strCode, iPos) then Exit;
Result := TCodeItem(Lines.Objects[iPos]).Name;
end;
function GetTCodeItemByCode(lines: TStringList; strCode: string): TCOdeItem; 
var
iPos: integer;
begin
Result := nil;
if Not Lines.Find(strCode, iPos) then Exit;
Result := TCodeItem(Lines.Objects[iPos]);
end;
procedure SetLines(lines: TStrings; sql: string);
var
vItem: TCodeItem;
begin
OpenQuery(Sql, dm.FQuery);
Lines.Clear;
while not dm.FQuery.Eof do
begin
    vItem := TCodeItem.Create(nil);           
    vItem.Codes := dm.FQuery.Fields[0].AsString;
    vItem.Name := dm.FQuery.Fields[1].AsString;
    if dm.FQuery.FieldCount >= 3 then
      vItem.Express := dm.FQuery.Fields[2].AsString;
    if dm.FQuery.FieldCount >= 4 then
      vItem.isUse := dm.FQuery.Fields[3].AsString;
      
    lines.AddObject(dm.FQuery.Fields[0].asString, vItem);
    dm.FQuery.Next;
end;
end;

procedure ShowCboString(cboObject: TbsSkinComboBox; lines: Tstrings;ShowMsg: string; Flag: integer = 0); overload;
var
iCount: integer;
vItem: TCodeItem;
begin
if Flag <> 2 then cboObject.Items.Clear;
if Flag = 1 then cboObject.Items.Add('全部');
for iCount := 0 to Lines.Count - 1 do
begin
    vItem := TCodeItem(Lines.Objects[iCount]);
    if (Flag = 3) then
    begin
      if vItem.isUse = 'Y' then cboObject.Items.AddObject(vItem.Name, Lines.Objects[iCount]);
    end
    else cboObject.Items.AddObject(vItem.Name, vItem);
end;
if cboObject.Items.Count = 0 then msgError(ShowMsg);
if cboObject.Items.Count > 0 then cboObject.ItemIndex := 0
end;

procedure ShowCboString(cboObject: TbsSkinComboBox; lines: Tstrings; sFind, ShowMsg: string; Flag: integer = 0);
var
iCount: integer;
vItem: TCodeItem;
begin
if Flag <> 2 then cboObject.Items.Clear;
if Flag = 1 then cboObject.Items.Add('全部');
for iCount := 0 to Lines.Count - 1 do
begin
    vItem := TCodeItem(Lines.Objects[iCount]);
    if Flag = 3 then
    begin
      if (vItem.Express = sFind) and (vItem.isUse = 'Y') then
      cboObject.Items.AddObject(vItem.Name, Lines.Objects[iCount]);
    end
    else
    begin
      if vItem.Express = sFind then
      cboObject.Items.AddObject(vItem.Name, Lines.Objects[iCount]);
    end;
end;
if cboObject.Items.Count = 0 then msgError(ShowMsg);
if cboObject.Items.Count > 0 then cboObject.ItemIndex := 0
end;
function GetCurrentDate(iDate: integer = 0): string;
var
strCommand: string;
begin
strCommand := 'select convert(char(10), getdate() - ' + IntTostr(iDate) + ', 121) ';
OpenQuery(strCommand, dm.FQuery);
Result := dm.FQuery.Fields[0].AsString;
end;

function GetWord(strSource: string): string;
begin
Result := strSource ;
Result := AnsiReplacestr(Result, '内蒙古', '');      
Result := AnsiReplacestr(Result, '内蒙', '');
Result := AnsiReplacestr(Result, '包头市', '');
Result := AnsiReplacestr(Result, '包头', '');
Result := AnsiReplacestr(Result, '昆区', '');
Result := AnsiReplacestr(Result, '昆都仑区', '');
Result := AnsiReplacestr(Result, '青山区', '');
Result := AnsiReplacestr(Result, '东河区', '');      
Result := AnsiReplacestr(Result, '东河', '');    
Result := AnsiReplacestr(Result, '青山', '');     
Result := AnsiReplacestr(Result, '九原区', '');    
Result := AnsiReplacestr(Result, '九原', '');     
Result := AnsiReplacestr(Result, '郊区', '');
end;
function GetPyIndexChar(strSource:string):string;
var
iCount: integer;
strTemp: string;
strChar: string;
begin
iCount := 1;
while iCount <= length(strSource) do
begin
    if strSource[iCount] > chr(127) then
    begin
      strChar := strSource[iCount] + strSource[iCount + 1];
     case word(strChar[1]) shl 8 +word(strChar[2]) of
        $B0A1..$B0D0 : strTemp :=strTemp + 'A';
        $B0D1..$B2C0 : strTemp :=strTemp + 'B';
        $B2C1..$B4F2 : strTemp :=strTemp + 'C';
        $B4F3..$B6E9 : strTemp :=strTemp + 'D';
        $B6EA..$B7A1 : strTemp :=strTemp + 'E';
        $B7A2..$B8C0 : strTemp :=strTemp + 'F';
        $B8C1..$B9FD : strTemp :=strTemp + 'G';
        $B9FE..$BBF6 : strTemp :=strTemp + 'H';
        $BBF7..$BFA5 : strTemp :=strTemp + 'J';
        $BFA6..$C0AB : strTemp :=strTemp + 'K';
        $C0AC..$C2E7 : strTemp :=strTemp + 'L';
        $C2E8..$C4C2 : strTemp :=strTemp + 'M';
        $C4C3..$C5B5 : strTemp :=strTemp + 'N';
        $C5B6..$C5BD : strTemp :=strTemp + 'O';
        $C5BE..$C6D9 : strTemp :=strTemp + 'P';
        $C6DA..$C8BA : strTemp :=strTemp + 'Q';
        $C8BB..$C8F5 : strTemp :=strTemp + 'R';
        $C8F6..$CBF9 : strTemp :=strTemp + 'S';
        $CBFA..$CDD9 : strTemp :=strTemp + 'T';
        $CDDA..$CEF3 : strTemp :=strTemp + 'W';
        $CEF4..$D1B8 : strTemp :=strTemp + 'X';
        $D1B9..$D4D0 : strTemp :=strTemp + 'Y';
        $D4D1..$D7F9 : strTemp :=strTemp + 'Z';
     else
        //result :=char(0);
        strTemp :=strTemp + 'V';
     end;
      iCount := iCount + 2;
    end
    else
    begin
       strTemp := strTemp + strSource[iCount];
      iCount := iCount + 1;
    end;
end;
Result := midstr(strTemp, 1, 4);
end;
function GetUserName(strCode: string ): string;
var
strCommand: string;
begin
if strCode = '' then Exit;
strCommand := 'select xm from jc_ryxx where Card = ' + Quotedstr(strCode);
OpenQuery(strCommand, dm.FQuery);
if dm.FQuery.Eof then 
    Result := ''
else
begin
    Result := dm.FQuery.Fields[0].AsString;
end;
end;
function Get0FormatStr(iCount: integer): string;
var
i: integer;
begin
Result := '';
for i := 0 to iCount - 1 do
begin
    Result := Result + '0';
end;
end;
function GetCode(strTable, strColumn, strWhere, strFormat: string): string;
var
strCommand: string;
iCode: integer;
begin
strCommand := 'select max(' + strColumn + ') from ' + strTable;
if strWhere > '' then strCommand := strCommand + ' where ' + strWhere;
OpenQuery(strCommand, dm.FQuery);
if dm.FQuery.Fields[0].IsNull then 
    iCode := 1
else iCode := dm.FQuery.Fields[0].AsInteger + 1;
Result := formatFloat(strFormat, iCode);
end;

function IsEditTextNull(AEdit: TbsSkinEdit;AMsg: string):boolean; 
begin
result := false;
if trim(AEdit.Text)='' then
begin
    MsgHint(AMsg);
    AEdit.SelectAll;
    AEdit.SetFocus;
    result := true;
end;
end;

function IsEditTextNull(AEdit: TbsSkinPasswordEdit;AMsg: string):boolean; 
begin
result := false;
if trim(AEdit.Text)='' then
begin
    MsgHint(AMsg);
    AEdit.SelectAll;
    AEdit.SetFocus;
    result := true;
end;
end; 
procedure FindCboItem(strCode: string; Cbo: TComboBox; Flag: integer = 0);
var
iCount: integer;
blFind: Boolean;
begin
blFind := False;
if Flag = 0 then
begin
    for iCount := 0 to cbo.Items.Count - 1 do
    begin
      if strCode = TCodeItem(cbo.Items.Objects[iCount]).Codes then
      begin
        cbo.ItemIndex := iCount;
        Exit;
      end;
    end;
end
else
begin
    for iCount := 0 to cbo.Items.Count - 1 do
    begin
      if strCode = cbo.Items[iCount] then
      begin
        cbo.ItemIndex := iCount;
        Exit;
      end;
    end;
end;
if Not blFind then cbo.ItemIndex := -1;
end;
procedure FindCboItem(strCode: string; Cbo: TbsSkinComboBox; Flag: integer = 0);
var
iCount: integer;
blFind: Boolean;
begin
blFind := False;
if Flag = 0 then
begin
    for iCount := 0 to cbo.Items.Count - 1 do
    begin
      if TCodeItem(Cbo.Items.Objects[iCount]) = nil then continue;
      if strCode = TCodeItem(cbo.Items.Objects[iCount]).Codes then
      begin
        cbo.ItemIndex := iCount;
        Exit;
      end;
    end;
end
else
begin
    for iCount := 0 to cbo.Items.Count - 1 do
    begin
      if strCode = cbo.Items[iCount] then
      begin
        cbo.ItemIndex := iCount;
        Exit;
      end;
    end;
end;
if Not blFind then cbo.ItemIndex := -1;
end;
procedure ShowCboString(cboObject: TbsSkinComboBox; sql, ShowMsg: string; FLag: integer = 0; showFlag: integer = 0);
var
vItem : TCodeItem;
begin
OpenQuery(sql, dm.FQuery);
if Flag = 0 then cboObject.Items.Clear;
if dm.FQuery.Eof then
begin
    if showMsg > '' then msgError(ShowMsg);
    Exit;
end;
while Not dm.FQuery.Eof do
begin
    vItem := TCodeItem.Create(nil);
    //vItem.Code := dm.FQuery.Fields[0].AsInteger;
    vItem.Codes := dm.FQuery.Fields[0].AsString;
    cboObject.Items.AddObject(dm.FQuery.Fields[1].AsString, vItem);
    dm.FQuery.Next;
end;
if showFlag = 0 then cboObject.ItemIndex := 0;
end;
procedure ShowCboString(cboObject: TComboBox; sql, ShowMsg: string);
var
vItem : TCodeItem;
begin
OpenQuery(sql, dm.FQuery);
cboObject.Items.Clear;
if dm.FQuery.Eof then
begin
    if showMsg > '' then msgError(ShowMsg);
    Exit;
end;
while Not dm.FQuery.Eof do
begin
    vItem := TCodeItem.Create(nil);
    vItem.Codes := dm.FQuery.Fields[0].AsString;
    cboObject.Items.AddObject(dm.FQuery.Fields[1].AsString, vItem);
    dm.FQuery.Next;
end;
cboObject.ItemIndex := 0;
end;
function XmlString(strXml: string): string;
begin       
Result := ansiReplacestr(strXml, '<', '<');
Result := ansiReplacestr(Result, '>', '>');
Result := ansiReplacestr(Result, '&', '&');
Result := ansiReplacestr(Result, '"', '"');
end;
procedure CboKeyPress(cboName: TbsSkinComboBox; var Key: Char);
var
iIndex: integer;
begin
   if not((key in ['0'..'9']) ) then Exit;
   iIndex := ord(key) - 48 - 1;
   if iIndex = -1 then iIndex := 10;
   if iIndex > cboName.Items.Count - 1 then iIndex := cboName.Items.Count - 1;
   cboName.Text:=cboName.Items.Strings[iIndex];
   cboName.ItemIndex := iIndex;
   key := #0;
end;
procedure CboKeyPress(cboName: TComboBox; var Key: Char);
var
iIndex: integer;
begin
   if not((key in ['0'..'9']) ) then key := #0;
   iIndex := ord(key) - 48 - 1;
   if iIndex = -1 then iIndex := 10;
   if iIndex > cboName.Items.Count - 1 then iIndex := cboName.Items.Count - 1;
   cboName.Text:=cboName.Items.Strings[iIndex];
   cboName.ItemIndex := iIndex;
   key := #0;
end;
function ListDirs(Path, strSuffix : string; strList: TstringList): Integer;
var
FindData: TWin32FindData;
FindHandle: THandle;
FileName: string;
sPath : string;
begin
if Path[Length(Path)] <> '\' then
    Path := Path + '\';
sPath := Path;
sPath := sPath + '*.' + strSuffix;
FindHandle := Windows.FindFirstFile(PChar(sPath), FindData);
while FindHandle <> INVALID_HANDLE_VALUE do
begin
    FileName := StrPas(FindData.cFileName);
    if (FileName <> '.') and (FileName <> '..') then
      strList.Add(Path + FileName);
    if not Windows.FindNextFile(FindHandle, FindData) then
      FindHandle := INVALID_HANDLE_VALUE;
end;
Windows.FindClose(FindHandle);
end;
procedure ShowTree(vTree: TTreeView);
var
strCommand: string;
vItem : TCodeItem;
begin
//strCommand := 'select distinct bsc from jz order by bsc';
strCommand := 'select name, code , flag from bsc order by flag, code ';

OpenQuery(strCommand, dm.FQuery);
while not dm.FQuery.Eof do
begin
    vItem := TCodeItem.Create(nil);
    vItem.Code := dm.FQuery.FieldValues['Code'];
    vItem.Express := dm.FQuery.FieldByName('Flag').AsString;
    vTree.Items.AddChildObject(nil, dm.FQuery.FieldValues['Name'], vItem);
    dm.FQuery.Next;
end;
end;
//function GetDataTime(const Value: string): TDateTime;         //日期格式是Wed Sep 06 11:00:00 2006
//var
// strTemp: string;
// vList: TstringList;
//begin
// vList := TStringList.Create;
// SeperateTerms(Value, ' ', vList);
// strTemp := vList[4] + '-' + IntToStr(FMonthList.IndexOf(vList[1]) + 1) + '-' + vList[2] + ' ' + vList[3];
// vList.Free;
//end;

procedure SeperateTerms(s:string;Separator:char;Terms:TStringList);
var
hs:string;
p:integer;
begin
Terms.Clear;
if Length(s)=0 then
   Exit;
p:=Pos(Separator,s);
while P<>0 do
begin
    hs:=Copy(s,1,p-1);//Copyterm
    Terms.Add(hs);//Addtolist
    Delete(s,1,p);//Removetermandseparator
    p:=Pos(Separator,s);//Searchnextseparator
end;
if Length(s)>0 then
      Terms.Add(s);//Addremainingterm
end;
//uses SubjectContentEdit;
procedure FindCboItem(strCode: integer; Cbo: TComboBox);
var
iCount: integer;
blFind: Boolean;
begin
blFind := False;
for iCount := 0 to cbo.Items.Count - 1 do
begin
    if strCode = TCodeItem(cbo.Items.Objects[iCount]).Code then
    begin
      cbo.ItemIndex := iCount;
      Exit;
    end;
end;
if Not blFind then cbo.ItemIndex := -1;
end;
function IsEditNoLength(AEdit:TEdit; iFactLength: integer; AMsg:string; Flag: integer = 0): boolean;
begin
if Flag = 0 then
begin
    if length(AEdit.Text) < iFactLength then
    begin
      MsgHint(AMsg);
      AEdit.SelectAll;
      AEdit.SetFocus;
      result := true;
      Exit;
    end;
end
else
begin 
    if length(AEdit.Text) <> iFactLength then
    begin
      MsgHint(AMsg);
      AEdit.SelectAll;
      AEdit.SetFocus;
      result := true;
      Exit;
    end;
end;
Result := False;
end;
function IsEditNoLength(AEdit:TbsSkinEdit; iFactLength: integer; AMsg:string; Flag: integer = 0): boolean;
begin
if Flag = 0 then
begin
    if length(AEdit.Text) < iFactLength then
    begin
      MsgHint(AMsg);
      AEdit.SelectAll;
      AEdit.SetFocus;
      result := true;
      Exit;
    end;
end
else
begin 
    if length(AEdit.Text) <> iFactLength then
    begin
      MsgHint(AMsg);
      AEdit.SelectAll;
      AEdit.SetFocus;
      result := true;
      Exit;
    end;
end;
Result := False;
end;
procedure ShowCbo(cboObject: TComboBox; sql, ShowMsg: string);
var
vItem : TCodeItem;
begin
OpenQuery(sql, dm.FQuery);
cboObject.Items.Clear;
if dm.FQuery.Eof then
begin
    if showMsg > '' then msgError(ShowMsg);
    Exit;
end;
while Not dm.FQuery.Eof do
begin
    vItem := TCodeItem.Create(nil);
    vItem.Code := dm.FQuery.FieldValues['Code'];
    cboObject.Items.AddObject(dm.FQuery.FieldValues['Content'], vItem);
    dm.FQuery.Next;
end;
cboObject.ItemIndex := 0;
end;
function GetShowDemoString(SourceString: string; iMaxShow: integer): string;
var
iLen: integer;
iCount: integer;
strTemp: string;
begin
Result := '';
iLen := 0;
strTemp := SourceString;
if strTemp = '' then Exit;
for iCount := 1 to length(strTemp) do
begin
    if integer(strTemp[iCount]) > $80 then
      iLen := iLen + 2
    else iLen := iLen + 1;
    if iLen > iMaxShow then break;
    Result := Result + strTemp[iCount];
end;
end;
procedure SaveRichMemo(sList: TStrings; dList: TStrings);       
var
//vStream: TMemoryStream;
iCount: integer;
begin                 
{vStream := TMemoryStream.Create;
sList.SaveToStream(vStream);
dList.LoadFromStream(vStream); 
vStream.Free;   }
{dList.Clear;
for iCount := 0 to sList.Count - 1 do
begin
    dList.Add(sList[iCount]);
end;}
dList.Clear;
dList.AddStrings(sList);
end;

procedure LoadRichMemo(AList: TStrings; ABlobField: TBlobField);
var
vStream: TMemoryStream;
begin
vStream := TMemoryStream.Create;
ABlobField.SaveToStream(vStream);
vStream.Seek(0, 0);
AList.LoadFromStream (vStream);
vStream.Free;
end;
procedure SaveRichMemo(AList: TStrings; AParameter: TParameter);
var
vStream: TMemoryStream;
begin
vStream := TMemoryStream.Create;
AList.SaveToStream (vStream);
vStream.Seek(0, 0);
AParameter.LoadFromStream(vStream, ftBlob);
vStream.Free;
end;
function addstr(Sourcestr,Beforestr:string;count:integer):string;
var my_str:string;
begin
if length(Sourcestr)>=count then
   result :=Sourcestr;
my_str :=Sourcestr;
Beforestr:=copy(Beforestr,1,1);
while length(my_str)<count do
my_str :=Beforestr+my_str;
result :=my_str;
end;
function ExecQuery(SqlStr: string; vQuery: TADOQuery): boolean;
begin
Result := False;
with vQuery do
begin
    Close;
    Sql.Clear;
    Sql.Add(SqlStr);
    try
      ExecSQL;
      Result := True;
    except
      Raise;
    end;
end
end;
function OpenQuery(SqlStr: string;vQuery: TADOQuery): boolean;
begin
Result := False;
with vQuery do
begin
    Close;
    Sql.Clear;
    Sql.Add(SqlStr);
    try
      Open;
      Result := True;
    except
      raise;
    end;
end
end;
function MsgBox(const Text, Caption: String; Flags: Longint): Integer;
begin
Result := Application.MessageBox(PChar(Text), PChar(Caption), Flags);
end;
procedure MsgHint(Const AMsg: String; Const ATitle: String = CHint);
begin
MsgBox(AMsg, ATitle, MB_OK + MB_ICONINFORMATION);
end;
procedure MsgWarning(Const AMsg: String; Const ATitle: String = CWarning);
begin
MsgBox(AMsg, ATitle, MB_OK + MB_ICONWARNING);
end;
procedure MsgError(Const AMsg: String; Const ATitle: String = CError);
begin
MsgBox(AMsg, ATitle, MB_OK + MB_ICONERROR);
end;
function MsgYesNo(Const AMsg: String; Const ATitle: String = CQuestion): boolean;
begin
Result := MsgBox(AMsg, ATitle, MB_YESNO + MB_ICONQUESTION) = IDYES;
end;
function MsgYesNoCancel(Const AMsg: String; Const ATitle: String = CQuestion): TModalResult;
begin
Result := 0;
case MsgBox(AMsg, ATitle, MB_YESNOCANCEL + MB_ICONQUESTION) of
    IDYES:   Result := mrOK;
    IDNO:    Result := mrNo;
    IDCANCEL:Result := mrCancel;
end;
end;
function GetLeftStr(const S, AFlag: string): string;
var
vPos: Integer;
begin
vPos := Pos(AFlag, S);
if vPos = 0 then Result := Trim(S)
else Result := Trim(Copy(S, 1, vPos - 1));
end;
function GetRightStr(const S, AFlag: string): string;
var
vPos: Integer;
begin
vPos := Pos(AFlag, S);
if vPos = 0 then Result := Trim(S)
else Result := Trim(Copy(S, vPos + 1, length(S) - vPos));
end;
function SubStrCount(AMain, ASub: string): Integer;
var
I: Integer;
begin
Result := 0;
for I := 1 to Length(AMain) - Length(ASub) + 1 do
if CompareText(ASub, Copy(AMain, I, Length(ASub))) = 0 then
    Inc(Result); 
end;
function ReplaceStr(Source,SouStr,ObjStr: string):string;
var
vPos: integer;
begin
result := '';
vPos:=Pos(SouStr,Source);
while vPos>0 do
begin
    result := result + Copy(Source,1,vPos-1) + ObjStr;
    Source := Copy(Source,vPos+Length(SouStr),Length(Source)-vPos-Length(SouStr)+1);
    vPos:=Pos(SouStr,Source);
end;
result := result + Source;
end;
function GetGridModelPath(ASubPath: string = 'Grid'): string;
var
S: string;
begin
S := ExtractfilePath(Application.ExeName) + ASubPath + '\';
if not DirectoryExists(S) then
    CreateFullDir(S);
Result := S;
end;
function CreateFullDir(ADir: string): Boolean;
var
I: Integer;
vLast: Integer;
vDir: string;
begin
if DirectoryExists(ADir) then
begin
    Result := True;
    Exit;
end;
vLast := 0;
for I := 1 to Length(ADir) do
    if ADir[I] = '\' then vLast := I;
if (vLast > Length(ADir)) or (vLast <= 1) then
begin
    Result := False;
    Exit;
end;
vDir := Copy(ADir, 1, vLast - 1);
Result := CreateFullDir(vDir);
if DirectoryExists(vDir) then
    CreateDir(ADir);
end;
function IsEditTextNull(AEdit: TEdit;AMsg: string): boolean;
begin
result := false;
if trim(AEdit.Text)='' then
begin
    MsgHint(AMsg);
    AEdit.SelectAll;
    AEdit.SetFocus;
    result := true;
end;
end;
end.