bgi and plot library

[startup]

my pleasure

now only GetImage(x1.i,y1.i,x2.i,y2.i, *bitmap) and PutImage(x1.i,y1.i, *bitmap, rop.i = #SRCAND) and i have no idea how to get them working.

[startup]

UPDATED - new GetImage and PutImage functions, ReSetWindowSize now retains content

source updated

[applePi]

i'm trying to replicate parts of this BGI code
http://csci.biola.edu/csci105/graphics_commands.htm
most functions works okay in purebasic and much easier, but it seems the BAR does not work, while the BAR3D works. also note the ellipse with blue fill does not have a HatchFill like in the picture at the end of the above page

it seems the BGI Lib are still used in schools and universities for 2D graphics tasks

http://www.stefansundin.se/programmerin ... MANUAL.pdf
http://www.cs.colorado.edu/~main/bgi/doc/bgi.html the link does not respond just now

Code: Select all

XIncludeFile "MINIPLOT.pbi"
XIncludeFile "MINIBGI.pbi"

UseModule MINIPLOT
UseModule MINIBGI
;EnableExplicit 

Procedure.d sinc(x.d)
If x=0.0 
  ProcedureReturn 1.0 
Else 
  ProcedureReturn Sin(x/(x*x))
EndIf
EndProcedure

Global x.d,xwin=800, ywin=800
Global Event.i, Quit.i, wnum.i,MaxX.i,MaxY.i,MaxRadius.i

InitGraph(xwin, ywin, "tester")

setcolor(#Red);
setfillstyle(SolidFill, #Red);

        ;//---------bar( x1, y1, x2, y2);
bar(20, 200, 150, 220);

setfillstyle(SolidFill, #Green);
bar(20, 230, 150, 250);

setfillstyle(SolidFill, #Green);
bar(160, 200, 190, 250) 
setfillstyle(BkSlashFill, #Blue);
Bar3D(660, 20, 660, 250, 30, 30, #Green) 
;============================================
setcolor(#Blue);
settextstyle(TimesNewRomanFont, -30, 3);

        ;//---------outtextxy( x, y, "text")
outtextxy(300, 230, "Triplex, size 3");
        
setcolor(#Red);

settextstyle(ItalicFont, 60, 3);
outtextxy(400, 500, "Gothic, Vertical, Size 3");
   ;/* draw ellipse */
   
;============================================

x = 50
SetColor(#Red)

SetLineStyle(SolidLn,1,3)
setfillstyle(HatchFill, #Blue);
Ellipses(400, 300, 0, 360, 100, 50);
 

SetLineStyle(SolidLn,1,1)
setcolor(#Red);

        ;//---------Line( x1, y1, x2, y2);
Lines(20, 20, 100, 80);

setcolor(#Blue);
                       ;//---------rectangle( x1, y1, x2, y2);
setfillstyle(SolidFill, #Blue)
rectangle(20, 100, 250, 350);

        ;//---------setfillstyle( fill_style, color)

        setcolor(#Red);
        setfillstyle(SolidFill, #Blue);

        ;//---------bar( x1, y1, x2, y2);
        bar(20, 200, 550, 220);
        ;//---------Circle( X, Y, radius)
        setcolor(#Green);
        Circles( 50, 310, 40);
        
        ;//---------putpixel (X, Y, color)
        ;putpixel(50, 310, RED);
        ;putpixel(60, 320, WHITE);
        
        ;//---------arc( X, Y, start_angle, end_angle, radius);
        ;//       Angles in degrees 0-360.
        ;//       0-right. Counter-clockwise (90-up, 180-left, 270-down)
        arc( 140, 310, 0, 90, 40);
        arc( 140, 310, 120, 160, 40);

        ;//---------Ellipse(x, y, start_angle, end_angle, x_radius, y_radius)
        Ellipses(60, 400, 0, 270, 50, 30);

        ;//---------fillellipse(x, y, x_radius, y_radius);
        setcolor(#Yellow);
        setfillstyle(SolidFill, #Yellow);
        ;FillEllipse(x.l,y.l,xradius.i,yradius.i, col.l)
        fillellipse(170, 400, 50, 30, #Red);

        setcolor(#Red);
        SetLineStyle(SolidLn,1,4)
        setfillstyle(HatchFill, #Blue);
        fillellipse(250, 400, 30, 50, #Blue);
   
  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      Quit = 1
    EndIf
  Until Quit = 1
;EndIf

End   ; All the opened windows are closed automatically by PureBasic

[startup]

thank you for you feedback.
yes it is still used!!!
i am just working on the screen switching and found some more problems. please be a little more patient, it will be a bigger new version.

richard

[startup]

this works for me perfectly with EnableExplicit. funny

the paging works, but i am fighting with the images. i hope i can update late tonight or tomorrow.

r.

Code: Select all

XIncludeFile "MINIBGI.pbi"

UseModule MINIBGI
EnableExplicit

Procedure.d sinc(x.d)
If x=0.0
  ProcedureReturn 1.0
Else
  ProcedureReturn Sin(x/(x*x))
EndIf
EndProcedure

Global x.d,xwin=800, ywin=800
Global Event.i, Quit.i, wnum.i,MaxX.i,MaxY.i,MaxRadius.i

InitGraph(xwin, ywin, "tester")

setcolor(#Red);
setfillstyle(#SolidFill, #Red);

        ;//---------bar( x1, y1, x2, y2);
bar(20, 200, 150, 220);

setfillstyle(#SolidFill, #Green);
bar(20, 230, 150, 250);

setfillstyle(#SolidFill, #Green);
bar(160, 200, 190, 250)
setfillstyle(#BkSlashFill, #Blue);
Bar3D(660, 20, 660, 250, 30, 30, #Green)
;============================================
setcolor(#Blue);
settextstyle(#TimesNewRomanFont, -30, 3);

        ;//---------outtextxy( x, y, "text")
outtextxy(300, 230, "Triplex, size 3");
       
setcolor(#Red);

settextstyle(#ItalicFont, 60, 3);
outtextxy(400, 500, "Gothic, Vertical, Size 3");
   ;/* draw ellipse */
   
;============================================

x = 50
SetColor(#Red)

SetLineStyle(#SolidLn,1,3)
setfillstyle(#HatchFill, #Blue);
Ellipses(400, 300, 0, 360, 100, 50);
 

SetLineStyle(#SolidLn,1,1)
setcolor(#Red);

        ;//---------Line( x1, y1, x2, y2);
Lines(20, 20, 100, 80);

setcolor(#Blue);
                       ;//---------rectangle( x1, y1, x2, y2);
setfillstyle(#SolidFill, #Blue)
rectangle(20, 100, 250, 350);

        ;//---------setfillstyle( fill_style, color)

        setcolor(#Red);
        setfillstyle(#SolidFill, #Blue);

        ;//---------bar( x1, y1, x2, y2);
        bar(20, 200, 550, 220);
        ;//---------Circle( X, Y, radius)
        setcolor(#Green);
        Circles( 50, 310, 40);
       
        ;//---------putpixel (X, Y, color)
        putpixel(50, 310, #Red);
        putpixel(60, 320, #White);
       
        ;//---------arc( X, Y, start_angle, end_angle, radius);
        ;//       Angles in degrees 0-360.
        ;//       0-right. Counter-clockwise (90-up, 180-left, 270-down)
        arc( 140, 310, 0, 90, 40);
        arc( 140, 310, 120, 160, 40);

        ;//---------Ellipse(x, y, start_angle, end_angle, x_radius, y_radius)
        Ellipses(60, 400, 0, 270, 50, 30);

        ;//---------fillellipse(x, y, x_radius, y_radius);
        setcolor(#Yellow);
        setfillstyle(#SolidFill, #Yellow);
        ;FillEllipse(x.l,y.l,xradius.i,yradius.i, col.l)
        fillellipse(170, 400, 50, 30, #Red);

        setcolor(#Red);
        SetLineStyle(#SolidLn,1,2) ;;;; the linesize was so big, that it filled
        setfillstyle(#HatchFill, #Blue);
        fillellipse(250, 400, 30, 50, #Blue);

;;;; added        
        SetLineStyle(#DashDotLn,1,2)
        setfillstyle(#SlashFill, #Black);
        fillellipse(290, 500, 30, 50, #Blue);

  Repeat
    Event = WaitWindowEvent()
    If Event = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      Quit = 1
    EndIf
  Until Quit = 1
;EndIf

End   ; All the opened windows are closed automatically by PureBasic

[infratec]

@applePi

you forgot the # in your code for some operations.
With EnableExplicit you'll find the code lines

Bernd

[infratec]

FillElipse is not working correct, because you set the fillstyle in it.
Correct is:

Code: Select all

Procedure FillEllipse(x.l,y.l,xradius.i,yradius.i, col.l)
  Protected fillinfo.FillSettingsType
  INC(x, origX)
  INC(y, origY)
  If defAspectRatio <> 0
    xradius = Int(10000*xradius) / aspX;
    yradius = Int(10000*yradius) / aspY
  EndIf
  GetFillSettings(@fillinfo)
  ;SetFillStyle(#SolidFill, col)
  Ellipse_(hdc,x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1)
  SetFillStyle(fillinfo\pattern, fillinfo\color)
  GdiFlush_()
EndProcedure

I uncommented SetFillStyle(#SolidFill, col)

Bernd

[infratec]

To be able to set the colors of the window, I modified InitGraph():

Code: Select all

InitGraph(WinX.l, WinY.l, title.s, Color.i=#Black, BackColor.i=#White)

And changed the procedure to

Code: Select all

SetColor(Color)
SetBkColor(bkcolor)

So it don't break something with the existing stuff.

Bernd

[infratec]

I converted the example on the website where applePi pointed to:

Code: Select all

XIncludeFile "MiniBGI.pbi"

UseModule MiniBGI
EnableExplicit

Global x.d,xwin=800, ywin=800
Global Event.i, Quit.i, wnum.i,MaxX.i,MaxY.i,MaxRadius.i

InitGraph(xwin, ywin, "tester", #White, #Black)


;---------setcolor( color )
; Colors:
; BLACK, BLUE, GREEN, CYAN, RED, MAGENT, BROWN, LIGHTGRAY, DARKGRAY, 
; LIGHTBLUE, LIGHTGREEN, LIGHTCYAN, LIGHTRED, LIGHTMAGENTA, YELLOW, WHITE

setcolor(#White);

;---------Line( x1, y1, x2, y2);
Lines(20, 20, 100, 80);

setcolor(#Blue);
;---------rectangle( x1, y1, x2, y2);
rectangle(20, 100, 150, 150);

;---------setfillstyle( fill_style, color)
; Fill_styles:
; EMPTY_FILL, SOLID_FILL, LINE_FILL, LTSLASH_FILL, SLASH_FILL, BKSLASH_FILL,
; LTBKSLASH_FILL, HATCH_FILL, XHATCH_FILL, INTERLEAVE_FILL, WIDE_DOT_FILL, 
; CLOSE_DOT_FILL, USER_FILL

setcolor(#Red);
setfillstyle(#SOLIDFILL, #Red);

;---------bar( x1, y1, x2, y2);
bar(20, 200, 150, 220);

setfillstyle(#SOLIDFILL, #Green);
bar(20, 230, 150, 250);

setfillstyle(#BKSLASHFILL, #Green);
bar(160, 200, 190, 250);

;---------Circle( X, Y, radius)
setcolor(#White);
Circles( 50, 310, 40);

;---------putpixel (X, Y, color)
putpixel(50, 310, #Red);
putpixel(60, 320, #White);

;---------arc( X, Y, start_angle, end_angle, radius);
;       Angles in degrees 0-360.
;       0-right. Counter-clockwise (90-up, 180-left, 270-down)
arc( 140, 310, 0, 90, 40);
arc( 140, 310, 120, 160, 40);

;---------Ellipse(x, y, start_angle, end_angle, x_radius, y_radius)
Ellipses(60, 400, 0, 270, 50, 30);

;---------fillellipse(x, y, x_radius, y_radius);
setcolor(#Yellow);
setfillstyle(#SOLIDFILL, #Yellow);
fillellipse(170, 400, 50, 30, #Yellow);

setcolor(#White);
setfillstyle(#HATCHFILL, #Red);
fillellipse(250, 400, 30, 50, #White);


;---------pieslice( x, y, start_angle, end_angle, radius)
setcolor(#Red);
setfillstyle(#SOLIDFILL, #Red);
pieslice(350, 60, 0, 90, 40);

setcolor(#White);
setfillstyle(#SOLIDFILL, #Blue);
pieslice(350, 60, 90,180, 40);

setcolor(#Green);
;setfillstyle(#WIDEDOTFILL, #White);
pieslice(350, 65, 180, 270, 60);

setcolor(#White);
;---------setlinestyle(style, pattern, thickness);
; line styles:
; SOLID_LINE, DOTTED_LINE, CENTER_LINE, DASHED_LINE, USERBIT_LINE
;    -- Normal: (SOLID_LINE, 0, 1);
setlinestyle(#DOTTEDLN, 0, 1);
Lines(300, 130, 500, 130)    ;

setlinestyle(#SOLIDLN, 0, 3);
Lines(300, 150, 500, 150);

setlinestyle(#DASHEDLN, 0, 1);
rectangle(300, 170, 500, 200);

setlinestyle(#SOLIDLN, 0, 1);  ;Back to normal
Lines(300, 220, 500, 220);

;---------settextjustify( horizontal, vertical )
; horizontal = LEFT_TEXT, CENTER_TEXT, Or RIGHT_TEXT
; vertical   = BOTTOM_TEXT, TOP_TEXT
;       -- Normal is (LEFT_TEXT, TOP_TEXT)

settextjustify(#LEFTTEXT,#TOPTEXT);

;---------settextstyle(font,direction,size)
; font = DEFAULT_FONT, TRIPLEX_FONT, SMALL_FONT, SANSSERIF_FONT, GOTHIC_FONT 
;       Or try numbers 0 thru 15?
; direction = HORIZ_DIR, VERT_DIR

setcolor(#Yellow);
;settextstyle(#TRIPLEX_FONT, #HORIZ_DIR, 2);

;---------outtextxy( x, y, "text")
outtextxy(300, 260, "Triplex, size 2");

setcolor(#White);

;settextstyle(#GOTHIC_FONT, #VERT_DIR, 2);
outtextxy(600, 20, "Gothic, Vertical, Size 2");


Repeat
  Event = WaitWindowEvent()
  If Event = #PB_Event_CloseWindow
    Quit = 1
  EndIf
Until Quit = 1

Some fonts are not available
and SetLineStyle() was not working.

I fixed some things with a dirty hack:
I added

Code: Select all

hdc = GetDC_(hwnd)

to InitGraph()
and uncommented the line

Code: Select all

hdc = GetDC_(hwnd)

in SetLineStyle().
SetLineStyle() works now
and also the default background of the bars appears.

Maybe hdc can be replaced in general by hWDC.

Bernd

[applePi]

Thanks Bernd for the suggestions, your code produce almost like the http://csci.biola.edu/csci105/graphics_commands.htm picture , after making the modifications

i am still have the graphics erased when covered by other windows in windows xp. while it is okay in windows 7
it is a handy library for the quick plotting
if there is a subforum under the name Graphics which contains the major important graphics utils made by users other than the native PB graphics, to contain this BGI Lib, danilo Cairo wrapper, [Windows] 2DDrawing commands with AntiAliasing through GDI+ by Danilo, luis glfw wrapper, the Michael MP3D Lib, and may be others.

[startup]

hi,

i made bernd's fixes, changed ellipes and filledellipse and fontsizes. i also kicked hcd out for hWDC.
on my computer i can't get the window blanked when overlapped - so for now i really don't know what to do.
constants like #HORIZ_DIR i called #HORIZDIR i will change those back (i was lazy - thoght saves typing).

the fonts came in those days (bgi) in drivers. gothic and other are not available (at least for me), i just use some fonts available on windows.

i can't get getimage and put image to work - that is, take a piece of real estate from the window, save it to a variable and put it back with putimage. anyone an idea?

Code: Select all

Procedure SetTextStyle(font.i,direction.l,charsize.l)
  Protected.b loByte,hiByte
  Protected.b nrfont
  Protected fontname.s = ""
  Protected lplf.LOGFONT
  Protected old.i
  loByte = LOBYTE(LOWORD(font))
  hiByte = HIBYTE(HIWORD(font))
  nrfont = loByte % $10
  If (nrfont>=0) And (nrfont <= #NrMaxFonts-1)
    fontname = instFont(nrfont)
  Else
    fontname = ""
  EndIf
  If fontname <> ""
    textSettings\font = font
    textSettings\direction = direction
    textSettings\charsize = charsize
    If charsize <= #MinCharSize
      charsize = charsize + #MinCharSize
    EndIf
    lplf\lfHeight = charsize
    lplf\lfWidth = 0
    lplf\lfEscapement = 10 * direction
    lplf\lfOrientation = 10 * direction
    lplf\lfItalic = #False
    lplf\lfWeight = (#FW_BOLD - #FW_NORMAL) * (loByte / $10) + #FW_NORMAL
    If (hiByte / $10) > 0
      lplf\lfItalic = 1
    EndIf
    lplf\lfUnderline = 0
    If (hiByte / $10) > 0
      lplf\lfUnderline = 1
    EndIf
    lplf\lfStrikeOut = 0
    lplf\lfCharSet = #DEFAULT_CHARSET
    lplf\lfOutPrecision = #OUT_DEFAULT_PRECIS
    lplf\lfClipPrecision = #CLIP_DEFAULT_PRECIS
    lplf\lfQuality = #DEFAULT_QUALITY
    lplf\lfPitchAndFamily = #DEFAULT_PITCH | #FF_DONTCARE
    PokeS(@lplf\lfFaceName[0], fontname)
    grFont = CreateFontIndirect_(@lplf)
    SelectObject_(hWDC, grFont)
    GdiFlush_()
  EndIf
EndProcedure

Procedure FillEllipse(x.l,y.l,xradius.i,yradius.i, col.l=-1)
  Protected fillinfo.FillSettingsType
  INC(x, origX)
  INC(y, origY)
  If defAspectRatio <> 0
    xradius = Int(10000*xradius) / aspX;
    yradius = Int(10000*yradius) / aspY
  EndIf
  Ellipse_(hWDC,x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1)
  GdiFlush_()
EndProcedure

Procedure Ellipses(x.l, y.l, start.l,stop.l,xradius.l,yradius.l)
  Protected.i nXStartArc,nYStartArc,nXEndArc,nYEndArc
  lastArcCoords\x = x
  lastArcCoords\y = y
  INC(x,origX)
  INC(y,origY)
  nXStartArc = Round(xradius * Cos(start*#Rad), #PB_Round_Nearest)
  nXEndArc   = Round(xradius * Cos(stop*#Rad), #PB_Round_Nearest)
  nYStartArc = Round(yradius * Sin(start*#Rad), #PB_Round_Nearest)
  nYEndArc   = Round(yradius * Sin(stop*#Rad), #PB_Round_Nearest)
  If defAspectRatio = 0
    xradius = Int(10000*xradius) / aspX;
    yradius = Int(10000*yradius) / aspY
  EndIf
  Arc_(hWDC,x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1,x+nXStartArc,y-nYStartArc,x+nXEndArc,y-nYEndArc)
  With lastArcCoords
    \xstart = \x+nXStartArc
    \ystart = \y-nYStartArc
    \xend   = \x+nXEndArc
    \yend   = \y-nYEndArc     
  EndWith
  GdiFlush_()
EndProcedure

[infratec]

@startup

we were to fast
FillEllipse() was nearly right, because else the color parameter is not used.
The bug comes from you GetFillSettings().
I also extend FillEllipse(). Now color is optional, else setcolor(#White) makes no sense.

Code: Select all

setcolor(#White)
setfillstyle(#HATCHFILL, #Red)
fillellipse(250, 400, 30, 50);, #White)

Code: Select all

Procedure GetFillSettings(*fillinfo.FillSettingsType)
  ;*fillinfo = fillSettings
  CopyStructure(@fillSettings, *fillinfo, FillSettingsType)
EndProcedure

Procedure FillEllipse(x.l,y.l,xradius.i,yradius.i, col.l=-1)
  Protected fillinfo.FillSettingsType
  INC(x, origX)
  INC(y, origY)
  If defAspectRatio <> 0
    xradius = Int(10000*xradius) / aspX;
    yradius = Int(10000*yradius) / aspY
  EndIf
  If col <> -1
    GetFillSettings(@fillinfo)
    SetFillStyle(fillinfo\pattern, col)
  EndIf
  Ellipse_(hdc,x-Int(xradius),y-Int(yradius),x+Int(xradius)+1,y+Int(yradius)+1)
  If col <> -1
    SetFillStyle(fillinfo\pattern, fillinfo\color)
  EndIf
  GdiFlush_()
EndProcedure

Procedure FillRect(x1.l,y1.l,x2.l,y2.l, col.l=-1)
  Protected fillinfo.FillSettingsType
  If (x1 > x2) Or (y1 > y2)
     ProcedureReturn
  EndIf
  INC(x1, origX)
  INC(y1, origY)
  INC(x2, origX+1)
  INC(y2, origY+1)
  If col <> -1
    GetFillSettings(@fillinfo)
    SetFillStyle(fillinfo\pattern, col)
  EndIf
  Rectangle_(hdc,x1,y1,x2,y2)
  If col <> -1
    SetFillStyle(fillinfo\pattern, fillinfo\color)
  EndIf
  GdiFlush_()
EndProcedure



Procedure GetArcCoords(*arccoords.ArcCoordsType)
  ;*arccoords = lastArcCoords
  CopyStructure(@lastArcCoords, *arccoords, ArcCoordsType)
EndProcedure

Procedure GetLineSettings(*lineinfo.LineSettingsType)
  ;*lineinfo = lineSettings
  CopyStructure(@lineSettings, *lineinfo, LineSettingsType)
EndProcedure

Same 'bug' at GetLineSettings() and GetArcCoords().

Bernd

[infratec]

Since I'm not a windows API guy, it took a bit longer to find a working solution for
Get- and PutImage():

Code: Select all

Procedure GetImage(x1.i,y1.i,x2.i,y2.i,*bmp.BITMAP)
  Protected.i hdcMemDC, hbmScreen
  Protected bih.BITMAPINFOHEADER
  
  hdcMemDC = CreateCompatibleDC_(hWDC)
  hbmScreen = CreateCompatibleBitmap_(hWDC, x2-x1+1, y2-y1+1)
  SelectObject_(hdcMemDC, hbmScreen)
  
  BitBlt_(hdcMemDC, 0, 0, x2-x1+1, y2-y1+1, hWDC, x1, y1, #SRCCOPY|#CAPTUREBLT)
  
;   OpenClipboard_ ( #Null )
;   EmptyClipboard_ ()
;   SetClipboardData_ (2, hbmScreen)
;   CloseClipboard_ ()
  
  GetObject_(hbmScreen, SizeOf(BITMAP), *bmp)
  
  bih\biSize = SizeOf(BITMAPINFOHEADER)
  bih\biHeight = *bmp\bmHeight
  bih\biWidth = *bmp\bmWidth
  bih\biPlanes = 1
  bih\biBitCount = *bmp\bmBitsPixel
  bih\biCompression = #BI_RGB
  bih\biSizeImage = 0
  bih\biXPelsPerMeter = 0
  bih\biYPelsPerMeter = 0
  bih\biClrUsed = 0
  bih\biClrImportant = 0
  
  *bmp\bmBits = AllocateMemory(*bmp\bmWidth * *bmp\bmHeight * ((*bmp\bmBitsPixel + 7) / 8))
  
;   Debug *bmp\bmBitsPixel
;   Debug (*bmp\bmBitsPixel + 7) / 8
;   Debug MemorySize(*bmp\bmBits)
  
  GetDIBits_(hWDC, hbmScreen, 0, *bmp\bmHeight, *bmp\bmBits, @bih, #DIB_RGB_COLORS)
  
  GdiFlush_()
  
  DeleteObject_(hbmScreen)
  DeleteObject_(hdcMemDC)
EndProcedure

Procedure PutImage(x1.i,y1.i,*bmp.BITMAP, rop.i=#SRCCOPY)
  Protected.i hdcMemDC
  Protected bih.BITMAPINFOHEADER
  Protected *hBitMap.BITMAP
  Protected *ppvBits
  
  hdcMemDC = CreateCompatibleDC_(hWDC)
  
  bih\biSize = SizeOf(BITMAPINFOHEADER)
  bih\biHeight = *bmp\bmHeight
  bih\biWidth = *bmp\bmWidth
  bih\biPlanes = 1
  bih\biBitCount = *bmp\bmBitsPixel
  bih\biCompression = #BI_RGB
  bih\biSizeImage = 0
  bih\biXPelsPerMeter = 0
  bih\biYPelsPerMeter = 0
  bih\biClrUsed = 0
  bih\biClrImportant = 0
  
  *hBitMap = CreateDIBSection_(hdcMemDC, @bih, #DIB_RGB_COLORS, @*ppvBits, #Null, 0)
  CopyMemory(*bmp\bmBits, *ppvBits, MemorySize(*bmp\bmBits))
  
  SelectObject_(hdcMemDC, *hBitMap)
  
  BitBlt_(hWDC, x1, y1, *bmp\bmWidth, *bmp\bmHeight, hdcMemDC, 0, 0, rop|#CAPTUREBLT)
  
  GdiFlush_()
  
  DeleteObject_(*hBitMap)
  DeleteObject_(hdcMemDC)
EndProcedure

You can use it like

Code: Select all

Define bmp.BITMAP
GetImage(100, 100, 199, 199, @bmp)
PutImage(500, 350, @bmp)
FreeMemory(bmp\bmBits)

But you have to check the internal calls, since I changed the parameter to .BITMAP instead of BGIimage.

Bernd

[infratec]

Bug in InitGraph()

Code: Select all

SetWriteMode(#CopyMode | #TRANSPARENT)

should be

Code: Select all

SetWriteMode(#CopyMode | #TRANSPARENT_)

Bernd

[startup]

thanx.

there will be a new version comming with screen switching, the window will run in its own thread etc.

i am still fighting the bitblt from screen to memory and back.