publicfunorpro.pas

用delphi开发的美容院管理系统

unit PublicFunOrPro;
interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, jpeg, Menus, ComCtrls, ToolWin, Buttons,winsock,Grids,
   OleCtnrs, Db, DBTables, ImgList,shellapi,ADODB;

  Type TSysInfo = record
     Caption: String;
     str_CurrentDir :string;            //当前运行的目录
     compuser : string;                 //计算机登录的用户名；
     hostname : string;                 //计算机的名称；
     hostip   : string;                 //主机的IP地址；
     name_id  : string;                 //系统用户名；
     name_yh  : string;                 //用户姓名；
  end;

//************************************************************//

  procedure SysInfo_ini();         //得到用户名； 初始化ＳysInfo
  function  sgcomp(sg0:tstringgrid;s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,s10:string):Boolean; // 比较是否有重复的"|/"表示不考
  procedure DeleteOneRow(TempString: TStringGrid);
  procedure AppendBlankRow(TempString: TStringGrid);
  function  DateToString(Date1:Tdate):string;                         //把日期转为字符串            decodedate
  function  GetSubStr(str:string):string;                             //读字符串'aaa(bbb)'中的'bbb'  ;
  function  stringNotChar(SString,SChar:string):boolean;              //判断SString中没有Schar;
  Function  StringGetChar(var SString:String;SChar:String):string;    //从SString中得到第一个以SChar分开的字符串；
  procedure stringgriddelete(stringgrida:tStringGrid;arow:integer);   //把 stringgridA 的第 AROW 行删除；
  procedure stringgridinsert(stringgrida:tstringgrid);                //在 stringgridA 的最前面加一行；
  Procedure StringgridClear(Stringgrida:Tstringgrid);                 //清除Stringgrida所有内容;
  Procedure StringgridAutoSize(Stringgrida:Tstringgrid);              //使stringgrid自动长度；
  function LoadImage(TempImage: TImage; FileName: string): Boolean;   //在Image控件中加入图片
  function  stringgridRepeat(Stringgrida:Tstringgrid;ACol:integer;SString:String):boolean;      //stringgrid的ACol列是否有重复；
  function  StringgridAddString(Stringgrida:Tstringgrid;ACol:integer;SString:String):string;    //把Stringgrid的所有ACOL列以SString加在一起；
  function  GetNo(SDatabaseName:string;STableName,selectFieldName,SelectFiledValue,
                  SFieldName,StartString:string;IDigit:integer):string;
  function GetNo2(STableName,selectFieldName,SelectFiledValue,
                  SFieldName,StartString:string;IDigit:integer):string;                
  function HaveField(SDatabaseName,StableName,SelectFieldName,SelectFiledValue:string):boolean;
  function havelikeField(SDatabaseName,StableName,SelectFieldName,SelectFiledValue:string):boolean;
  function getIndex(SS:string;Sarray : Array of String):Integer;
  Function GetComboboxIndex(SS:string;ComboboxX:Tcombobox):integer;
  function GetDateString(SDatabaseName: string): string;
  function GetDateTimeString(SDatabaseName: string): string;
  function MoveRow(TempString: TStringGrid; Symbol: Boolean): Boolean;
  function GetMaxDate(temp_year,temp_month:integer):string;
  procedure StringGridDrawCell(Sender: TObject; ACol,
                      ARow: Integer; Rect: TRect; State: TGridDrawState);
  var SysInfo :TsysInfo;

implementation



function  sgcomp(sg0:tstringgrid;s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,s10:string):Boolean; // 比较是否有重复的
var i1:integer;
    t1:boolean;
begin
  i1:=1;
  result:=false;
  if sg0.Cells[0,i1]<>'' then
  begin
    while sg0.Cells[0,i1]<>'' do
    begin
      t1:=true;
      if s0<>'|/' then if sg0.cells[0,i1]<>s0 then t1:=false;
      if (s1<>'|/')and(T1) then if  sg0.cells[1,i1]<>s1 then t1:=false;
      if (s2<>'|/')and(T1) then if  sg0.cells[2,i1]<>s2 then t1:=false;
      if (s3<>'|/')and(T1) then if  sg0.cells[3,i1]<>s3 then t1:=false;
      if (s4<>'|/')and(T1) then if  sg0.cells[4,i1]<>s4 then t1:=false;
      if (s5<>'|/')and(T1) then if  sg0.cells[5,i1]<>s5 then t1:=false;
      if (s6<>'|/')and(T1) then if  sg0.cells[6,i1]<>s6 then t1:=false;
      if (s7<>'|/')and(T1) then if  sg0.cells[7,i1]<>s7 then t1:=false;
      if (s8<>'|/')and(T1) then if  sg0.cells[8,i1]<>s8 then t1:=false;
      if (s9<>'|/')and(T1) then if  sg0.cells[9,i1]<>s9 then t1:=false;
      if (s10<>'|/')and(T1) then if  sg0.cells[10,i1]<>s10 then t1:=false;
      i1:=i1+1;
      if t1 then break;
    end;
    result:=t1;
  end;
end;

procedure StringGridDrawCell(Sender: TObject; ACol,
                      ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  tstringgrid(sender).Canvas.Font.Size:=10;
  tstringgrid(sender).Canvas.Font.Name:='宋体' ;
  tstringgrid(sender).Canvas.font.Color:=clwindowtext;
  tstringgrid(sender).Canvas.Brush.Color:=$00D6F2F3;
  if gdselected in state then
  begin
    tstringgrid(sender).Canvas.Brush.Color:=clBlack;
    tstringgrid(sender).Canvas.font.Color:=clWhite;
  end;
  if gdfixed in state then
  begin
    tstringgrid(sender).Canvas.Brush.Color:=$00A1B6B7;
    tstringgrid(sender).Canvas.TextRect(rect,rect.left,rect.top+1,' '+tstringgrid(sender).Cells[acol,arow]);
  end else tstringgrid(sender).Canvas.TextRect(rect,rect.left,rect.top,tstringgrid(sender).Cells[acol,arow]);
end;

function LoadImage(TempImage: TImage; FileName: string): Boolean;
var
  I,J,LastWidth,LastHeight: Integer;
  Extension               : string;
begin
    Result := True;
    if FileName='' then
    begin
      Result := False;
      Exit
    end;

    if not FileExists(FileName) then
    begin
      MessageBox(Application.Handle,'指定的文件不存在,重新确认!','信息',MB_OK+MB_ICONINFORMATION);
      Result := False;
      Exit
    end;

    TempImage.Stretch := False;
    // 获取文件的扩展名
    Extension := copy(FileName,pos('.',FileName)+1,3);
    // 驻册这个扩展名
    TempImage.Picture.RegisterFileFormat('*',Extension,TGraphic);
    try
     //装入图片
      TempImage.Picture.LoadFromFile(FileName);
      LastWidth := TempImage.Width;
      LastHeight := TempImage.Height ;
      I:=TempImage.Picture.Height ;
      J:=TempImage.Picture.Width ;
      TempImage.Stretch :=False;
      if (I>TempImage.Height) or (J>TempImage.Width) then
      begin
        TempImage.Stretch := True;
        if I>J then
          TempImage.Height := Trunc(TempImage.Width* I/J )
        else
          TempImage.Width := Trunc(TempImage.Height* J/I );

        if (TempImage.Height>LastHeight) or (TempImage.Width>LastWidth) then
        begin
          if TempImage.Height>LastHeight  then
          begin
            TempImage.Height :=LastHeight;
            TempImage.Width :=Trunc(LastHeight*J/I)
          end
          else
          begin
            TempImage.Width :=LastWidth;
            TempImage.Height :=Trunc(LastWidth*I/J)
          end
        end
      end;
    except
      Result := False;
      MessageBox(Application.Handle,'文件不存在或已破坏！','错误',MB_OK+MB_ICONINFORMATION);
    end;
end;


//得到计算机名与IP（IP为GETIP的返回值，参数NAME为计算机名）；
function getiP(var name :string):string;
type
  tapinaddr = array [0..10] of pinaddr;
  papinaddr = ^tapinaddr;
var
  Phe  : phostent;
  pptr : papinaddr;
  buffer : array[0..63] of char;
  i : integer;
  ginitdata : twsadata;
  a:string;
begin
  a:='';
  wsastartup($101,ginitdata);
  result:='';
  for i:=0 to 63 do
  begin
    buffer[i]:=' ';
  end;
  gethostname(buffer,sizeof(buffer));
  for i:=0 to 63 do
  begin
    if buffer[i]>' ' then a:=a+buffer[i];
  end;
  name:=trim(a);
  phe:=gethostbyname(buffer);
  if phe=nil then exit;
  pptr:=papinaddr(phe^.h_addr_list);
  i:=0;
  while pptr^[i]<>nil do
  begin
    result:=strpas(inet_ntoa(pptr^[i]^));
    inc(i);
  end;
  wsacleanup;
end;

//得到用户名； 初始化ＳysInfo
procedure SysInfo_ini();
var  user : pchar;
     l    : dword;
begin
  SysInfo.str_CurrentDir:=GetCurrentDir;
  if copy(SysInfo.str_currentdir,length(SysInfo.str_currentdir),1)<>'\' then
     SysInfo.str_currentdir:=SysInfo.str_currentdir+'\';
  //用户名
  l:=1024;
  user:=stralloc(succ(l));
  if getusername(user,l) then SysInfo.compuser:=strpas(user)
  else SysInfo.compuser:='?';
  strdispose(user);
  SysInfo.hostip:=getip(SysInfo.hostname);
end;

//*********************************************************//

function  DateToString(Date1:Tdate):string;
var year1,monse1,date2:word;
    y,m,d:string;
begin
  decodedate(date1,year1,monse1,date2);
  y:=inttostr(year1);
  m:=inttostr(monse1);
  d:=inttostr(date2) ;
  if length(m)=1 then m:='0'+m;
  if length(d)=1 then d:='0'+d;
  result:=y+'-'+m+'-'+d;
end;
//读字符串'aaa(bbb)'中的'bbb'  ;
function  GetSubStr(str:string):string;
var i1:integer;
    str1:string;
begin
  str1:='';
  i1:=1;
  while ( copy(str,i1,1)<>'(') and (i1<length(str)) do
  begin
    i1:=i1+1;
  end;
  i1:=i1+1;
  if i1<length(str) then str1:=copy(str,i1,length(str)-i1)
  else str1:=str;
  result:=str1;
end;

function  stringNotChar(SString,SChar:string):boolean;
var i1:integer;
begin
  result:=True;
  for i1:=1 to length(SString) do
  begin
    if copy(SString,i1,1)=Schar then
    begin
      result := false;
      break;
    end;
  end;
end;

Function  StringGetChar(var SString:String;SChar:String):string;
var i1:integer;
begin
  result:='';
  while copy(SString,1,1)=SChar do
  begin
    SString:=copy(SString,2,Length(SString)-1);
    if Length(SString)=0 then break;
  end;
  if Length(SString)=0 then exit;
  while Copy(SString,1,1)<>SChar do
  begin
    result:=result+Copy(SString,1,1);
    SString:=copy(SString,2,Length(SString)-1);
    if Length(SString)=0 then break;
  end;
end;

//把 stringgridA 的第 AROW 行删除；
procedure stringgriddelete(stringgrida:tStringGrid;arow:integer);
var
  i1,j1:integer;
begin
  for i1:=0    to stringgrida.ColCount+11 do
  for j1:=arow to stringgrida.RowCount+10   do
    stringgrida.Cells[i1,j1]:=stringgrida.Cells[i1,j1+1];
  stringgrida.RowCount:=stringgrida.RowCount-1;
end;

//在 stringgridA 的最前面加一行；
procedure stringgridinsert(stringgrida:tstringgrid);
var
  i1,j1:integer;
begin
  stringgrida.RowCount:=stringgrida.RowCount+1;
  for i1:=0 to stringgrida.ColCount+11     do
  for j1:=stringgrida.RowCount+10 downto 2 do
    stringgrida.Cells[i1,j1]:=stringgrida.Cells[i1,j1-1];
  for i1:=0 to stringgrida.ColCount+1 do
    stringgrida.Cells[i1,1]:='';
end;

Procedure StringgridClear(Stringgrida:Tstringgrid);
var i1,j1:integer;
begin