\ Bitmap-DOL 2/5/99
needs core-ext
needs ids
needs DataMgr
needs zstrings
needs struct
struct
1 cells field i-width
1 cells field i-height
1 cells field i-bytes/line
1 cells field i-flags
4 cells field i-filler
160 20 * chars field i-data \ max
end-struct bitmap:
20. 2constant p-bytes/line
2variable RscHandle
2variable PixDB
2variable RscDB
2variable Pixel
2variable DBPtr
2variable RHnd
2variable size
variable pic-no
bitmap: image
: ShowBitmap ( y x ID-no ID-type )
DmGetResource
2dup RscHandle 2!
MemHandleLock ( y x addr. )
WinDrawBitmap
RscHandle 2@ MemHandleUnlock
throw
RscHandle 2@ DmReleaseResource
throw
;
: ShowImage ( y x -- )
image >abs WinDrawBitmap
;
: GetImage ( h w n -- )
pic-no !
image i-width !
image i-height !
image i-width @
7 + 8 / dup 1 and +
image i-bytes/line !
image i-flags 10 0 fill
dmModeReadOnly z" Pictures"
OpenDB PixDB 2!
pic-no @ PixDB 2@ DmGetRecord
2dup RHnd 2!
MemHandleLock
114. D+ ( s. ) \ skip header stuff
image i-height @ 0 do 2dup ( s. s. )
image i-bytes/line @ s>d 2swap
image i-bytes/line @ i *
image i-data + >abs ( s. u. s. d. )
memmove throw
p-bytes/line d+
loop
RHnd 2@ MemHandleUnLock throw
false pic-no @ PixDB 2@
DmReleaseRecord throw
PixDB 2@ CloseDB
;
: SaveImage ( id icon? z-addr u -- )
2swap >r >r
dmModeWrite rot rot
OpenDB RscDB 2!
image i-height @
image i-bytes/line @ * 16 + s>d
2dup size 2!
r> r> if [id] tAIB else [id] Tbmp then
RscDB 2@ DmNewResource
\ DmNewResource ( size. resID
\ resType. dbP. -- VoidHand. )
2dup RHnd 2!
MemHandleLock 2>r
\ DmWrite ( bytes. &srcP. offset.
\ &recordP. -- Err )
size 2@ image >abs 0. 2r>
DmWrite throw
RHnd 2@ MemHandleUnLock throw
RHnd 2@ DmReleaseResource
throw
RscDB 2@ CloseDB
;
: CopyImage
40 65 0 getimage
1001 false z" HcpResources"
saveimage
\ page 80 10 showimage
;
: tt CopyImage ;