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

[stephane fonteyne]

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

[Guest]

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).]