Main
   Home
   About
   DiscussionBoard
Files
   About
   Submit
   Search
Downloads
   Action
   QB64
Links
   Link to us
QB45.org
[ Back to QB45 | FAQ | Search a message | Reply to this message | Back to messages ]

yudorifda on 11/20/08 - 00:02:00

Is there source code for capturing screen in mode 640x480 (64K and 16M), then saving it in BSAVE mode? if yes, then how should I use DEF SEG and BLOAD for using the saved screen? I don't know segment and offset address that I should use.

How about converting the captured screen into sprite file format (QUICKBASIC format)?

Frankly, I do not really understand any programming language. I'd love to appreciate anyone who assist me.

Thank you very much.

Todd on 11/20/08 - 07:33:50

There was one program I know that captured 640x480 into 4 parts and save these 4 parts as individual files. I think I have the code somewhere on my computer. Want me to look for it?

John on 11/26/08 - 22:35:34

I think I have the code you are looking for. It saves the 640x480 - screen 12 into 3 RGB files (1 per plane) and other 1 for the intensity, using DEF SEG and BLoad, so it is very fast.

Ask for it at: linux_loader@hotmail.com

anouar on 12/03/08 - 15:31:40

ou est le sourse

saad on 12/03/08 - 15:33:37

j'ai pas trouver la source de programme
quelqu'un peux m'aider

Todd on 12/03/08 - 16:48:55

BMP2BSV: http://www.sixbynine.net/filequick/135

BSV Capture and Display (with BLOAD/BSAVE): http://www.sixbynine.net/filequick/136

Tolga on 12/08/08 - 05:23:53

Type RegTpeX
Ax as integer
Bx as integer
Cx as integer
Dx as integer
Es as integer
Di as integer
Ds as integer
Si as integer
Flags as integer
Bp as integer
End Type

Type BmpHeaderType
id AS STRING * 2
filesize AS LONG
Reserved AS STRING * 4
imageoffset AS LONG
infoheaderlength AS LONG
imagewidth AS LONG
imageheight AS LONG
numplanes AS INTEGER
bpp AS INTEGER
compressiontype AS LONG
imagesize AS LONG
xres AS LONG
yres AS LONG
NumColsUsed AS LONG
NumColsImportant AS LONG
End Type

Dim Shared Bmp as BmpHeader
dim shared inregs as regtypex, outregs as regtypex
dim shared cBank%
dim byte as string * 1
dim some as string * 640

Bmp.ID = "BM"
Bmp.filesize = 54& + 1024& + (480& * 640&)
Bmp.Reserved = ""
Bmp.imageoffset = 54 + 1024
Bmp.infoheaderlength = 40
Bmp.imagewidth = 640
Bmp.imageheight = 480
Bmp.numplanes = 1
Bmp.bpp = 8
Bmp.compressiontype = 0
Bmp.imagesize = 640& * 480&
Bmp.xres = 0
Bmp.yres = 0
Bmp.NumColsUsed = 0
Bmp.NumColsImportant = 0

Inregs.Ax = &H4F02
Inregs.Bx = &H101
Call Interruptx (&H10, Inregs, OutRegs)


For x% = 0 To 639
For y% = 0 To 479
c% = RND * 256
Dot x%, y%, c%
Next
Next

Open "C:\QB.BMP" For Binary as 1
Put #1,,BMP
For t% = 0 To 255
Out &H3C7, t%
r% = (INP(&H3C9) * 4) AND &HFF
g% = (INP(&H3C9) * 4) AND &HFF
b% = (INP(&H3C9) * 4) AND &HFF
byte = chr$(b%)
Put #1,,Byte
byte = chr$(g%)
Put #1,,Byte
byte = chr$(r%)
Put #1,,Byte
byte = chr$(0)
Put #1,,Byte
Next


For y% = 0 To 479
For x% = 0 To 639
MID$(Some,x%+1,1)=Pixel(x%, 480 - y%)
Next
Put #1,,Some
Next
Close 1

End



Sub Dot (x%, y%, c%)
DEF SEG = &HA000
Poke SetOffset%(x%, y%), c%
DEF SEG
End Sub

Function Pixel%(x%, y%)
Def Seg = &HA000
O& = SetOffset%(x%, y%)
Pixel% = Peek(O&)
DEF SEG
End Function

Sub SetBank(k%)
Inregs.Ax = &H4F05
Inregs.Bx = k%
CALL INTERRUPTX(&H10, Inregs, OutRegs)
End Sub

Function SetOffset%(x%, y%)
O& = x%
P% = 0
For t% = 0 to y% - 1
O& = O& + 640&
if O& > 65535 Then
O& = O& - 65535
P% = P% + 1
End If
Next
if p% <> cBank% Then
cBank% = P%
SetBank
end if
End Function



Tolga on 12/08/08 - 05:29:45

PLEASE REPLACE THIS!!!

SUB SETBANK
Inregs.Ax = &H4F05
Inregs.Bx = cBANK%
CALL INTERRUPTX(&H10, Inregs, OutRegs)
END SUB

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

The code above opens a vesa screen 640x480x8. Then draws random colored pixels and then saves it to 'C:\QB:BMP'. The Usage with Screen 12 is much more easy. But, you must set the;
BMP.BPP
BMP.ImageSize
BMP.FileSize values with the desired numbers...

Screen 12 uses 4 bit color depth thus one byte in image data in a bmp file contains 2 pixels... So the sizes reduced as their half values... Hope This was helpfull...

e3traC on 12/08/08 - 05:32:01

well done Tolga. But what about BSAVE and BLOAD ?

Todd on 12/08/08 - 07:59:18

The link I posted above works with BSAVE and BLOAD.

johntux on 02/03/09 - 16:59:00

Hi guys. I've finally found the code. Here it is, simply copy and paste it to a new .BAS file. It runs (for me, at least) on Qb45 and PDS7.1





DECLARE SUB Save640 (File$)
DECLARE SUB Load640 (File$)
Screen 12

Randomize Timer

Line (0, 0)-(639, 479), 1, BF

For i = 1 To 15
x = Int(Rnd * 400) + 10
y = Int(Rnd * 300) + 10
r = Int(Rnd * 100) + 1
c = Int(Rnd * 15) + 1
Circle (x, y), r, c
PAINT (x, y), c + 1, c
Next i
'*** The following sub saves 4 files with the same name, but different
'*** extension. Must remove them when the program ends.
Save640 "\ss"
LOCATE 1, 1: Print "Screenshot taken... Press a key to load it... "
SLEEP
'*** Loads a full screen shot.
Load640 "\ss"
LOCATE 1, 1: Print " done! =)"
'*** This code removes the files saved by the Save640 SUB
Kill "\ss.red"
Kill "\ss.grn"
Kill "\ss.blu"
Kill "\ss.int"

Sub Load640(File$)
DEF SEG = &HA000
OUT &H3C4, 2: OUT &H3C5, 1: BLOAD File$ + ".BLU", 0 'bitplane 0
OUT &H3C4, 2: OUT &H3C5, 2: BLOAD File$ + ".GRN", 0 'bitplane 1
OUT &H3C4, 2: OUT &H3C5, 4: BLOAD File$ + ".RED", 0 'bitplane 2
OUT &H3C4, 2: OUT &H3C5, 8: BLOAD File$ + ".INT", 0 'bitplane 3
OUT &H3C4, 2: OUT &H3C5, 16
DEF SEG
End Sub

Sub Save640(File$)
DEF SEG = &HA000
OUT &H3CE, 4: OUT &H3CF, 0: BSAVE File$ + ".BLU", 0, 38400 'bitplane 0 (blue)
OUT &H3CE, 4: OUT &H3CF, 1: BSAVE File$ + ".GRN", 0, 38400 'bitplane 1 (green)
OUT &H3CE, 4: OUT &H3CF, 2: BSAVE File$ + ".RED", 0, 38400 'bitplane 2 (red)
OUT &H3CE, 4: OUT &H3CF, 3: BSAVE File$ + ".INT", 0, 38400 'bitplane 3 (intensity)
OUT &H3CE, 4: OUT &H3CF, 0
DEF SEG
End Sub






=)

johntux on 02/03/09 - 17:02:27

Ooops... seems I don't know how to use the "

" tag. Well, copy all the text between the [code] and
words...
:P

Todd on 02/03/09 - 17:50:23

I fixed it. It was somewhat old code in the system. It looks like it's working now.

Dar on 02/04/10 - 05:48:27

start a qbasic and write programming

Reply to this message
Name:
Message:
Please enter this number:
No HTML allowed. You may use BB-code in your posting.
Members
Login
Register
QB45 Members
Member List