Announcement

Collapse

Maintenance

The forum could be offline for 30-60 minutes in the very near future for maintenance (said 3pm Pacific). I was behind on getting this notice. I do apologize.
See more
See less

Example OOP in PBDOS/PBCC/PBDLL or PowerBASIC for Windows LIKE Delphi

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Example OOP in PBDOS/PBCC/PBDLL or PowerBASIC for Windows LIKE Delphi

    Hello programmers and support of PowerBASIC,

    I have here an example in Powerbasic with OOP concept,
    I wil that OOP immplementation in PB also Units en projects

    Here is the code (very easy)
    // OOP in PB

    UNIT URechtHoek
    #INCLUDE "C:\PBDLL70\WINAPI\WINAPI32.INC"

    INTERFACE

    TYPE
    TRechtHoek = CLASS(TObject)
    PRIVATE
    DIM x1, y1, x2, y2, aantal AS INTEGER
    DIM TekenKader AS STRING * 1
    PUBLIC
    DECLARE SUB Init(BYVAL xx1 AS INTEGER,BYVAL yy1 AS INTEGER,BYVAL xx2 AS INTEGER,BYVAL yy2 AS INTEGER)
    DECLARE FUNCTION Raak(BYVAL xm AS INTEGER,BYVAL ym AS INTEGER) AS BOOLEAN
    DECLARE FUNCTION RaakKader(BYVAL xm AS INTEGER,BYVAL ym AS INTEGER) AS BOOLEAN
    DECLARE FUNCTION RaakRechterOnderhoek(BYVAL xm AS INTEGER,BYVAL ym AS INTEGER) AS BOOLEAN
    DECLARE SUB Verhoog()
    DECLARE SUB ToonAantal()
    DECLARE SUB Verplaats(BYVAL DeltaX AS INTEGER,BYVAL DeltaY AS INTEGER)
    DECLARE SUB NieuweRechterOnderhoek(BYVAL Xnieuw AS INTEGER, Ynieuw AS INTEGER)
    DECLARE SUB Teken()
    DECLARE SUB Wis()
    END TYPE

    IMPLEMENTATION

    #COMPILE UNIT UScreen
    #COMPILE UNIT SysUtils
    #COMPILE UNIT Graphics
    #COMPILE UNIT Classes

    SUB TRechthoek.Init(BYVAL xx1 AS INTEGER,BYVAL yy1 AS INTEGER,BYVAL xx2 AS INTEGER,BYVAL yy2 AS INTEGER)
    x1 = xx1
    y1 = yy1
    x2 = xx2
    y2 = yy2
    aantal = 0
    tekenkader = "*"
    END SUB

    FUNCTION TRechthoek.Raak(BYVAL xm AS INTEGER,BYVAL ym AS INTEGER) AS BOOLEAN
    FUNCTION = FALSE
    IF x1 < xm AND xm < x2 AND y1 < ym AND ym < y2 THEN
    FUNCTION = TRUE
    END FUNCTION

    FUNCTION TRechthoek.RaakKader(BYVAL xm AS INTEGER,BYVAL ym AS INTEGER) AS BOOLEAN
    FUNCTION = FALSE
    IF x1 < xm AND xm < x2 AND y1 = ym THEN
    FUNCTION = TRUE
    END FUNCTION

    FUNCTION TRechthoek.RaakRechterOnderhoek(BYVAL xm AS INTEGER,BYVAL ym AS INTEGER) AS BOOLEAN
    FUNCTION = FALSE
    IF xm = x2 AND ym = y2 THEN
    FUNCTION = TRUE
    END FUNCTION

    SUB TRechthoek.Verhoog()
    INCR Aantal
    END SUB

    SUB TRechthoek.ToonAantal()
    SCREEN.locate x1 + 1, y1 + 1)
    SCREEN.Print(InTOStr(aantal))
    END SUB

    SUB TRechthoek.Verplaats(BYVAL DeltaX AS INTEGER,BYVAL DeltaY AS INTEGER)
    x1 = x1 + deltax
    x2 = x2 + deltax
    y1 = y1 + deltay
    y2 = y2 + deltay
    END SUB

    SUB TRechthoek.NieuweRechterOnderhoek(BYVAL Xnieuw AS INTEGER, Ynieuw AS INTEGER)
    x2 = xnieuw
    y2 = ynieuw
    END SUB

    SUB TRechthoek.Teken()
    LOCAL i AS INTEGER

    FOR i = x1 TO x2
    SCREEN.Locate(i,y1)
    SCREEN.PrintChar(Tekenkader)
    SCREEN.Locate(i,y2)
    SCREEN.PrintChar(Tekenkader)
    NEXT

    FOR i = y1 TO y2
    SCREEN.Locate(i,x1)
    SCREEN.PrintChar(Tekenkader)
    SCREEN.Locate(i,x2)
    SCREEN.PrintChar(Tekenkader)
    NEXT
    END SUB

    SUB TRechthoek.Wis
    Tekenkader = " "
    Teken
    Tekenkader = "*"
    SCREEN.Locate(x1 + 1, y1 + 1)
    SCREEN.Print(" ")
    END SUB
    END UNIT //Class

    #COMPILE UNIT UProgram

    INTERFACE
    #COMPILE UNIT UScreen
    #COMPILE UNIT URechthoek
    #COMPILE UNIT Classes

    TYPE
    TProgram = CLASS(TThread)
    PRIVATE
    PUBLIC
    CONSTRUCTOR CREATE
    DECLARE SUB Execute
    OVERRIDE
    END TYPE

    IMPLEMENTATION

    CONSTRUCTOR TProgram.Execute
    INHERITED CREATE(FALSE)
    FreeOnTerminate = TRUE
    END CONSTRUCTOR
    END UNIT

    SUB TProgram.Execute
    'Declarations variabels and objects
    LOCAL Muis AS TMuis CLASS
    LOCAL r1, r2 AS TRechtHoek CLASS
    LOCAL xm, ym, xm2, ym2 AS INTEGER
    LOCAL letter AS STRING

    'Create objects in PBDOS, PBCC, PBDLL
    r1 = TRechthoek.CREATE
    r2 = TRechthoek.CREATE
    Muis = TMuis.CREATE
    Muis.Show()
    SCREEN.Cls()

    'Object.method
    r1.Init(2,2,8,5)
    r2.Init(40,10,50,16)

    r1.teken()
    r2.Teken()
    letter = ""

    DO WHILE letter <> "x" AND NOT Terminated
    IF Muis.LeftButton THEN
    Muis.TextPosition(xm,ym)
    IF r1.Raak(xm,ym) THEN r1.Verhoog
    IF r2.Raak(xm,ym) THEN r2.Verhoog
    DO WHILE Muis.LeftButton
    Muis.TextPosition(xm2,ym2)
    IF xm <> xm2 OR ym <> ym2) THEN
    IF r1.RaakKader(xm,ym) THEN
    r1.Wis()
    r1.Verplaats(xm2 - xm, ym2 - ym)
    r1.teken()
    END IF
    IF r2.Raakkader(xm,ym) THEN
    r2.Wis()
    r2.Verplaats(xm2 - xm, ym2 - ym)
    r2.teken()
    END IF
    END IF
    xm = xm2
    ym = ym2
    LOOP
    END IF


    IF Muis.RightButton THEN
    Muis.TextPosition(xm,ym)
    IF r1.Raak(xm,ym) THEN r1.ToonAantal()
    IF r2.Raak(xm,ym) THEN r2.ToonAantal()
    END IF

    IF SCREEN.INSTAT THEN letter := SCREEN.Inkey$
    LOOP
    END SUB

    FUNCTION PBMAIN()

    #COMPILE UNIT Forms

    APP.Init()
    APP.CreateForm(Tform, Form1)
    APP.Run()

    END FUNCTION

  • #2
    Hi Stephane,
    Not to sound rude, but I looked in almost all the forums and I think you have made your point. I think support is already aware of this and the subject has already been hashed and bashed about. There is a place on the website for submitting wishlists to the company.

    Regard,
    Adam

    ------------------


    [This message has been edited by Adam Ritchie (edited March 04, 2000).]

    Comment

    Working...
    X