calmoney.pas

一个售楼系统

Unit CalMoney;

Interface

Uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, ExtCtrls, ComCtrls, Math, Mask, DateUtils,
   DBCtrlsEh, Grids, DBGridEh, DB, ADODB, Buttons, ACReportClass,
   EhLibAdo, DBGridEhImpExp, LbButton;

Type
   TCalForm = Class(TForm)
      PageControl1: TPageControl;
      TabSheet2: TTabSheet;
      TabSheet3: TTabSheet;
      Label1: TLabel;
      Edit1: TEdit;
      Label2: TLabel;
      Edit2: TEdit;
      Bevel1: TBevel;
      Label3: TLabel;
      Edit3: TEdit;
      Label4: TLabel;
      Edit4: TEdit;
      Label5: TLabel;
      Edit5: TEdit;
      Label6: TLabel;
      Edit6: TEdit;
      Label7: TLabel;
      Edit7: TEdit;
      StaticText1: TStaticText;
      Label8: TLabel;
      Edit8: TEdit;
      Label9: TLabel;
      Edit9: TEdit;
      Label10: TLabel;
      Label11: TLabel;
      combobox1: TComboBox;
      Bevel2: TBevel;
      Label32: TLabel;
      Label33: TLabel;
      ComboBox2: TComboBox;
      ComboBox3: TComboBox;
      StaticText2: TStaticText;
      Label12: TLabel;
      Edit10: TEdit;
      Label13: TLabel;
      Edit11: TEdit;
      Label14: TLabel;
      Edit12: TEdit;
      Label15: TLabel;
      Edit13: TEdit;
      Label16: TLabel;
      Edit14: TEdit;
      Label18: TLabel;
      Edit15: TEdit;
      radiogroup1: TRadioGroup;
      Label30: TLabel;
      Label38: TLabel;
      Edit17: TEdit;
      StaticText3: TStaticText;
      Edit16: TEdit;
      Edit18: TEdit;
      Edit19: TEdit;
      Edit20: TEdit;
      Edit21: TEdit;
      Edit22: TEdit;
      Edit23: TEdit;
      Label20: TLabel;
      Label21: TLabel;
      StaticText5: TStaticText;
      Label22: TLabel;
      DBDateTimeEditEh1: TDBDateTimeEditEh;
      GroupBox1: TGroupBox;
      ADOQuery1: TADOQuery;
      DataSource1: TDataSource;
      DBGridEH1: TDBGridEh;
      StaticText10: TStaticText;
      StaticText4: TStaticText;
      Panel1: TPanel;
      BitBtn5: TBitBtn;
      AcReport1: TAcReport;
      BitBtn6: TBitBtn;
      BitBtn18: TBitBtn;
      SaveDialog1: TSaveDialog;
      LbButton1: TLbButton;
      LbButton2: TLbButton;
      LbButton3: TLbButton;
      LbButton4: TLbButton;
      Procedure FillDenEr(Money, MLL: double; Months: integer; MDate: TDate);
      Procedure FillDiJian(Money, MLL: double; Months: integer; MDate: TDate);
      Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
      Procedure ComboBox2KeyPress(Sender: TObject; Var Key: char);
      Procedure ComboBox2Change(Sender: TObject);
      Procedure ComboBox1KeyPress(Sender: TObject; Var Key: char);
      Procedure Edit20Change(Sender: TObject);
      Procedure RadioGroup1Click(Sender: TObject);
      Procedure Edit17Change(Sender: TObject);
      Procedure Button5Click(Sender: TObject);
      Procedure FormCreate(Sender: TObject);
      Procedure Edit8Change(Sender: TObject);
      Procedure ComboBox1Change(Sender: TObject);
      Procedure BitBtn5Click(Sender: TObject);
      Procedure BitBtn6Click(Sender: TObject);
      Procedure BitBtn18Click(Sender: TObject);
      Procedure Edit12Change(Sender: TObject);
      Procedure LbButton1Click(Sender: TObject);
      Procedure LbButton2Click(Sender: TObject);
      Procedure LbButton3Click(Sender: TObject);
      Procedure LbButton4Click(Sender: TObject);
   Private
        { Private declarations }
   Public
        { Public declarations }
   End;

Var
   CalForm          : TCalForm;

Implementation
Uses CALMoneyx, DM, PUBFunction;
{$R *.dfm}

Procedure TCalForm.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
   With ADOQuery1 Do Begin
      Close;
      sql.Text := 'delete from 按揭计算明细表';
      ExecSQL;
   End;
   Action := cafree;
   CalForm := Nil;
End;

Procedure TCalForm.ComboBox2KeyPress(Sender: TObject; Var Key: char);
Begin
   If Not (Key In ['0'..'9', #8, #13]) Then Key := #0;
End;

Procedure TCalForm.ComboBox2Change(Sender: TObject);
Var
   year, month      : integer;
Begin
   year := StrToIntDef(ComboBox2.Text, 0);
   month := StrToIntDef(ComboBox3.Text, 0);
   If month > 12 Then Begin
      month := 12;
      ComboBox3.Text := '12';
   End;
   StaticText2.Caption := IntToStr(year * 12 + month);
End;

Procedure TCalForm.ComboBox1KeyPress(Sender: TObject; Var Key: char);
Begin
   Key := #0;
End;

Procedure TCalForm.Edit20Change(Sender: TObject);
Begin
   Edit22.Text := Edit20.Text;
End;

Procedure TCalForm.RadioGroup1Click(Sender: TObject);
Begin
   GroupBox1.Visible := radiogroup1.ItemIndex = 1;
End;

Procedure TCalForm.Edit17Change(Sender: TObject);
Var
   F                : double;
Begin
   F := STRTOFLOATDEF(Edit17.Text, 0);
   F := F * 1.2;
   StaticText5.Caption := FloatToStr(F);
End;

Procedure TCalForm.Button5Click(Sender: TObject);
Begin
    //
End;

Procedure TCalForm.FormCreate(Sender: TObject);
Begin
   DBDateTimeEditEh1.Text := FormatDateTime('yyyy-mm-dd', Now);
   RadioGroup1Click(self);
End;

Procedure TCalForm.FillDiJian(Money, MLL: double; Months: integer; MDate:
   TDate);
Var
   i                : integer;
   MYE, MBJ, MLC, MBJLC: double;

Begin
    // dbgrideh1.DataSource :=nil;
   With ADOQuery1 Do Begin
      Close;
      sql.Text := 'DELETE FROM 按揭计算明细表';
      ExecSQL;
      Close;
      sql.Text := 'SELECT * FROM 按揭计算明细表';
      open;
      MYE := Money;
      For i := 1 To Months Do Begin
         MBJLC := GetMoneyDJ(Money, MLL, Months, i, MBJ, MLC);
         Append;
         fieldbyname('序数').AsInteger := i;
         fieldbyname('缴费日期').AsDateTime := MDate;
         fieldbyname('应缴本金').AsFloat := MBJ;
         fieldbyname('应缴利息').AsFloat := MLC;
         fieldbyname('本利合计').AsFloat := MBJLC;

         fieldbyname('按揭余额').AsFloat := MYE;
         MYE := roundto(MYE - MBJ, -2);
         MDate := GetNextMonths(MDate, 1);
         post;
      End;
   End;

End;

Procedure TCalForm.FillDenEr(Money, MLL: double; Months: integer;
   MDate: TDate);
Begin
   With ADOQuery1 Do Begin
      Close;
      sql.Text := 'DELETE FROM 按揭计算明细表';
      ExecSQL;
      Close;
      sql.Text := 'SELECT * FROM 按揭计算明细表';
      open;
   End;
End;

Procedure TCalForm.Edit8Change(Sender: TObject);
Var
   total, moneyx, area: double;
Begin
   area := STRTOFLOATDEF(Edit9.Text, 0); //面积
   moneyx := STRTOFLOATDEF(Edit8.Text, 0); //单价
   total := moneyx * area;              //总价
   Edit10.Text := FloatToStr(total);
End;

Procedure TCalForm.ComboBox1Change(Sender: TObject);
Var
   temp             : String;
   CS, total, dk, zfd: double;
Begin
   temp := Copy(combobox1.Text, 0, 1);
   CS := StrToIntDef(temp, 0);          //成数
   If CS = 0 Then Begin
      Edit11.Text := '';
      Edit12.Text := '';
      //Edit11.Color:=$FFFFFF;
      Edit12.Color := $FFFFFF;
      Edit12.SetFocus;
      Exit;
   End Else Begin
      total := STRTOFLOATDEF(Edit10.Text, 0);
      dk := roundto(total * CS * 0.1, -2); //贷款=总价*成数*10/100;
      zfd := total - dk;                //自付款
      Edit11.Text := FloatToStr(dk);
      Edit12.Text := FloatToStr(zfd);
      //Edit11.Color:=clBtnFace;
      Edit12.Color := clBTNFACE;
   End;
End;

Procedure TCalForm.BitBtn5Click(Sender: TObject);
Var
   CURRDIR          : String;
Begin
   CURRDIR := ExtractFilePath(Application.ExeName);
   If (Not ADOQuery1.Active) Then Exit;
   If (ADOQuery1.recordcount = 0) Then Exit;
   AcReport1.LoadFromFile(CURRDIR + 'CAL_DJF.APT');
   AcReport1.Print;
End;

Procedure TCalForm.BitBtn6Click(Sender: TObject);
Var
   CURRDIR          : String;
Begin
   CURRDIR := ExtractFilePath(Application.ExeName);
   If (Not ADOQuery1.Active) Then Exit;
   If (ADOQuery1.recordcount = 0) Then Exit;
   AcReport1.LoadFromFile(CURRDIR + 'CAL_DJF.APT');
   AcReport1.Preview;
End;

Procedure TCalForm.BitBtn18Click(Sender: TObject);
Var
   ExpClass         : TDBGridEhExportClass;
   Ext              : String;
Begin
   If (Not ADOQuery1.Active) Then Exit;
   If (ADOQuery1.recordcount = 0) Then Exit;
   SaveDialog1.FileName := 'file1';
   If SaveDialog1.Execute Then Begin
      Case SaveDialog1.FilterIndex Of
         1: Begin
               ExpClass := TDBGridEhExportAsText;
               Ext := 'txt'
            End;
         2: Begin
               ExpClass := TDBGridEhExportAsHTML;
               Ext := 'htm'
            End;
         3: Begin
               ExpClass := TDBGridEhExportAsXLS;
               Ext := 'xls'
            End;
      Else
         ExpClass := Nil;
         Ext := ''
      End;
      If ExpClass <> Nil Then Begin
         If UpperCase(Copy(SaveDialog1.FileName, Length(SaveDialog1.FileName)
            - 2, 3)) <>
            UpperCase(Ext) Then
            SaveDialog1.FileName := SaveDialog1.FileName + '.' + Ext;
         SaveDBGridEhToExportFile(ExpClass, DBGridEH1,
            SaveDialog1.FileName, true);
      End;
   End;

End;

Procedure TCalForm.Edit12Change(Sender: TObject);
Var
   temp             : String;
   CS, total, dk    : double;
Begin
   temp := Copy(combobox1.Text, 0, 1);
   CS := StrToIntDef(temp, 0);          //成数
   If CS = 0 Then Begin
      total := STRTOFLOATDEF(Edit10.Text, 0);
      dk := roundto(total - STRTOFLOATDEF(Edit12.Text, 0), 2);
      Edit11.Text := FloatToStr(dk);
   End;

End;

Procedure TCalForm.LbButton1Click(Sender: TObject);
Var
   LC, LL, total, dk, zfd, MonthMoney: double;
   CS, Months       : integer;
   DZED, DZBL, JGQS2, JGQS: double;
   temp             : String;
   i                : integer;
Begin

   temp := Copy(combobox1.Text, 0, 1);
   CS := StrToIntDef(temp, 0);          //成数
   Months := StrToIntDef(StaticText2.Caption, 0); //月数
   LL := STRTOFLOATDEF(Edit17.Text, 0) / 1000; //月利率
   total := STRTOFLOATDEF(Edit10.Text, 0);
   dk := STRTOFLOATDEF(Edit11.Text, 0); //贷款=总价*成数*10/100;
   MonthMoney := 0;
   If (LL = 0) Or (dk = 0) Then Begin
      Application.MessageBox('数据未填完整！无法继续计算！', '数据不全', MB_ICONERROR);
      Exit;
   End;

   Case radiogroup1.ItemIndex Of
      0: Begin
            MonthMoney := roundto(DEBX(dk, Months, LL), -2); //每月还款
            LC := roundto(MonthMoney * Months, -2); //总利息
            Edit13.Text := FloatToStr(MonthMoney);
            Edit14.Text := FloatToStr(LC);
            Edit15.Text := FloatToStr(roundto(LC - dk, -2));
         End;

      1: FillDiJian(dk, LL, Months, StrToDateDef(DBDateTimeEditEh1.Text,
            Now));
   End;

End;

Procedure TCalForm.LbButton2Click(Sender: TObject);
Begin
   With ADOQuery1 Do Begin
      Close;
      sql.Text := 'delete from 按揭计算明细表';
      ExecSQL;
   End;
   Edit8.Clear;
   Edit9.Clear;
   Edit10.Clear;
   Edit11.Clear;
   Edit12.Clear;
   Edit13.Clear;
   Edit14.Clear;
   Edit15.Clear;
   Edit17.Clear;
End;

Procedure TCalForm.LbButton3Click(Sender: TObject);
Var
   area, moneyx, total, temp: double;
   yhs, gzf, sxf    : double;
   b1, b2, LArea    : double;
Begin
   moneyx := STRTOFLOATDEF(Edit1.Text, 0);
   area := STRTOFLOATDEF(Edit2.Text, 0);
   yhs := STRTOFLOATDEF(Edit16.Text, 0) / 100;
   gzf := STRTOFLOATDEF(Edit18.Text, 0) / 100;
   total := area * moneyx;
   Edit3.Text := FloatToStr(total);
   temp := total * yhs;
   Edit4.Text := FloatToStr(temp);
   temp := total * gzf;
   Edit5.Text := FloatToStr(temp);

   LArea := STRTOFLOATDEF(Edit20.Text, 0);
   b1 := STRTOFLOATDEF(Edit19.Text, 0) / 100;
   b2 := STRTOFLOATDEF(Edit21.Text, 0) / 100;

   If area <= LArea Then
      temp := total * b1
   Else
      temp := total * b2;
   Edit6.Text := FloatToStr(temp);
   sxf := STRTOFLOATDEF(Edit23.Text, 0);
   temp := area * sxf;
   Edit7.Text := FloatToStr(temp);

End;

Procedure TCalForm.LbButton4Click(Sender: TObject);
Begin
   Edit1.Clear;
   Edit2.Clear;
   Edit3.Clear;
   Edit4.Clear;
   Edit5.Clear;
   Edit6.Clear;
   Edit7.Clear;
End;

End.