Hola a Todos, tengo este codigo en FreeBasic, aunque se basa en la api32 y es practicamente lo mismo que VB
lo he mejorado bastante pero aun falla un poco, al redimensionar la ventana va perfecto, pero si cojo otra ventana y la muevo por encima de esta hay algo de parpadeo, no se si es por el orden de las funciones graficas, tambien he leido algo de doble buffer, pero los ejemplos que he descargado no van bien del todo. Graciassss
el codigo es el siguiente
-----------------------------------
#INCLUDE "windows.bi"
Declare Function WinMain(hInst As HINSTANCE , hPrevInst As HINSTANCE,CmdLine As LPSTR,CmdShow As DWORD) As Integer
Declare Function WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As Integer
Dim Shared As String ClassName,AppName
ClassName = "SimpleWin32"
AppName = "Win32 Simple Bitmap"
Dim Shared ps As PAINTSTRUCT
Dim Shared hdc As HDC
Dim Shared hMemDC As HDC
Dim Shared rect As RECT
Dim Shared hInstance As HINSTANCE
Dim Shared CommandLine As LPSTR
Dim Shared hBitmap As HBITMAP
dim shared as hwnd btn1 ,btn2
hInstance = GetModuleHandle(NULL)
CommandLine = GetCommandLine()
ExitProcess(WinMain(hInstance,NULL,CommandLine, SW_SHOWDEFAULT))
Function WinMain(hInst As HINSTANCE , hPrevInst As HINSTANCE,CmdLine As LPSTR,CmdShow As DWORD) As Integer
Dim wc As WNDCLASSEX
Dim msg As MSG
Dim hwnd As HWND
wc.cbSize = Sizeof(WNDCLASSEX)
wc.style = CS_HREDRAW Or CS_VREDRAW ' <----------- si comento esta linea el parpadeo reduce bastante
wc.lpfnWndProc = @WndProc
wc.hInstance = hInstance
wc.hbrBackground = Cast(HBRUSH, COLOR_WINDOW+1)
wc.lpszClassName = Strptr(ClassName)
wc.hIcon = LoadIcon(NULL,IDI_APPLICATION)
wc.hIconSm = wc.hIcon
wc.hCursor = LoadCursor(NULL,IDC_ARROW)
RegisterClassEx(@wc)
hwnd = CreateWindowEx(NULL,ClassName,AppName, WS_OVERLAPPEDWINDOW,CW_USEDEFAULT, _
CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,NULL,NULL, hInst,NULL)
ShowWindow(hwnd,SW_SHOWNORMAL)
UpdateWindow(hwnd)
While GetMessage(@msg,NULL,0,0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Wend
Return msg.wParam
End Function
sub DrawGrid
dim as integer XX,YY
for xx=0 to rect.right step 8 ' <----------- si aqui pongo rect.right/2 en teoria deberia llenar media ventana, pero no lo hace
for yy=0 to rect.bottom step 8
setpixel(hdc,xx,yy,0)
movetoex(hdc,xx,yy,0)
lineto(hdc,xx,yy)
next yy
next xx
end sub
Function WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As Integer
select case umsg
case WM_CREATE
'print "WM_CREATE"
hBitmap = LoadImage(NULL,"image.bmp",IMAGE_Bitmap,0,0,LR_DEFAULTCOLOR Or LR_LOADFROMFILE )
btn1 = CreateWindowEx( 0, "BUTTON", "Button 1", WS_VISIBLE Or WS_CHILD, 10, 10, 100, 20, hWnd, 0, 0, 0 )
btn2 = CreateWindowEx( 0, "BUTTON", "Button 2", WS_VISIBLE Or WS_CHILD, 300, 10, 100, 20, hWnd, 0, 0, 0 )
case WM_PAINT
'print "WM_PAINT"
hdc = BeginPaint(hWnd,@ps)
hMemDC = CreateCompatibleDC(hdc)
SelectObject(hMemDC,hBitmap)
GetClientRect(hWnd,@rect)
FillRect(hdc, @rect, CreateSolidBrush(BGR(127, 127, 127)))
BitBlt(hdc,0,0,rect.right,rect.bottom,hMemDC,0,0,SRCCOPY)
DrawGrid
DeleteDC(hMemDC)
EndPaint(hWnd,@ps)
case WM_DESTROY
DeleteObject(hBitmap)
PostQuitMessage(NULL)
case WM_ERASEBKGND ' Con esta linea he mejorado el parpadeo, pero aun sigue
case Else
Return DefWindowProc(hWnd,uMsg,wParam,lParam)
end select
Return 0
End Function
