⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 u_vardef.pas

📁 青年文明号管理系统
💻 PAS
字号:
unit u_vardef;

interface
uses SysUtils, Windows, Forms, Classes, ComCtrls, Controls,StdCtrls,ADODB,filectrl,StrUtils,DBGridEh;
procedure copyA(s:string;d:string;ext:string);//复制多个相同扩展名的文件
procedure GetYearMonth(comname:Tcombobox);
function GetPYIndexChar( hzchar:string):string;
procedure Showmsg(msg :string);
procedure DelQ(ds:TADOquery;col:integer);
procedure SaveQ(ds:TADOquery);
procedure ShowRep(FileName:string;ds:TADOquery);
function gdir():String;
function getfilelong(fname:string):Longint;//获得文件大小
function getryxh(dwbh:string):integer;
procedure gridtotable(gd:TDBGridEh;ds:TADOquery);
{取得拼音名}
var//定义全局变量
rec:integer;
G_DW:INTEGER;
g_dwbh:INTEGER;
g_dwmc:string;
//bz:string;
year_month :string;
vDh:string;
vFydw:integer;//发往单位
vCkdw:integer;//出库单位
vGhdw:string;//供货单位
vJg,vkc:double;//价格,库存
vIsAdd:integer;//1新增,0修改
vLoginRq:tdate;//取登录日期
olename:string;//ole字段名称
Fname:string;//doc保存文件名,带路径
vtitle:string;//文档编辑标题
vopenpath:string;//打开文件路径
implementation

uses udm;

procedure GetYearMonth(comname:Tcombobox);
begin

end;

function GetPYIndexChar( hzchar:string):string;
var
i,j:integer;
cha:char;
st:string;
begin
  j:=length(hzchar);
  j:=j-1;
  st:='';
  i:=1;
 while i<=j do
  begin
  case WORD(hzchar[i]) shl 8 + WORD(hzchar[i+1]) of
    $B0A1..$B0C4 : cha := 'A';
    $B0C5..$B2C0 : cha := 'B';
    $B2C1..$B4ED : cha := 'C';
    $B4EE..$B6E9 : cha := 'D';
    $B6EA..$B7A1 : cha := 'E';
    $B7A2..$B8C0 : cha := 'F';
    $B8C1..$B9FD : cha := 'G';
    $B9FE..$BBF6 : cha := 'H';
    $BBF7..$BFA5 : cha := 'J';
    $BFA6..$C0AB : cha := 'K';
    $C0AC..$C2E7 : cha := 'L';
    $C2E8..$C4C2 : cha := 'M';
    $C4C3..$C5B5 : cha := 'N';
    $C5B6..$C5BD : cha := 'O';
    $C5BE..$C6D9 : cha := 'P';
    $C6DA..$C8BA : cha := 'Q';
    $C8BB..$C8F5 : cha := 'R';
    $C8F6..$CBF9 : cha := 'S';
    $CBFA..$CDD9 : cha := 'T';
    $CDDA..$CEF3 : cha := 'W';
    $CEF4..$D188 : cha := 'X';
    $D1B9..$D4D0 : cha := 'Y';
    $D4D1..$D7F9 : cha := 'Z';
  else
    cha := 'X';
  end;
  i:=i+2;
  st:=st+cha;
end;
result:=st;
end;

procedure Showmsg(msg :string);
begin
application.MessageBox(pchar(msg),'提示');
end;


procedure DelQ(ds:TADOquery;col:integer);
var
s:string;
begin
  if ds.RecordCount=0 then exit;
  s:=ds.Fields[col].AsString;
  if (Application.MessageBox(Pchar('确定删除?'+s),'提示',MB_YESNO+MB_ICONQUESTION))=ID_Yes then
    begin
      ds.Edit;
      ds.Delete;
    end;
end;

procedure SaveQ(ds:TADOquery);
begin
   try
      ds.Edit;
      ds.Post;
      showmsg('保存成功。');
   except
      on E: Exception do
      raise Exception.Create('保存失败!'+e.Message);
   end;
end;

procedure ShowRep(FileName:string;ds:TADOquery);
var
vdir:string;
vb:boolean;
begin
  GetDir(0,vdir);
  vdir:=vdir+'\rep\'+FileName;
  vb:=ds.Active;
  if not vb then  ds.Open;
  dm.frDS.DataSet:=ds;
  dm.frRep.LoadFromFile(vdir);
  dm.frRep.ShowReport;
  if not vb then ds.Close;
end;


function gdir():String;
var
d:string;
begin
  //getdir(0,d);
  d:=ExtractFilePath(Application.ExeName);
  result:=d;
end;

function getfilelong(fname:string):Longint;
var 
f: file of Byte; 
size : Longint; 
begin 
AssignFile(f, fname); 
Reset(f);
size := FileSize(f); 
result:=size;
CloseFile(f); 
end; 

function getryxh(dwbh:string):integer;
var
vXh:integer;
begin
  dm.tmp.Close;
  dm.tmp.SQL.Text:='select max(xh) from t_jtqk where dwbh='''+dwbh+'''';
  dm.tmp.Open;
  if dm.tmp.Fields[0].IsNull then
     vXh:=1
  else
     vXh:=dm.tmp.Fields[0].AsInteger+1;
result:=vXh;     
end;

procedure copyA(s:string;d:string;ext:string);
var
disp:tform;
flb:tFileListBox;
i:integer;
vfilename:string;
vext:string;
begin
disp:=tform.Create(nil);
flb:=tFileListBox.Create(disp);
flb.ParentWindow:=disp.Handle;
flb.ApplyFilePath(s);
for i:=0 to flb.Items.Count-1 do
  begin
  vfilename:=flb.Items.Strings[i];
  vext:=leftstr(vfilename,2);
  //vext:=rightstr(vfilename,3);
  if vext=ext then
     try
       copyfile(pchar(s+'\'+vfilename),pchar(d+'\'+vfilename),true);
     except
       on E: Exception do
       showmsg('复制文件时错误'+e.Message);
     end;
  end;

end;

///////////
procedure gridtotable(gd:TDBGridEh;ds:TADOquery);
var
i,j:integer;
i1,j1:integer;
begin
ds.Open;
i:=gd.RowCount;
j:=gd.Columns.Count;
gd.DataSource.DataSet.First;
for i1:=1 to i do
begin
ds.append;
ds.edit;
   for j1:=0 to j-1 do
   begin
     ds.Fields[j1].Value:=gd.Fields[j1].Value;
   end;
   ds.Post;
   gd.DataSource.DataSet.Next;
end;
end;
////////

end.
 

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -