global.pas

产品信息系统!关于产品基础信息的系统!功能强大!

{//标题：服装MRP系统
 //内容：总调用声明，函数，过程等
 //修改：
}
unit Global;
interface

uses Forms, Base, ADODB, SysUtils,Dialogs,ComCtrls,Math;

const
  c_Company = '开发单位：伟星集团信息中心';
  c_AppTitle = '产品信息管理系统';
  c_AppType = '产品信息';

{$IFDEF DEMO}
 // c_AppEdition = '试用版';
 // c_Day = 30;
{$ENDIF}

{$IFDEF 1.0}
 // c_AppEdition = '简单版';
{$ENDIF}

{$IFDEF 2.0}
  //c_AppEdition = '标准版';
{$ENDIF}
{$IFDEF 3.0}
 // c_AppEdition = '增强版';
{$ENDIF}

   {标准屏幕宽度}
  c_ScreenWidth = 800;
  c_ScreenHeight = 600;
   {通信消息标识}
  c_Msg = 'MSG';
  c_Connect = 'Connect';
  c_Close = 'Close';
  c_DisConnect = 'Disconnect';
  c_OpenAccount = 'OpenAccount';
   {局域，远程标识}
  c_Lan = 'Lan';
  c_Remote = 'Rem';
   {权限Check表示符}
  c_Check = '+';
  c_UnCheck = '-';
   {用于树型结构}
  C_CharArray = 'ABCDEFGH';
   {星期数组}
  sWeek: array[1..7] of string = ('日', '一', '二', '叁', '四', '五', '六');

type
  TBaseFormClass = class of TfrmBase;

var
  G_iUserID, G_iDepID: integer; {用户内部ID,所属部门内部ID}
  G_sUserCode, G_sUserName, G_sDepName,G_sDepCode: string; {用户代码，用户名，所属部门名}
  G_cUserCode:string;{存储过程login_check返回的参数}
  G_bAdmin, G_bTakeEffect: Boolean; {是否超级用户,帐套是否启用}
  G_bMultiUser:string;{是否启用一用户多登录模式}
  G_iAccountID: integer; {当前打开的帐套ID}
  G_sPWD: string; {用户密码}
  G_sSpace: string; {局域网/远程}
  G_bAppEnabled: Boolean; {程序是否可使用}
  G_CanInput:Boolean;{数据是否能进行拷贝}
  WCI_fHth,WCI_fWP,WCI_fModel,WCI_fSize,WCI_fSH,WCI_fColor:string;{全过程数据录入临时变量}
{$IFDEF DEMO}
  G_StartDate: Double; {可用天数}
{$ENDIF}

function GFTreeFindItem(NodeItem: TTreeNode; TreeView: TTreeView; Name: string): TTreeNode;
   {新建节点}
function GFTreeAddItem(eCount: Integer; bCheck: Boolean;
  Query: TADOQuery; var TreeView: TTreeView): TTreeNode;
function SyRMB(NN: Real): string; {把小写数字转换成大写金额}
   {创建Normal窗口}
procedure ShowNormalForm(FormClass: TBaseFormClass; ParentFrom: TForm;
  ModuleID: Integer; FunctionName: string; var Form: TForm);
   {创建Modal窗口}
procedure ShowModalForm(FormClass: TFormClass; ParentFrom: TForm; var Form: TForm);

function DoRoundTo(Value: Double;i:Integer): Double;

implementation

uses main;

{创建Normal窗口}

procedure ShowNormalForm(FormClass: TBaseFormClass; ParentFrom: TForm; ModuleID: Integer; FunctionName: string; var Form: TForm);
begin
    if not Assigned(Form) then
    begin
        //ShowMessage('not Assigned');
        Form := FormClass.CreateWithFunction(ParentFrom, ModuleID, FunctionName);
    end;
  //else
    //showmessage('jin');
  //ShowMessage('Assigned');
  Form.Show;
end;

{创建Modal窗口}

procedure ShowModalForm(FormClass: TFormClass; ParentFrom: TForm; var Form: TForm); //因为有Var修辞符，所以必须要进行显示转化。
begin
  if not Assigned(Form) then
    Form := FormClass.Create(ParentFrom);
  Form.ShowModal;
end;

function GFTreeFindItem(NodeItem: TTreeNode; TreeView: TTreeView; Name: string): TTreeNode;
begin
//得到子节点
  if NodeItem = nil then
    NodeItem := TreeView.Items.GetFirstNode
  else
    NodeItem := NodeItem.GetFirstChild;

//判断是否是要找的节点，否则继续找下一个同级节点，直到找到或找完为止
  if (NodeItem <> nil) and (NodeItem.text <> Name) then
    repeat
      NodeItem := NodeItem.GetNextSibling;
    until (NodeItem = nil) or (NodeItem.text = Name);

  Result := NodeItem;
end;

function GFTreeAddItem(eCount: Integer; bCheck: Boolean;
  Query: TADOQuery; var TreeView: TTreeView): TTreeNode;
var
  ThisNode, Node: TTreeNode;
  I: Integer;
  sName: string;
  pID: ^Integer;
begin
  Node := nil;
     //历遍当前数组
  for I := 1 to eCount do
  begin

    sName := Query.FieldbyName(C_CharArray[i] + 'Name').asString;
    if Trim(sName) = '' then
      Break;
    New(pID);
    pID^ := Query.FieldbyName(C_CharArray[i] + 'ID').asInteger;

    ThisNode := GFTreeFindItem(node, TreeView, sName);
    if ThisNode <> nil then
      Node := ThisNode //如果找到，继续找下一个字符串的节点
    else
    begin
      if I = 1 then //根节点
        Node := TreeView.items.AddObject(Node, sName, pID)
      else //子节点
      begin
        Node := TreeView.items.AddChildObject(Node, sName, pID);
        //if bCheck then Node..CheckboxType := tvctCheckbox;//2005-08-28
      end;
    end;
  end;
  Result := Node;
end;

function SyRMB(NN: Real): string; //将数据转换为大写金额
var
  HZ, NS, NW, NA, N1, N2: string;
  LA, X, Nk: Integer;
begin
  if NN > 9999999999999.99 then
  begin
    HZ := '金额溢出';
    Result := HZ;
    exit;
  end;

  if NN = 0 then
  begin
    HZ := '零元';
    result := HZ;
    exit;
  end; //if
  NS := '零壹贰叁肆伍陆柒捌玖';
  NW := '分角元拾佰仟万拾佰仟亿拾佰仟万';
  NA := FloatToStr(NN * 100);
  LA := length(NA);
  X := 1;
  HZ := '';
  while X <= LA do
  begin
    NK := Ord(NA[x]) - Ord('0');
    N1 := Copy(NS, NK * 2 + 1, 2);
    N2 := Copy(NW, LA * 2 + 1 - X * 2, 2);
    if (NK = 0) and ((N2 = '亿') or (N2 = '万') or (N2 = '元')) then
    begin
      if copy(HZ, Length(HZ) - 1, 2) = '零' then
        HZ := copy(HZ, 1, length(HZ) - 2);
      if copy(HZ, Length(HZ) - 1, 2) = '亿' then
        if N2 = '元' then
        begin
          N1 := N2;
          N2 := '零';
        end
        else
          N2 := ''
      else
      begin
        N1 := N2;
        N2 := '零';
      end
    end
    else if NK = 0 then
    begin
      if copy(HZ, length(HZ) - 1, 2) = '零' then
        N1 := '';
      if N2 = '分' then
      begin
        if copy(HZ, length(HZ) - 1, 2) = '零' then
          HZ := copy(HZ, 1, length(HZ) - 2) + '整'
        else
          HZ := HZ + '整';
        N1 := '';
      end;
      N2 := '';
    end;
    HZ := HZ + N1 + N2;
    X := X + 1
  end;
  Result := HZ;
end;

function DoRoundTo(Value: Double;i:Integer): Double;
    {procedure Set8087CW(NewCW: Word);
    asm
        MOV Default8087CW,AX
        FNCLEX
        FLDCW Default8087CW
    end;}
    const
        RoundUpCW =$133f;//不能使进1，以平常的计算方法 //$1B32;能使进1
    var
        OldCW : Word;
    begin
        OldCW := Default8087CW;
        try
            Set8087CW(RoundUpCW);
            Result := RoundTo(Value,i);
        finally
            Set8087CW(OldCW)
        end;
    end;

end.