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

📄 pub.~pas

📁 一个非常好的桑拿浴管理系统
💻 ~PAS
字号:
unit pub;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, Grids, DBGrids, StdCtrls, ExtCtrls, ComCtrls, QuickRpt, QRCtrls;

  //StringGrid 字对齐
  procedure GRL_SGAlign(SG:TStringGrid;S_Rect: TRect;s_Align,S_text:String);

  //动态 设置 DBGrid title 居中
  procedure pro_Align(DG : TDBGrid;Position : string);

  //流水号补零
  Function FRL_LiuShui(LiuShui : integer; len : Integer):String;

  //删除一行
  procedure GRL_DeleteOneRow(SG: TStringGrid; ARow,EndCol: Integer);

  //增加一行
  procedure GRL_InSertOneRow(SG: TStringGrid; ARow: Integer);

  //清除加隐含列的数据  StingGrid
  procedure GRL_SGClear(SG: TStringGrid;StartCol,EndCol,StartRow,EndRow:Integer);

  //清除不加隐含列的数据    StingGrid
  procedure GRL_ClearStrGrid(SG: TStringGrid; StartCol: Integer=0;StartRow: Integer=0);

  //判断浮点数
  procedure GRL_SetFloat(var Key:Char;Str:String);

  //窗口居中
  procedure Frm_Center(frm_name : TForm);

  //根据权限访问
  procedure Power_Select(power_name,user_name_ZHI : string; Query :TAdoQuery;sheet_name : TPageControl);

  //选择下一个控件Tab (控件内容不为空) tag = 5
  procedure Tab_next(mainForm : TForm);

  //求SerVer日期
  Function FRL_ServerTime(ADOSvr:TADOConnection): String;

  //dateTimePicker的选择(四个)
  procedure DTSelect(ls_num : integer;Dt_2,Dt_3,Dt_4 : TDateTimePicker);

  //根据四个dateTimePicker查询数据
  function SGDTSelect(ls_d1 : string;Dt1,Dt2,Dt3,Dt4 : TDateTimePicker) : string;

  // stringGrid 定位到操作的行
  procedure proc_goto(sgRow : tStringGrid;ls_condition : string;ls_Row : integer);


var
  sny_user,sny_user_fk,sny_title1,sny_title2 : string;  //登陆人员姓名,登陆人所属分库

implementation

uses dataModule, reg, main, commutationTicket, finace, log, sysSetting;

// stringGrid 定位到操作的行
procedure proc_goto(sgRow : tStringGrid;ls_condition : string;ls_Row : integer); 
var
  i : integer;
begin
  with sgRow do
  begin
    for i := 1 to (RowCount - 1) do
      if (Trim(Cells[ls_Row,i]) = ls_condition) then
      begin
        Row := RowCount - 1;
        Row := i;
      end;
  end;
end;

//根据四个dateTimePicker查询数据(1.date 3.time 2.date 4.time) 顺序
function SGDTSelect(ls_d1 : string;Dt1,Dt2,Dt3,Dt4 : TDateTimePicker) : string;
//                       (字段名称)
var
  i : integer;
  ls_rq1,ls_rq2,ls_sql : string;
begin
  Result := '';

  if (Dt1.Checked = true) and (Dt2.Checked = true) then
    if (Dt1.Date > Dt2.Date) then
    begin
      Application.MessageBox('起始日期不能大于截至日期!','提示',Mb_OK+MB_IconInformation);
      Exit;
    end;

  if (Dt1.Checked = true) and (Dt2.Checked = false) then i := 1
  else i := 0;
  if (i = 0) and Dt3.Checked then
  begin
    ls_rq1 := FormatDateTime('yyyy-mm-dd',Dt1.Date) +' '+ formatDateTime('hh:mm:ss',Dt3.Time);
    ls_rq2 := FormatDateTime('yyyy-mm-dd',Dt2.Date) +' '+ formatDateTime('hh:mm:ss',Dt4.Time);
  end;

  if (i = 1) then //one dateTimePicker
  ls_sql := ' where ' +ls_d1+ ' >= ' + ''''+FormatDateTime('yyyy-mm-dd',Dt1.Date)+'''' + ' and ' +
             ls_d1 +' <= ' + ''''+FormatDateTime('yyyy-mm-dd',Dt1.Date + 1)+''''
  else if (i = 0) then  //(2个date  or 4个date)
  begin
    if (Dt3.Checked) then  // four
      ls_sql := ' where ' +ls_d1+ ' >= '+''''+ ls_rq1 +''''+' and '+ ls_d1 +' <= '+''''+ ls_rq2 +''''
    else // two
      ls_sql := ' where ' +ls_d1+ ' >= ' + ''''+FormatDateTime('yyyy-mm-dd',Dt1.Date)+'''' + ' and ' +
                 ls_d1 +' <= ' +''''+FormatDateTime('yyyy-mm-dd',Dt2.Date + 1)+'''';
  end;

  Result := ls_sql;
end;

//dateTimePicker的选择(四个)
procedure DTSelect(ls_num : integer;Dt_2,Dt_3,Dt_4 : TDateTimePicker);
begin
  case ls_num of
  2: if Dt_2.Checked=true then
     begin
       Dt_3.Checked:=true;
       Dt_4.Checked:=true;
     end else
     if Dt_2.Checked=false then
       Dt_4.Checked:=false;
  3: if Dt_3.Checked=false then
       begin
         Dt_2.Checked:=false;
         Dt_4.Checked:=false;
       end;
  4: if Dt_4.Checked=true then
     begin
       Dt_2.Checked:=true;
       Dt_3.Checked:=true;
     end else
     if Dt_4.Checked=false then
     begin
       Dt_2.Checked:=false;
     end;
  end;
end;

//选择下一个控件Tab
procedure Tab_next(mainForm : TForm);
begin
  with mainForm do
  if (activeControl.Tag = 5) then    //   (控件内容不为空)   tag = 5
  begin
    if ((activeControl is Tedit) and not(Trim((activeControl as Tedit).Text) = ''))
    or ((activeControl is Tlabelededit) and not(Trim((activeControl as Tlabelededit).Text) = ''))
    or ((activeControl is Tcombobox) and not(Trim((activeControl as Tcombobox).Text) = ''))
    or ((activeControl is Tmemo) and not(Trim((activeControl as Tmemo).Text) = ''))
    then
    Perform(WM_NEXTDLGCTL, 0, 0)
  end
  else if (activeControl.Tag = 4) then   //   (控件内容不限制)   tag = 4
  begin
    if (activeControl is Tedit)
    or (activeControl is Tlabelededit)
    or (activeControl is Tcombobox)
    or (activeControl is Tmemo)
    or (activeControl is TDateTimePicker)
    then
    //(mainForm.activeControl as TWinControl).SELECTNEXT(mainForm.activeControl, TRUE, TRUE);
    Perform(WM_NEXTDLGCTL, 0, 0);
  end;
  //mainForm.activeControl.SELECTNEXT(mainForm.activeControl, TRUE, TRUE);
end;

//根据权限访问
procedure Power_Select(power_name,user_name_ZHI : string; Query : TAdoQuery;sheet_name : TPageControl);
var
  ls_sql : string;
  i,li_count_ZD : integer; //字段的个数
begin
  //ls_sql := '';
  With Query do
  begin
    Close;
    Sql.Clear;
    Sql.Add('select name from syscolumns where object_name(id) = ''sny_user'' and name like'''+power_name+'%''');
    PrePared;
    Open;
    li_count_ZD := RecordCount;
    While not eof do
    begin
      ls_sql := ls_sql +','+Trim(FieldByName('name').AsString);
      next;
    end;
    ls_Sql := copy(ls_sql,2,length(ls_sql) - 1);

    Close;
    Sql.Clear;
    SQl.Add('select '+ls_sql+' from sny_user where user_name = '''+user_name_ZHI+'''');
    PrePared;
    Open;
    for i := 0 to (li_count_ZD - 1) do
    if query.Recordset.Fields.Item[i].Value = '1' then
    sheet_name.Pages[i].TabVisible := true
    else
    sheet_name.Pages[i].TabVisible := false;
  end;
end;

//窗口居中
procedure Frm_Center(frm_name : TForm);
begin
  frm_name.Left := trunc((screen.Width - frm_name.Width) / 2);
  frm_name.Top := trunc((screen.Height - frm_name.Height) / 2) - 14;
end;

//判断浮点数
procedure GRL_SetFloat(var Key:Char;Str:String);
  //Member Function
  function LFRL_IsNumVal(StrVal: String): boolean;
  var
    I, TMI_DecimalCount: Integer;
    TMB_InvalChar: Boolean; //输入是否合法
  begin
    TMB_InvalChar := False;
    TMI_DecimalCount := 0;
    for I := 1 to Length (StrVal) do
    begin
      if (StrVal [I] < '0') or (StrVal [I] > '9') then
      begin
        if StrVal [I] = '.' then
          TMI_DecimalCount := TMI_DecimalCount + 1             //一个点
        else if  Not (( I = 1 ) and  ( StrVal[I]= '-' )) then  //负数
          TMB_InvalChar := True;

      end;
    end;
    if (TMB_InvalChar) or (TMI_DecimalCount > 1) then
      Result := False
    else
      Result := True;
  end;
begin
  if (Key=Chr(VK_Return))or(Key=Chr(Vk_Back))then Exit;
  Str := Str + String(Key);
  if not LFRL_IsNumVal(Str) then
  begin
    Key := #0;
    MessageBeep(0);
  end;
end;

//清除不加隐含列的数据
procedure GRL_ClearStrGrid(SG: TStringGrid; StartCol: Integer=0;StartRow: Integer=0);
var
  TMI_col,TMI_row : Integer;
begin
  with SG do
  begin
    for TMI_row := StartRow to RowCount-1 do
      for TMI_col := StartCol to ColCount-1 do
        Cells[TMI_col,TMI_row] := '';
    RowCount := 2;
  end;
end;

//清除加隐含列的数据
procedure GRL_SGClear(SG: TStringGrid;StartCol,EndCol,StartRow,EndRow:Integer);
var
  i,j: Integer;
begin
  with SG do
  begin
    for i := StartCol to EndCol do
      for j := StartRow to EndRow do
        Cells[i,j] := '';
    RowCount := 2;
  end;
end;

//增加一行
procedure GRL_InSertOneRow(SG: TStringGrid; ARow: Integer);
var
  I,j :Integer;
begin
  ARow := SG.Row ;
  SG.RowCount := SG.RowCount + 1;
  with SG do
  begin
    for i := RowCount downto Row do
      for j := 0 to ColCount - 1 do
        Cells [J,I+2] := Cells [J,I+1];
    for j := 0 to ColCount - 1 do
        Cells[j,ARow+1] := '';
    Row := ARow + 1;
    setfocus;
  end;
end;

//删除一行
//                         StringGrid         要删除的Row
procedure GRL_DeleteOneRow(SG: TStringGrid; ARow,EndCol: Integer);
var
  j :Integer;
begin
  //ARow := SG.Row ;
  with SG do
  begin
    While ARow <= RowCount - 1 do
    begin
      if RowCount = 2 then
      begin
        for j := 0 to EndCol do
          Cells[j,1] := '';
        Exit;
      end
      else
        for j := 0 to EndCol do      // ColCount - 1
          Cells[j,ARow] := Cells[j,ARow+1];
        inc(ARow);
    end;
    if RowCount > 2 then
    RowCount := RowCount - 1;
  end;
end;

//流水号补零
Function FRL_LiuShui(LiuShui : integer; len : Integer):String;
var
  I : Integer;
  TMS_Ls : String;
begin
  TMS_Ls := '';
  for i := 1 to len do
  TMS_Ls := TMS_Ls +'0';
  Result := formatFloat(TMS_Ls,LiuShui);
end;

//StringGrid 位置
procedure GRL_SGAlign(SG:TStringGrid;S_Rect: TRect;s_Align,S_text:String);
begin
  with SG.Canvas do
  begin
    //center
    if S_Align = 'c' then
      TextRect(S_Rect, (S_Rect.Left + (S_Rect.Right - S_Rect.Left- textwidth(S_text)) div 2),
                      (S_Rect.Top + (S_Rect.Bottom - S_Rect.Top- textheight(S_text)) div 2), S_text);
    //Left
    if S_Align = 'l' then
      TextRect(S_Rect, (S_Rect.Left + 3),(S_Rect.Top +
                      (S_Rect.Bottom - S_Rect.Top- textheight(S_text)) div 2), S_text);
    //Right
    if S_Align = 'r' then
      TextRect(S_Rect, (S_Rect.Left + S_Rect.Right - S_Rect.Left- textwidth(S_text) -3),
                      (S_Rect.Top + (S_Rect.Bottom - S_Rect.Top- textheight(S_text)) div 2), S_text);
  end;
end;

//Dbgrid 位置
procedure pro_Align(DG : TDBGrid;Position : string);
var
  i : integer;
begin
  With DG do
  if Position = 'c' then
  for i := 0 to (Columns.Count - 1) do
  Columns[i].Title.Alignment := TACenter
  else if Position = 'l' then
  for i := 0 to (Columns.Count - 1) do
  Columns[i].Title.Alignment := taLeftJustify
  else if Position = 'r' then
  for i := 0 to (Columns.Count - 1) do
  Columns[i].Title.Alignment := taRightJustify;
end;

//求SerVer日期
Function FRL_ServerTime(ADOSvr:TADOConnection): String;
var
  AqrySvr:TADOQuery;
  GS_ServerTime : Tdatetime;
begin
 AqrySvr := TADOQuery.Create(nil);
 AqrySvr.Connection := ADOSvr;
 try
    with AqrySvr do
    begin
      Close;
      SQL.Clear;
      SQL.Add(' SELECT GETDATE() DATETIME ');
      Open;
      GS_ServerTime:=FieldByName('DATETIME').AsDateTime;
      Result:=FormatDateTime('yyyy-mm-dd hh:nn:ss',GS_ServerTime);
      Free;
    end;
  except
    Application.MessageBox('系统提取时间出错!','提示',Mb_OK+MB_IconInformation);
    Result := '';
    AqrySvr.Free;
  end;
end;

end.

⌨️ 快捷键说明

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