u_tools_leo.pas

来自「一个仓库管理中的子系统－－采购子系统」· PAS 代码 · 共 1,257 行 · 第 1/3 页

{*******************************************************}
{                                                       }
{         Leo Application Program Tool Library          }
{                                                       }
{       Copyright (c) 2000,2005 Leo ToolKit Group       }
{                                                       }
{*******************************************************}
{*******************************************************}
{                                                       }
{               王瑜 应用程序开发工具包                 }
{                                                       }
{            版权所有 2000,2005 大家随便了 :)           }
{                                                       }
{*******************************************************}
//最后更新时间 20001.6.3

unit u_tools_leo;
//
//
//
//
//
//
//
//
//
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,db,DBTables,grids, Quickrpt, QRCtrls;
const
  headsizelength=20;
  system_error_caption='系统提示';
  system_erroor_button=mb_ok+mb_iconstop;
type
/////////////////////////////////////////////////////////////////////////////////
  TFunction_Class=class(twincontrol)
  procedure beforePrint(sender: TObject; var Value: String);
  end;

  TStreams=class
  private
  flist:tlist;
  function getcount:integer;
  public
  property count:integer read getcount;
  function add(stream:tstream):integer;
  function delete(index:integer):boolean;
  function write(stream:tstream;index:integer):boolean;
  function savetostream(stream:tmemorystream):boolean;
  function loadfromstream(stream:tstream):boolean;
  function savetofile(filename:string):boolean;
  function loadfromfile(filename:string):boolean;
  constructor create;
  destructor  Destroy;override;
  end;
/////////////////////////////////////////////////////////////////////////////////
  TMsgPacket=class
    private
      flist:tstringlist;
      fmem:tmemorystream;
      fstreamcount:integer;
      function getvalue(const name:string):string;
      function getheadsize:integer;
      procedure setvalue(const name,value:string);
      function getsize:integer;
      function isempty:boolean;
    public
      constructor create;
      destructor destory;
      function loadfromstream(stream:tstream):boolean;
      function savetostream(stream:tmemorystream):boolean;
      function loadfromfile(filename:string):boolean;
      function savetofile(filename:string):boolean;
    property headsize:integer read getheadsize;
    property parameters:tstringlist read flist;
    property mem:tmemorystream read fmem write fmem;
    property values[const name:string]:string read getvalue write setvalue;
    property size:integer read getsize;
    property empty:boolean read isempty;
    property streamcount:integer read fstreamcount;
    end;
/////////////////////////////////////////////////////////////////////////////////
TSqlGenerater=class
//这个类主要是用来生成SQL语句的
//可以生成删除，插入，选择，条件等语句。
  private
  public
    function GenInsert(TableName:string;Fields:Array of String;Values:Array of Const):String;overload;
    function GenSelect(Tables:Array of string;Fields:Array of String;WhereSql:string):String;
    function GenUpdate(TableName:String;Fields:Array of String;Values:Array of Const;WhereSql:String):String;overload;
    function GenNormalWhere(fields:array of string;values:array of const):string;overload;
    function GenWhere(items:array of const):string;
    function GenDelete(TableName:string;WhereString:string):string;
  end;
/////////////////////////////////判断有效性函数//////////////////////
function changedateformat(str:string):string;
function isinteger(str:string):boolean;
function isfloat(str:string):boolean;
function isdate(str:string):boolean;
function istime(str:string):boolean;
/////////////////////////////////时间日期函数//////////////////////
function nextday(d:string):string;overload;
//取下一天的日期
function priorday(d:string):string;overload;
//取前一天的日期
function nextday(d:string;num:integer):string;overload;
//取下面指定多少天的日期
function priorday(d:string;num:integer):string;overload;
//取前面指定多少天的日期
//////////下面一组函数用于把一个表单的信息显示在一个report上面
function replace_stringgrid(grid:tstringgrid;Band:TQRStringsBand;function_class:tfunction_class):boolean;
function replace_qrlabel_all(form:tform;Rep:TQuickRep):boolean;
function replace_qrlabel(control:tcontrol;Band:twincontrol):boolean;
function FindChildControl(const control:tcontrol;ControlName: string): tcomponent;

function changelength_back(str:string;fillchar:char;strlength:integer):string;
//在字符串的后面补齐
function getsql_cal_ware(warename:string;wareidnames:array of string;wareslname,xbname,xbzbidname:string;xbxbidnames:array of string;xbslname,zbid,caltype:string):string;overload
function getsql_cal_ware(warename,wareidname,wareslname,xbname,xbzbidname,xbxbidname,xbslname,zbid,caltype:string):string;overload;
//巨好的函数,可以将一个明细表的的数据更改反映到仓库的总数据中去
{参数说明:
warename,仓库表的表名
wareidname,仓库表的ID号,也就是物资的ID号
wareslname,仓库表中需要修改的数量字段号
xbname,明细表的表名
xbzbidname,明细表对应的主表ID号字段名称
xbxbidname,明细表中对应的物资ID号字段名称
xbslname,明细比中对应的数量字段名称
zbid,需要倒库的主表ID号,例如'00067845'
caltype,倒库操作的类型,'+'代表往仓库加,'-'代表从仓库减出来
}
function VarrecToString(rec:TVarRec):String;
// 将一个tvarrec类型的变量转化为一个string类型的变量
function OpenQuery(query:tquery;sqlstring:string;action:string):boolean;overload;
// 这个函数用语执行一个SQL语句
//action参数用于指明是open,还是 execsql
//当action='open'时 调用 open 函数；当action='execsql'时，调用execsql函数。
function OpenQuery(query:tquery;sqllist:tstringlist;action:string):boolean;overload;
// 这个函数用语执行一个SQL语句序列
//action参数用于指明是open,还是 execsql
//当action='open'时 调用 open 函数；当action='execsql'时，调用execsql函数。
function movequery(query:tquery;tablename:string;keyfieldname:string;keyvalue:string;action:string):string;
//这个函数用于将一个query往前或往后移动一个游标,或是到头或是到尾。
//query是调用的query名字
//table是移动的表名字
//keyfieldname是依据移动的关键字段名字
//keyvalue是当前移动关键字的值
//action 是需要移动的动作 可以是 last,first,search,open,next,prior
//返回的是当前关键字段的值。
function changelength(str:string;fillchar:char;strlength:integer):string;
//用于将一个字符串前面添满字符
function formatdatetime(str:string):string;
//用于将一个时间字符串格式化成规定格式 例如：1998-09-23 15:56
function setdata(var cs:string;datatype:string;data:string):boolean;
//用于将一个参数存储于一个字符串中。
function getdata(cs:string;datatype:string):string;
//用于从一个字符串中取出一个参数值
function StreamToOlevariant(const stream:tstream;out v:olevariant):boolean;
//在madias程序中使用，用于将stream流转换为variant变量
function OlevariantToStream(stream:tstream; v:olevariant;size:longint):boolean;
//在madias程序中使用，用于将variant流转换为stream变量
Procedure distributetext (canvas:tcanvas; width: integer; font: tfont; text:string; strings: tstringlist);
//按照画布的canvas，在width的范围内将text划分几个子string 并放在strings中
Procedure writetext (canvas:tcanvas; x1,y1,x2,y2: integer; textxdirectionspace,textydirectionspace:integer;text: string; font: tfont; alignflag: integer; ifrh: boolean);
//用于将一个字符串写到一个画布上，
//alignflag:对齐标志 0:左对齐，1:中对齐，2:右对齐。
//ifrh:是否绕行标志 true:绕行，false：不绕行
function isnextmonth(year1,month1,year2,month2:integer):integer;
//判断两个月份之间是否连续
//相等0
//连续1
//不连续2
implementation
function changedateformat(str:string):string;
begin
result:=copy(str,1,4)+'-'+copy(str,5,2)+'-'+copy(str,7,2);
end;
////////////////////////////////////////////////////////////////
function isinteger(str:string):boolean;
begin
result:=false;
try
  strtoint(str);
except
  application.MessageBox('输入的字符串不能转换为整数。',system_error_caption,system_erroor_button);
  exit;
end;
result:=true;
end;
////////////////////////////////////////////////////////////////////
function isfloat(str:string):boolean;
begin
result:=false;
try
  strtofloat(str);
except
  application.MessageBox('输入的字符串不能转换为浮点数。',system_error_caption,system_erroor_button);
  exit;
end;
result:=true;
end;
////////////////////////////////////////////////////////////////////
function isdate(str:string):boolean;
begin
result:=false;
shortdateformat:='yyyymmdd';
try
  strtodate(changedateformat(str));
except
  application.MessageBox('输入的字符串不能转换为有效日期。',system_error_caption,system_erroor_button);
  exit;
end;
result:=true;
end;
////////////////////////////////////////////////////////////////////
function istime(str:string):boolean;
begin
result:=false;
shortdateformat:='yyyymmddhhnnss';
try
  strtotime(str);
except
  application.MessageBox('输入的字符串不能转换为有效时间。',system_error_caption,system_erroor_button);
  exit;
end;
result:=true;
end;
////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////
function nextday(d:string):string;
var
  year,month,day:word;
begin
shortdateformat:='yyyymmdd';
decodedate(strtodate(copy(d,1,4)+'-'+copy(d,5,2)+'-'+copy(d,7,2)),year,month,day);
try
if (month=2) and (day=28) and ((year mod 4)=0) then
  begin
  day:=29;
  exit;
  end;
if (month=2) and (day=28) and ((year mod 4)<>0) then
  begin
  day:=1;
  month:=3;
  exit;
  end;
if (month=12) and (day=31) then
  begin
  day:=1;
  month:=1;
  inc(year);
  exit;
  end;
if ((month=1) or (month=3) or (month=5) or (month=7) or (month=8) or (month=10)) and (day=31) then
  begin
  inc(month);
  day:=1;
  exit;
  end;
if ((month=4) or (month=6) or (month=9) or (month=11)) and (day=30) then
  begin
  inc(month);
  day:=1;
  exit;
  end;
inc(day);
finally
shortdateformat:='yyyymmdd';
result:=datetostr(encodedate(year,month,day));
end;

end;
////////////////////////////////////////////////////////////////////
function priorday(d:string):string;
var
  year,month,day:word;
begin
try
  shortdateformat:='yyyymmdd';
  decodedate(strtodate(copy(d,1,4)+'-'+copy(d,5,2)+'-'+copy(d,7,2)),year,month,day);
  if (day=1) and ((month=2) or (month=4) or (month=6) or (month=8)or(month=9) or(month=11))  then
    begin
    day:=31;
    dec(month);
    exit;
    end;
  if (day=1) and ((month=5) or (month=7) or (month=10) or(month=12) )  then
    begin
    day:=30;
    dec(month);
    exit;
    end;
  if (day=1) and (month=3) then
    if (year mod 4)=0 then
      begin
      day:=29;
      month:=2;
      exit;
      end
    else
      begin
      day:=28;
      month:=2;
      exit;
      end;
  if (day=1) and (month=1) then
    begin
    day:=31;
    month:=12;
    dec(year);
    exit;
    end;
  dec(day);
finally
  shortdateformat:='yyyymmdd';
  result:=datetostr(encodedate(year,month,day));
end;
end;
////////////////////////////////////////////////////////////////////
function nextday(d:string;num:integer):string;
var
  count1:integer;
  buf:string;
begin
buf:=d;
for count1:=1 to num do
  buf:=nextday(buf);
result:=buf;  
end;
////////////////////////////////////////////////////////////////////
function priorday(d:string;num:integer):string;
var
  count1:integer;
  buf:string;
begin
buf:=d;
for count1:=1 to num do
  buf:=priorday(buf);
result:=buf;
end;
////////////////////////////////////////////////////////////////////

procedure Tfunction_class.beforePrint(sender: TObject; var Value: String);
var
  buf:string;
  count1:integer;
begin
buf:=tstringgrid(TQRStringsBand(TQRLabel(sender).parent).items.objects[0]).cells[strtoint(TQRLabel(sender).hint),TQRStringsBand(TQRLabel(sender).parent).index];
//说明，这里有一点比较特殊的地方，就是时间日期的显示，如果判断全部是数字，并且为8位则转换为日期格式。
if value='' then exit;
if (length(buf)<>8) or (pos('.',buf)>0) then
  begin
  value:=buf;
  exit;
  end;
for count1:=1 to length(value) do
  if not ((ord(value[count1])>=48) and (ord(value[count1])<=57)) then break;
if count1=length(value)+1 then
  value:=formatdatetime(buf)
else value:=buf;
end;
/////////////////////////////////////////////////////////////////////////////////
function replace_stringgrid(grid:tstringgrid;Band:TQRStringsBand;function_class:tfunction_class):boolean;
var
  count1,count2:integer;
  qrlabel:tqrlabel;
  shape:tqrshape;
begin
//即计算需要显示多少行数据,这里假定如果一行为全空,则表示显示数据结束.
for count1:=0 to grid.RowCount-1 do
  begin
  for count2:=0 to grid.colcount-1 do
      if grid.cells[count2,count1]<>'' then break;
  if count2=grid.colcount then break;
  end;
if count1=0 then exit;
band.Items.clear;
for count2:=0 to count1-1 do
  band.items.add(inttostr(count2));
for count1:=0 to grid.colcount-1 do
  begin
  qrlabel:=tqrlabel.Create(band);
  qrlabel.parent:=band;
  qrlabel.AutoSize:=true;
  qrlabel.Caption:='leo';
  qrlabel.hint:=inttostr(count1);
  qrlabel.ShowHint:=false;
  qrlabel.Font:=grid.font;
  qrlabel.font.color:=clblack;
  qrlabel.Left:=round(grid.cellrect(count1,0).left/grid.width*band.Width)+5;
  qrlabel.top:=round((band.Height-qrlabel.height)/2);
  qrlabel.onprint:=function_class.beforePrint;
  qrlabel.visible:=true;
  if count1<>grid.colcount-1 then
    begin
    shape:=tqrshape.Create(band);
    shape.parent:=band;
    shape.Width:=3;
    shape.Height:=band.Height-2;
    shape.left:=round(grid.cellrect(count1,0).right/grid.width*band.Width);
    shape.top:=0;
    shape.Shape:=qrsVertLine;
    shape.visible:=true;
    end;
  end;
band.items.objects[0]:=grid;
end;
/////////////////////////////////////////////////////////////////////////////////
function FindChildControl(const control:tcontrol;ControlName: string): tcomponent;
var
  count1:integer;
begin
for count1:=0 to control.ComponentCount-1 do
  if uppercase(control.components[count1].name)=uppercase(controlname) then break;
if count1=control.ComponentCount then result:=nil
else result:=control.components[count1];
end;