Making Filled Shapes Functions from Scratch

Windows specific questions.
Post Reply
myndgrrrrrl
Posts: 11
Joined: Feb 09, 2022 0:03

Making Filled Shapes Functions from Scratch

Post by myndgrrrrrl »

Hello, i am making a function to draw squares from scratch, because somehow FillRect() doesn't work for me. But it makes my program slow.

Code: Select all

Sub DrawSQR(ByVal x As Integer, ByVal y As Integer, _
                    ByVal c As Integer, ByVal s As Integer = 1)  


    Dim i As Integer
    Dim j As Integer
    For i = 0 To s
        For j = 0 To s
            SetPixel(Memhdc, j+x,i+y,c)
        Next
    Next 

End Sub

what can i do to fix that?
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Making Filled Shapes Functions from Scratch

Post by badidea »

What about Rectangle? See: https://www.freebasic-portal.de/tutoria ... 64-s5.html
I am not a big fan of Microsoft, but I am pretty sure that they have a working rectangle drawing routing.
myndgrrrrrl
Posts: 11
Joined: Feb 09, 2022 0:03

Re: Making Filled Shapes Functions from Scratch

Post by myndgrrrrrl »

Somehow the Rectangle() function doesn't work for me
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Making Filled Shapes Functions from Scratch

Post by badidea »

You say that this (below) does not show any rectangles?
I switched to Windows and it works fine here. For both 32 and 64 bit fbc.

Code: Select all

''' Lutz Ifers WinAPI-Tutorial
''' Lizenz: WTFPL
'''
''' Kapitel 2.2 - "Filled Shapes"

#include "windows.bi"
const ProgrammName = "Filled Shapes"

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

dim as WNDCLASS wcMeinFenster
with wcMeinFenster
    .style         =  CS_HREDRAW or CS_VREDRAW
    .lpfnWndProc   =  @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,_
    100, 100, 400, 400,_
    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 ULONG,_
    byval wParam as WPARAM, byval lParam as LPARAM) as LRESULT

    select case message
        case WM_DESTROY
            PostQuitMessage 0
            return 0

        case WM_PAINT
            dim as PAINTSTRUCT pnt
            dim as HDC hDC = BeginPaint(hWnd, @pnt)
                dim as HBRUSH hbrushRot = CreateSolidBrush(RGBA(0,0,255,0))
                dim as HBRUSH hbrushBlau = CreateSolidBrush(RGBA(255,0,0,0))
                dim as HBRUSH hbrushBGR  = GetSysColorBrush(COLOR_BACKGROUND)

                SelectObject hDC, hbrushRot
                Rectangle hDC, 10, 10, 300, 300

                SelectObject hDC, hbrushBlau
                Rectangle hDC, 20, 20, 200, 200

                SelectObject hDC, hbrushBGR
                Rectangle hDC, 100, 100, 280, 280

                SelectObject hDC, GetStockObject(LTGRAY_BRUSH)
                Rectangle hDC, 150, 150, 250, 250

                SelectObject hDC, GetStockObject(NULL_BRUSH)
                Ellipse hDC, 20, 210, 90, 280
                RoundRect hDC, 210, 20, 290, 90, 16, 16

                DeleteObject hbrushBGR
                DeleteObject hbrushRot
                DeleteObject hbrushBlau
            EndPaint(hWnd, @pnt)
            return 0

    end select
    return DefWindowProc(hWnd, message, wParam, lParam)
end function

'declare function Ellipse(hDC, nLeft, nTop, nRight, nBottom) as BOOL
'declare function RoundRect(hDC, nLeft, nTop, nRight, nBottom, nWidth, nHeight) as BOOL
Post Reply