mainfrm.pas

程序用Delphi6编写

/////////////////////////////////////////////////////////////////
//                                                             //
//　1、『灵犀网管』是我去年年底写的一个网吧管理程序，后来事务  //
//　繁忙，一直没功夫继续写下去。                               //
//　2、程序用Delphi6编写，用到了两个第三方控件RxLib、EhLib。   //
//　3、这里是全部的源代码，Client端和Server端的一部分功能还没  //
//　写，有兴趣的朋友不妨把它写完。                             //
//　                                                           //
//　                              黎长波                       //
//　                              2002.5.26                    //
//　                              [e-mail]             //
//                                                             //
/////////////////////////////////////////////////////////////////

unit MainFrm;
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, Buttons, Menus, Grids, DBGridEh, ExtCtrls, StdCtrls,
  user, ActnList, ImgList, Registry, DBCtrls, DateUtils, Variants;

type
  TTimeSect = record
    Index: Integer;
    BeginTime: TDateTime;
    EndTime: TDateTime;
    Length: TDateTime;
    NetMoney: Double;
    TongXiao: Boolean;
  end;
  TSectMoneyAndTime = record
    Money: Double;
    Time: Double;
  end;
  TInSectState = (ssAllIn, ssTwoPortIn, ssBeginIn, ssEndIn, ssAllOut, ssInclude);
  TFjResult = (frSp, frNet, frAll);
  TTimeSectArray = array[1..5] of TTimeSect;
  TEachSectMoney = array[1..5] of Double;
  //*************以上为自定义类型****************
  TfrmMain = class(TForm)
    mmMain: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N4: TMenuItem;
    StatusBar1: TStatusBar;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ActionList1: TActionList;
    actBeginComputer: TAction;
    actEndComputer: TAction;
    N5: TMenuItem;
    ImageList1: TImageList;
    actConfigID: TAction;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N6: TMenuItem;
    N10: TMenuItem;
    N3: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N37: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    N41: TMenuItem;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton6: TToolButton;
    N42: TMenuItem;
    actEditMoney: TAction;
    actSwapComputer: TAction;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    N43: TMenuItem;
    N44: TMenuItem;
    N45: TMenuItem;
    N46: TMenuItem;
    N47: TMenuItem;
    N48: TMenuItem;
    N49: TMenuItem;
    Panel2: TPanel;
    Panel1: TPanel;
    pnlInfo: TPanel;
    Panel4: TPanel;
    pnlNote: TPanel;
    Splitter1: TSplitter;
    Panel6: TPanel;
    Panel7: TPanel;
    DBGridEhMain: TDBGridEh;
    Panel9: TPanel;
    Panel8: TPanel;
    Splitter2: TSplitter;
    ToolButton5: TToolButton;
    ToolButton10: TToolButton;
    ToolButton12: TToolButton;
    ToolButton11: TToolButton;
    Timer1: TTimer;
    N35: TMenuItem;
    N36: TMenuItem;
    N40: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    PopupMenu1: TPopupMenu;
    N30: TMenuItem;
    N50: TMenuItem;
    N51: TMenuItem;
    N53: TMenuItem;
    N54: TMenuItem;
    N55: TMenuItem;
    actFuJia: TAction;
    Panel10: TPanel;
    Memo1: TMemo;
    N21: TMenuItem;
    N22: TMenuItem;
    ToolButton13: TToolButton;
    actClear: TAction;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    N31: TMenuItem;
    N23: TMenuItem;
    procedure actConfigIDExecute(Sender: TObject);
    procedure actBeginComputerExecute(Sender: TObject);
    procedure actEndComputerExecute(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure actEditMoneyExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ShowHyForm(Sender: TObject);
    procedure ShowSpForm(Sender: TObject);
    procedure ShowConfigForm(Sender: TObject);
    procedure Splitter2Moved(Sender: TObject);
    procedure actFuJiaExecute(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure actClearExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure actSwapComputerExecute(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    procedure SetPanel8;
    procedure OpenNote;

    function CheckToday(ADate: TDate): Boolean;
  public
    { Public declarations }
    procedure DelAllComputer;
    procedure SetComputerNo(No: Integer);
    procedure EnableControl;
    procedure BeginComputer(XianShi: TTime; YaJin: Double;
      BeiZhu: string); overload; 
    procedure BeginComputer(KaHao: string; XianShi: TTime; YaJin: Double;
      BeiZhu: string); overload;
    procedure SetTongxiao(var Youhui: TTimeSect; const Tongxiao: TTimeSect);
    procedure Taxis(var ATimeSect: TTimeSect; var BTimeSect: TTimeSect); // 对时段按开始时间进行排序，并且将时段长度为0的放到后面。
    procedure TaxisTheTimeSectArray; //对TheTimeSectArray实际执行排序。
    procedure SetLength; //设置时段长度。
    procedure EndComputer;
    //procedure TxTrim(var Youhui: TTimeSect; const Tongxiao: TTimeSect);
    procedure DecodeMoney(ABeginTime, AEenTime: TDateTime; var APt, AYh, ATx: Double; IsTx: Boolean);
    procedure MyRound(var Money: Double); //几舍几入。
    procedure GetFjMoney(const ComputerID: Integer;
      var SpMoney, NetMoney: Double);
    procedure PutIntoAccount(ANetMoney, AFjMoney: Double; ADate: TDate);
    procedure ClearRecord;
    procedure SetHyCardMoney(const ID: string; Money: Double);
    procedure SetInfoPanel;

    function GetHyCardMoney(const ID: string): Double;
    function EncodeMoney(APt, AYh, ATx: Double; IsHy: Boolean): Double;
    function DateTimeToChinesStr(ADateTime: TDateTime): string;
    function GetTimes(ABeginTime, AEndTime: TDateTime): TDateTime;
    function GetMoney(ATimes, AFeilu: Double): Double;
    function InSect(ATime, ASectBegin, ASectEnd: TDateTime): Boolean; //针对24小时内的情况。
    function InSectState(ABeginTime, AEndTime: TDateTime; ATimeSect: TTimeSect): TInSectState;
    function InSectTimes(ABeginTime, ATimeLength: Double; ATimeSect: TTimeSect): TDateTime;
    function EachSectMoney(ABeginTime, AEndTime: TDateTime): TEachSectMoney;
    function InTongxiao(ATime: TDateTime; ATongxiaoSect: TTimeSect): Boolean;
    function BuildTimeSect(ATongXiao: Boolean): TTimeSectArray;
    function JiFei(AStartTime, AEndTime: TDateTime;
      AFeilu, AZDSF, ARound: Double): Double;
    function IsHuiyan(ID: string): Boolean; overload;
    function IsHuiyan(ID: string; PassWord: string): Boolean; overload;
    function NetMoney(BeginTime, EndTime: TDateTime; TongXiao: Boolean): Double; overload;
    function NetMoney(BeginTime, EndTime: TDateTime; TongXiao: Boolean; UserID: string): Double; overload;
  end;

var
  frmMain: TfrmMain;
  TheTimeSectArray: TTimeSectArray;

implementation

uses MainDM, HyFrm, Bar, DB, AddHyFrm, StartComputerFrm,
  FuJiaFrm, SpFrm, ConfigFrm, JieZhangFrm, ADODB, MrjsFrm, SpNumFrm,
  AboutFrm;


{$R *.DFM}


{ TfrmMain }

procedure TfrmMain.DelAllComputer;
begin
  with dmMain.tblMain do
  begin
    while not Eof do
    begin
      Delete;
    end;
  end;
end;



procedure TfrmMain.actConfigIDExecute(Sender: TObject);
begin
  with dmMain.qryForAll do
  begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT 上机时间 FROM 计费 WHERE 上机时间<>NULL');
    Open;
  end;
  //if MessageDlg('此操作将清空当前所有的上机记录，要执行此操作吗？'
  //  , mtWarning, [mbYes, mbNo], 0) = mrYes then
  if dmMain.qryForAll.Eof then
  begin
    frmSpNum := TfrmSpNum.Create(Self);
    try
      frmSpNum.Caption := '设置电脑数目';
      frmSpNum.SpinEdit1.MaxValue := 999;
      if frmSpNum.ShowModal = mrOk then
      begin
        Screen.Cursor := crHourGlass;
        dmMain.tblMain.DisableControls;
        DelAllComputer;
        SetComputerNo(frmSpNum.SpinEdit1.Value);
        dmMain.tblMain.EnableControls;
        dmMain.tblMain.Refresh;
      end;
    finally
      Screen.Cursor := crDefault;
      frmSpNum.Free;
    end;
  end
  else
    ShowMessage('当前有用户正在上机，请清除后再设置！');
end;

procedure TfrmMain.SetComputerNo(No: Integer);
var
  K: Integer;
begin

  with dmMain.tblMain do
  begin
    begin
      for K := 1 to No do
      begin
        Append;
        FieldByName('机号').Value := K;
      end;
    end;
    Post;
  end;
end;


procedure TfrmMain.actBeginComputerExecute(Sender: TObject);
begin
  frmStartComputer := TfrmStartComputer.Create(Self);
  try
    if frmStartComputer.ShowModal = mrOK then
      frmStartComputer.StartComputer;
  finally
    frmStartComputer.Free;
  end;
end;

procedure TfrmMain.actEndComputerExecute(Sender: TObject);
const
  RMB = '￥';
var
  BeginDateTime, EndDateTime, AllDateTime: TDateTime;
  PtMoney, YhMoney, TxMoney, AllNetMoney: Double;
  FjSpMoney, FjNetMoney, FjAllMoney: Double;
  YjMoney {压金}, YsMoney {应收}: Double;
  HyCard: string;
  isTx: Boolean;
  isHy: Boolean;
  ComputerID: Integer;
begin
  dmMain.tblMain.Edit;
  dmMain.tblMain.FieldByName('下机时间').AsDateTime := Now;
  BeginDateTime := dmMain.tblMain.FieldByName('上机时间').AsDateTime;
  EndDateTime := dmMain.tblMain.FieldByName('下机时间').AsDateTime;
  YjMoney := dmMain.tblMain.FieldByName('压金').AsFloat;
  AllDateTime := EndDateTime - BeginDateTime;
  isTx := dmMain.tblMain.FieldByName('通宵').AsBoolean;
  HyCard := dmMain.tblMain.FieldByName('卡号').AsString;
  if HyCard <> '' then
    isHy := True
  else
    isHy := False;
  ComputerID := dmMain.tblMain.FieldByName('机号').AsInteger;
  DecodeMoney(BeginDateTime, EndDateTime, PtMoney, YhMoney, TxMoney, isTx);
  AllNetMoney := EncodeMoney(PtMoney, YhMoney, TxMoney, isHy);
  //FjMoney:=GetFjMoney(ComputerID);
  MyRound(AllNetMoney);
  GetFjMoney(ComputerID, FjSpMoney, FjNetMoney);
  FjAllMoney := FjSpMoney + FjNetMoney;
  YsMoney := AllNetMoney + FjAllMoney - YjMoney;

  //对frmJz初始化。
  frmJz := TfrmJz.Create(Self);
  //frmJz.lblBegin.Caption := DateToStr(BeginDateTime);
  //frmJz.lblEnd.Caption := DateToStr(EndDateTime);
  frmJz.lblTimeAll.Caption := DateTimeToChinesStr(AllDateTime);
  frmJz.lblNetMoney.Caption := RMB + FormatFloat('0.00', AllNetMoney);
  frmJz.lblFjMoney.Caption := RMB + FormatFloat('0.00', FjAllMoney);
  frmJz.lblYsMoney.Caption := RMB + FormatFloat('0.00', YsMoney);
  frmJz.lblCardMoney.Caption := RMB + FormatFloat('0.00', GetHyCardMoney(HyCard));
  if IsHy then
    frmJz.CheckBox1.Enabled := False;

  if frmJz.ShowModal = mrOk then
  begin
    dmMain.tblMain.FieldByName('网费').AsCurrency := AllNetMoney;
    dmMain.tblMain.Post;
    if (frmJz.CheckBox1.Checked = true) and (frmJz.ComboBox1.Text <> '') then
    begin
      with dmMain.tblSpBuy do
      begin
        Append;
        FieldByName('机号').Value := StrToInt(frmJz.ComboBox1.Text);
        FieldByName('品名').Value := IntToStr(ComputerID) + '号机费用';
        FieldByName('售价').Value := AllNetMoney + FjAllMoney;
        FieldByName('数量').Value := 1;
        FieldByName('类型').Value := False;
        Post;
      end;
    end;
    if AutoClear then ClearRecord;
  end
  else
    dmMain.tblMain.Cancel;
end;

procedure TfrmMain.EnableControl;
begin

end;

procedure TfrmMain.N35Click(Sender: TObject);
begin
  frmHy.ShowModal;
end;

procedure TfrmMain.ToolButton1Click(Sender: TObject);
begin
  frmHy.ShowModal
end;

function TfrmMain.JiFei(AStartTime, AEndTime: TDateTime; AFeilu,
  AZDSF, ARound: Double): Double;
var
  AllDate: TDateTime;
  AllHour: TDateTime;
  ShouFei: Double;
begin
  AllDate := AEndTime - AStartTime;
  AllHour := 24 * AllDate;
  ShouFei := FeiLu;
end;

procedure TfrmMain.actEditMoneyExecute(Sender: TObject);
begin