Next Chapter 45 MDI Form

PROJECT SOURCE CODE

SPONSORED LINKS

MDI Form

Private Sub MDIForm_Load()

Dim SleepDate As Date

Dim i As Integer

On Error GoTo ErHand

Expiry = True

frmSplash.lbl.Caption = "Loading Please Wait..."

frmSplash.lbl1.Caption = " "

SleepDate = Time

i = 100

For i = 10 To 1 Step -50

Call Sleep(SleepDate + 500 + Val(i))

DoEvents

frmSplash.lbl1.Caption = frmSplash.lbl1.Caption + "|"

Next i

Call Sleep(SleepDate + 1000)

Unload frmSplash

frmLogin.Show vbModal

If Not LoginSucceeded Then End

SelCompFrm.Show vbModal '********* Show The Select Company Form

Exit Sub

ErHand:

MsgBox "Some Internal Error Occurs,Please Contact To Surendra Enterprises..", vbCritical, App.Title

End

End Sub

Private Sub MDIForm_Terminate()

End

End Sub

Private Sub MDIForm_Unload(Cancel As Integer)

End

End Sub

Private Sub subMnAccountReports_Click(Index As Integer)

Dim SQL As String

Dim Diff, DrTotal, CrTotal As Double

Select Case Index

Case 0

If DE.OpTrialConn.State = adStateOpen Then DE.OpTrialConn.Close

DE.OpTrialConn.Open ConnectString

SQL = "SELECT ACMAST.ACCODE, ACMAST.ACDESC, AcTrans.CLOSING, AcTrans.YOBDR, AcTrans.YOBCR FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode WHERE ACMAST.RECTYPE ='A' AND NOT(AcTrans.YOBDR=0 AND AcTrans.YOBCR=0) Order By ACMAST.ACDESC"

DE.rsOPTrialCmd.Open SQL, DE.OpTrialConn, adOpenStatic, adLockReadOnly, adCmdText

Set OpTrialRpt.DataSource = DE

OpTrialRpt.Sections("ReportHeader").Controls("DtLbl").Caption = "Opening Trial as on " & Format(SelectedCompany.FromDate, "dd/mm/yyyy")

SQL = "SELECT Sum(AcTrans.CLOSING) AS SumOfCLOSING, Sum(AcTrans.YOBDR) AS SumOfYOBDR, Sum(AcTrans.YOBCR) AS SumOfYOBCR " & _

"FROM ACMAST INNER JOIN AcTrans ON ACMAST.ACCODE = AcTrans.Accode WHERE (((ACMAST.RECTYPE)='A'))"

Dim rst As New ADODB.Recordset

rst.CursorLocation = adUseClient

rst.Open SQL, DE.OpTrialConn, adOpenForwardOnly, adLockReadOnly, adCmdText

If Not rst.RecordCount > 0 Then

MsgBox "Account transaction not available.", vbCritical, "Opening Trial"

Exit Sub

End If

DrTotal = IIf(IsNull(rst!SumOfYOBDR), 0, rst!SumOfYOBDR)

CrTotal = IIf(IsNull(rst!SumOfYOBCR), 0, rst!SumOfYOBCR)

Diff = Abs(DrTotal - CrTotal)

OpTrialRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption = Format(IIf(DrTotal < CrTotal, Diff, ""), "0.00")

OpTrialRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption = Format(IIf(CrTotal < DrTotal, Diff, ""), "0.00")

If Val(OpTrialRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption) = Val(OpTrialRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption) Then

OpTrialRpt.Sections("ReportFooter").Controls("DiffLbl").Caption = ""

OpTrialRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption = ""

OpTrialRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption = ""

Else

OpTrialRpt.Sections("ReportFooter").Controls("DiffLbl").Caption = "Difference in Opening :"

End If

OpTrialRpt.Sections("ReportFooter").Controls("DebitLbl").Caption = Format(DrTotal + Val(OpTrialRpt.Sections("ReportFooter").Controls("DiffDebitLbl").Caption), "0.00")

OpTrialRpt.Sections("ReportFooter").Controls("CreditLbl").Caption = Format(CrTotal + Val(OpTrialRpt.Sections("ReportFooter").Controls("DiffCreditLbl").Caption), "0.00")

OpTrialRpt.Show

Case 1

TrialBalFrm.Move 0, 0

TrialBalFrm.Show

Case 2

FinLgrFrm.Move 0, 0

FinLgrFrm.Show

Case 3

DayBKFrm.Move 0, 0

DayBKFrm.Show

Case 4

CashBKFrm.Move 0, 0

CashBKFrm.Show

Case 5

BankBKFrm.Move 0, 0

BankBKFrm.Show

Case 6

BSheetFrm.Move 0, 0

BSheetFrm.Show

Case 7

PLFrm.Move 0, 0

PLFrm.Show

End Select

End Sub

Private Sub subMnCompany_Click(Index As Integer)

On Error GoTo ErHand

Dim CompNewFrm As CompFrm

Select Case Index

Case 0 'Select Company

SelCompFrm.Show vbModal

Case 1 'Create

Set CompNewFrm = New CompFrm

CompNewFrm.CompAddMode = True

CompNewFrm.Show

Case 2 'Alter Company

Set CompNewFrm = New CompFrm

CompNewFrm.CompEditMode = True

CompNewFrm.Show

Case 3 'Shut Company

If Forms.Count > 1 Then

MsgBox "Please, Close all open windows then try again.", vbExclamation

Else

Call UnloadApplication(False)

SelectedCompany.Company = ""

Call SetMenuItems

End If

Case 5 'Backup

'BackupFrm.Show vbModal

frmBackRest.Show vbModal

Case 8 'Print Setup

With CD

.DialogTitle = "Print Setup"

If VBA.Environ$("OS") = "Windows_NT" Then

'MsgBox "NT Technology."

Else

.Flags = &H40

End If

.ShowPrinter

End With

Case 10 'Exit

Call UnloadApplication

End Select

ErHand:

If err.Number <> 0 Then

ErrHandler "subMnCompany_Click(" & Index & ")"

End If

End Sub

Private Sub subMnInventoryReports_Click(Index As Integer)

Select Case Index

Case 0 'Sale Register

SaleRegisFrm.Move 0, 0

SaleRegisFrm.Show

Case 1 'Purchase Register

PrchRegisFrm.Move 0, 0

PrchRegisFrm.Show

Case 3 'Stock Register

StockRegisFrm.Move 0, 0

StockRegisFrm.Show

Case 4 'Stock Statement

StatementFrm.Move 0, 0

StatementFrm.Show

Case 5 'Stock Ledger

StockLgrFrm.Move 0, 0

StockLgrFrm.Show

Case 7 'Fastest Selling

MthlyChrtFrm.Show

Case 8 'Manufacturer Wise Sale/Purchase Chart

ManufChrtFrm.Show

Case 9 'Supplier Wise Sale/Purchase Chart

'PartyChrtFrm.Show

End Select

End Sub

Private Sub subMnMiscellaneousReports_Click(Index As Integer)

Select Case Index

Case 0 'Patient History

PatientLedger.Show

Case 1 'Addmission Ledger

Admission_Ragister.Move 0, 0

Admission_Ragister.Show

Case 2 'Doctor/Anesthetist Ledger

'Doctorswork.Show

Doctorledger.Show

Case 3 'Registration Ledger

Registrationfeereport.Show

Case 4 'Supplier Ledger

Case 5 'Head Wise Cash Collection

HeadWiseCashCollection.Show

Case 6 'Date Wise Cash Collection

DateWiseCashCollection.Show

Case 7 'Cosent Form

consent.Show

End Select

End Sub

Private Sub subMnPatientEntries_Click(Index As Integer)

Select Case Index

Case 0 'In Door Patient Registration

registration.Show

Case 1 ' OPD Patient Registration

opd.Move 0, 0

opd.Show

End Select

End Sub

Private Sub subMnTransactionEntries_Click(Index As Integer)

Dim NewFrm As Form

Select Case Index

Case 0 'Purchase

Set NewFrm = New PurchFrm

NewFrm.Tag = "PV"

NewFrm.Show

Case 1 'Purchase Return

Set NewFrm = New PurchFrm

NewFrm.Tag = "PR"

NewFrm.Show

Case 3 'Sale

Set NewFrm = New SaleFrm

NewFrm.Tag = "SV"

NewFrm.Show

Case 4 'Sale Return

Set NewFrm = New SaleFrm

NewFrm.Tag = "SR"

NewFrm.Show

Case 6 'Deep Account View

BEVFrm.Show

End Select

End Sub

Private Sub subMnUtilities_Click(Index As Integer)

Select Case Index

Case 0

Call ShellExecute(Me.hwnd, "Open", "Calc.exe", "", "", ByVal 0)

Case 1

Call ShellExecute(Me.hwnd, "Open", "Notepad.exe", "", "", ByVal 1)

Case 2

Call ShellExecute(Me.hwnd, "Open", "Explorer.exe", "", "", ByVal 1)

Case 3

Call ShellExecute(Me.hwnd, "Open", "Write.exe", "", "", ByVal 1)

Case 5

BalUPDFrm.Show vbModal

Case 6

YrInstFrm.Show vbModal

Case 8

'PwdFrm.Move 0, 0

'PwdFrm.Show

CreateUserFrm.Move 0, 0

CreateUserFrm.Show

End Select

End Sub

Private Sub subMnMasterEntries_Click(Index As Integer)

Select Case Index

Case 0 'Doctor Master Entry

DoctorEntry.Move 0, 0

DoctorEntry.Show

Case 1 'Anaesthetist Master Entry

AnaesthetistEntry.Move 0, 0

AnaesthetistEntry.Show

Case 2 'Department Entry

DepartmentFrm.Move 0, 0

DepartmentFrm.Show

Case 3 ' Bed Master Entry

newbed.Show

Case 5 'Bill Master Entry

BillMaster.Move 0, 0

BillMaster.Show

Case 6 'Daily Fee Master Entry

Dailybill.Move 0, 0

Dailybill.Show

Case 8 ' Diagnosis Entry

Diagnosis.Move 0, 0

Diagnosis.Show

Case 9 ' Complaint Master Entry

complaintmaster.Move 0, 0

complaintmaster.Show

Case 10 'Advice Master Entry

Advice.Move 0, 0

Advice.Show

Case 12 'Account Group Entry

GroupFrm.Move 0, 0

GroupFrm.Show

Case 13 'Create Account Entry

AcountFrm.Show

Case 15 'Item Group Entry

IGFrm.Move 0, 0

IGFrm.Show

Case 16 'Manufacturer Entry

ManufFrm.Move 0, 0

ManufFrm.Show

Case 17 'Item Entry

'ItemFrm.Move 0, 0

ItemFrm.Show

Case 18 'Item Opening Entry

ItemOPFrm.Show

End Select

End Sub

Private Sub subMnVoucherEntries_Click(Index As Integer)

Dim NewFrm As Form

Select Case Index

Case 0 'Payment Voucher

Set NewFrm = New VoucherFrm

NewFrm.Tag = "PT"

NewFrm.Show

Case 1 'Receipt Voucher

Set NewFrm = New VoucherFrm

NewFrm.Tag = "RT"

NewFrm.Show

Case 3 'Contra Voucher

Set NewFrm = New VoucherFrm

NewFrm.Tag = "CO"

NewFrm.Show

Case 4 'Journal Voucher

Set NewFrm = New VoucherFrm

NewFrm.Tag = "JV"

NewFrm.Show

End Select

End Sub