Load a Bitmap BMP in this Double buffer code

[Tolo68]

Hello everyone, I have the following code with DoubleBuffer.

I want to load a BMP image in the main window, that is, as a background.

That it covers the yellow background, but not the rest of the colors. I have tried with LoadImage and SelectObject but there is no way.

Thank you so much!!!!

Code: Select all

'-------------------------------------------------------------------------------

#include "windows.bi"
const ProgrammName = "Bitmaps blitten"
DIM shared Tiempo as double

dim shared Ancho as integer
dim shared Alto as integer

declare function Fenster(byval hWnd as HWND, byval message as UINTEGER,_
    byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT

dim as WNDCLASS wcMeinFenster
with wcMeinFenster
    '.style         =  CS_OWNDC Or CS_VREDRAW Or CS_HREDRAW
    .lpfnWndProc   =  ProcPtr(Fenster)
    .cbClsExtra    =  0
    .cbWndExtra    =  0
    .hInstance     =  GetModuleHandle(NULL)
    .hCursor       =  LoadCursor(NULL, IDC_ARROW)
    .hIcon         =  LoadIcon(NULL, IDI_APPLICATION)
    .hbrBackground =  GetStockObject(WHITE_BRUSH)
    .lpszClassName =  StrPtr(ProgrammName)
    .lpszMenuName  =  NULL
end with
RegisterClass @wcMeinFenster

dim as HWND hMeinFenster = CreateWindow(_
    ProgrammName, "Titelzeile", WS_OVERLAPPEDWINDOW,_
    CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,_
    NULL, NULL, GetModuleHandle(NULL), NULL)

ShowWindow   hMeinFenster, SW_NORMAL
UpdateWindow hMeinFenster

dim as MSG msg
do while getmessage(@msg, NULL, 0, 0) <> 0
    DispatchMessage  @msg
loop
end msg.wParam

function Fenster(byval hWnd as HWND, byval message as UINTEGER,_
    byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
    
    static as HBRUSH Brush
    static as RECT ClientRect
    static as HBITMAP   hBitmap
    static as HDC       hDC2
    dim    as HDC       hDC

    select case message
    
        case WM_DESTROY
            print "WM_DESTROY"
            DeleteDC(hDC2)
            DeleteObject(hBitmap)
            PostQuitMessage 0
            return 0

        case WM_CREATE
            print "WM_CREATE"
            Brush = CreateSolidBrush(&HFFFF)
            getclientrect(hwnd,@ClientRect)
            
            dim x as integer
            dim y as integer
            for x=0 to 1000 step 120
                for y=0 to 1000 step 25
                    CreateWindowEx( 0, "BUTTON", "Button 1", WS_VISIBLE Or WS_CHILD, x, y, 100, 20, hwnd, 0, 0, 0 )
                next y
            next x
            
            hDC = GetDC(hWnd)
            hBitmap = CreateCompatibleBitmap(hDC, 1300, 1300)
            hDC2    = CreateCompatibleDC(hDC)
            ReleaseDC(hWnd, hDC)
            SelectObject(hDC2, hBitmap)
            FillRect(hDC2, @ClientRect, Brush)

           '---------------------------
           '----- paint bitmap here
            '---------------------------

            dim as INTEGER ix, iy
            for ix = 0 to 255
                for iy = 0 to 255
                    SetPixel hDC2, ix +50, iy+50, RGBA(ix, iy, 128, 0)
                next
            next
            
            '----------------------------------
            for x=0 to 1500 step 15
            for y=0 to 1500 step 15
                Ellipse hDC2,x,y,x+10,y+10
            next y
            next x
            '----------------------------------
            
            return 0

        case WM_PAINT
            print "WM_PAINT"
            dim as PAINTSTRUCT pnt
            hDC = BeginPaint(hWnd, @pnt)
                BitBlt hDC, 0, 0, 1300, 1300, hDC2, 0, 0, SRCCOPY
            EndPaint(hWnd, @pnt)
            
            return 0
    end select
    return DefWindowProc(hWnd, message, wParam, lParam)
end function

[Tolo68]

Hello fxm
I don't understand what you mean by code tags.

Thank you!!

[fxm]

[code]
Your code inserted here ...
[/code]

(in the edit menu, you have the '</>' button to help you to generate the code tags)

[Tolo68]

Thanks fxm

I did not know how it was done, I wrote it down.
Best regards!!!

[dodicat]

In WM_CREATE
Set up a hidden fb screen, 1300 x 800 as a demo.
Set up an image the same dimension as the screen.
Draw stuff to the image using bgr (or rgbx) instead of rgb.
Then setpixel all the way through the image using fb point function.
(I have left out your buttons and ellipses, you can pop them back)
(I have used puts from crt.bi to write to the console)
Note, you could use any bitmap to load to an image, but I haven't tried that, maybe you could experiment.
The salient point is use the Windows bgr (or my rgbx), and not fb rgb for colours.

Code: Select all

'-------------------------------------------------------------------------------

#include "windows.bi"
#include "crt.bi"
Const ProgrammName = "Bitmaps blitten"
Dim Shared Tiempo As Double

Dim Shared Ancho As Integer
Dim Shared Alto As Integer
Dim Shared As Single spread=25,scale=.76

Sub Tree(x1 As Single,y1 As Single,size As Single,angle As Single,depth As Single,colb As Uinteger<32>=0,colL As Uinteger<32>=0,im As Any Ptr=0)
      #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
      Var x2=x1-.25*size*Cos(angle*.01745329)
      Var y2=y1-.25*size*Sin(angle*.01745329)
      Static As Integer<32> count,fx,fy,sz,z
      If count=0 Then  fx=x1:fy=y1:sz=size:z=2^(depth+1)-1
      Line im,(x1,y1)-(x2,y2),colb
      If count=0 Then  fx=x2:fy=y2:sz=size
      count=count+1
      If count>z Then count=0
      If incircle(fx,fy,(.45*sz),x2,y2)=0 Then Circle im,(x2,y2),.01*sz,colL 
      If depth>0 Then
            Tree(x2, y2, size * Scale, angle - Spread, depth - 1,colB,colL,im)
            Tree(x2, y2, size * Scale, angle + Spread, depth - 1,colB,colL,im)
      End If
End Sub

Function rgbx(r As Ubyte ,g As Ubyte ,b As Ubyte) As Ulong '= bgr
      Return (((b Shl 16 ) Or ((g) Shl 8 ) Or (r) Or &hFF000000)- &hFF000000)
End Function

Declare Function Fenster(Byval hWnd As HWND, Byval message As Uinteger,_
Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT

Dim As WNDCLASS wcMeinFenster
With wcMeinFenster
      '.style         =  CS_OWNDC Or CS_VREDRAW Or CS_HREDRAW
      .lpfnWndProc   =  Procptr(Fenster)
      .cbClsExtra    =  0
      .cbWndExtra    =  0
      .hInstance     =  GetModuleHandle(NULL)
      .hCursor       =  LoadCursor(NULL, IDC_ARROW)
      .hIcon         =  LoadIcon(NULL, IDI_APPLICATION)
      .hbrBackground =  GetStockObject(WHITE_BRUSH)
      .lpszClassName =  Strptr(ProgrammName)
      .lpszMenuName  =  NULL
End With
RegisterClass @wcMeinFenster

Dim As HWND hMeinFenster = CreateWindow(_
ProgrammName, "Titelzeile", WS_OVERLAPPEDWINDOW,_
CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,_
NULL, NULL, GetModuleHandle(NULL), NULL)

ShowWindow   hMeinFenster, SW_NORMAL
UpdateWindow hMeinFenster

Dim As MSG msg
Do While getmessage(@msg, NULL, 0, 0) <> 0
      DispatchMessage  @msg
Loop
End msg.wParam

Function Fenster(Byval hWnd As HWND, Byval message As Uinteger,_
      Byval wParam As WPARAM, Byval lParam As LPARAM) As LRESULT
      
      Static As HBRUSH Brush
      Static As RECT ClientRect
      Static As HBITMAP   hBitmap
      Static As HDC       hDC2
      Dim    As HDC       hDC
      
      Select Case message
      
      Case WM_DESTROY
            Puts "WM_DESTROY"
            DeleteDC(hDC2)
            DeleteObject(hBitmap)
            PostQuitMessage 0
            Return 0
            
      Case WM_CREATE
            
            #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
            
            Screenres 1300,800,32,,-1 'hidden screen
            Width 1300\8,800\16
            Var i=Imagecreate(1300,800)
            '===============draw to image using bgr ===================
            For n As Long=0 To 799
                  Var r=map(0,799,n,0,255)
                  Var g=map(0,799,n,100,255)
                  Var b=255
                  Line i,(0,n)-(1300,n),bgr(r,g,b)
            Next n
            tree(1300/2,700,640,90+(20),12,bgr(0,10,0),bgr(0,100,0),i)
            Dim As Long bw=1300/20,bh=1300/40,k=bw/4
            For y As Long=600 To 800+30 Step bh
                  For x As Integer<32>=-bw To 1300 Step bw
                        Line i,(x+k,y)-Step(bw,bh),bgr(200,100+(Rnd*15-Rnd*15),0),bf
                        Line i,(x+k,y)-Step(bw,bh),bgr(200,200,200),b
                  Next x
                  k=-k
            Next y
            
            Draw String i,(10,10),"tree ",bgr(255,100,0)
            '===============================================================
            Puts "WM_CREATE  please wait about 4 seconds"
            Brush = CreateSolidBrush(&HFFFF)
            getclientrect(hwnd,@ClientRect)
            
            Dim x As Integer
            Dim y As Integer
            For x=0 To 1000 Step 120
                  For y=0 To 1000 Step 25
                        'CreateWindowEx( 0, "BUTTON", "Button 1", WS_VISIBLE Or WS_CHILD, x, y, 100, 20, hwnd, 0, 0, 0 )
                  Next y
            Next x
            
            hDC = GetDC(hWnd)
            hBitmap = CreateCompatibleBitmap(hDC, 1300, 1300)
            hDC2    = CreateCompatibleDC(hDC)
            ReleaseDC(hWnd, hDC)
            SelectObject(hDC2, hBitmap)
            FillRect(hDC2, @ClientRect, Brush)
            
            '---------------------------
            '----- paint bitmap here
            '---------------------------
            
            Dim As Integer ix, iy
            For ix = 0 To 1300-1
                  For iy = 0 To 800-1
                        SetPixel hDC2, ix, iy, Point(ix,iy,i)
                  Next
            Next
            
            '----------------------------------
            For x=0 To 1500 Step 15
                  For y=0 To 1500 Step 15
                        'Ellipse hDC2,x,y,x+10,y+10
                  Next y
            Next x
            '----------------------------------
            
            Return 0
            
      Case WM_PAINT
            Print "WM_PAINT"
            Dim As PAINTSTRUCT pnt
            hDC = BeginPaint(hWnd, @pnt)
            BitBlt hDC, 0, 0, 1300, 1300, hDC2, 0, 0, SRCCOPY
            EndPaint(hWnd, @pnt)
            
            Return 0
      End Select
      Return DefWindowProc(hWnd, message, wParam, lParam)
      End Function 

[Tolo68]

Thanks Dodicat, but I already solved it !!!!!!

Create a other HDC (HDC3)

Load the image with LoadImage(....)
I made a SelectObject of the BMP file in this HDC3, and then sent it to Buffer HDC2 with BitBlt ( HDC2....., HDC3..... )
Then I can already draw in the HDC2 with the background Bitmap.

The double buffer works perfectly for me with a background bitmap !!!!

Thank you very much!!!

[dodicat]

Thanks Tolo68
I'll try that.
In the meantime I have done your buttons up.

Code: Select all

'-------------------------------------------------------------------------------

#include "windows.bi"
#include "crt.bi"
const ProgrammName = "Bitmaps blitten"
DIM shared Tiempo as double

dim shared Ancho as integer
dim shared Alto as integer

function contrast(c as ulong) as ulong
       #define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
       'get the rgb values
       dim as ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
       do
           r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
           'get at least 120 byte difference
           loop until abs(r-r2)>120 andalso abs(g-g2)>120 andalso abs(b-b2)>120
          return rgb(r2,g2,b2) 
   end function

declare function Fenster(byval hWnd as HWND, byval message as UINTEGER,_
    byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT

dim as WNDCLASS wcMeinFenster
with wcMeinFenster
    '.style         =  CS_OWNDC Or CS_VREDRAW Or CS_HREDRAW
    .lpfnWndProc   =  ProcPtr(Fenster)
    .cbClsExtra    =  0
    .cbWndExtra    =  0
    .hInstance     =  GetModuleHandle(NULL)
    .hCursor       =  LoadCursor(NULL, IDC_ARROW)
    .hIcon         =  LoadIcon(NULL, IDI_APPLICATION)
    .hbrBackground =  GetStockObject(WHITE_BRUSH)
    .lpszClassName =  StrPtr(ProgrammName)
    .lpszMenuName  =  NULL
end with
RegisterClass @wcMeinFenster

dim as HWND hMeinFenster = CreateWindow(_
    ProgrammName, "Titelzeile", WS_OVERLAPPEDWINDOW,_
    CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,_
    NULL, NULL, GetModuleHandle(NULL), NULL)

ShowWindow   hMeinFenster, SW_NORMAL
UpdateWindow hMeinFenster

dim as MSG msg
do while getmessage(@msg, NULL, 0, 0) <> 0
    DispatchMessage  @msg
loop
end msg.wParam

function Fenster(byval hWnd as HWND, byval message as UINTEGER,_
    byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT
    
    static as HBRUSH Brush
    static as RECT ClientRect
    static as HBITMAP   hBitmap
    static as HDC       hDC2
    dim    as HDC       hDC

    select case message
    
        case WM_DESTROY
            print "WM_DESTROY"
            DeleteDC(hDC2)
            DeleteObject(hBitmap)
            PostQuitMessage 0
            return 0

        case WM_CREATE
              dim as long count
            print "WM_CREATE"
            Brush = CreateSolidBrush(&HFFFF)
            getclientrect(hwnd,@ClientRect)
            Screenres 100,20,32,,-1 'hidden screen
            Width 100\8,20\16
            dim as any ptr i(1 to 369)
            dim x as integer
            dim y as integer
            dim as ulong clr
            randomize 
            for x=0 to 1000 step 120
                for y=0 to 1000 step 25
                      count+=1
                      clr=rgb(rnd*255,rnd*255,rnd*255)
                      i(count)=imagecreate(100,20,clr)
                      draw string i(count),(5,5),"Button "+str(count),contrast(clr)
                      Bsave ("small.bmp",i(count))
                   var c= CreateWindowEx( 0, "BUTTON", "", WS_VISIBLE Or WS_CHILD Or BS_BITMAP, x, y, 100, 20, hwnd, 0, 0, 0 )
                  var  hBitmap = LoadImage(0,"small.bmp", IMAGE_BITMAP, 100, 20,  LR_LOADFROMFILE )
                 SendMessage(c, BM_SETIMAGE, IMAGE_BITMAP, Cast(LPARAM, hbitmap))
                 kill "small.bmp"
                next y
            next x
            for n as long=lbound(i) to ubound(i)
                imagedestroy i(n)
                next
            'print count
            
            hDC = GetDC(hWnd)
            hBitmap = CreateCompatibleBitmap(hDC, 1300, 1300)
            hDC2    = CreateCompatibleDC(hDC)
            ReleaseDC(hWnd, hDC)
            SelectObject(hDC2, hBitmap)
            FillRect(hDC2, @ClientRect, Brush)

           '---------------------------
           '----- paint bitmap here
            '---------------------------

            dim as INTEGER ix, iy
            for ix = 0 to 255
                for iy = 0 to 255
                    ''SetPixel hDC2, ix +50, iy+50, RGBA(ix, iy, 128, 0)
                next
            next
            
            '----------------------------------
            for x=0 to 1500 step 15
            for y=0 to 1500 step 15
                Ellipse hDC2,x,y,x+10,y+10
            next y
            next x
            '----------------------------------
            
            return 0

        case WM_PAINT
            puts "WM_PAINT"
            dim as PAINTSTRUCT pnt
            hDC = BeginPaint(hWnd, @pnt)
                BitBlt hDC, 0, 0, 1300, 1300, hDC2, 0, 0, SRCCOPY
            EndPaint(hWnd, @pnt)
            
            return 0
    end select
    return DefWindowProc(hWnd, message, wParam, lParam)
end function 

[Tolo68]

Thank you Dodicat!!!! when i run your example, i didn't know if it was a GDI window or a parcheesi board!!!!