pawn.~pa

一个典当行的业务管理系统程序

unit Pawn;

interface


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, ToolWin, ComCtrls, ImgList;

type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    mnuPawn: TMenuItem;
    mnuStatic: TMenuItem;
    mnuNewPawnInput: TMenuItem;
    mnuQuit: TMenuItem;
    mnuStockpile: TMenuItem;
    mnuMaintain: TMenuItem;
    mnuDataComm: TMenuItem;
    mnuReport: TMenuItem;
    mnuHelp: TMenuItem;
    mnuExit: TMenuItem;
    mnuAbout: TMenuItem;
    mnuSend: TMenuItem;
    mnuReceive: TMenuItem;
    Image1: TImage;
    mnuOperCode: TMenuItem;
    mnuGoddsSpec: TMenuItem;
    mnuCerName: TMenuItem;
    mnuDataClear: TMenuItem;
    mnuDataBackup: TMenuItem;
    N1: TMenuItem;
    mnuBuy: TMenuItem;
    mnuOtherBuy: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    mnuDayReport: TMenuItem;
    mnuMonthReport: TMenuItem;
    mnuRePawnInput: TMenuItem;
    mnuPawnModify: TMenuItem;
    mnuPawnQuery: TMenuItem;
    mnuPawnLost: TMenuItem;
    mnuPawnFind: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    mnuPawnTime: TMenuItem;
    mnuDelete: TMenuItem;
    mnuConverDead: TMenuItem;
    N7: TMenuItem;
    N4: TMenuItem;
    mnuHandleS: TMenuItem;
    mnuCode: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    mnuRatesetup: TMenuItem;
    procedure mnuExitClick(Sender: TObject);
    procedure mnuNewPawnInputClick(Sender: TObject);
    procedure mnuBuyClick(Sender: TObject);
    procedure mnuQuitClick(Sender: TObject);
    procedure mnuStockpileClick(Sender: TObject);
    procedure mnuMoneyStatClick(Sender: TObject);
    procedure mnuRePawnInputClick(Sender: TObject);
    procedure mnuPawnQueryClick(Sender: TObject);
    procedure mnuDeleteClick(Sender: TObject);
    procedure mnuPawnLostClick(Sender: TObject);
    procedure mnuPawnFindClick(Sender: TObject);
    procedure mnuPawnModifyClick(Sender: TObject);
    procedure mnuOtherBuyClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuTimeLimitClick(Sender: TObject);
    procedure mnuDayReportClick(Sender: TObject);
    procedure mnuOperCodeClick(Sender: TObject);
    procedure mnuGoddsSpecClick(Sender: TObject);
    procedure mnuConverDeadClick(Sender: TObject);
    procedure mnuCodeClick(Sender: TObject);
    procedure mnuCerNameClick(Sender: TObject);
    procedure mnuPawnTimeClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure mnuDataBackupClick(Sender: TObject);
    procedure mnuDataClearClick(Sender: TObject);
    procedure mnuMonthReportClick(Sender: TObject);
    procedure mnuHandleSClick(Sender: TObject);
    procedure mnuRatesetupClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    //procedure HandleException(Sender:Tobject;E:Exception);
    Function MaxCode:string;
    Function CodePlus(Code:string):string;
  end;

var
  frmMain: TfrmMain;
implementation

uses PawnInput, Stockpile, Login,Ransom, PawnMaintain,StockMoney,
  RepawnInput,PawnQuery, PawnModify,Handle, DmPawn, Msg, DeadLimitSet,
  DayReport, OperCode, Category, ConverDead, SetCode, GlobalVar,
  Certificate, ConfirmDate, SetLimit, DataBackup, DataClear, MonthReport,
  THandle;

{$R *.DFM}
Function TfrmMain.CodePlus(Code:String):string;
var
   HeadLen,TailLen,I,TempLen:integer;
   HeadCode,TailCode,tempTail:string;
   TempCode:longint;
begin
     HeadLen:=length(GlobalVar.gHeadCode);
     TailLen:=length(GlobalVar.gTailCode);
     HeadCode:=Code;
     TailCode:=Code;
     //防止当前的编号尾部编号的长度大于设置的尾部编号的长度
     tempTail:=Code;
     Delete(tempTail,1,HeadLen);
     TempLen:=length(tempTail);
     if TempLen>TailLen then
     begin
          TailLen:=TempLen;
     end;
     //  ------------------------------
     Delete(HeadCode,HeadLen+1,TailLen);
     I:=CompareStr(HeadCode,GlobalVar.gHeadCode);
     if I=0 then
     begin
          Delete(TailCode,1,HeadLen);
          TempCode:=strtoint(TailCode);
          TempCode:=TempCode+1;
          TailCode:=inttostr(TempCode);
          CodePlus:=HeadCode+TailCode;
     end
     else
         CodePlus:=GlobalVar.gHeadCode+GlobalVar.gTailCode;
end;

Function TfrmMain.MaxCode:string;
var
   HeadLen:integer; //TailLen:integer;
   Sql:string;
   sNowTailCode:string;
   cTempCode,cNowTailCode:longint;
begin

     HeadLen:=length(GlobalVar.gHeadCode);
     //TailLen:=length(GlobalVar.gTailCode);
     cTempCode:=0;
     Sql:='SELECT PawnTicketCode FROM PawnHead_Tbl ';
     Sql:=Sql+ 'WHERE PawnTicketCode like '''+GlobalVar.gHeadCode + '%'+''';';
     with dmPawnFrm do
     begin
          dqHeadUn.Close;
          dqHeadUn.SQL.Clear;
          dqHeadUn.SQl.Add(Sql);
          dqHeadUn.Open;
          if dqHeadUn.IsEmpty=False then
          begin
               dqHeadUn.First;
               while not dqHeadUn.Eof do
               begin
                    sNowTailCode:=dqHeadUn.FieldByName('PawnTicketCode').asstring;
                    //取出尾部编号
                    Delete(sNowTailCode,1,HeadLen);
                    cNowTailCode:=strtoint(sNowTailCode);
                    if cNowTailCode>cTempCode then
                    begin
                       //sTempCode:=sNowTailCode;
                       cTempCode:=cNowTailCode;
                    end;
                    dqHeadUn.Next;
               end;
               MaxCode:=GlobalVar.gHeadCode+inttostr(cTempCode);
          end
          else
              MaxCode:='';

     end;
end;


{procedure TfrmMain.HandleException(Sender:Tobject;E:Exception);
   //ErrorMessage:string;
begin
     //exit;
     Application.ShowException(E);
     {
    // writeToHistoryFile(ExceptionFileName,'PC-Name:'+ComputerName);
     if Sender is Tcomponent then
        ErrorMessage:=Format('%s-%s',[Tcomponent(Sender).Name,E.Message])
     else
         ErrorMessage:=Format('%s-%s',[Sender.ClassName,E.Message]);
   //  writeToHistoryFile(ExceptionFileName,ErrorMessage);
   }
//end;

procedure TfrmMain.mnuExitClick(Sender: TObject);
begin
     if MessageDlg(Msg.MsgWelcomeQuit,
        mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        begin
             //close;
             dmPawnFrm.Database.Close ;
            PostMessage(self.Handle,WM_Close,0,0);
        end;
end;

procedure TfrmMain.mnuNewPawnInputClick(Sender: TObject);
var
   frmConfirmDate:TfrmConfirmDate;
   frmPawnInput:TfrmPawnInput;
begin
     frmConfirmDate:=TfrmConfirmDate.Create(nil);
     frmConfirmDate.ShowModal;
     frmConfirmDate.Free;
     //进入新当
     frmPawnInput:=TfrmPawnInput.create(nil);
     //取出当票头尾编号
     with dmPawnFrm do
     begin
          tblTicketCode.Open;
          GlobalVar.gHeadCode:=tblTicketCodeHeadCode.AsString;
          GlobalVar.gTailCode:=tblTicketCodeTailCode.AsString;
          tblTicketCode.Close;
          if (GlobalVar.gHeadCode='') or
             (GlobalVar.gTailCode='') then
          begin
               messagedlg(Msg.MsgSetTicketCode,mtwarning,[mbYes],0);
               exit;
          end;
     end;
     frmPawnInput.ShowModal;
     frmPawnInput.free;
end;

procedure TfrmMain.mnuBuyClick(Sender: TObject);
var
   frmRansom:TfrmRansom;
begin
     frmRansom:=TfrmRansom.create(nil);
     frmRansom.showmodal;
     frmRansom.free;
end;

procedure TfrmMain.mnuQuitClick(Sender: TObject);
begin
     mnuExitClick(sender);
end;

procedure TfrmMain.mnuStockpileClick(Sender: TObject);
var
   frmstockpile:Tfrmstockpile;
begin
     frmstockpile:=Tfrmstockpile.Create (nil);
     frmstockpile.showmodal;
     frmstockpile.Free;
end;

procedure TfrmMain.mnuMoneyStatClick(Sender: TObject);
var
   frmStockMoney:TfrmStockMoney;
begin
     frmStockMoney:=TfrmStockMoney.create(nil);
     frmStockMoney.showmodal;
     frmStockMoney.free;
end;

procedure TfrmMain.mnuRePawnInputClick(Sender: TObject);
var
   frmRePawnInput:TfrmRePawnInput;
begin
     frmRePawnInput:=TfrmRePawnInput.Create (nil);
     //取出当票头尾编号
     with dmPawnFrm do
     begin
          tblTicketCode.Open;
          GlobalVar.gHeadCode:=tblTicketCodeHeadCode.AsString;
          GlobalVar.gTailCode:=tblTicketCodeTailCode.AsString;
          tblTicketCode.Close;
          if (GlobalVar.gHeadCode='') or
             (GlobalVar.gTailCode='') then
          begin
               messagedlg(Msg.MsgSetTicketCode,mtwarning,[mbYes],0);
               exit;
          end;
     end;
     frmRePawnInput.showmodal;
     frmRePawnInput.free;
end;

procedure TfrmMain.mnuPawnQueryClick(Sender: TObject);
var
   frmPawnQuery:TfrmPawnQuery;
begin
     frmPawnQuery:=TfrmPawnQuery.Create (nil);
     frmPawnQuery.cmdDelete.Visible:=False;
     frmPawnQuery.cmdLost.Visible :=False;
     frmPawnQuery.cmdFind.Visible :=False;
     frmPawnQuery.showmodal;
     frmPawnQuery.free;
end;

procedure TfrmMain.mnuDeleteClick(Sender: TObject);
var
   frmPawnQuery:TfrmPawnQuery;
begin
     frmPawnQuery:=TfrmPawnQuery.Create (nil);
     frmPawnQuery.cmdLost.Visible :=False;
     frmPawnQuery.cmdFind.Visible :=False;
     //frmPawnQuery.dgDetail.DataSource:=dmPawnFrm.dsQueryDetailUn ;
     frmPawnQuery.showmodal;
     frmPawnQuery.free;
end;

procedure TfrmMain.mnuPawnLostClick(Sender: TObject);
var
   frmPawnQuery:TfrmPawnQuery;
begin
     frmPawnQuery:=TfrmPawnQuery.Create (nil);
     frmPawnQuery.cmdDelete.Visible :=False;
     frmPawnQuery.cmdFind.Visible :=False;
     frmPawnQuery.showmodal;
     frmPawnQuery.free;
end;

procedure TfrmMain.mnuPawnFindClick(Sender: TObject);
var
   frmPawnQuery:TfrmPawnQuery;
begin
     frmPawnQuery:=TfrmPawnQuery.Create (nil);
     frmPawnQuery.cmdDelete.Visible :=False;
     frmPawnQuery.cmdLost.Visible :=False;
     frmPawnQuery.showmodal;
     frmPawnQuery.free;
end;

procedure TfrmMain.mnuPawnModifyClick(Sender: TObject);
var
   frmPawnModify:TfrmPawnModify;
begin
     frmPawnModify:=TfrmPawnModify.Create (nil);
     frmPawnModify.showmodal;
     frmPawnModify.free;
end;

procedure TfrmMain.mnuOtherBuyClick(Sender: TObject);
var
   frmHandle:TfrmHandle;
begin
     frmHandle:=TfrmHandle.Create (nil);
     frmHandle.showmodal;
     frmHandle.free;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
     //Application.OnException:=HandleException;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     Action := caFree;
end;

procedure TfrmMain.mnuTimeLimitClick(Sender: TObject);
var
   frmDeadLimit:TfrmDeadLimit;
begin
     frmDeadLimit:=TfrmDeadLimit.Create(nil);
     frmDeadLimit.showmodal;
     frmDeadLimit.Free;
end;

procedure TfrmMain.mnuDayReportClick(Sender: TObject);
var
   frmDayReport:TfrmDayReport;
begin
     frmDayReport:=TfrmDayReport.Create(nil);
     frmDayReport.ShowModal ;
     frmDayReport.Free;
end;

procedure TfrmMain.mnuOperCodeClick(Sender: TObject);
var
   frmOperCode:TfrmOperCode;
begin
     frmOperCode:=TfrmOperCode.Create(nil);
     frmOperCode.ShowModal;
     frmOperCode.Free;
end;

procedure TfrmMain.mnuGoddsSpecClick(Sender: TObject);
var
   frmCategory:TfrmCategory;
begin
     frmCategory:=TfrmCategory.Create(nil);
     frmCategory.ShowModal;
     frmCategory.Free;
end;

procedure TfrmMain.mnuConverDeadClick(Sender: TObject);
var
   frmConverDead:TfrmConverDead;
begin
     frmConverDead:=TfrmConverDead.Create(nil);
     frmConverDead.showmodal;
     frmConverDead.Free;
end;

procedure TfrmMain.mnuCodeClick(Sender: TObject);
var
   frmSetCode:TfrmSetCode;
begin
     frmSetCode:=TfrmSetCode.Create(nil);
     frmSetCode.ShowModal;
     frmSetCode.Free;
end;

procedure TfrmMain.mnuCerNameClick(Sender: TObject);
var
   frmCertificate:TfrmCertificate;
begin
     frmCertificate:=TfrmCertificate.Create(nil);
     frmCertificate.ShowModal;
     frmCertificate.Free;
end;

procedure TfrmMain.mnuPawnTimeClick(Sender: TObject);
var
   frmSetLimit:TfrmSetLimit;
begin
     frmSetLimit:=TfrmSetLimit.Create(nil);
     frmSetLimit.ShowModal;
     frmSetLimit.Free;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
     //取出典当期限
     with dmPawnFrm do
     begin
          tblPawnLimit.Open;
          if tblPawnLimitLimitCode.IsNull then
          begin
               GlobalVar.PawnLimit:=3;
          end;
          GlobalVar.PawnLimit:=tblPawnLimitLimitCode.Value;
          tblPawnLimit.Close;
     end;
end;

procedure TfrmMain.mnuDataBackupClick(Sender: TObject);
var
   frmDataBackup:TfrmDataBackup;
begin
     frmDataBackup:=TfrmDataBackup.Create(nil);
     frmDataBackup.ShowModal;
     frmDataBackup.Free;
end;

procedure TfrmMain.mnuDataClearClick(Sender: TObject);
var
   frmDataClear:TfrmDataClear;
begin
     frmDataClear:=TfrmDataClear.Create(nil);
     frmDataClear.ShowModal;
     frmDataClear.Free;
end;

procedure TfrmMain.mnuMonthReportClick(Sender: TObject);
var
   frmMonthRep: TfrmMonthRep;
begin
     frmMonthRep:=TfrmMonthRep.Create(nil);
     frmMonthRep.ShowModal;
     frmMonthRep.Free;
end;

procedure TfrmMain.mnuHandleSClick(Sender: TObject);
var
   frmSHandle:TfrmSHandle;
begin
     frmSHandle:=TfrmSHandle.Create(nil);
     frmSHandle.ShowModal;
     frmSHandle.Free;
end;

procedure TfrmMain.mnuRatesetupClick(Sender: TObject);
var
   frmRateSetup:TfrmRateSetup;
begin
     frmRateSetup:=TfrmRateSetup.Create(nil);
     frmRateSetup.ShowModal;
     frmRateSetup.Free;
end;

end.