myvar.pas

来自「图书馆管理系统设计详细资料」· PAS 代码 · 共 1,824 行 · 第 1/4 页

    shour:=inttostr(hour);
    smin :=inttostr(min);
    ssec :=inttostr(sec);
   if length(shour)<2 then shour:='0'+shour    ;
   if length(smin)<2  then smin :='0'+smin       ;
   if length(ssec)<2  then ssec :='0'+ssec       ;
   result := shour+smin+ssec  ;
end;

function mygettime2fu : string;
var hour,min,sec,msec:word;
    shour,smin,ssec:string   ;
begin
   decodetime(now,hour,min,sec,msec)  ;
    shour:=inttostr(hour);
    smin :=inttostr(min);
    ssec :=inttostr(sec);
   if length(shour)<2 then shour:='0'+shour  ;
   if length(smin)<2  then smin :='0'+smin   ;
   if length(ssec)<2  then ssec :='0'+ssec   ;
   result := shour+'时'+smin+'分'+ssec+'秒'  ;
end;

function mygetonlydatefu : string;
var year,month,day:word;
    yea,mon,da:string   ;
var hour,min,sec,msec:word;
    shour,smin,ssec,smsec:string   ;
begin
   decodedate(date,year,month,day)  ;
   yea:= inttostr(year);
   yea:=copy(yea,3,2);
   mon:=inttostr(month);
   da:=inttostr(day);
   if length(mon)<2 then mon:='0'+mon    ;
   if length(da)<2 then da:='0'+da       ;
   decodetime(now,hour,min,sec,msec)  ;
   shour:=inttostr(hour);
   smin :=inttostr(min);
   ssec :=inttostr(sec);
   smsec:=inttostr(msec);
   if length(shour)<2 then shour:='0'+shour  ;
   if length(smin)<2  then smin :='0'+smin   ;
   if length(ssec)<2  then ssec :='0'+ssec   ;
   if length(smsec)<2 then smsec:='0'+smsec  ;

   result := yea+mon+da+'-'+shour+smin+ssec+smsec;
end;

function  tabinstab(Quy:TQuery;sn1,sn2:string):integer;
begin
  quy.Close;
  quy.SQL.Clear;
  quy.SQL.Add(' insert into '+ sn1 + ' select * from ' + sn2  );
  quy.Active := true;
  quy.First;
  result := quy.RecordCount;
end;


function selectlikefu(Quy:TQuery;sn,zdm,zdv,tj : string):integer;
begin
  quy.Close;
  quy.SQL.Clear;
  quy.SQL.Add(' select * from ' + sn + ' where '+ZDM+' LIKE '+'"'+'%'+zdv +'%'+'"'+ tj );
  quy.Active := true;
  quy.First;
  result := quy.RecordCount;
end;

{追加一条记录 带一张图片 //用的导航器 }

function  insertjlpcfu(st:string;var vjlh:integer;mydbgrid:Tdbgrid;
                 DBN:tDBNavigator;zdm:string):integer;
var i   : integer;
    s   : string;
begin
  result:=0  ;
  i := 0;
  DBN.BtnClick(nbinsert);
  while i < (mydbgrid.FieldCount-1) do
  begin
    s := sltfu(st);
    if  mydbgrid.Fields[i].FullName<>zdm
    then  mydbgrid.Fields[i].value:=s
    else  mydbgrid.Fields[i].value:='';
    inc(i);
  end;
  inc(vjlh);
  mydbgrid.Fields[i].value:=inttostr(vjlh)  ;
   DBN.BtnClick(nbpost);
end;


{增加一条记录全部//用的导航器
 增加记录  st = 'aaa,bbb,ccc,ddd,' }
function myinsertjlfu(dbgrid:Tdbgrid;DBNavigator:TDBNavigator;st:string):integer;
var i,k   : integer;
    s   : string;
begin

  result := 0;
  i := 1;      //有自动增加字段
  DBNavigator.BtnClick(nbInsert);
  while i < (dbgrid.FieldCount) do
  begin
    s := sltfu(st);
    k := pos(',',s);
    if k > 0
    then begin
           showmessage('字符串中含有《逗号》出错！'
           + #10 + #13 + '字段名 : ' + dbgrid.Columns[i].Title.Caption
           + #10 + #13 + '出错值 : ' + s );
           result := i;
         end;
    {k := pos(' ',s);
    if k > 0
    then begin
           showmessage('字符串中含有《间隔符》出错！'
             + #10 + #13 + '字段名 : ' + dbgrid.Columns[i].Title.Caption
             + #10 + #13 + '出错值 : ' + s );
           result := i;
         end; }

    if (DBGrid.Fields[i].DataType = ftstring) and ( result = 0 )
    then begin
           if length(s) > DBGrid.Fields[i].Size
           then begin
                  showmessage('字符串长度出错！'
                     +#13+'字段号..' + inttostr(i+1)
                     +#13+'字段名..' + dbgrid.Columns[i].Title.Caption
                     +#13+'字段值..' + s );
                  result := i;
                end
           else DBGrid.Fields[i].Asstring := s;
         end
    else if DBGrid.Fields[i].DataType = ftinteger
    then begin
           if not jcintfu(s)
           then begin
                  showmessage('整数类型出错！'
                     +#13+'字段号..' + inttostr(i+1)
                     +#13+'字段名..' + dbgrid.Columns[i].Title.Caption
                     +#13+'字段值..' + s );
                  result := i;
                end
           else DBGrid.Fields[i].Asstring := s;
         end
    else if DBGrid.Fields[i].DataType = ftfloat
         then begin
                if not jcrealfu(s)
                then begin
                       showmessage('实数类型出错！'
                          +#13+'字段号..' + inttostr(i+1)
                          +#13+'字段名..' + dbgrid.Columns[i].Title.Caption
                          +#13+'字段值..' + s );
                       result := i;
                     end
                else DBGrid.Fields[i].Asstring := s;
              end
   { else if DBGrid.Fields[i].DataType = ftBoolean
         then begin
                if not jcrealfu(s)
                then begin
                       showmessage('实数类型出错！'
                          +#13+'字段号..' + inttostr(i+1)
                          +#13+'字段名..' + dbgrid.Columns[i].Title.Caption
                          +#13+'字段值..' + s );
                       result := i;
                     end
                else DBGrid.Fields[i].Asstring := s;
              end  }
    else if (DBGrid.Fields[i].DataType = ftDate) or
            (DBGrid.Fields[i].DataType = ftDatetime )
         then begin
                if not jcdateSPfu(s)
                then begin
                       showmessage('日期类型出错！'
                       +#13+'字段号..' + inttostr(i+1)
                       +#13+'字段名..' + dbgrid.Columns[i].Title.Caption
                       +#13+'字段值..' + s );
                       result := i;
                     end
                else if s = ''
                     then //DBGrid.Fields[i].Asstring := null
                     else DBGrid.Fields[i].Asstring := s;
          end
     else   DBGrid.Fields[i].Asstring := s;
    inc(i);
  end;
  if result = 0 then  DBNavigator.BtnClick(nbPost)
                else  DBNavigator.BtnClick(nbCancel);
end;

{修改一条记录全部//用的导航器
 修改记录  st = 'aaa,bbb,ccc,ddd,' }
function mymodifyjlfu(dbgrid:Tdbgrid;DBNavigator:TDBNavigator;st:string):integer;
var i,k   : integer;
    s   : string;
begin

  result := 0;
  i := 1;       //有自动增加字段
  DBNavigator.BtnClick(nbEdit);
  while i < (dbgrid.FieldCount) do
  begin
    s := sltfu(st);
    k := pos(',',s);
    if k > 0
    then begin
           showmessage('字符串中含有《逗号》出错！'
           + #10 + #13 + '字段名 : ' + dbgrid.Columns[i].Title.Caption
           + #10 + #13 + '出错值 : ' + s );
           result := i;
         end;
  {  k := pos(' ',s);
    if k > 0
    then begin
           showmessage('字符串中含有《间隔符》出错！'
             + #10 + #13 + '字段名 : ' + dbgrid.Columns[i].Title.Caption
             + #10 + #13 + '出错值 : ' + s );
           result := i;
         end;  }

    if (DBGrid.Fields[i].DataType = ftstring) and ( result = 0 )
    then begin
           if length(s) > DBGrid.Fields[i].Size
           then begin
                  showmessage('字符串长度出错！'
                     +#13+'字段号..' + inttostr(i+1)
                     +#13+'字段名..' + dbgrid.Columns[i].Title.Caption
                     +#13+'字段值..' + s );
                  result := i;
                end
           else DBGrid.Fields[i].Asstring := s;
         end
    else if DBGrid.Fields[i].DataType = ftinteger
    then begin
           if not jcintfu(s)
           then begin
                  showmessage('整数类型出错！'
                     +#13+'字段号..' + inttostr(i+1)
                     +#13+'字段名..' + dbgrid.Columns[i].Title.Caption
                     +#13+'字段值..' + s );
                  result := i;
                end
           else DBGrid.Fields[i].Asstring := s;
         end
    else if DBGrid.Fields[i].DataType = ftfloat
         then begin
                if not jcrealfu(s)
                then begin
                       showmessage('实数类型出错！'
                          +#13+'字段号..' + inttostr(i+1)
                          +#13+'字段名..' + dbgrid.Columns[i].Title.Caption
                          +#13+'字段值..' + s );
                       result := i;
                     end
                else DBGrid.Fields[i].Asstring := s;
              end
    else if (DBGrid.Fields[i].DataType = ftDate) or
            (DBGrid.Fields[i].DataType = ftDatetime )
         then begin
                if not jcdateSPfu(s)
                then begin
                       showmessage('日期类型出错！'
                       +#13+'字段号..' + inttostr(i+1)
                       +#13+'字段名..' + dbgrid.Columns[i].Title.Caption
                       +#13+'字段值..' + s );
                       result := i;
                     end
                else if s = ''
                     then //DBGrid.Fields[i].Asstring := null
                     else DBGrid.Fields[i].Asstring := s;
              end
    else   DBGrid.Fields[i].Asstring := s;
    inc(i);
  end;
  if result = 0 then  DBNavigator.BtnClick(nbPost)
                else  DBNavigator.BtnClick(nbCancel);
end;

function myjctxtvalue(DBGrid:TDBGrid; s:string;i:integer):integer;
var k : integer;
    name:string;
begin
  name:= DBGrid.Columns[i].Title.Caption ;
  result := 0; 
  k := pos(',',s);
  if k > 0
  then begin
         showmessage('字符串中含有《逗号》出错！'
           + #10 + #13 + '字段名 : ' + name
           + #10 + #13 + '出错值 : ' + s );
         result := 1;
       end;
  k := pos(' ',s);
  if k > 0
  then begin
         showmessage('字符串中含有《间隔符》出错！'
           + #10 + #13 + '字段名 : ' + name
           + #10 + #13 + '出错值 : ' + s );
         result := 1;
       end;

  if (DBGrid.Fields[i].DataType = ftstring) and (length(s) > DBGrid.Fields[i].Size)
  then begin
         showmessage('字符串长度出错！'
             + #10 + #13 + '字段名 : ' + name
             + #10 + #13 + '出错值 : ' + s );
         result := 3;
       end
  else
  if (DBGrid.Fields[i].DataType = ftinteger) and (not jcintfu(s))
  then begin
         showmessage('整数类型出错！'
             + #10 + #13 + '字段名 : ' + name
             + #10 + #13 + '出错值 : ' + s );
         result := 4;
       end
  else
  if (DBGrid.Fields[i].DataType = ftfloat) and (not jcrealfu(s))
  then begin
         showmessage('实数类型出错！'
             + #10 + #13 + '字段名 : ' + name
             + #10 + #13 + '出错值 : ' + s );
         result := 5;
       end
  else
  if ((DBGrid.Fields[i].DataType = ftDate) or
      (DBGrid.Fields[i].DataType = ftDatetime )) and (not jcdateSPfu(s))
  then begin
         showmessage('日期类型出错！'
                  + #10 + #13 + '字段名 : ' + name
                  + #10 + #13 + '出错值 : ' + s );
         result := 6;
       end;
end;

function  mygotojlhfu(quy:TQuery;vjlh:integer): boolean;
begin
   result := false;
   quy.Last;
   while not quy.bof do begin
   if quy.Fieldbyname('jlh').value=vjlh
   then begin
        result :=true;
        exit;
        end;
    if quy.Fieldbyname('jlh').value<vjlh
   then begin
        result := false;
        exit;
        end;
   quy.Prior ;
   end;
end;


{清屏}
procedure mydelpmjlpd(StatusBar:TStatusPanel;ProBar: TProgressBar;
                      quy : TQuery;sql : TUpdateSQL;fname:string);
var txt : textfile;
    gs  : string;
    i   : integer;
    vjlh : integer;
begin
  if quy.IsEmpty
  then exit;
  if quy.RecordCount > 0       //一条以上记录
  then begin
         assignfile(txt,fname);
         rewrite(txt);
         quy.DisableConstraints;
         ProBar.Visible:=true;
         ProBar.Max:= quy.RecordCount;
         ProBar.Position:=0;
         quy.CachedUpdates := true;
         sql.SetParams(ukdelete);
         while not quy.Eof do
         begin
            ProBar.Position:= ProBar.Position+1;
            i := 0; gs := '';
            while i < quy.FieldCount do
            begin
            gs := gs + quy.Fields.Fields[i].AsString  + ',';
            inc(i);
            end;
            writeln(txt,gs);
            StatusBar.Text := gs;
           vjlh := quy.FieldByName('jlh').ASinteger;
           SQL.Query[ukdelete].Params[0].Value :=  vjlh ;
           SQL.ExecSQL(ukdelete);
           quy.Next;
         end;
          closefile(txt);
         quy.EnableConstraints;
         quy.CachedUpdates := false;
       end;
end;

{清屏,带图片}
procedure mydelpmjlpicpd(StatusBar:TStatusPanel;ProBar: TProgressBar;
                      quy : TQuery;sql : TUpdateSQL;fname,zdm,zdsvm:string);
var txt : textfile;
    gs  : string;
    i   : integer;
    vjlh : integer;
begin
  if quy.IsEmpty
  then exit;
  if quy.RecordCount > 0       //一条以上记录
  then begin
         assignfile(txt,fname);
         rewrite(txt);
         quy.DisableConstraints;
         ProBar.Visible:=true;
         ProBar.Max:= quy.RecordCount;
         ProBar.Position:=0;
         quy.CachedUpdates := true;
         sql.SetParams(ukdelete);
         while not quy.Eof do
         begin
            ProBar.Position:= ProBar.Position+1;
            i := 0; gs := '';
            while i < quy.FieldCount do
            begin
            if   quy.Fields[i].FullName<>zdm then
            gs := gs + quy.Fields.Fields[i].AsString  + ','
            else  begin
            gs := gs + '' + ',' ;
            if quy.Fields[i].Value<>'' then
            TBlobField(quy.Fields[i]).savetoFile(extractfilepath(fname)+quy.fieldbyname(zdsvm).asstring +'.bmp');
            end;
            inc(i);
            end;
            writeln(txt,gs);
            StatusBar.Text := gs;
           vjlh := quy.FieldByName('jlh').ASinteger;
           SQL.Query[ukdelete].Params[0].Value :=  vjlh ;
           SQL.ExecSQL(ukdelete);
           quy.Next;
         end;
          closefile(txt);
         quy.EnableConstraints;
         quy.CachedUpdates := false;
       end;
end;


{清屏,带文字}
procedure mydelpmjltxtpd(StatusBar:TStatusPanel;ProBar: TProgressBar;
                      quy : TQuery;sql : TUpdateSQL;fname,zdm,zdsvm:string);
var txt : textfile;
    gs  : string;
    i   : integer;