Weekly Qbasic and Qb64 Lesson Topics
March 19, 2024, 06:00:33 am
Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
News: Want to see a specific Tutorial? ASK!
 
  Home Help Search Arcade Links Staff List Login Register  

DataBase Programming

Pages: [1]
  Print  
Author Topic: DataBase Programming  (Read 3834 times)
ChatKing
Post Demos
*
Posts: 23


« on: November 22, 2011, 11:39:56 am »

Hi to All

I have written these codes to share with you for comments and your suggestions, I love to write DataBase programs. Can any body tell me where I can get complete built-in functions of QB64 with a little bit details and new methods of DataBase Programs and can we write codes for web programming in QB64. Waiting for your comments and suggestions please.

Code:
DIM SHARED names AS STRING
DIM SHARED phone AS STRING
DIM SHARED city AS STRING
OPEN "Directory.txt" FOR APPEND AS #1
CLOSE #1
Main

'-----------------------------------------------------------------------------------------------

SUB Heading
CLS
PRINT TAB(30); "Telephone Directory"
PRINT TAB(30); "-------------------"
PRINT
PRINT
END SUB

'-----------------------------------------------------------------------------------------------

SUB Entry
Heading
OPEN "Directory.txt" FOR APPEND AS #1
Again:
INPUT "Enter Name         : "; names
INPUT "Enter Phone Number : "; phone
INPUT "Enter City Name    : "; city
WRITE #1, names, phone, city
PRINT STRING$(50, "-")
INPUT "Try Again [Y] : "; ch$
ch$ = UCASE$(ch$)
IF (ch$ = "Y") THEN GOTO Again
CLOSE #1
Main
END SUB

'----------------------------------------------------------------------------------------------

SUB Main
Heading
PRINT TAB(20); "(1) New Entry.............."
PRINT TAB(20); "(2) Display Record........."
PRINT TAB(20); "(3) Search Record.........."
PRINT TAB(20); "(4) About Programme........"
PRINT TAB(20); "(5) Exit Programme........."
LOCATE 12, 20
INPUT "Enter Your Selection [1-5] : "; sl
IF (sl < 1) OR (sl > 5) THEN Main
IF (sl = 1) THEN Entry
IF (sl = 2) THEN Display
IF (sl = 3) THEN Record
IF (sl = 4) THEN About1
IF (sl = 5) THEN END
END SUB

'----------------------------------------------------------------------------------------------

SUB Display
DIM a AS INTEGER

LET a = 0
Heading
OPEN "Directory.txt" FOR INPUT AS #1
WHILE NOT EOF(1)
    a = a + 1
    INPUT #1, names, phone, city
    PRINT names, phone, city
    IF a = 20 THEN
        INPUT "Press any key for other Entries.....", ch$
        a = 0
        Heading
    END IF
WEND
PRINT STRING$(79, "-")
PRINT "Press any key......."
Jump:
A$ = INKEY$
IF A$ = "" THEN GOTO Jump
Main
END SUB

'----------------------------------------------------------------------------------------------

SUB Record
DIM a AS INTEGER
DIM n AS STRING
LET a = 0
Heading
LOCATE 5, 5
INPUT "Enter Name : "; n
n = UCASE$(n)
PRINT STRING$(79, "-")
OPEN "Directory.txt" FOR INPUT AS #1
WHILE NOT EOF(1)
    a = a + 1
    INPUT #1, names, phone, city
    IF (UCASE$(names) = n) THEN PRINT names, phone, city
    IF (a = 22) THEN
        INPUT "Press any key...."; ch$
        a = 0
        Heading
    END IF
WEND
CLOSE #1
PRINT STRING$(79, "-")
PRINT "Press any key......."
Jump1:
A$ = INKEY$
IF A$ = "" THEN GOTO Jump1
Main
END SUB

'----------------------------------------------------------------------------------------------

SUB About1
Heading
PRINT
PRINT TAB(20); "Programmer : ChatKing"
PRINT
PRINT TAB(20); "Contact    : m_com_98@yahoo.com"
PRINT
PRINT TAB(20); "Version    : TD 1.00"
PRINT
PRINT TAB(20); "License    : Freeware"
LOCATE 15, 20
INPUT "Press any key.............."; ch$
Main
END SUB
Report Spam   Logged

Share on Facebook Share on Twitter

GarrisonRicketson
Admin
Administrator
Hero Member
*****
Posts: 583



WWW
« Reply #1 on: November 22, 2011, 07:02:00 pm »

I like this one Chatking,..it can be used also for, other types of data,..I just checked ,and it created the file directory.txt, saved it, etc, just fine,...
 There have been some people, on   qb64.net working on some,
Have you been there ?, don't recall seeing your name, but there are so many people there I lose track, also it would take some searching,to find the posts, because they "burried" pretty fast with new posts,..Some of them do "browse" here too, Later tonight, I could check,..
from Garry
Report Spam   Logged

GarrisonRicketson
Admin
Administrator
Hero Member
*****
Posts: 583



WWW
« Reply #2 on: November 26, 2011, 04:25:55 am »

 I was thinking more about this, "built in functions",..?  So any way looking at the wiki, I find this,http://qb64.net/wiki/index.php?title=CALL_ABSOLUTE
Quote
Qbasic and QB64 have the Absolute statement built in and require no library.

 As I interpret, some of what I read here,.this basicly implies, one can create theyer own functions, as subs,..? Here is some code shown in the example,..
Code:


DECLARE SUB MouseDriver (AX%, BX%, CX%, DX%, LB%, RB%, EX%)
DIM SHARED mouse$ ' Hardware communications resource string (created in SUB MouseDriver)
DIM SHARED CX%, DX%, LB%, RB% ' CX = column, DX = row, LB and RB are left and right buttons
SCREEN 12         

MouseDriver 1, BX%, CX%, DX%, LB%, RB%, 1 ' EX% = 1 initiates the mouse. Otherwise use EX% = 0
     ' ----------------------- DEMO CODE ----------------------
COLOR 10: LOCATE 1, 36: PRINT "H = Hide, S = Show, M = Move, L = Limit area"
COLOR 6: LOCATE 2, 10: PRINT "Hold mouse button down for total: P = Presses, R = Releases"
COLOR 13: LOCATE 29, 30: PRINT "Click or [Esc] EXIT!";
CIRCLE (220, 150), 90, 10 ' use radius and center coordinates to find circle later
LOCATE 9, 22: PRINT "Click in circle"
COLOR 12: LOCATE 27, 10: PRINT "Show the mouse the same number of times it was Hidden!"
COLOR 14

DO: Funct$ = UCASE$(INKEY$) ' any keypress....keeps loop running for mouse

  MouseDriver 3, BX%, CX%, DX%, LB%, RB%, 0 ' AX% = 3 reads mouse every loop
  LOCATE 1, 2: PRINT "LB "; LB% ' left button value 0 or 1 pressed
  LOCATE 1, 29: PRINT "RB "; RB% ' right button value 0 or 1 pressed
  LOCATE 1, 10: PRINT "COL"; CX% ' column coordinate
  LOCATE 1, 20: PRINT "ROW"; DX% ' row coordinate
  IF CX% >= 230 AND CX% <= 390 AND DX% >= 445 AND DX% <= 460 AND LB% THEN EXIT DO
   SELECT CASE Funct$
     CASE "S": MouseDriver 1, BX%, CX%, DX%, LB%, RB%, 0  ' AX% = 1 show mouse
     CASE "H": MouseDriver 2, BX%, CX%, DX%, LB%, RB%, 0  ' AX% = 2 hide mouse(accumulates)
     CASE "M": CX% = 220: DX% = 150 ' set CX% and DX% to circle center
      MouseDriver 4, BX%, CX%, DX%, LB%, RB%, 0  ' AX% = 4 moves mouse pointer to a coordinate
     CASE "P": BX% = -1
      IF LB% THEN BX% = 0: IF RB% THEN BX% = 1
      MouseDriver 5, BX%, CX%, DX%, LB%, RB%, 0 ' AX% = 5 read button presses since last read
      COLOR 6: LOCATE 29, 10: PRINT "Presses ="; BX%; SPACE$(2);
     CASE "R": BX% = -1
      IF LB% THEN BX% = 0: IF RB% THEN BX% = 1
      MouseDriver 6, BX%, CX%, DX%, LB%, RB%, 0 ' AX% = 6 read button releases since last read
      COLOR 6: LOCATE 29, 10: PRINT "Releases ="; BX%; SPACE$(2);
     CASE "L": limit = NOT limit ' alternates between partial to fullscreen cursor move area.
      IF limit THEN CX% = 100: DX% = 500 ELSE CX% = 0: DX% = 639 ' min and max column coordinates
      MouseDriver 7, BX%, CX%, DX%, LB%, RB%, 0 ' AX% = 7 limit horizontal column area
      IF limit THEN CX% = 100: DX% = 400 ELSE CX% = 0: DX% = 479 ' min and max row coordinates
      MouseDriver 8, BX%, CX%, DX%, LB%, RB%, 0 ' AX% = 8 limit vertical row area

   END SELECT

     ' CALCULATING WHEN THE POINTER IS INSIDE OF THE CIRCLE
   ' Pythagorean calculation: X ^ 2 + Y ^ 2 <= Radius ^ 2 for a position inside circle
  XX& = ((CX% - 220) ^ 2) + ((DX% - 150) ^ 2) ' 220 and 150 are circle center coordinates
  COLOR 11: LOCATE 22, 8
  PRINT "Columns"; CHR$(253); " + Rows"; CHR$(253); " <= Radius"; CHR$(253); " : IF"; XX&; "<= 8100 THEN ";
  IF XX& <= 8100 THEN ' 90 ^ 2 = 8100 is the circle radius squared
   PRINT "Over Circle"; SPACE$(7)
   IF LB% = 1 THEN COLOR 12 ' left mouse button pressed in circle
   IF RB% = 1 THEN COLOR 13 ' right mouse button pressed in circle
  ELSE: PRINT "Out of Circle"; SPACE$(5): COLOR 14 ' when mouse is not over circle
  END IF
 LOOP UNTIL Funct$ = CHR$(27)                                ' escape
 SYSTEM
     ' -------------------- END DEMO CODE -----------------

MouseData:
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00


SUB MouseDriver (AX%, BX%, CX%, DX%, LB%, RB%, EX%)
  IF EX% = 1 THEN ' initiate mouse once. EX normally = 0
   ' mouse$ = Hardware communications resource string
   RESTORE MouseData ' restore MouseDATA
   mouse$ = SPACE$(57) ' defines fixed length as 57 bytes
   FOR i% = 1 TO 57
    READ a$ ' read data for communication string
    H$ = CHR$(VAL("&H" + a$))   ' get DATA hex ASCII character
    MID$(mouse$, i%, 1) = H$
   NEXT i%
  END IF
  DEF SEG = VARSEG(mouse$)
  CALL Absolute(AX%, BX%, CX%, DX%, SADD(mouse$)) 'get coordinates and buttons
  DEF SEG
  IF EX% = 1 THEN
   LOCATE 29, 60
   IF AX% THEN
    PRINT "Mouse Found"; ' AX = -1 IF FOUND
   ELSE : BEEP: PRINT "Mouse not found"; : SYSTEM
   END IF
  END IF
  LB% = BX% AND 1 ' positive 1 return values
  RB% = (BX% AND 2) \ 2
  MB% = (BX% AND 4) \ 4
END SUB
 

 I  can't explain very well, this but at http://www.qb64.net "Clippy" would be able to,..
from Garry
Edit: This is for  a mouse function, ok,  for data bas, and webdesign, obviuosly different functions would be needed,...But from what I see, useing DECLARE and then smpley includeing the sub,..
 I will look around and see if I can not find some better samples, related to data bases and web "progamming",...
« Last Edit: November 26, 2011, 04:36:14 am by GarrisonRicketson » Report Spam   Logged

GarrisonRicketson
Admin
Administrator
Hero Member
*****
Posts: 583



WWW
« Reply #3 on: November 26, 2011, 04:51:09 am »

Here is this, I think maybe you will find it interesting,..
http://qb64.net/wiki/index.php?title=Inter-Program_Data_Sharing_Demo
 I don't see any reason to place the code, here,..Unless if you are useing FireFox, because it is a "defective" browser, you do need to get a plugin,or add on, to be able to copy/paste code from the wiki,..but thats another subject.
http://qb64.net/wiki/index.php?title=Mozilla_FireFox_Code_Copy_Add_On 
If you have trouble I would be happy to just, put the code here,let me know.
 These also are related: http://qb64.net/wiki/index.php?title=OPENCLIENT  
http://qb64.net/wiki/index.php?title=OPENHOST
http://qb64.net/wiki/index.php?title=OPENCONNECTION  
 from Garry
« Last Edit: November 26, 2011, 04:56:56 am by GarrisonRicketson » Report Spam   Logged

SMcNeill
Newbie
*
Posts: 3


« Reply #4 on: August 26, 2012, 10:50:27 pm »

I've created a few routines to use for quick and easy database type creation:
http://www.qb64.net/forum/index.php?topic=6870.0

Download the 2 files and $INCLUDE them at the start and finish of your code, and then you can just use the routines with a few simple calls.

First use the function DiskAccess to get a data handle for use.
Then WriteData, or ReadData, or DeleteData, UndeleteData, PackData, SwapData.

No need for open, close, input, output, seek, get, put, or any of that.  The routines make us a database, index it, and give several advanced abilities -- and they're easy to use.

Take a look at it, and if you have any questions about how something works, feel free to ask.  I'll do my best to answer any questions anyone might have.  Wink
Report Spam   Logged
GarrisonRicketson
Admin
Administrator
Hero Member
*****
Posts: 583



WWW
« Reply #5 on: August 29, 2012, 08:52:21 pm »

OK, thanks for posting this, 
from Garry
Report Spam   Logged


Pages: [1]
  Print  
 
Jump to:  

Powered by EzPortal
Bookmark this site! | Upgrade This Forum
SMF For Free - Create your own Forum


Powered by SMF | SMF © 2016, Simple Machines
Privacy Policy