Đề tài Quản lý thu mua chè

Mục lục Phần I NộI dung GiớI thiệu về ngôn ngữ Visual Basic Lập trình vớI ngôn ngữ Visual Basic Cấu trúc của một chương trình viết bằng ngôn ngữ Visual Basic Phần II Mục đích và yêu cầu của phần mềm Chức năng chính của Phần mềm Quản lý thu mua chè Cơ sở dữ liệu Phần III Mã nguồn chương trình LỜI CẢM ƠN Đồ án này là kết quả học tập, rèn luyện của em trong hơn bốn năm học tại trường Đại Học Quản lý và Kinh doanh Hà Nội. Để có được kết quả này, em đã nhận được rất nhiều sự động viên, giúp đỡ và chỉ bảo của các thầy cô, gia đình,bạn bè… Trước hết, em xin được chân thành cảm ơn Thầy giáo Đoàn Hữu Vượng đã tận tình hướng dẫn và giúp đỡ em hoàn thành đề tài luận văn tốt nghiệp này. Em xin chân thành cảm ơn các thầy, cô giáo trường Đại Học Quản lý và Kinh doanh Hà Nội, đặc biệt là Khoa Tin Học, đã giảng dạy, truyền thụ cho em những kiến thức quý báu và tạo mọi điều kiện thuận lợi cho em trong suốt quá trình học tập tại trường. Xin được gửi lời cảm ơn đến những người thân trong gia đình, bạn bè gần xa đã giúp đỡ, động viên tôi trong quá trình thực hiện luận văn . Lời nói đầu Ở nước ta, những năm gần đây, công nghệ thông tin đã phát triển không ngừng, đi sâu vào nhiều lĩnh vực của đời sống. Mọi cá nhân, tổ chức đều cần đến công nghệ thông tin để hoạt động, phát triển. Hoạt động kinh doanh chè nói chung và thu mua chè, cũng không nằm ngoài quy luật trên. Đây là một công việc với nhiều công đoạn phức tạp, đa dạng. Nó đòi hỏi người quản lý phải nắm được những người trực tiếp bán chè, nhân viên, các loại chè mà đơn vị mình thu mua, đưa ra các thông tin về công nợ…Để góp phần nhỏ vào công cuộc phát triển công nghệ thông tin và cũng là muốn cố gắng thử sức mình em đã chọn đề tài "Quản lý thu mua chè" làm đề tài cho luận văn tốt nghiệp của mình. Đề tài "Quản lý thu mua chè" là một đề tài khá lớn, trong khi thời gian để thực hiện, kinh nghiệm lập trình, kiến thức nghiệp vụ của em còn hạn chế, nên chắc chắn chương trình này vẫn còn rất nhiều thiếu sót. Em mong nhận được sự chỉ bảo, đóng góp ý kiến của các thầy, cô giáo, các bạn bè…. Phần I : Giới thiệu ngôn ngữ Visual Basic Ngôn ngữ Visual Basic ngày càng được sử dụng rộng rãi trong các đề án, chương trình thực hiện trong và ngoài nước. Visual Basic được xem là một công cụ phát triển phần mềm thông dụng hiện nay. Sau phiên bản Visual Basic 1.0 là Visual Basic 2.0, đã từng chạy nhanh hơn, dễ sử dụng hơn. Đến Visual Basic 3.0 bổ sung thêm một số phương thức đơn giản, dễ điều khiển cơ sở dữ liệu hơn. Visual Basic 4.0 bổ sung thêm hơn hỗ trợ phát triển 32 bit và bắt đầu tiến trình chuyển Visual Basic thành ngôn ngữ lập trình hướng đốI tượng. Visual Basic 5.0 bổ sung khả năng tạo các điều khiển riêng. Visual Basic 6.0 có thêm nhiều chức năng mạnh như các ứng dụng Internet/ Intranet. . .v.v….. Visual Basic gắn liền vớI khái niệm lập trình trực quan, nghĩa là khi thiết kế chương trình, bạn thấy ngay được kết quả qua từng thao tác. Visual Basic cho phép chỉnh sửa một cách đơn giản, nhanh chóng giao diện của các đốI tượng trong ứng dụng. Đó là một thuận lợI cho ngườI lập trình. VớI Visual Basic, việc lập trình trong Windows đã trở nên hiệu quả hơn và đơn giản hơn rất nhiều. Một khả năng nữa của Visual Basic là khả năng kết hợp các thư viện liên kết động DLLl (Dynamic Link Library). DLL chính là phần mở rộng cho Visual Basic, tức là khi xây dựng một chương trình có một số yêu cầu mà Visual Basic không đáp ứng đầy đủ ta có thể viết các DLL để phụ thêm cho chương trình. Các công cụ để thiết kế giao diện: Như chúng ta đã biết Visual Basic là ngôn ngữ lập trình có tính hướng đốI tượng nên công việc thiết kế giao diện là rất đơn giản. Chúng ta chỉ việc tiến hành đưa các đốI tượng cần thiết trong thanh công cụ vào Form bằng cách kích – kéo sau đó thay đổI các thuộc tính của chúng trên cửa sổ Properties cho phù hợp vớI mục đích lập trình. Form: Form là một biểu mẫu của mỗI ứng dụng trong Visual Basic. Ta dùng Form nhằm mục đích định vị và sắp xếp các bộ phận trên nó khi thiết kế giao diện vớI ngườI sử dụng. Ta có thể xem Form như một bộ phận mà nó có thể chứa các bộ phận khác. Các thành phần trong Form chính của ứng dụng tương tác vớI các Form khác và các bộ phận của chúng tạo nên giao tiếp cho ứng dụng. Form chính là giao diện chính của ứng dụng, các Form khác có thể chứa các công cụ để nhập dữ liệu, xem xét v.v… Trong nhiều ứng dụng của Visual Basic, kích cỡ và vị trí của biểu mẫu lúc thiết kế là kích cỡ mà ngườI dùng sẽ gặp vào lúc sử dụng. Điều này, có nghĩa là Visual Basic cho phép ta thay đổI kích cỡ và di chuyển vị trí Form đến bất cứ nơi nào trên màn hình khi chạy một đề án, bằng cách thay đổI một số thuộc tính của nó trên cửa sổ thuộc tính đốI tượng (Properties Windows ). Thực tế, một trong tính năng thiếu của Visual Basic là khả năng tiến hành các thay đổI động để đáp ứng sự kiện ngườI dùng. Toolbox (hộp công cụ): Toolbox là hộp công cụ chưa các biểu tượng, biểu thị cho các điều khiển mà ta có thể biểu mẫu là bảng chứa các đối tượng đã được định nghĩa sẵn của Visual Basic. Các đối tượng này được sử dụng trong Form để tạo thành giao diện cho các chương trình ứng dụng của Visual Basic. Ta có thể coi hộp công cụ là một hộp “đồ nghề” của người thiết kế chương trình. Scrollbar (thanh cuốn): Scrollbar là đối tượng cho phép nhận từ người dùng một giá trị tuỳ theo vị trí con chạy trên thanh cuốn thay cho các giá trị số. Thanh cuốn có một số thuộc tính quan trọng sau: Thuộc tính Min: xác định cận dưới của thanh cuốn. Thuộc tính Max: xác định cận trên của thanh cuốn. Thuộc tính Value: xác định giá trị tạm thời của thanh cuốn. Option Button (Nút chọn): Đối tượng nút chọn (thường được dùng nhiều nút) cho phép người dùng chọn một trong những lựa chọn đưa ra. Như vậy, tại 1 thời điểm chỉ có thể là 1 trong những nút chọn đuợc chọn Checkbox( hộp kiểm); Cũng như nút chọn, đối tượng hộp kiểm được dùng nhiều hộp một lần. Nhưng khác với nút chọn, hộp kiểm cho phép người dùng lựa một hay nhiều điều kiện. Như vậy tại 1 thời điểm có thể có nhiều hộp kiểm được chọn Label(nhãn): Đối tượng nhãn cho phép người dùng gắn nhãn 1 bộ phận nào đó của giao diện trong lúc thiết kế giao diện cho chương trình ứng dụng . Các nhãn dùng để hiển thị thông tin không muốn người dùng thay đổi. Trong thực tế, các nhãn thường được dùng để định danh 1 hộp văn bản hoặc 1 điều khiển khác bằng việc mô tả nội dung của điều khiển đó. Một công cụ phổ biến cho việc hiển thị thông tin trợ giúp, Picturebox, Image ( hộp ảnh, điều khiển ảnh ); Đối tượng Image và Picturebox dùng để hiển thị ảnh . Nó cho phép người thiết kế đưa hình ảnh từ các file ảnh ( .bmp , .gif …) lên Form Textbox ( hộp văn bản ); Đối tượng Textbox dùng làm hộp nhập dữ liệu cho phép đưa các chuỗi ký tự vào Form. Có thể dùng hộp văn bản để nhập dữ liệu hoặc hiển thị văn bản . Tất cả các công cụ trong windows về chỉnh sửa văn bản như : cut , copy , paste đều dùng trong hộp văn bản Command Button ( nút lệnh ): Khi người dùng kích vào 1 nút lệnh trong biểu mẫu, một thao tác nào đó sẽ được thực hiện tuỳ theo thủ tục sự kiện được viết để đáp ứng sự kiện kích chuột đó . Listbox ( hộp danh sách ): Đối tượng Listbox cho phép kết xuất các thông tin về nhiều chuỗi kí tự vào trong nó thông qua phương thức additem. Thường được dùng để hiển thị thông tin dưới dạng danh sách có liên quan với nhau. Listbox không cho phép người dùng nhập dữ liệu vào. Combo box ( hộp kết hợp ); Công cụ này cho phép người dùng gõ vào thông tin và hiển thị thông tin . nó có tác dụng như hộp danh sách và hộp văn bản . Hộp kết hợp có 3 loại: Hộp kết hợp thả xuống ( drop-down combo ) : là 1 hộp văn bản cho phép người dùng gõ vào, kế bên có 1 mũi tên mà khi nhấn vào nó sẽ xổ ra 1 danh sách cho phép người sử dụng chọn lựa . Hộp kết hợp đơn giản ( simple combo ) : luôn hiển thị danh sách và cho phép người dùng gõ vào hộp văn bản. Hộp danh sách thả xuống ( drop- down list box) : tương tự như hộp kết hợp thả xuống. Danh sách sẽ không hiển thị sẵn nếu người dùng không nhấn vào mũi tên bên cạnh. người sử dụng chỉ có thể chọn từ danh sách, gõ vào hộp văn bản thì danh sách sẽ cuộn đúng đến phần tử yêu cầu và đánh dấu nó. Ole ( đối tượng nhúng ): Ole là viết tắt của Object - Linking and Embedding . Nó cho phép ta nhúng toàn bộ ứng dụng và dữ liệu từ một ứng dụng khác vào chương trình . Ole không chỉ là 1 hệ thống cho phép nhúng hay kết nối dữ liệu từ 1 ứng dụng khác mà vào thời gian chạy của chương trình ta sẽ có 1 bản sao của ứng dụng đó trong chương trình của ta. Nó có khả năng automation cho phép đóng gói các đối tượng chức năng của ứng dụng để có thể sử dụng trong ứng dụng khác. Project explorer : Project explorer trong Visual Basic 6.0 giúp quản lý và định hướng các đề án, biểu mẫu, các module,…. Visual Basic cho phép tổ chức nhiều đề án trong 1 nhóm gọi là project groups. Ta có thể lưu tập hợp các đề án trong Visual Basic thành 1 tập tin nhóm đề án. Các tập tin này có phần mở rộng là .Vbg . Propeties windows ( cửa sổ thuộc tính ): Là nơi chứa danh sách các thuộc tính của một đối tượng cụ thể. Các thuộc tính này có thể khác nhau với từng đối tượng cụ thể. Ta có thể đặt các thuộc tính cho phù hợp với các chương trình ứng dụng. Lập trình trong Visual Basic: Ở phần một, chúng ta mới chỉ biết tuỳ biến biểu mẫu bằng cách bổ xung các điều khiển vào cho phù hợp với yêu cầu của chương trình. Tuy nhiên, đó chỉ có thể coi là bộ mặt của chương trình. Muốn chương trình chạy được thì chúng ta phải thêm vào các thành phần khác như lệnh, dữ liệu. . và cách thức thể hiển chúng trong chương trình. Khi lập trình trong Visual Basic thì phần lớn các mã được xử lý để đáp ứng sự kiện. Ví dụ như sự kiện kích chuột, bấm phím, load form…Các dòng mã thi hành trong một chương trình Visual Basic phải nằm trong các thủ tục hoặc hàm, các dòng lệnh nằm ngoài sẽ không làm việc. Toàn bộ mã lệnh được gõ vào trong cửa sổ code. Cửa sổ code: Cửa số code bao gồm các thành phần sau: Thanh tách: cửa sổ code có một thanh tách (Split bar) nằm đầu thanh cuộn dọc. Mục đích của nó là: khi các dòng mã trở nên nhiều, ta có thể chia cửa sổ code thành 2 phần. Hộp liệt kê Object: nằm ở đầu cửa sổ code bên trái, nó liệt kê tất cả các điều khiển có trên biểu mẫu và thêm vào một đối tượng có tên là: General. Khi thả hộp liệt kê và nhắp vào một đối tượng nào đó thì sẽ đưa ta đến phần mã viết cho đối tượng đó. Hộp Procedure: hộp này cung cấp mọi sự kiện mà đối tượng đã được lựa chọn trong hộp liệt kê object. Intellisence: Intellisence là một công cụ thông minh, nó giúp ta đỡ mất công gõ và tra cứu. Intellisence mở các hộp liệt kê cùng với các thông tin về đối tượng mà ta đang tiếp cận. Nó có 3 phần: QuickInfo: cho ta thông tin về cú pháp của 1 lệnh Visual Basic. Mỗi khi nhập một từ khoá theo sau là một dấu cách hoặc dấu chấm. . .một hộp thoại sẽ hiện ra cung cấp cú pháp của thành phần đó. List properties/Methods: tính năng này đưa ra một danh sách các tính chất và phương pháp của đối tượng ngay khi ta gõ dấu chấm. Available constant : tính năng này cung cấp một danh sách các hằng sẵn có. Biến: Trong Visual Basic, tên biến có thể dài tối đa 255 kí tự. Kí tự đầu tiên phải là một chữ cái và tên biến có thể là một tổ hợp chữ cái, chữ số và dấu gạch dưới. Không được dùng các từ khoá trong Visual Basic ( như end, print. . .) làm tên biến. Visual Basic không phân biệt chữ hoa, chữ thường. Cách khai báo biến: Dim as Phạm vi sử dụng biến phụ thuộc vào cách khai báo biến và vị trí đặt dòng lênh khai báo. Các kiểu dữ liệu: String: các biến string lưu giữ các kí tự. Một chuỗi có thể có một hay nhiều kí tự. Integer: biến nguyên lưu giữ các giá trị số nguyên từ -32768 đến +32767. Long Integer: biến số nguyên dài lưu giữ các số nguyên giữa: -2147483648 đến +214783647. Single precision: các số có phần thập phân gồm: Single precision có độ chính xác đến 7 chữ số và double precision có độ chính xác lên đến 16 vị trí. Currency: Biến tiền tệ là một kiểu mới. Kiểu này cho ta 15 chữ số trước dấu thập phân và 4 chữ số sau dấu thập phân. Date: kiểu dữ liệu ngày tháng. Byte: kiểu byte có thể lưu giữ các số nguyên từ 0 đến 255. Boolean: đây là kiểu logic với các giá trị True/False. Variant: kiểu này được thiết kế để lưu mọi dữ liệu khác nhau của Visual Basic. Các toán tử: Các toán tử tính toán: Các toán tử Ý nghĩa Ví dụ + Có thể dùng để cộng hai toán hạng hoặc hai chuỗi với nhau. X=y+1 A=”A”+”B” - trừ 2 số hạng X=y-1 * Nhân 2 số hạng X=y*2 / Chia, trả về kiểu số thực Y=4/2 \ Chia lấy nguyên X=3\2(x=1) Mod Chia lấy dư X=7 mod 4 (x=3) ^ Lấy luỹ thừa X=y^3 (X=y3) Các toán tử so sánh: Toán tử Ý nghĩa > So sánh xem số thứ nhất có lớn hơn số thứ 2 không < So sánh xem số thứ nhất có nhỏ hơn số thứ 2 không. = So sánh số thứ nhất có bằng số thứ 2 không. So sánh số thứ nhất có khác số thứ 2 không. >= So sánh số thứ nhất có lớn hơn hay bằng số thứ 2 không <= So sánh số thứ nhất có nhỏ hơn hay bằng số thứ 2 không Các toán tử Boolean: Toán tử Ý nghĩa And Chỉ nhận giá trị True nếu cả 2 số hạng đều là True Or Chỉ nhận giá trị False nếu cả 2 số hạng đều là False Not Phủ định giá trị của số hạng Cấu trúc điều khiển: Các cấu trúc chọn: Cấu trúc If….Then… Dạng 1: If then End If Khi gặp một điều lệnh If…..then, Visual Basic sẽ kiểm tra , nếu là True thì máy sẽ thực hiện nếu kêt quả là False thì máy sẽ bỏ qua lệnh và thực hiện những lệnh sau End If. Dạng 2: If then else Khi gặp lệnh này, nếu lấy giá trị True thì thực hiện bỏ qua , còn nếu lấy giá trị False thì bỏ qua và thực hiện . Nhiều khi bạn phải thực hiện nhiều lệnh ứng với điều kiện là True hay False. Để làm được điều đó, ta sử dụng dạng khác của cấu trúc If …..then, có dạng tổng quát như sau: If then else end if Cấu trúc Select Case: Cú pháp: Select case Case ………………… Case …………….. Case else End Select Cấu trúc lặp: Cấu trúc lặp có điều kiện: Cú pháp 1: While Wend Cú pháp 2: Do While được thực hiện lặp đi lặp lại nếu vẫn nhận giá trị True. Do đó, để thoát khỏi vòng lặp thì trong . Trong cú pháp 1, thì được xét trước khi thực hiện các câu lệnh, còn trong cú pháp 2 thì các câu lệnh được thực hiện trước khi xét đến . Cấu trúc For …Next: Cú pháp: For = to [Step ] Next biến Đây là lệnh lặp biết trước số lần lặp. Khi gặp cấu trúc lệnh này, Visual Basic sẽ gán giá trị cho , thực hiện , rồi tăng lên một giá trị tuỳ theo . Vòng lặp này sẽ kết thúc khi có giá trị lớn hơn Cấu trúc For Each….Next: For Each In Next Khi gặp cấu trúc này, Visual Basic sẽ lặp lại cho từng phần tử của mảng, hay các điều khiển…Người ta thường dùng cấu trúc này để duyệt nhiều đối tượng điều khiển. Thủ tục: Trong Visual Basic, một thủ tục mà trước khi ta muốn sử dụng nó thì ta phải định nghĩa nó và ta phải dùng từ khoá “Sub” để khai báo nó. Private/Public Sub End Sub Nếu dùng từ khoá Public, thủ tục có thể được dùng trong bất kì Form nào trong chương trình. Nếu ta khai báo bằng từ khoá Private thì thủ tục chỉ có thể được dùng được trong Form,module chứa nó mà thôi. Giá trị được truyền cho thủ tục thông qua tham số. Một thủ tục có thể có hoặc không có tham số. Khi gọi một thủ tục có tham số, ta phải truyền giá trị cho tham số của thủ tục đó. Trong Visual Basic, có 2 cách để truyền thám số : By Ref ( truyền tham chiếu) và By Val ( truyền tham trị ). Private/Public Sub ( as , , v.v…) End Sub Hiển thị và nhận thông tin: Ta sử dụng các hộp đối thoại để hiển thị thông tin cho người dùng hoặc nhận thông tin. Trong Visual Basic có 4 hộp thoại, đó là: Thông điệp: (MesageBox) Là một hộp thoại đơn giản nhất, gồm 2 loại: Chỉ cung cấp thông tin Tương tác với người sử dụng. Hộp nhập (InputBox): InputBox dùng để nhập thông tin từ người dùng, nó bao gồm một dòng thông báo, hộp soạn thảo và 2 nút “OK” và “Cancel”. Nó có mặt hạn chế là chỉ cho người sử dụng nhập rất ít thông tin. Các hộp thoại thông dụng Bởi hộp thoại này xuất hiện mọi nơi, nên thay vì phải viết chương trình nhiều lần, Windows chứa chúng trong cùng một DLL, Comdlg32.dll hay Comdlg.ocx Có 6 hộp thoại: mở tập tin (File Open) Lưu tập tin (File save). Chọn mầu (Color). Chọn phông (Font). Trợ giúp (Help). In ấn (Print). Hộp thoại hiệu chỉnh (Custom Dialog). Đây là loại hộp đối thoại do người lập trình định nghĩa để tương thích với yêu cầu nhận thông tin của người sử dụng. Nó có ưu điểm là ta có thể thiết kế theo ý thích. Trở ngại của nó là khi thi hành từng biểu mẫu thì sẽ sử dụng tài nguyên hệ thống như bộ nhớ, thời gian CPU. Nếu dùng nhiều hộp thoại hiệu chỉnh trong ứng dụng có thể mất tài nguyên hệ thống và dễ bị treo máy. Phần 2 :PHẦN MỀM QUẢN LÝ THU MUA CHÈ I. MỤC ĐÍCH VÀ NHU CẦU THỰC TẾ CỦA PHẦN MỀM Hiện nay, các phần mềm đang được sử dụng rộng rãi trong các doanh nghiệp tư nhân hay các cơ quan nhà nước , nó giúp cho họ dễ dàng quản lý‎ được công việc kinh doanh của mình . Vì vậy phần mềm "Quản lý Thu mua Chè" này được viết ra nhằm giúp cho công việc thu mua chè có nhiều thuận lợi, chặt chẽ hơn. Nó cũng giúp cho doanh nghiệp tránh được các thất thoát không đáng có . Nếu như thực hiện công việc này theo những cách viết tay và tinh toán cổ điển bằng giấy tờ, sổ sách thì sẽ cần đến rất nhiều nhân lực, vật lực cho việc nhập số liệu, tính toán, lưu giữ hóa đơn. Và cho dù có đầy đủ nhân lực, vật lực, thì công việc trên sẽ tiêu tốn một thời gian rất lớn. Khi ta cần một bản báo cáo hay hóa đơn chi tiết nếu làm bằng thủ công với một đống giấy hóa đơn , báo cáo thì sẽ rất mất thời gian . Trong khi đấy, ta vẫn không đảm bảo là sẽ tránh được các sai sót không đáng sảy ra. Vì vậy, việc áp dụng công nghệ thông tin vào công việc trên là một điều tất yếu và vô cùng cần thiết . Khi phần mềm “Quản lý thu mua Chè ” xuất hiện nó sẽ khắc phục được các nhược điểm của cách làm việc cổ điển. Chính là : Giảm thiểu chi phí sức người, sức của, thời gian cho việc thống kê, quản lý thu mua. Tránh được các nhầm lẫn, sai sót trong công việc do con người gây ra. Đưa ra các số liệu với độ chính xác , với một thời gian nhanh nhất. II.CHỨC NĂNG CHÍNH CỦA PHẦN MỀM: Quản lý người sử dụng chương trình: Quản lý thu mua Chè: Quản lý công nợ: In báo cáo: Sơ đồ chương trình: CHỨC NĂNG CHƯƠNG TRÌNH QL người sử dụng chương trình Quản lý thu mua Chè Báo báo cáo thu mua chè Quản lý công nợ Quản lý người sử dụng chương trình: Chương trình Quản lý thu mua chè được sử dụng trong các doanh nghiệp kinh doanh Chè, nên bảo mật dữ liệu là một công việc vô cùng quan trọng. Сhức năng quản lý quyền truy cập của những người được phép sử dụng chương trình cho phép doanh nghiệp có thể hạn chế việc thất thoát thông tin. Ta có thể chia nhưng người được phép sử dụng chương trình thành 2 nhóm chính: người quản trị (Aministrator), Người quản lý việc thu mua chè. Người quản lý việc thu mua chè: là nhóm người có quyền truy cập vào Username , khi nhóm người này truy cập vào thì họ có toàn quyền sử dụng những tiện ích có trong quyền hạn của một người quản ly’‎ như : nhập hóa đơn trong việc thu mua Chè , thanh toán các hóa đơn, cập nhật giá , in hóa đơn hay thay đổi mật khẩu truy cập của mình……. Tuy nhiên nhóm này vẫn nằm trong sự quản ly’ của những người có thẩm quyền cao hơn và đây chính là những Người Quản trị . Người quản trị: Đây là nhóm người có quyền cao nhất. Ngoài các quyền hạn của nhóm người quản lý thu mua Chè, nhóm này còn được phép quản lý nhóm người kia (Như : có thể xóa bỏ người sử dụng “UserName” hay sửa chữa dữ liệu hoặc tạo mới ra các Username mới ) . In ra các báo cáo tùy vào lựa chọn của Admnistrator hay khách hàng , cập nhật tiền trong quỹ ……….. Quản lý thu mua Chè: Đây là chức năng cho phép người quản lý thu mua chè có thể nhập các thông tin cần thiết liên quan đến các khách đến bán chè cho doanh nghiệp. Nó có thể tự động phân loại chè theo trình tự (A , B , C ……) , tính khối lượng chè , tính tổng số tiền phải trả cho khách hàng , in hóa đơn và hủy hóa đơn của khách hàng khi không cần thiết đến hóa đơn đó nữa . Quản lý công nợ: Chức năng này giúp người quản lý dễ ràng thực hiện công việc thanh toán các hợp đồng mà doanh nghiệp còn nợ hoặc chưa trả đủ tiền trong khi thu mua chè vì nó có thể tự động cập nhật những thông tin chi tiết về ngày tháng thanh tóan và còn nợ hay đã thanh toán hoàn toàn. Báo cáo thu mua Chè: Đây là chức năng đưa ra báo cáo thu mua chè , danh sách hóa đơn nợ hay không nợ và chức năng này có thể đưa ra các báo cáo cụ thể được phân rõ ràng theo từng ngày ,tháng,năm… một cách thống nhất . Sau khi thực hiện được những công việc trên .Nó có thể giúp người sử dụng tiết kiệm thời gian và có một báo cáo chính xác bằng việc in ấn các báo cáo bằng máy và lưu chi tiết bằng excell . III CƠ SỞ DỮ LIỆU : Bảng 1 : Hóa đơn STT Tên trường Kiểu dữ liệu Mô Tả 1 MaHD Text Mã hóa đơn 2 MaKH Text Mã Khách hàng 3 UserName Text Tên người sử dụng 4 NgayMua Date/Time Ngày mua 5 Tongtien Text Tổng tiền 6 TongKhoiluong Text Tổng khối lượng 7 No Text Tiền nợ Bảng 2: Khách hàng STT Tên trường Kiểu dữ liệu Mô Tả 1 MaKH Text Mã khách hàng 2 TenKH Text Tên khách hàng 3 DiaChi Text Địa chỉ khách hàng Bảng 3 : Nhập tiền STT Tên trường Kiểu dữ liệu Mô Tả 1 SoTien Text Số tiền 2 NgayNhap Date/Time Ngày nhập Bảng 4 : Nợ tiền STT Tên trường Kiểu dữ liệu Mô Tả 1 MaHD Text Mã hóa đơn 2 Ngaytra Date/Time Ngày trả tiền 3 SoTien Text Số tiền dược trả 4 LanTra Text Lần trả Bảng 5: Nội dung mua STT Tên trường Kiểu dữ liệu Mô Tả 1 MaHD Text Mã hóa đơn 2 LoaiChe Text Phân loại chè 3 GiaChe Text Giá chè 4 KhoiLuongBD Text Khối lượng ban đầu 5 PhantramChe Text Phần trăm chè 6 TyleNuoc Text Tỷ lệ hao hụt 7 Baobi Text Bao bì 8 KhoiluongSau Text Khối lượng sau 9 Giatri Text giá trị Bảng 6: OldData STT Tên trường Kiểu dữ liệu Mô Tả 1 LoaiChe Text Loại chè 2 OldPrice Text Giá chè cũ 3 LastUser Text Người sử dụng cuối 4 LastDay Date/Time Ngày cập nhật cuối 5 LastTyleNuoc Text Tỷ lệ nước cuối 6 YearNow Text Năm hiện tại 7 MaxSTT Text Max stt của bảng Price Bảng 7: Price STT Tên trường Kiểu dữ liệu Mô Tả 1 SoTT Text Số thứ tự 2 LoaiChe Text Loại chè 3 Gia Date/Time giá chè 4 NgayCapnhat Text Ngày cập nhật 5 UserName Text Tên người sử dụng Bảng 8: Tea STT Tên trường Kiểu dữ liệu Mô Tả 1 LoaiChe Text loại chè Bảng 9: Tổng tiền STT Tên trường Kiểu dữ liệu Mô Tả 1 TongTien Text Tổng tiền 2 NgayNhapCuoi Text Ngày nhập cuối Bảng 10: User STT Tên trường Kiểu dữ liệu Mô Tả 1 UserName Text Tên người sử dụng 2 Pass Text Mật khẩu truy cập 3 CapNhatGia Text Cập nhật giá chè 4 ThanhToanNo Text Thanh toan nợ Bảng 11:Userlog STT Tên trường Kiểu dữ liệu Mô Tả 1 UserName Text Tên người sử dụng 2 LoginTime Date/Time Thời gian truy cập vào 3 LogoutTime Date/Time Thời gian thoát khỏi Mối quan hệ giữa các bảng : Phần III: Mã nguồn : frmnFlash: Dim i As Byte Dim j As Integer Private Sub Form_Load() sBorder.Width = Me.Width sBorder.Height = Me.Height sBorder.Top = 0 sBorder.Left = 0 i = 0 Timer1.Enabled = True End Sub Private Sub Timer1_Timer() i = i + 1 Dim start If i = 2 Then start = Timer Do While Timer < start + 2 DoEvents Loop End If If i = 4 Then start = Timer Do While Timer < start + 2 DoEvents Loop End If If i > 4 Then lblStatus.Caption = "... Ready" start = Timer Do While Timer < start + 1 DoEvents Loop Timer1.Enabled = False Unload Me frmLogin.Show Exit Sub End If lblStatus.Caption = LoadResString(500 + i) DoEvents End Sub frmLogin: Private Sub cmdLogOn_Click() txtName.Text = LCase(txtName.Text) txtPass.Text = LCase(txtPass.Text) If txtName.Text = "" Then Dim A As Byte MsgboxC "B¹n ph¶i nhËp tªn ng­êi sö dông vµo « trèng Tªn truy cËp !", vbCritical txtName.SetFocus Exit Sub End If If txtPass.Text = "" Then MsgboxC "B¹n ph¶i nhËp mËt khÈu ®Ó tiÕp tôc !", vbCritical txtPass.SetFocus Exit Sub End If Dim UserExist As Boolean If RsUser.RecordCount <= 0 Then MsgboxC "XuÊt hiÖn lçi 'RsUser.RecordCount<=0'. Xin vui lßng liªn hÖ t¸c gi¶ söa ch÷a !" End End If RsUser.MoveFirst Do While Not RsUser.EOF If LCase(RsUser.Fields(0)) = LCase(txtName.Text) Then UserExist = True If LCase(RsUser.Fields(1)) LCase(txtPass.Text) Then MsgboxC "MËt khÈu b¹n võa nhËp bÞ sai . Xin vui lßng nhËp l¹i mËt khÈu !" txtPass.SetFocus Exit Sub Else If CInt(RsUser.Fields(2)) = 1 Then frmMainUser.cmdCapNhat.Enabled = True End If If CInt(RsUser.Fields(3)) = 1 Then frmMainUser.cmdNo.Enabled = True End If Exit Do End If End If RsUser.MoveNext Loop If UserExist = False Then MsgboxC "Tªn truy nhËp cña b¹n hiÖn kh«ng cã . Xin vui lßng liªn hÖ víi ng­êi qu¶n lý !" Exit Sub End If UserName = LCase(txtName.Text) Password = LCase(txtPass.Text) Unload Me If LCase(UserName) = "administrator" Then frmMainAdmin.Show With RsUserLog .AddNew .Fields(0) = UserName .Fields(1) = Now .update End With Else frmMainUser.Show With RsUserLog .AddNew .Fields(0) = UserName .Fields(1) = Now .update End With End If End Sub Private Sub Form_Activate() pTitle.BackColor = ColorMain s1.BorderColor = ColorMain End Sub Private Sub Form_Deactivate() pTitle.BackColor = ColorDeactivate s1.BorderColor = ColorDeactivate End Sub Private Sub Form_Load() Call CreateControls ' Hµm nµy dïng ®Ó khëi t¹o Controls End Sub Public Sub CreateControls() Call InitTitleBar(Me) imgList.ListImages.Add , , LoadResPicture("logon", 1) imgList.ListImages.Add , , LoadResPicture("window", 1) imgList.ListImages.Add , , LoadResPicture("help2", 1) Set cmdLogOn.Picture = imgList.Overlay(1, 1) 'D¸n Icon len 2 Command Button Set cmdExit.Picture = imgList.Overlay(2, 2) Set cmdHelp.Picture = imgList.Overlay(3, 3) End Sub frmMainUser: Dim C As Boolean Private Sub InitForm() lblDay.Caption = "H«m nay, ngµy " & Day(Now) & ", th¸ng " & Month(Now) & ", n¨m " & Year(Now) ani1.LoadFile App.Path & "\animation\daihung1.gif", False End Sub Private Sub DisplayNhap() SetParent frmNhap.hWnd, frMain.hWnd frmNhap.Show MoveWindow frmNhap.hWnd, 0, -35, 900, 600, 1 End Sub Private Sub chameleonButton2_Click() End End Sub Private Sub CloseForm_Click() Dim ans ans = MsgboxC("B¹n cã muèn tho¸t ra khái ch­¬ng tr×nh kh«ng ?", vbYesNo, "§ang tho¸t !") If ans = vbYes Then End End If End Sub Private Sub cmdCapNhat_Click() With frmPrice SetParent .hWnd, frmMainUser.frMain.hWnd .Show MoveWindow .hWnd, 10, 10, 424, 189, 1 End With End Sub Private Sub cmdChangPass_Click() With frmChangePass SetParent .hWnd, frmMainUser.frMain.hWnd .Show MoveWindow .hWnd, 10, 10, 370, 190, 1 End With End Sub Private Sub cmdExit_Click() Dim ans ans = MsgboxC("B¹n cã muèn tho¸t ra khái ch­¬ng tr×nh kh«ng ?", vbYesNo, "§ang tho¸t !") If ans = vbYes Then If RsUserLog.RecordCount <= 0 Then Else RsUserLog.MoveLast RsUserLog.Fields(2) = Now RsUserLog.update End If End End If End Sub Private Sub cmdHelp_Click() MsgboxC "C¸c th«ng tin trî gióp sÏ ®­îc cung cÊp trùc tiÕp tõ ng­êi cung cÊp s¶n phÈm" End Sub Private Sub cmdLog_Click() If RsUserLog.RecordCount <= 0 Then Else RsUserLog.MoveLast RsUserLog.Fields(2) = Now RsUserLog.update End If '--------------- Unload prj_BuyTea.frmNhap Set frmNhap = Nothing Unload prj_BuyTea.frmThanhToanNo Set frmThanhToanNo = Nothing Unload prj_BuyTea.frmPrice Set frmPrice = Nothing Unload prj_BuyTea.frmMainUser Set frmMainUser = Nothing Unload prj_BuyTea.frmChangePass Set frmChangePass = Nothing Unload prj_BuyTea.Rpt_HoaDon Set Rpt_HoaDon = Nothing Unload prj_BuyTea.frmBaocao Set frmBaocao = Nothing Unload prj_BuyTea.frm_DoThi Set frm_DoThi = Nothing Unload prj_BuyTea.frmDataMan Set frmDataMan = Nothing Unload prj_BuyTea.frmMoney Set frmMoney = Nothing Unload prj_BuyTea.frmUserMan Set frmUserMan = Nothing Unload prj_BuyTea.frmMenu Set Menu = Nothing Unload prj_BuyTea.Form1 Set Form1 = Nothing Unload prj_BuyTea.frmXemNo Set frmXemNo = Nothing '--------------- Unload Me frmLogin.Show End Sub Private Sub cmdNo_Click() With frmThanhToanNo SetParent .hWnd, frmMainUser.frMain.hWnd .Show MoveWindow .hWnd, 10, 10, 590, 360, 1 End With End Sub Private Sub cmdNhap_Click() Call DisplayNhap End Sub Private Sub Form_Load() Call InitForm End Sub Private Sub tmTime_Timer() Dim H As String Dim M As String H = Hour(Now) If Minute(Now) < 10 Then M = "0" & Minute(Now) Else M = Minute(Now) End If If C = False Then lblTime.Caption = H & ":" & M C = True Else lblTime.Caption = H & " " & M C = False End If End Sub frmNhap: Dim curPos As Integer Dim LoadedImg As Boolean Dim Saved As Boolean Dim EditHD As Boolean Dim NewH As Boolean Dim HDNo As Boolean Private Sub chkBaobi_Click() On Error Resume Next If chkBaobi.Value = 1 Then txtBaoBi.Enabled = True lblBaobi.Enabled = True txtBaoBi.SetFocus TinhTien Else txtBaoBi.Enabled = False lblBaobi.Enabled = False TinhTien End If End Sub Private Sub chkTyleChe_Click() On Error Resume Next If chkTyleChe.Value = True Then txtTyleChe.Enabled = True lblTyle1.Enabled = True txtTyleChe.SetFocus Else txtTyleChe.Enabled = False lblTyle1.Enabled = False End If End Sub Private Sub chkTyleNuoc_Click() On Error Resume Next If chkTyleNuoc.Value = 1 Then txtTylenuoc.Enabled = True lblTyleNuoc.Enabled = True txtTylenuoc.SetFocus TinhTien Else txtTylenuoc.Enabled = False lblTyleNuoc.Enabled = False TinhTien End If End Sub Private Sub cmbLoai1_Click() On Error Resume Next With cmbLoai1 If .Text = "Lo¹i A" Then txtGia1.Text = GiaA End If If .Text = "Lo¹i B" Then txtGia1.Text = GiaB End If If .Text = "Lo¹i C" Then txtGia1.Text = GiaC End If If .Text = "Lo¹i D" Then txtGia1.Text = GiaD End If End With TinhTien End Sub Private Sub cmdAdd_Click() ' On Error Resume Next If txtKhoiLuongTruoc.Text = "0" Then MsgboxC "Kh«ng thÓ nhËp tiÕp hµng nÕu kh«ng cã ®ñ d÷ liÖu !", vbInformation txtKhoiLuongTruoc.SetFocus Exit Sub End If NewH = True Call EnableCont Call newHang ' Reset Controls End Sub Private Sub cmdClose_Click() Unload Me End Sub Private Sub cmdDel_Click() On Error Resume Next lv.ListItems.Remove curPos NewH = True Call ReOrder If lv.ListItems.Count <= 0 Then cmdDel.Enabled = False Exit Sub End If End Sub Private Sub cmdNew_Click() On Error Resume Next Dim S As Integer S = CInt(Right(lblMaHD.Caption, 4)) lblMaHD.Caption = AutoKey Dim ctl As Control txtTenKH.Text = "" txtDiachi.Text = "" txtBaoBi.Text = "0" lblA.Caption = "0" lblB.Caption = "0" lblC.Caption = "0" lblD.Caption = "0" lblTongBB.Caption = "0" txtKhoiLuongTruoc.Text = "0" lblThanhTien.Caption = "0" lblTongKL.Caption = "0" lblKhoiLuongSau.Caption = "0" lblTongtien.Caption = "0" txtTylenuoc.Text = "0" Check1.Value = 0 Check1_Click lv.ListItems.Clear Call EnableCont NewH = True txtTenKH.SetFocus End Sub Private Sub cmdPrint_Click() If lv.ListItems.Count <= 0 Then MsgboxC "B¹n ph¶i nhËp hµng tr­íc khi l­u th«ng tin !", vbInformation, "Ch­a nhËp d÷ liÖu !" Exit Sub End If If txtTenKH.Text = "" Or txtDiachi.Text = "" Then MsgboxC "B¹n ch­a nhËp ®Çy ®ñ tªn kh¸ch hµng vµ ®Þa chØ ! Ch­¬ng tr×nh sÏ tù ®­a tªn vµ ®Þa chØ nÕu b¹n bá qua.", vbYesNo, " Chó ý" txtTenKH.Text = lblMaHD.Caption txtDiachi.Text = " - kh«ng x¸c ®Þnh - " End If '----------------Tru tien trong tai khoan --------------- HDNo = False RsTongTien.MoveFirst If (CDbl(RsTongTien.Fields(0)) < CDbl(lblTongtien.Caption)) Then MsgboxC "HiÖn thêi sè tiÒn trong tµi kho¶n cña b¹n lµ " & Format(RsTongTien.Fields(0), "#,###") & " b¹n muèn mua tiÕp vµ nî phÇn cßn l¹i hay kh«ng ?", vbYesNo If MsgAns = vbNo Then Exit Sub ElseIf MsgAns = vbYes Then HDNo = True End If End If Call SaveData '--------------- In hoa don --------------------- If chkKoIn.Value = 0 Then With Rpt_HoaDon .lblNgay.Caption = Date .lblDiachi.Caption = txtDiachi.Text .lblMaHD.Caption = lblMaHD.Caption .lblTenKH.Caption = txtTenKH.Text .lblKhoiLuongSau.Caption = lblTongKL.Caption .lblTongtien.Caption = lblTongtien.Caption .lblUser.Caption = UserName .lblKlA.Caption = lblA.Caption .lblKlB.Caption = lblB.Caption .lblKlC.Caption = lblC.Caption .lblKlD.Caption = lblD.Caption RsOldData.MoveFirst Do Until RsOldData.EOF If RsOldData.Fields(0) = "Lo¹i A" Then .lblGiaA = RsOldData.Fields(1) .lblTienA = Format(CDbl(.lblGiaA) * CDbl(.lblKlA), "#,###") End If If RsOldData.Fields(0) = "Lo¹i B" Then .lblGiaB = RsOldData.Fields(1) .lblTienB = Format(CDbl(.lblGiaB) * CDbl(.lblKlB), "#,###") End If If RsOldData.Fields(0) = "Lo¹i C" Then .lblGiaC = RsOldData.Fields(1) .lblTienC = Format(CDbl(.lblGiaC) * CDbl(.lblKlC), "#,###") End If If RsOldData.Fields(0) = "Lo¹i D" Then .lblGiaD = RsOldData.Fields(1) .lblTienD = Format(CDbl(.lblGiaD) * CDbl(.lblKlD), "#,###") End If RsOldData.MoveNext Loop .Show End With End If Call cmdNew_Click 'Call update(lblMaHD) End Sub Private Sub cmdSave_Click() On Error Resume Next If txtKhoiLuongTruoc.Text = "0" Then MsgboxC "Kh«ng thÓ nhËp tiÕp hµng nÕu kh«ng cã ®ñ d÷ liÖu !", vbInformation txtKhoiLuongTruoc.SetFocus Exit Sub End If If curPos = 0 Then Exit Sub End If If NewH = True Then lv.ListItems.Add , , lv.ListItems.Count + 1 curPos = lv.ListItems.Count NewH = False End If Call addHang(curPos) End Sub Private Sub Form_Load() On Error Resume Next curPos = 1 '****** Add combo cmbLoai1.AddItem "Lo¹i A" cmbLoai1.AddItem "Lo¹i B" cmbLoai1.AddItem "Lo¹i C" cmbLoai1.AddItem "Lo¹i D" cmbLoai2.AddItem "Lo¹i A" cmbLoai2.AddItem "Lo¹i B" cmbLoai2.AddItem "Lo¹i C" cmbLoai2.AddItem "Lo¹i D" cmbLoai1.Text = cmbLoai1.list(0) cmbLoai2.Text = cmbLoai2.list(1) '************************ lblMaHD.Caption = AutoKey imgNav.ListImages.Add , , LoadResPicture("back_dis", 1) imgNav.ListImages.Add , , LoadResPicture("foward_dis", 1) imgNav.ListImages.Add , , LoadResPicture("back", 1) imgNav.ListImages.Add , , LoadResPicture("foward", 1) imgNav.ListImages.Add , , LoadResPicture("back_click", 1) imgNav.ListImages.Add , , LoadResPicture("foward_click", 1) Call DefControls NewH = True End Sub Private Sub Check1_Click() On Error Resume Next If Check1.Value = True Then chkTyleChe.Value = 0 sFrame.Width = 6435 frmLoai2.Visible = True chkTyleChe.Enabled = True txtTyleChe.Enabled = True Else chkTyleChe.Enabled = False chkTyleChe.Value = 0 sFrame.Width = 3435 frmLoai2.Visible = False txtTyleChe.Text = "100" txtTyleChe.Enabled = False End If End Sub Public Sub TinhTien() On Error Resume Next Dim KNuoc As Double 'Khoi luong nuoc trong che Dim Ktruoc As Double 'Khoi luong ban dau Dim Ksau As Double 'Khoi luong sau Dim Che1 As Double 'Khoi luong loai1 Dim Che2 As Double 'Khoi luong loai2 Dim Tong 'As Double Dim Baobi As Double ' khoi luong bao bi '########################################## 'Cong thuc tinh ' Khoi luong nuoc = (Khoi luong ban dau - Khoi luong bao bi ) * (Ty le nuoc) ' Khoi luong sau = (Khoi luong truoc) - (Khoi luong nuoc) - (Bao bi) '------------------------------------------------------------------------- Ktruoc = CDbl(txtKhoiLuongTruoc.Text) Baobi = CDbl(txtBaoBi.Text) KNuoc = (Ktruoc - Baobi) * CDbl(txtTylenuoc.Text) / 100 If chkTyleNuoc.Value = 0 And chkBaobi.Value = 0 Then lblKhoiLuongSau.Caption = Ktruoc End If If chkTyleNuoc.Value = 1 And chkBaobi.Value = 0 Then lblKhoiLuongSau.Caption = Ktruoc - KNuoc End If If chkTyleNuoc.Value = 0 And chkBaobi.Value = 1 Then lblKhoiLuongSau.Caption = Ktruoc - Baobi End If If chkTyleNuoc.Value = 1 And chkBaobi.Value = 1 Then lblKhoiLuongSau.Caption = Ktruoc - KNuoc - Baobi End If Ksau = CDbl(lblKhoiLuongSau.Caption) If Check1.Value = 0 Then Che1 = Ksau Che2 = 0 Else Che1 = Ksau * CDbl(txtTyleChe.Text) / 100 Che2 = Ksau - (Ksau * CDbl(txtTyleChe.Text) / 100) End If Tong = (Che1 * CDbl(txtGia1.Text)) + (Che2 * CDbl(txtGia2.Text)) Tong = Round(Tong, 0) '---------------------------------------------------------------------- 'Quy t¾c lµm trßn : cã 2 lo¹i lµm trßn do biÕn RoundUp (Boolean) quyÕt ®Þnh ' +> RoundUp=True : lµm trßn lªn . NÕu sè lÎ >500 vµ < 1000 th× lµm trßn lªn 1000 ' NÕu sè lÎ < 500 thi trßn thµnh 500 ' +> RoundUp=False : lµm trßn xuèng . NÕu sè lÎ >500 vµ < 1000 th× lµm trßn xuèng 500 ' NÕu sè lÎ < 500 thi trßn thµnh 0 '---------------------------------------------------------------------- If (Tong Mod 1000) > 500 Then If RoundUp = True Then ' Lµm trßn lªn Tong = Tong - (Tong Mod 1000) + 1000 Else ' lµm trßn xuèng Tong = Tong - (Tong Mod 1000) + 500 End If End If If (Tong Mod 1000) < 500 Then If RoundUp = True Then Tong = Tong - (Tong Mod 1000) + 500 Else Tong = Tong - (Tong Mod 1000) End If End If ' Hµm FormatMoney sÏ ®­a ra ®Þnh d¹ng kiÓu tiÒn . 'VD 1110000 sÏ ®­îc chuyÓn thµnh 1,100,000 lblThanhTien.Caption = FormatMoney(Tong) If lblThanhTien.Caption = "" Then lblThanhTien.Caption = "0" End If End Sub Private Sub DisplayPos(CurP As Integer) On Error Resume Next Dim i As Byte With lv.ListItems(CurP) txtKhoiLuongTruoc.Text = .SubItems(1) For i = 0 To 3 If cmbLoai1.list(i) = .SubItems(2) Then cmbLoai1.Text = cmbLoai1.list(i) Exit For End If Next i txtTyleChe.Text = .SubItems(3) If .SubItems(4) "" Then Check1.Value = True For i = 0 To 3 If cmbLoai2.list(i) = .SubItems(4) Then cmbLoai2.Text = cmbLoai2.list(i) Exit For End If Next i lblTyle.Caption = .SubItems(5) Else Check1.Value = False End If Check1_Click If .SubItems(6) "0" Then txtBaoBi.Text = .SubItems(6) Else txtBaoBi.Text = "0" chkBaobi.Value = 0 End If If .SubItems(7) "0" Then txtTylenuoc.Text = .SubItems(7) Else txtTylenuoc.Text = "0" chkTyleNuoc.Value = 0 End If lblKhoiLuongSau.Caption = .SubItems(8) lblThanhTien.Caption = .SubItems(9) End With End Sub Private Sub SaveData() ' On Error Resume Next Dim maKH As String Dim tien As String maKH = AutoKH With RsHoaDon .AddNew .Fields(0) = lblMaHD.Caption .Fields(1) = maKH .Fields(2) = UserName .Fields(3) = Date .Fields(5) = CDbl(lblTongKL.Caption) .Fields(4) = CDbl(lblTongtien.Caption) If HDNo = True Then RsTongTien.MoveFirst .Fields(6) = CDbl(lblTongtien.Caption) - CDbl(RsTongTien.Fields(0)) RsTongTien.Fields(0) = "0" RsTongTien.update ElseIf HDNo = False Then With RsTongTien .MoveFirst tien = .Fields(0) .MoveFirst .Fields(0) = CDbl(tien) - CDbl(lblTongtien.Caption) .update End With End If .update End With If lblA.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i A", lblA.Caption) End If If lblB.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i B", lblB.Caption) End If If lblC.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i C", lblC.Caption) End If If lblD.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Lo¹i D", lblD.Caption) End If With rsKhachHang .AddNew .Fields(0) = maKH .Fields(1) = txtTenKH.Text .Fields(2) = txtDiachi.Text .update End With End Sub Private Sub newHang() ' Khoi tao lai cac Control khi chon nhap them hang On Error Resume Next EditHD = False txtBaoBi.Text = "0" txtKhoiLuongTruoc.Text = "0" txtTylenuoc.Text = "0" chkBaobi.Value = False chkTyleNuoc.Value = False Check1.Value = 0 Check1_Click txtKhoiLuongTruoc.SetFocus End Sub Private Sub DefControls() EditHD = False lblNote.Caption = "" lblMaHD.Caption = AutoKey sFrame.Width = 3435 frmLoai2.Visible = False End Sub Private Sub EnableCont() On Error Resume Next txtKhoiLuongTruoc.Enabled = True Check1.Enabled = True chkTyleNuoc.Enabled = True chkBaobi.Enabled = True cmbLoai1.Enabled = True End Sub Private Sub ReOrder() On Error Resume Next Dim i As Integer Call ReSum If lv.ListItems.Count <= 0 Then Exit Sub End If For i = 1 To lv.ListItems.Count lv.ListItems(i).Text = i Next i End Sub Private Sub ReSum() On Error Resume Next lblA.Caption = "0" lblB.Caption = "0" lblC.Caption = "0" lblD.Caption = "0" lblTongBB.Caption = "0" lblTongKL.Caption = "0" lblTongtien.Caption = "0" If lv.ListItems.Count <= 0 Then Exit Sub End If Dim i As Integer Dim A As Double Dim B As Double Dim C As Double Dim D As Double Dim Per As Double A = 0 B = 0 C = 0 D = 0 For i = 1 To lv.ListItems.Count With lv.ListItems(i) Per = CDbl(.SubItems(3)) / 100 If .SubItems(2) = cmbLoai1.list(0) Then A = A + (Per * .SubItems(8)) End If If .SubItems(2) = cmbLoai1.list(1) Then B = B + Per * .SubItems(8) End If If .SubItems(2) = cmbLoai1.list(2) Then C = C + Per * .SubItems(8) End If If .SubItems(2) = cmbLoai1.list(3) Then D = D + Per * .SubItems(8) End If If Per < 100 Then ' Che bi lan Per = CDbl(.SubItems(5)) / 100 If .SubItems(4) = cmbLoai1.list(0) Then A = A + (Per * .SubItems(8)) End If If .SubItems(4) = cmbLoai1.list(1) Then B = B + Per * .SubItems(8) End If If .SubItems(4) = cmbLoai1.list(2) Then C = C + Per * .SubItems(8) End If If .SubItems(4) = cmbLoai1.list(3) Then D = D + Per * .SubItems(8) End If End If lblTongBB.Caption = CDbl(lblTongBB.Caption) + CDbl(lv.ListItems(i).SubItems(6)) lblTongKL.Caption = CDbl(lblTongKL.Caption) + CDbl(lv.ListItems(i).SubItems(8)) lblTongtien.Caption = CDbl(lblTongtien.Caption) + CDbl(lv.ListItems(i).SubItems(9)) End With Next i lblA.Caption = A lblB.Caption = B lblC.Caption = C lblD.Caption = D End Sub Private Sub SaveND(rsND As ADODB.Recordset, Ma As String, Loai As String, Kl As String) Dim P As Double If Loai = "Lo¹i A" Then P = GiaA End If If Loai = "Lo¹i B" Then P = GiaB End If If Loai = "Lo¹i C" Then P = GiaC End If If Loai = "Lo¹i D" Then P = GiaD End If With rsND .AddNew .Fields(0) = Ma ' Ma hoa don .Fields(1) = Loai ' Loai che .Fields(2) = P ' Gia che .Fields(7) = Kl ' Khoi luong .Fields(8) = CDbl(P) * CDbl(Kl) .update End With End Sub Private Sub update(mahd As String) Dim gia, klt, klt1, tt As Double Dim i As Integer Dim Sql As String Dim cmd As ADODB.Command If lv.ListItems.Count = 0 Then Exit Sub End If 'Call GetOldData Set cmd = New ADODB.Command For i = 1 To lv.ListItems.Count If lv.ListItems(i).SubItems(4) = "" Then If lv.ListItems(i).SubItems(2) = "Lo¹i A" Then gia = GiaA ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i B" Then gia = GiaB ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i C" Then gia = GiaC ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i D" Then gia = GiaD End If Sql = "insert into tbl_noidungmua(mahd,loaiche,giache,khoiluongbd,phantramche,tylenuoc,baobi,khoiluongsau,giatri) values('" & mahd & "','" & lv.ListItems(i).SubItems(2) & "','" & CStr(gia) & "','" & lv.ListItems(i).SubItems(1) & "','" & lv.ListItems(i).SubItems(3) & "','" & lv.ListItems(i).SubItems(6) & "','" & lv.ListItems(i).SubItems(7) & "','" & "','" & lv.ListItems(i).SubItems(8) & "','" & lv.ListItems(i).SubItems(9) & "')" MsgBox Sql With cmd .ActiveConnection = Cnn .CommandText = Sql .Execute End With End If If lv.ListItems(i).SubItems(4) "" Then If lv.ListItems(i).SubItems(2) = "Lo¹i A" Then gia = GiaA ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i B" Then gia = GiaB ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i C" Then gia = GiaC ElseIf lv.ListItems(i).SubItems(2) = "Lo¹i D" Then gia = GiaD End If klt = (CDbl(lv.ListItems(i).SubItems(1)) * CDbl(lv.ListItems(i).SubItems(3))) / 100 tt = klt * gia Sql = "insert into tbl_noidungmua values('" & mahd & "','" & lv.ListItems(i).SubItems(2) & "','" & CStr(gia) & "','" & lv.ListItems(i).SubItems(1) & "','" & lv.ListItems(i).SubItems(3) & "','" & lv.ListItems(i).SubItems(6) & "','" & lv.ListItems(i).SubItems(7) & "','" & CStr(klt) & "','" & CStr(tt) & "')" With cmd .ActiveConnection = Cnn .CommandText = Sql .Execute End With If lv.ListItems(i).SubItems(4) = "Lo¹i A" Then gia = GiaA ElseIf lv.ListItems(i).SubItems(4) = "Lo¹i B" Then gia = GiaB ElseIf lv.ListItems(i).SubItems(4) = "Lo¹i C" Then gia = GiaC ElseIf lv.ListItems(i).SubItems(4) = "Lo¹i D" Then gia = GiaD End If klt1 = CDbl(lv.ListItems(i).SubItems(1)) - klt tt = klt1 * gia Sql = "insert into tbl_noidungmua values('" & mahd & "','" & lv.ListItems(i).SubItems(4) & "','" & CStr(gia) & "','" & lv.ListItems(i).SubItems(1) & "','" & lv.ListItems(i).SubItems(5) & "','" & "0" & "','" & "0" & "','" & CStr(klt1) & "','" & CStr(tt) & "')" With cmd .ActiveConnection = Cnn .CommandText = Sql .Execute End With End If Next i Set cmd = Nothing End Sub frmPrice: Dim ValA As Boolean Dim ValB As Boolean Dim ValC As Boolean Dim ValD As Boolean Private Sub CloseButton_Click() Unload Me End Sub Private Sub cmdClose_Click() '------- Refresh lai gia With frmNhap.cmbLoai1 If .Text = .list(0) Then .Text = .list(1) ElseIf .Text = .list(1) Then .Text = .list(2) ElseIf .Text = .list(2) Then .Text = .list(3) ElseIf .Text = .list(3) Then .Text = .list(1) End If End With With frmNhap.cmbLoai2 If .Text = .list(0) Then .Text = .list(1) ElseIf .Text = .list(1) Then .Text = .list(2) ElseIf .Text = .list(2) Then .Text = .list(3) ElseIf .Text = .list(3) Then .Text = .list(1) End If End With '------------------------------------- Unload Me End Sub Private Sub cmdSave_Click() If txtNewA.Text = "" Or _ txtNewB.Text = "" Or _ txtNewC.Text = "" Or _ txtNewD.Text = "" Then MsgboxC "Kh«ng thÓ l­u gi¸ c¸c lo¹i chÌ !" Exit Sub End If SavePrice ValA, lblA, txtNewA SavePrice ValB, Me.lblB, Me.txtNewB SavePrice ValC, Me.lblC, Me.txtNewC SavePrice ValD, Me.lblD, Me.txtNewD txtNewA.Enabled = False txtNewB.Enabled = False txtNewC.Enabled = False txtNewD.Enabled = False End Sub Private Sub Form_Load() Call GetOldPrice imgList.ListImages.Add , , LoadResPicture("save1", 1) imgList.ListImages.Add , , LoadResPicture("no", 1) imgList.ListImages.Add , , LoadResPicture("close", 1) Set cmdSave.Picture = imgList.Overlay(1, 1) Set cmdCancel.Picture = imgList.Overlay(2, 2) Set cmdClose.Picture = imgList.Overlay(3, 3) Call InitTitleBar(Me) End Sub Private Sub imgA_Click() If ValA = False Then ValA = True imgA.Picture = imgChecked.Picture imgA.Refresh txtNewA.Enabled = True txtNewA.SetFocus Else ValA = False imgA.Picture = imgUnCheck.Picture imgA.Refresh txtNewA_LostFocus cmdCancel.SetFocus txtNewA.Enabled = False txtNewA.Text = GiaA End If SaveButton End Sub Private Sub imgA_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgA.Picture = imgTemp.Picture End Sub Private Sub lblA_Click() imgA_Click End Sub Private Sub imgb_Click() If ValB = False Then ValB = True imgB.Picture = imgChecked.Picture imgB.Refresh txtNewB.Enabled = True txtNewB.SetFocus Else ValB = False imgB.Picture = imgUnCheck.Picture imgB.Refresh txtNewB_LostFocus cmdCancel.SetFocus txtNewB.Enabled = False txtNewB.Text = GiaB End If SaveButton End Sub Private Sub imgb_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgB.Picture = imgTemp.Picture End Sub Private Sub lblb_Click() imgb_Click End Sub Private Sub lblb_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgb_MouseDown Button, Shift, X, Y End Sub Private Sub imgC_Click() If ValC = False Then ValC = True imgC.Picture = imgChecked.Picture imgC.Refresh txtNewC.Enabled = True txtNewC.SetFocus Else ValC = False imgC.Picture = imgUnCheck.Picture imgC.Refresh txtNewC_LostFocus cmdCancel.SetFocus txtNewC.Text = GiaC txtNewC.Enabled = False End If SaveButton End Sub Private Sub imgC_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgC.Picture = imgTemp.Picture End Sub Private Sub lblc_Click() imgC_Click End Sub Private Sub lblc_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgC_MouseDown Button, Shift, X, Y End Sub Private Sub imgD_Click() If ValD = False Then ValD = True imgD.Picture = imgChecked.Picture imgD.Refresh txtNewD.Enabled = True txtNewD.SetFocus Else ValD = False imgD.Picture = imgUnCheck.Picture imgD.Refresh txtNewD_LostFocus cmdCancel.SetFocus txtNewD.Text = GiaD txtNewD.Enabled = False End If SaveButton End Sub Private Sub imgD_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgD.Picture = imgTemp.Picture End Sub Private Sub lblD_Click() imgD_Click End Sub Private Sub lblD_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgD_MouseDown Button, Shift, X, Y End Sub Private Sub txtNewA_Change() With txtNewA If .Text = "" Then Exit Sub End If .Text = Format(.Text, "#,###") .SelStart = Len(.Text) If Len(.Text) > 7 Then MsgboxC "Gi¸ 1kg chÌ kh«ng ®­îc lín h¬n 6 sè" .Text = "0" Exit Sub End If End With End Sub Private Sub txtNewD_KeyPress(KeyAscii As MSForms.ReturnInteger) txtNewA_KeyPress KeyAscii End Sub Private Sub txtNewD_LostFocus() With txtNewD .BackColor = C3 .SelStart = 0 .SelLength = 0 End With End Sub Private Sub SavePrice(Save As Boolean, Lbl As VB.Label, Tx As MSForms.TextBox) If Save = False Then Exit Sub End If With RsGiaChe .AddNew .Fields(1) = Lbl.Caption .Fields(2) = Tx.Text .Fields(3) = Date If UserName = "" Then .Fields(4) = "Error !" Else .Fields(4) = UserName End If .update End With With RsOldData If .RecordCount <= 0 Then .AddNew End If .MoveFirst .Fields(0) = "Lo¹i A" .Fields(1) = CDbl(txtNewA.Text) GiaA = CDbl(txtNewA.Text) .MoveNext .Fields(0) = "Lo¹i B" .Fields(1) = CDbl(txtNewB.Text) GiaB = CDbl(txtNewB.Text) .MoveNext .Fields(0) = "Lo¹i C" .Fields(1) = CDbl(txtNewC.Text) GiaC = CDbl(txtNewC.Text) .MoveNext .Fields(0) = "Lo¹i D" .Fields(1) = CDbl(txtNewD.Text) GiaD = CDbl(txtNewD.Text) .update End With End Sub Public Sub SaveButton() If ValA = False And ValB = False And ValC = False And ValD = False Then cmdSave.Enabled = False Else cmdSave.Enabled = True End If End Sub Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub Private Sub pTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub frmThanhToanNo: Const CB_SHOWDROPDOWN = &H14F Dim Tmp Private Sub CloseButton_Click() Unload Me End Sub Private Sub cmdThanhToan_Click() Dim max As Integer If (Text3.Text = "") Or (Text5.Text = "") Then Exit Sub End If If RsHoaDon.RecordCount <= 0 Then Exit Sub End If RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(0) = Text1.Text Then If CDbl(Text3.Text) >= CDbl(Text5.Text) Then RsHoaDon.Fields(6).Value = CDbl(Text3.Text) - CDbl(Text5.Text) If RsNo.RecordCount <= 0 Then RsNo.AddNew RsNo.Fields(0).Value = Text1.Text RsNo.Fields(1).Value = Date RsNo.Fields(2).Value = CDbl(Text5.Text) RsNo.Fields(3).Value = max + 1 RsNo.update Else RsNo.MoveFirst Do Until RsNo.EOF = True If RsNo.Fields(0).Value = Text1.Text Then max = 1 If max < RsNo.Fields(3).Value Then max = RsNo.Fields(3).Value End If RsNo.MoveNext Loop RsNo.AddNew RsNo.Fields(0).Value = Text1.Text RsNo.Fields(1).Value = Date RsNo.Fields(2).Value = CDbl(Text5.Text) RsNo.Fields(3).Value = max + 1 RsNo.update End If ElseIf CDbl(Text3.Text) < CDbl(Text5.Text) Then frmMsgOk.lblTitle = "Chó ý" frmMsgOk.lblPrompt = " Sè thanh to¸n kh«ng ®­îc lín h¬n sè nî" frmMsgOk.Show Text5.Text = "" End If End If RsHoaDon.MoveNext Loop Call Create_List Call Clear_Text End Sub Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub Private Sub list_DblClick() Dim Stt As Integer If Text1.Text "" Then SendStr = Text1.Text frmXemNo.Show Else Exit Sub End If End Sub Private Sub list_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim Stt As Integer Text5.Enabled = True For Stt = 1 To list.ListItems.Count If list.ListItems(Stt).Selected = True Then Text1.Text = list.ListItems(Stt).SubItems(1) Text2.Text = list.ListItems(Stt).SubItems(2) Text3.Text = list.ListItems(Stt).SubItems(3) End If Next If RsHoaDon.RecordCount <= 0 Then Exit Sub End If RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(0) = Text1.Text Then If rsKhachHang.RecordCount <= 0 Then Exit Sub End If rsKhachHang.MoveFirst Do Until rsKhachHang.EOF = True If rsKhachHang.Fields(0) = RsHoaDon.Fields(1) Then Text6.Text = rsKhachHang.Fields(2) End If rsKhachHang.MoveNext Loop End If RsHoaDon.MoveNext Loop End Sub Private Sub MyButton1_Click() Unload Me End Sub Private Sub pTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub Private Sub Form_Load() Call InitTitleBar(Me) Call Create_List Call CreateRs Text4.Text = "H«m nay, ngµy " & DatePart("d", Date) & " th¸ng " & DatePart("m", Date) & " n¨m " & DatePart("yyyy", Date) Text5.Enabled = False End Sub Public Sub Create_List() Dim Stt As Integer list.ColumnHeaders.Clear list.ColumnHeaders.Add 1, , "Sè TT", 400 list.ColumnHeaders.Add 2, , "M· Ho¸ ®¬n", 1600 list.ColumnHeaders.Add 3, , "Tªn ng­êi b¸n", 1500 list.ColumnHeaders.Add 4, , "Sè tiÒn nî", 1000, 1 list.FullRowSelect = True list.ListItems.Clear If RsHoaDon.RecordCount <= 0 Then Exit Sub End If RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(6) > 0 Then If rsKhachHang.RecordCount <= 0 Then Exit Sub End If rsKhachHang.MoveFirst Do Until rsKhachHang.EOF = True If (RsHoaDon.Fields(1) = rsKhachHang.Fields(0)) Then Stt = Stt + 1 list.ListItems.Add , , Stt list.ListItems(Stt).SubItems(1) = RsHoaDon.Fields(0) list.ListItems(Stt).SubItems(2) = rsKhachHang.Fields(1) list.ListItems(Stt).SubItems(3) = Format(RsHoaDon.Fields(6), "#,###") End If rsKhachHang.MoveNext Loop End If RsHoaDon.MoveNext Loop '------------ Text5.Enabled = False End Sub Private Sub Text5_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then Exit Sub End If If KeyAscii = 13 Then Call cmdThanhToan_Click End If If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0 End If End Sub frmMainAdmin Dim C As Boolean Public Sub InitForm() bottom1.BackColor = ColorMain SetParent frmMenu.hWnd, frameMenu.hWnd frmMenu.Show MoveWindow frmMenu.hWnd, 0, -30, frmMenu.Width, frmMenu.Height, 1 ani1.LoadFile App.Path & "\animation\daihung1.gif", False End Sub Private Sub cmdLog_Click() If RsUserLog.RecordCount <= 0 Then Else RsUserLog.MoveLast RsUserLog.Fields(2) = Now RsUserLog.update End If '-------------------- Unload prj_BuyTea.frmNhap Set frmNhap = Nothing Unload prj_BuyTea.frmThanhToanNo Set frmThanhToanNo = Nothing Unload prj_BuyTea.frmPrice Set frmPrice = Nothing Unload prj_BuyTea.frmMainUser Set frmMainUser = Nothing Unload prj_BuyTea.frmChangePass Set frmChangePass = Nothing Unload prj_BuyTea.Rpt_HoaDon Set Rpt_HoaDon = Nothing Unload prj_BuyTea.frmBaocao Set frmBaocao = Nothing Unload prj_BuyTea.frm_DoThi Set frm_DoThi = Nothing Unload prj_BuyTea.frmDataMan Set frmDataMan = Nothing Unload prj_BuyTea.frmMoney Set frmMoney = Nothing Unload prj_BuyTea.frmUserMan Set frmUserMan = Nothing Unload prj_BuyTea.frmMenu Set Menu = Nothing Unload prj_BuyTea.Form1 Set Form1 = Nothing Unload prj_BuyTea.frmXemNo Set frmXemNo = Nothing '--------------- Unload Me Set frmMainAdmin = Nothing frmLogin.Show End Sub Private Sub Form_Load() Call InitForm End Sub Private Sub cmdThoat_Click() Dim ans ans = MsgboxC("B¹n cã muèn tho¸t khái ch­¬ng tr×nh kh«ng ?", vbYesNo, "Tho¸t khái ch­¬ng tr×nh !") If ans = vbYes Then If RsUserLog.RecordCount <= 0 Then Else RsUserLog.MoveLast RsUserLog.Fields(2) = Now RsUserLog.update End If End End If End Sub Private Sub tmTime_Timer() Dim H As String Dim M As String H = Hour(Now) If Minute(Now) < 10 Then M = "0" & Minute(Now) Else M = Minute(Now) End If If C = False Then lblTime.Caption = H & ":" & M C = True Else lblTime.Caption = H & " " & M C = False End If End Sub frmUserMan: Dim uName As String ' User Name Dim uEdit As Boolean Private Sub DefaultCtl() lblNote.Caption = "" imgListUser.ListImages.Add , "user0", LoadResPicture("user0", 1) imgListUser.ListImages.Add , "user1", LoadResPicture("user1", 1) imgListUser.ListImages.Add , "user2", LoadResPicture("user2", 1) End Sub Private Sub CloseButton_Click() Unload Me End Sub Private Sub cmdAbort_Click() Call ButtonEnabled(True) Call LockText End Sub Private Sub cmdDel_Click() If uName = "administrator" Then MsgboxC "Th«ng tin vÒ nhµ qu¶n lý kh«ng thÓ bÞ xo¸ . Xin vui lßng chän mét ng­êi kh¸c !", vbCritical Exit Sub End If Dim ans As Byte ans = MsgboxC("B¹n cã muèn xo¸ tªn truy nhËp : '" & uName & "' kh«ng ?", vbYesNo) If ans = vbYes Then If RsUser.RecordCount <= 0 Then Exit Sub End If RsUser.MoveFirst Do While Not RsUser.EOF If RsUser.Fields(0) = uName Then RsUser.Delete RsUser.update txtUserName.Text = "" txtPass.Text = "" txtConf.Text = "" chkNo.Value = False chkGia.Value = False Exit Do End If RsUser.MoveNext Loop Call CreateLV End If End Sub Private Sub cmdEdit_Click() If uName = "administrator" Then MsgboxC "Th«ng tin vÒ nhµ qu¶n lý kh«ng thÓ bÞ thay ®æi. §Ó ®æi mËt khÈu xin chän môc §æi mËt khÈu !", vbCritical Exit Sub End If If uName = "" Then MsgboxC "B¹n ph¶i chän mét ng­êi dïng trong danh s¸ch trªn !", vbInformation Exit Sub End If cmdEdit.Visible = False Call ButtonEnabled(False) lvUser2.Enabled = False txtUserName.Enabled = True txtPass.Enabled = True txtConf.Enabled = True chkNo.Enabled = True chkGia.Enabled = True Call EditUser(uName) uEdit = True End Sub Private Sub cmdMain_Click() Unload Me End Sub Private Sub cmdNew_Click() uEdit = False Call ButtonEnabled(False) txtUserName.Text = "" txtUserName.Enabled = True txtPass.Text = "" txtPass.Enabled = True txtConf.Text = "" txtConf.Enabled = True chkGia.Enabled = True chkGia.Value = False chkNo.Enabled = True chkNo.Value = False End Sub Private Sub cmdSave_Click() If txtUserName.Text = "" Then MsgboxC "B¹n ph¶i nhËn tªn ng­êi sö dông !" txtUserName.SetFocus Exit Sub End If If Len(txtUserName.Text) > 15 Or Len(txtUserName.Text) < 6 Then MsgboxC "Tªn truy nhËp ph¶i dµi h¬n 6 ký tù vµ ng¾n h¬n 15 ký tù !" txtUserName.SetFocus Exit Sub End If If txtPass.Text = "" Then MsgboxC "MËt khÈu ch­a ®­îc nhËp !" txtConf.SetFocus Exit Sub End If If Len(txtPass.Text) > 12 Then MsgboxC "MËt khÈu ph¶i ng¾n h¬n 12 ký tù !" txtConf.SetFocus Exit Sub End If If txtConf.Text txtPass.Text Then MsgboxC "MËt khÈu x¸c nhËn bÞ sai . Xin vui lßng nhËp l¹i !" txtConf.SetFocus Exit Sub End If If uEdit = True Then RsUser.Fields(0) = txtUserName.Text RsUser.Fields(1) = txtPass.Text If chkGia.Value = True Then RsUser.Fields(2) = "1" Else RsUser.Fields(2) = "0" End If If chkNo.Value = True Then RsUser.Fields(3) = "1" Else RsUser.Fields(3) = "0" End If RsUser.update Else RsUser.AddNew RsUser.Fields(0) = txtUserName.Text RsUser.Fields(1) = txtPass.Text If chkGia.Value = True Then RsUser.Fields(2) = "1" Else RsUser.Fields(2) = "0" End If If chkNo.Value = True Then RsUser.Fields(3) = "1" Else RsUser.Fields(3) = "0" End If RsUser.update End If Call ButtonEnabled(True) Call LockText Call CreateLV End Sub Private Sub Form_Load() Skin1.LoadSkin App.Path & "\s1.skn" Skin1.ApplySkin lvUser2.hWnd Call CreateCnn Call CreateRs Call DefaultCtl Call CreateLV Call InitTitleBar(Me) s1.Height = Me.Height End Sub Private Sub CreateLV() lvUser2.ListItems.Clear If RsUser.RecordCount <= 0 Then Exit Sub End If Dim U As Integer RsUser.MoveFirst Do While Not RsUser.EOF U = U + 1 lvUser2.ListItems.Add , , RsUser.Fields(0), "user1" If CInt(RsUser.Fields(2)) = 1 Or CInt(RsUser.Fields(3)) = 1 Then lvUser2.ListItems(U).Icon = "user2" End If If RsUser.Fields(0) = "administrator" Then lvUser2.ListItems(U).Icon = "user0" End If RsUser.MoveNext Loop End Sub Private Sub ButtonEnabled(Be As Boolean) cmdNew.Visible = False cmdDel.Visible = False cmdEdit.Visible = False cmdMain.Visible = False cmdSave.Visible = False cmdAbort.Visible = False DoEvents cmdNew.Enabled = Be cmdDel.Enabled = Be cmdEdit.Enabled = Be cmdMain.Enabled = Be cmdSave.Enabled = Not Be cmdAbort.Enabled = Not Be lvUser2.Enabled = Be cmdNew.Visible = True cmdDel.Visible = True cmdEdit.Visible = True cmdMain.Visible = True cmdSave.Visible = True cmdAbort.Visible = True DoEvents End Sub Private Sub VisibleEdit() Me.Height = 6885 Me.Top = 0 Me.Left = 0 frmUserInf.Visible = True frmButton.Top = frmUserInf.Top + frmUserInf.Height + 100 frmNote.Top = frmButton.Top + frmButton.Height End Sub Private Sub EditUser(n As String) On Error GoTo e1 Dim i As Integer RsUser.MoveFirst Do While Not RsUser.EOF i = i + 1 If RsUser.Fields(0) = n Then txtUserName.Text = RsUser.Fields(0) txtPass.Text = RsUser.Fields(1) txtConf.Text = txtPass.Text chkGia.Value = CInt(RsUser.Fields(2)) chkNo.Value = CInt(RsUser.Fields(3)) uPos = i Exit Sub End If RsUser.MoveNext Loop e1: End Sub Private Sub lvUser2_ItemClick(ByVal Item As MSComctlLib.ListItem) Call Display(Item.Text) uName = Item.Text End Sub Private Function CheckName() As Boolean On Error GoTo e1 RsUser.MoveFirst Do While Not RsUser.EOF If LCase(txtUserName.Text) = LCase(RsUser.Fields(0)) Then CheckName = True Exit Function End If RsUser.MoveNext Loop e1: End Function frmBaoCao: Private Sub imgBaoCao_Click() 'Tab Bao cao Thu Mua ---------- imgBaocao.Visible = False imgBaocao1.Visible = True DT_Lich = Date frm_ThuMua.Visible = True OptDate.Value = True optMuaChe.Value = True Call Add_cmbLoai(cmbChonLoaiPL) cmbChonLoaiPL.Text = "Toµn bé" Call Create_ListThuMua 'Tab User access ------------------ imgUser1.Visible = False imgUser.Visible = True frm_ListUser.Visible = False End Sub Private Sub imgUser_Click() 'Tab Bao cao Thu mua -------- imgBaocao.Visible = True imgBaocao1.Visible = False frm_ThuMua.Visible = False 'Tab User Access ----------------- imgUser1.Visible = True imgUser.Visible = False frm_ListUser.Visible = True DT_Lich_User = Date OptDate_User.Value = True OptTimeAccess_User.Value = True cmbViewUser_User.Enabled = False End Sub '--------------------------------------------Tabstrip USER----------------------------------------------- Private Sub Create_ListUser() Dim Stt As Integer ListUser.ListItems.Clear Call ListviewHeader_UserAccess(ListUser) If RsUserLog.RecordCount = 0 Then Exit Sub End If Stt = 0 If OptDate_User.Value = True Then RsUserLog.MoveFirst Do Until RsUserLog.EOF = True If DatePart("d", RsUserLog.Fields(1)) = DT_Lich_User.Day _ And DatePart("m", RsUserLog.Fields(1)) = DT_Lich_User.Month _ And DatePart("yyyy", RsUserLog.Fields(1)) = DT_Lich_User.Year Then Call ListviewDetail_UserAccess(ListUser, RsUserLog, Stt) End If RsUserLog.MoveNext Loop ElseIf OptMonth_User.Value = True Then RsUserLog.MoveFirst Do Until RsUserLog.EOF = True If DatePart("m", RsUserLog.Fields(1)) = DT_Lich_User.Month _ And DatePart("yyyy", RsUserLog.Fields(1)) = DT_Lich_User.Year Then Call ListviewDetail_UserAccess(ListUser, RsUserLog, Stt) End If RsUserLog.MoveNext Loop ElseIf OptYear_User.Value = True Then RsUserLog.MoveFirst Do Until RsUserLog.EOF = True If DatePart("yyyy", RsUserLog.Fields(1)) = DT_Lich_User.Year Then Call ListviewDetail_UserAccess(ListUser, RsUserLog, Stt) End If RsUserLog.MoveNext Loop End If End Sub Private Sub Create_ListviewUser_Update() Dim No As Integer Dim Stt As Integer ListUser.ListItems.Clear Call ListviewHeader_UserUpdate(ListUser) If RsGiaChe.RecordCount <= 0 Then Exit Sub End If If OptDate_User.Value = True Then RsGiaChe.MoveFirst Do Until RsGiaChe.EOF = True If RsGiaChe.Fields(3) = DT_Lich_User Then Call ListviewDetail_UserUpdate(ListUser, RsGiaChe, Stt, cmbViewUser_User) End If RsGiaChe.MoveNext Loop ElseIf OptMonth_User.Value = True Then RsGiaChe.MoveFirst Do Until RsGiaChe.EOF = True If DatePart("yyyy", RsGiaChe.Fields(3)) = DT_Lich_User.Year _ And DatePart("m", RsGiaChe.Fields(3)) = DT_Lich_User.Month Then Call ListviewDetail_UserUpdate(ListUser, RsGiaChe, Stt, cmbViewUser_User) End If RsGiaChe.MoveNext Loop ElseIf OptYear_User.Value = True Then RsGiaChe.MoveFirst Do Until RsGiaChe.EOF = True If DatePart("yyyy", RsGiaChe.Fields(3)) = DT_Lich_User.Year Then Call ListviewDetail_UserUpdate(ListUser, RsGiaChe, Stt, cmbViewUser_User) End If RsGiaChe.MoveNext Loop End If End Sub Private Sub Create_ListviewUser_Contact() Dim Stt As Integer ListUser.ListItems.Clear Call ListviewHeader_UserAccess_Contact(ListUser) If RsHoaDon.RecordCount <= 0 Then Exit Sub End If If OptDate_User.Value = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(3) = DT_Lich_User Then Call ListviewDetail_UserAccess_Contact(ListUser, RsHoaDon, rsKhachHang, Stt, cmbViewUser_User) End If RsHoaDon.MoveNext Loop ElseIf OptMonth_User.Value = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich_User.Year _ And DatePart("m", RsHoaDon.Fields(3)) = DT_Lich_User.Month Then Call ListviewDetail_UserAccess_Contact(ListUser, RsHoaDon, rsKhachHang, Stt, cmbViewUser_User) End If RsHoaDon.MoveNext Loop ElseIf OptYear_User.Value = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich_User.Year Then Call ListviewDetail_UserAccess_Contact(ListUser, RsHoaDon, rsKhachHang, Stt, cmbViewUser_User) End If RsHoaDon.MoveNext Loop End If End Sub Private Sub cmbViewUser_User_Click() If OptTimeAccess_User = True Then Call Create_ListUser ElseIf OptListOperation_User = True Then Call Create_ListviewUser_Update ElseIf Me.OptHD_User = True Then Call Create_ListviewUser_Contact End If End Sub Private Sub DT_Lich_User_Change() If OptTimeAccess_User.Value = True Then cmbViewUser_User.Enabled = False Call Create_ListUser ElseIf OptListOperation_User.Value = True Then ElseIf OptHD_User.Value = True Then Call Create_ListviewUser_Contact End If End Sub Private Sub OptMonth_User_Click() If OptTimeAccess_User.Value = True Then cmbViewUser_User.Enabled = False Call Create_ListUser ElseIf OptHD_User.Value = True Then Call Create_ListviewUser_Contact ElseIf OptListOperation_User = True Then Call Create_ListviewUser_Update End If End Sub Private Sub OptYear_User_Click() If OptTimeAccess_User.Value = True Then cmbViewUser_User.Enabled = False Call Create_ListUser ElseIf OptHD_User.Value = True Then Call Create_ListviewUser_Contact ElseIf OptListOperation_User = True Then Call Create_ListviewUser_Update End If End Sub Private Sub OptDate_User_Click() If OptTimeAccess_User.Value = True Then cmbViewUser_User.Enabled = False Call Create_ListUser ElseIf OptHD_User.Value = True Then Call Create_ListviewUser_Contact ElseIf OptListOperation_User = True Then Call Create_ListviewUser_Update End If End Sub Private Sub OptHD_User_Click() cmbViewUser_User.Enabled = True Call AddCombo(RsUser, 0, cmbViewUser_User) Call Create_ListviewUser_Contact cmbViewUser_User.Text = "Toµn bé" End Sub Private Sub OptListOperation_User_Click() Call Create_ListviewUser_Update cmbViewUser_User.Enabled = True Call AddCombo(RsUser, 0, cmbViewUser_User) cmbViewUser_User.Text = "Toµn bé" End Sub Private Sub OptTimeAccess_User_Click() Call Create_ListUser cmbViewUser_User.Enabled = False End Sub '--------------------------------------------Tabstrip Thu Mua----------------------------------------------- Private Sub Create_ListThuMua() Dim Stt As Integer ListThuMua.ListItems.Clear Call ListviewHeader_ThuMua(ListThuMua) If RsHoaDon.RecordCount = 0 Then Exit Sub End If Stt = 0 '--------------------------------------------------------------------- If Me.OptDate = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True 'If IsNull(RsHoaDon.Fields(6)) = True Or RsHoaDon.Fields(6) = "0" Then If RsHoaDon!ngaymua = DT_Lich Then Call ListviewDetail_ThuMua(ListThuMua, RsHoaDon, Stt) End If 'End If RsHoaDon.MoveNext Loop ElseIf Me.OptMonth = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True 'If IsNull(RsHoaDon.Fields(6)) = True Or RsHoaDon.Fields(6) = "0" Then If (DatePart("m", RsHoaDon!ngaymua) = DT_Lich.Month) _ And (DatePart("yyyy", RsHoaDon!ngaymua) = DT_Lich.Year) Then Call ListviewDetail_ThuMua(ListThuMua, RsHoaDon, Stt) End If 'End If RsHoaDon.MoveNext Loop ElseIf Me.OptYear = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True 'If IsNull(RsHoaDon.Fields(6)) = True Or RsHoaDon.Fields(6) = "0" Then If DatePart("yyyy", RsHoaDon!ngaymua) = DT_Lich.Year Then Call ListviewDetail_ThuMua(ListThuMua, RsHoaDon, Stt) End If 'End If RsHoaDon.MoveNext Loop End If Dim i As Integer Dim TongKL As Double Dim TongGT As Double TongKL = 0 TongGT = 0 If ListThuMua.ListItems.Count 0 Then For j = 1 To ListThuMua.ListItems.Count TongKL = TongKL + CDbl(ListThuMua.ListItems(j).ListSubItems(5).Text) TongGT = TongGT + CDbl(ListThuMua.ListItems(j).ListSubItems(6).Text) Next End If lblKhoiLuong.Caption = Format(CDbl(TongKL), "#,###") lblGiaTri.Caption = Format(CDbl(TongGT), "#,###") Label12.Caption = "Gi¸ trung b×nh : " If lblGiaTri.Caption = "" Or lblKhoiLuong.Caption = "" Then lblGt_tb.Caption = 0 Else lblGt_tb.Caption = Format(CDbl(lblGiaTri.Caption) / CDbl(lblKhoiLuong.Caption), "#,###") End If End Sub Private Sub Create_ListPhanLoai() Dim No As Integer Dim Stt As Integer ListThuMua.ListItems.Clear Call ListviewHeader_PhanLoai(ListThuMua) If RsHoaDon.RecordCount = 0 Then Exit Sub End If Stt = 0 '--------------------------------------------------------------------- If Me.OptDate = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(3) = DT_Lich Then Call ListviewDetail_PhanLoai(ListThuMua, RsHoaDon, RsNoiDungMua, Stt, cmbChonLoaiPL, No) End If RsHoaDon.MoveNext Loop ElseIf Me.OptMonth = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If (DatePart("m", RsHoaDon.Fields(3)) = DT_Lich.Month) _ And (DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich.Year) Then Call ListviewDetail_PhanLoai(ListThuMua, RsHoaDon, RsNoiDungMua, Stt, cmbChonLoaiPL, No) End If RsHoaDon.MoveNext Loop ElseIf Me.OptYear = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich.Year Then Call ListviewDetail_PhanLoai(ListThuMua, RsHoaDon, RsNoiDungMua, Stt, cmbChonLoaiPL, No) End If RsHoaDon.MoveNext Loop End If Dim i As Integer Dim TongKL As Double Dim TongGT As Double TongKL = 0 TongGT = 0 If ListThuMua.ListItems.Count 0 Then For j = 1 To ListThuMua.ListItems.Count TongKL = TongKL + CDbl(ListThuMua.ListItems(j).ListSubItems(6).Text) TongGT = TongGT + CDbl(ListThuMua.ListItems(j).ListSubItems(7).Text) Next End If lblKhoiLuong.Caption = Format(CDbl(TongKL), "#,###") lblGiaTri.Caption = Format(CDbl(TongGT), "#,###") Label12.Caption = "Gi¸ trung b×nh : " If lblGiaTri.Caption = "" Or lblKhoiLuong.Caption = "" Then lblGt_tb.Caption = 0 Else lblGt_tb.Caption = Format(CDbl(lblGiaTri.Caption) / CDbl(lblKhoiLuong.Caption), "#,###") End If End Sub Private Sub Create_ListNo() Dim Stt As Integer ListThuMua.ListItems.Clear Call ListviewHeader_No(ListThuMua) If RsHoaDon.RecordCount = 0 Then Exit Sub End If Stt = 0 '--------------------------------------------------------------------- If Me.OptDate = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(3) = DT_Lich Then Call ListviewDetail_No(ListThuMua, RsHoaDon, rsKhachHang, Stt, chkNo) End If RsHoaDon.MoveNext Loop ElseIf Me.OptMonth = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If (DatePart("m", RsHoaDon.Fields(3)) = DT_Lich.Month) _ And (DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich.Year) Then Call ListviewDetail_No(ListThuMua, RsHoaDon, rsKhachHang, Stt, chkNo) End If RsHoaDon.MoveNext Loop ElseIf Me.OptYear = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich.Year Then Call ListviewDetail_No(ListThuMua, RsHoaDon, rsKhachHang, Stt, chkNo) End If RsHoaDon.MoveNext Loop End If Dim i As Integer Dim TongKL As Double Dim TongGT As Double TongKL = 0 TongGT = 0 If ListThuMua.ListItems.Count 0 Then For j = 1 To ListThuMua.ListItems.Count If ListThuMua.ListItems(j).ListSubItems(7).Text "" Then TongGT = TongGT + CDbl(ListThuMua.ListItems(j).ListSubItems(7).Text) Else TongGT = TongGT + 0 End If Next End If lblGiaTri.Caption = Format(CDbl(TongGT), "#,###") If lblGiaTri.Caption = "" Or lblKhoiLuong.Caption = "" Then lblGt_tb.Caption = 0 End If End Sub Private Sub Create_ListTongHop() Dim Stt As Integer ListThuMua.ListItems.Clear Call ListviewHeader_TongHop(ListThuMua) If OptMonth = True Then Call ListviewDetail_TongHop(ListThuMua, Stt, "thang", DT_Lich) ElseIf OptYear = True Then Call ListviewDetail_TongHop(ListThuMua, Stt, "nam", DT_Lich) End If Dim i As Integer Dim TongKL As Double Dim TongGT As Double Dim TongNo As Double TongKL = 0 TongGT = 0 If ListThuMua.ListItems.Count 0 Then For j = 1 To ListThuMua.ListItems.Count TongKL = TongKL + CDbl(ListThuMua.ListItems(j).ListSubItems(2).Text) TongGT = TongGT + CDbl(ListThuMua.ListItems(j).ListSubItems(3).Text) If ListThuMua.ListItems(j).ListSubItems(4).Text "" Then TongNo = TongNo + CDbl(ListThuMua.ListItems(j).ListSubItems(4).Text) Else TongNo = TongNo + 0 End If Next End If lblKhoiLuong.Caption = Format(CDbl(TongKL), "#,###") lblGiaTri.Caption = Format(CDbl(TongGT), "#,###") Call Label_No_UnHide Label12.Caption = "Tæng gi¸ trÞ nî :" lblGt_tb.Caption = Format(CDbl(TongNo), "#,###") End Sub Private Sub Label_No_Hide() Label2.Caption = "Tæng tiÒn nî : " Label3.Visible = False Label1.Visible = False Label7.Visible = False Label12.Visible = False lblGt_tb.Visible = False lblKhoiLuong.Visible = False End Sub Private Sub Label_No_UnHide() Label2.Caption = "Tæng gi¸ trÞ : " Label3.Visible = True Label1.Visible = True Label7.Visible = True Label12.Visible = True lblGt_tb.Visible = True lblKhoiLuong.Visible = True End Sub Private Sub OptDate_Click() If optMuaChe.Value = True Then Call Create_ListThuMua Call Label_No_UnHide ElseIf optPhanLoaiChe.Value = True Then Call Create_ListPhanLoai Call Label_No_UnHide ElseIf optNo.Value = True Then Call Create_ListNo Call Label_No_Hide End If End Sub Private Sub optYear_Click() If optMuaChe.Value = True Then Call Create_ListThuMua Call Label_No_UnHide ElseIf optPhanLoaiChe.Value = True Then Call Create_ListPhanLoai Call Label_No_UnHide ElseIf optNo.Value = True Then Call Create_ListNo Call Label_No_Hide ElseIf optTongHop.Value = True Then Call Create_ListTongHop End If End Sub Private Sub optMonth_Click() If optMuaChe.Value = True Then Call Create_ListThuMua Call Label_No_UnHide ElseIf optPhanLoaiChe.Value = True Then Call Create_ListPhanLoai Call Label_No_UnHide ElseIf optNo.Value = True Then Call Create_ListNo Call Label_No_Hide ElseIf optTongHop.Value = True Then Call Create_ListTongHop End If End Sub Private Sub DT_Lich_Change() If optMuaChe.Value = True Then Call Create_ListThuMua Call Label_No_UnHide ElseIf optPhanLoaiChe.Value = True Then Call Create_ListPhanLoai Call Label_No_UnHide ElseIf optNo.Value = True Then Call Create_ListNo ElseIf optTongHop.Value = True Then Call Create_ListTongHop End If End Sub Private Sub optTongHop_Click() Call Create_ListTongHop OptDate.Enabled = False Me.cmbChonLoaiPL.Visible = False Me.chkNo.Visible = False End Sub Private Sub optPhanLoaiChe_Click() Me.cmbChonLoaiPL.Visible = True chkNo.Visible = False lblChonLoai.Visible = True Call Create_ListPhanLoai Call Label_No_UnHide OptDate.Enabled = True End Sub Private Sub optMuaChe_Click() Call Create_ListThuMua Call Label_No_UnHide Me.cmbChonLoaiPL.Visible = False chkNo.Visible = False lblChonLoai.Visible = False OptDate.Enabled = True End Sub Private Sub optNo_Click() Call Create_ListNo Me.cmbChonLoaiPL.Visible = False chkNo.Visible = True lblChonLoai.Visible = False Call Label_No_Hide OptDate.Enabled = True End Sub Private Sub cmbChonLoaiPL_Click() Call Create_ListPhanLoai OptDate.Enabled = True End Sub Private Sub chkNo_Click() Call Create_ListNo End Sub Private Sub cmdPrint_Click() Dim Sql As String '------------------- Thu mua che ------------------------------ If optMuaChe = True Then Dim rsMuaChe As Recordset With rptMuaChe .BottomMargin = 1000 .LeftMargin = 1000 .RightMargin = 1000 .TopMargin = 1000 .ReportWidth = 9000 End With If OptDate = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.Tongtien) AS TongTien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi " & _ "HAVING ((cstr(tbl_HoaDon.NgayMua)='" & DT_Lich & "')); " ElseIf OptYear = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.Tongtien) AS TongTien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi " & _ " HAVING ((cstr(datepart('yyyy',tbl_HoaDon.NgayMua))='" & DT_Lich.Year & " ')); " ElseIf OptMonth = True Then Sql = " SELECT Year([NgayMua]) AS [year], Month([NgayMua]) AS [month], tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY Year([NgayMua]), Month([NgayMua]), tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi " & _ " HAVING (((Year([NgayMua]))='" & DT_Lich.Year & "' ) AND ((Month([NgayMua]))='" & DT_Lich.Month & "')); " End If Set rsMuaChe = New Recordset rsMuaChe.Open Sql, Cnn, adOpenKeyset Set rptMuaChe.DataSource = rsMuaChe rptMuaChe.Show '--------------- Danh sach hoa don no ---------------------- ElseIf optNo = True Then Dim rsNoTra As Recordset With rptNo .BottomMargin = 1000 .LeftMargin = 1000 .RightMargin = 1000 .TopMargin = 1000 .ReportWidth = 9000 End With With rptNoTra .BottomMargin = 1000 .LeftMargin = 1000 .RightMargin = 1000 .TopMargin = 1000 .ReportWidth = 9000 End With If OptDate = True Then If chkNo.Value = 0 Then Sql = " SELECT tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua " & _ " HAVING ((cstr(tbl_HoaDon.NgayMua)='" & DT_Lich & "') AND ((Sum(tbl_HoaDon.[No]))CInt(0))); " Else Sql = " SELECT tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua " & _ " HAVING ((cstr(tbl_HoaDon.NgayMua)='" & DT_Lich & "') AND ((Sum(tbl_HoaDon.[No]))=CInt(0))); " End If ElseIf OptMonth = True Then '---------------------------------- If chkNo.Value = 0 Then Sql = " SELECT Month([NgayMua]) AS [month], Year([NgayMua]) AS [year], tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiLuong, sum(tbl_HoaDon.Tongtien) AS TongTien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY Month([NgayMua]), Year([NgayMua]), tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi" & _ " HAVING ((cstr(Month([NgayMua]))='" & DT_Lich.Month & "') AND (cstr(Year([NgayMua]))='" & DT_Lich.Year & "' ) AND ((Sum(tbl_HoaDon.[No]))CInt(0))); " Else Sql = " SELECT Month([NgayMua]) AS [month], Year([NgayMua]) AS [year], tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiLuong, sum(tbl_HoaDon.Tongtien) AS TongTien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY Month([NgayMua]), Year([NgayMua]), tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi" & _ " HAVING ((cstr(Month([NgayMua]))='" & DT_Lich.Month & "') AND (cstr(Year([NgayMua]))='" & DT_Lich.Year & "' ) AND ((Sum(tbl_HoaDon.[No]))=CInt(0))); " End If '--------------------------------- ElseIf OptYear = True Then If chkNo.Value = 0 Then Sql = " SELECT tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua " & _ " HAVING ((cstr(datepart('yyyy',tbl_HoaDon.NgayMua))='" & DT_Lich.Year & "') AND ((Sum(tbl_HoaDon.[No]))CInt(0))); " Else Sql = " SELECT tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua " & _ " HAVING ((cstr(datepart('yyyy',tbl_HoaDon.NgayMua))='" & DT_Lich.Year & "') AND ((Sum(tbl_HoaDon.[No]))=CInt(0))); " End If End If Set rsNoTra = New Recordset rsNoTra.Open Sql, Cnn, adOpenKeyset Set rptNoTra.DataSource = rsNoTra rptNoTra.Show '------------------------------ Tong hop ------------------------------ ElseIf optTongHop = True Then Dim rsTongHop As Recordset With rptTongHop .BottomMargin = 1000 .LeftMargin = 1000 .RightMargin = 1000 .TopMargin = 1000 .ReportWidth = 9000 End With If OptMonth = True Then Sql = " SELECT tbl_HoaDon.NgayMua as MuaNgay, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " From tbl_HoaDon " & _ " GROUP BY tbl_HoaDon.NgayMua " & _ " HAVING ((CStr(DatePart('yyyy',[NgayMua]))='" & DT_Lich.Year & "' And CStr(DatePart('m',[NgayMua]))='" & DT_Lich.Month & "')); " ElseIf OptYear = True Then Sql = " SELECT Year([NgayMua]) AS nam, 'Tháng ' & Month([NgayMua]) & ' n¨m ' & Year([NgayMua]) AS MuaNgay, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " From tbl_HoaDon " & _ " GROUP BY Year([NgayMua]), Month([NgayMua]) " & _ " HAVING (((Year([NgayMua]))='" & DT_Lich.Year & "' )) " & _ "ORDER BY Year([NgayMua]), Month([NgayMua]); " End If Set rsTongHop = New Recordset rsTongHop.Open Sql, Cnn, adOpenKeyset Set rptTongHop.DataSource = rsTongHop rptTongHop.Show '-------------PHAN LOAI CHE ----------------------------- ElseIf optPhanLoaiChe = True Then Dim rsPhanLoaiChe As Recordset With rptPhanLoaiChe .BottomMargin = 800 .LeftMargin = 750 .RightMargin = 750 .TopMargin = 800 .ReportWidth = 9500 End With If OptDate = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe, Sum(tbl_NoidungMua.KhoiluongSau) AS KhoiLuong, Sum(tbl_NoidungMua.GiaChe) AS GiaChe, Sum(tbl_NoidungMua.Giatri) AS Giatri " & _ " FROM (tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH) INNER JOIN tbl_NoidungMua ON tbl_HoaDon.MaHD = tbl_NoidungMua.MaHD " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe " & _ " HAVING ((cstr(tbl_HoaDon.NgayMua)='" & DT_Lich & "' )); " ElseIf OptYear = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe, Sum(tbl_NoidungMua.KhoiluongSau) AS KhoiLuong, Sum(tbl_NoidungMua.GiaChe) AS GiaChe, Sum(tbl_NoidungMua.Giatri) AS Giatri " & _ " FROM (tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH) INNER JOIN tbl_NoidungMua ON tbl_HoaDon.MaHD = tbl_NoidungMua.MaHD " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe " & _ " HAVING ((cstr(datepart('yyyy',tbl_HoaDon.NgayMua))='" & DT_Lich.Year & "' )); " ElseIf OptMonth = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe, tbl_NoidungMua.KhoiluongSau AS KhoiLuong, tbl_NoidungMua.GiaChe AS GiaChe, tbl_NoidungMua.Giatri AS Giatri " & _ " FROM (tbl_KhachHang INNER JOIN tbl_HoaDon ON tbl_KhachHang.MaKH = tbl_HoaDon.MaKH) INNER JOIN tbl_NoidungMua ON tbl_HoaDon.MaHD = tbl_NoidungMua.MaHD " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe, tbl_NoidungMua.KhoiluongSau, tbl_NoidungMua.GiaChe, tbl_NoidungMua.Giatri; " & _ " HAVING ((CStr(DatePart('m',[ngaymua]))='" & DT_Lich.Month & "' And CStr(DatePart('yyyy',[ngaymua]))='" & DT_Lich.Year & "' ));" End If Set rsPhanLoaiChe = New Recordset rsPhanLoaiChe.Open Sql, Cnn, adOpenKeyset Set rptPhanLoaiChe.DataSource = rsPhanLoaiChe rptPhanLoaiChe.Show End If End Sub