Announcement

Collapse
No announcement yet.

Flashing

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Flashing

    I'm playing around with an API custom graphic control. I'd like to make it at least as efficient as the ddt control. Right away I see that the graphic window flashes when the main window is resized. At this point then only thing I can think of is installing a hook to monitor the wm_syscommand messages of the main window.

    Code follows.
    Code:
    #COMPILE EXE "DRW_CAD"
    DEFLNG I - N
    #INCLUDE "win32api.inc"
    '/=======================================================================================/'
    '                           GRAPHIC_CTRL.DLL EQUATES
    '/=======================================================================================/'
    %NULL     = 0
    %FALSE    = 0
    %TRUE     = 1
    
    %GFX  = 100
    
    $WIN    = "MAIN_CLASS"
    $GRF    = "GRAF_CLASS"
    $GFXE   = ".GFX"
    $GFBUF  = "BUFFER.GFX"
    
    '/=======================================================================================/'
    '                           GRAPHIC_CTRL.DLL STRUCTURES
    '/=======================================================================================/'
    TYPE BitMapFile_Struct
      BITMAPFILEHEADER
      BITMAPINFOHEADER
    END TYPE
    
    TYPE Points_Struct
      X                 AS LONG
      Y                 AS LONG
    END TYPE
    
    TYPE Area_Struct
      X                 AS LONG
      Y                 AS LONG
      X1                AS LONG
      Y1                AS LONG
    END TYPE
    
    TYPE PAINT_Struct
        BtnDc           AS DWORD
        Erase           AS LONG
        Area_Struct
        Restore         AS LONG
        IncUpdate       AS LONG
        rgbReserved(31) AS BYTE
    END TYPE
    
    TYPE GfxCtl_Struct
      ParHndl         AS DWORD
      GfxHndl         AS DWORD
      GfxId           AS DWORD
      GfxDc           AS DWORD
      GfxClr          AS DWORD
      GfxNow          AS WORD
    END TYPE
    '/======================================================================================/'
    '                           WINDOWS DECLARES
    '/======================================================================================/'
    DECLARE FUNCTION dwGetUpdateRect LIB "User32.dll" ALIAS "GetUpdateRect" _
           (BYVAL hWnd AS DWORD, BYVAL lpRect AS DWORD, BYVAL bErase AS LONG) AS LONG
    
    DECLARE FUNCTION dwGetClientRect LIB "User32.dll" ALIAS "GetClientRect"(BYVAL hwnd AS DWORD, _
            BYVAL lpRect AS DWORD) AS LONG
    DECLARE FUNCTION dwGetWindowRect LIB "User32.dll" ALIAS "GetWindowRect"(BYVAL hWnd AS DWORD, _
            BYVAL lpRect AS DWORD) AS LONG
    DECLARE FUNCTION dwClientToScreen LIB "User32.dll" ALIAS "ClientToScreen"(BYVAL hWnd AS DWORD, _
            BYVAL lpPoint AS DWORD) AS LONG
    DECLARE FUNCTION dwScreenToClient LIB "User32.dll" ALIAS "ScreenToClient"(BYVAL hWnd AS DWORD, _
            BYVAL lpPoint AS DWORD) AS LONG
    DECLARE FUNCTION dwInvalidateRect LIB "USER32.DLL" ALIAS "InvalidateRect" (BYVAL hWnd AS DWORD, _
            BYVAL lpRect AS DWORD, BYVAL bErase AS LONG) AS LONG
    DECLARE FUNCTION dwValidateRect LIB "User32.dll" ALIAS "ValidateRect" _
            (BYVAL hWnd AS DWORD, BYVAL lpRect AS DWORD) AS LONG
    
    DECLARE FUNCTION DWBeginPaint LIB "User32.dll" ALIAS "BeginPaint"(BYVAL hWnd AS DWORD, _
            BYVAL lpPaint AS DWORD) AS DWORD
    DECLARE FUNCTION DWEndPaint LIB "User32.dll" ALIAS "EndPaint"(BYVAL hWnd AS DWORD, _
            BYVAL lpPaint AS DWORD) AS LONG
    DECLARE FUNCTION GetDC LIB "User32.dll" ALIAS "GetDC" (OPTIONAL BYVAL hWnd AS DWORD) AS DWORD
    DECLARE FUNCTION DWDrawFrameControl LIB "User32.dll" ALIAS "DrawFrameControl"_
            (BYVAL hDC AS DWORD, BYVAL lpRect AS DWORD, BYVAL un1 AS DWORD, _
             BYVAL un2 AS DWORD) AS LONG
    DECLARE FUNCTION dwFillRect LIB "User32.dll" ALIAS "FillRect" (BYVAL hDC AS DWORD, _
            BYVAL lpRect AS DWORD, BYVAL hBrush AS DWORD) AS LONG
    
    '/======================================================================================/'
    '                           GDI32.DLL DECLARES
    '/======================================================================================/'
    DECLARE FUNCTION dwCreateDIBSection LIB "GDI32.DLL" ALIAS "CreateDIBSection" (BYVAL hdc AS DWORD, _
            BYVAL bmiPtr AS DWORD, BYVAL dwUsage AS DWORD, BYVAL ppvBits AS DWORD, _
            BYVAL hSection AS DWORD, BYVAL dwOffset AS DWORD) AS DWORD
    
    '/=======================================================================================/'
    '                           GRAPHIC_CTRL.DLL FUNCTIONS
    '/=======================================================================================/'
    DECLARE FUNCTION FN_InitClass ALIAS "Fn_InitClass"(BYVAL ClassStyle AS DWORD, _
            BYVAL CallBackPtr AS DWORD, BYVAL ClsExtra AS DWORD, BYVAL WndExtra AS DWORD, _
            BYVAL AppInst AS DWORD, BYVAL BkgColor AS LONG, _
            BYVAL ClassNamePtr AS STRING) EXPORT AS LONG
    DECLARE FUNCTION FN_InitWindow ALIAS "FN_InitWindow"(BYVAL ExtraStyle AS DWORD, WinClass AS STRING, _
            WinTitle AS STRING, BYVAL DefStyle AS DWORD, BYVAL Xpos AS LONG, BYVAL Ypos AS LONG, _
            BYVAL CtlWide AS LONG, BYVAL CtlHigh AS LONG, BYVAL Owner AS DWORD, _
            BYVAL CtlId AS DWORD, BYVAL AppInst AS DWORD) EXPORT AS LONG
    DECLARE FUNCTION GrfActivate ALIAS "GrfActivate"(BYVAL PrntHndl AS DWORD, _
            BYVAL CtlId AS DWORD) EXPORT AS DWORD
    DECLARE SUB GrfCreateBitMap ALIAS "GrfCreateBitMap" (BmpHndl AS LONG, BmpDc AS LONG, _
            BYVAL Xwide AS LONG, BYVAL Yhigh AS LONG, OldObj AS LONG) EXPORT
    DECLARE SUB GrfDestroyBmp ALIAS "GrfDestroyBmp"(BmpHndl AS LONG, BmpDc AS LONG, _
            BYVAL OldObj AS LONG) EXPORT
    DECLARE SUB GrfDwToByte ALIAS "GrfDwToByte"(dwBGRColors() AS DWORD, _
            ByteBGRColors() AS BYTE) EXPORT
    DECLARE SUB GrfFilledRect ALIAS "GrfFilledRect"(BYVAL WinHndl AS DWORD, BYVAL CtlId AS DWORD, _
            BYVAL FromX AS DWORD, BYVAL FromY AS DWORD, BYVAL ToX AS DWORD, BYVAL ToY AS DWORD, _
            BYVAL FillColor AS LONG) EXPORT
    DECLARE SUB GrfGetdwBGRColors ALIAS "GrfGetBGRColors"(BYVAL BmpHndl AS DWORD, BmpWide AS LONG, _
            BmpHigh AS LONG, BgrColors() AS DWORD) EXPORT
    DECLARE SUB GrfLoadBmp ALIAS "GrfLoadBmp"(Xwide AS LONG, YHigh AS LONG, _
            BYVAL BmpName AS STRING, BmpHndl AS LONG, BmpDc AS LONG, OldObj AS LONG) EXPORT
    DECLARE SUB GrfSaveBitMap ALIAS "GrfSaveBitMap"(BmpFile AS STRING, BYVAL BmpHndl AS LONG) EXPORT
    DECLARE SUB GrfSetUpFileBytes ALIAS "GrfSetUpFileBytes"(Buffer() AS BYTE, BmpWIDTH AS LONG, _
            BmpHeight AS LONG, Newsize AS LONG, Newbuf() AS BYTE) EXPORT
    DECLARE FUNCTION NewGraphic ALIAS "NewGraphic"(BYVAL ParHndl AS DWORD, BYVAL GfxId AS DWORD, _
            BYVAL Title AS STRING, BYVAL Ulx AS LONG, BYVAL Uly AS LONG, BYVAL XWide AS LONG, _
            BYVAL YHigh AS LONG,BYVAL CtlStyle AS DWORD, BYVAL ExtStyle AS DWORD) EXPORT AS LONG
    
    '/===========================================================================================/'
    '                               GLOBALS
    '/===========================================================================================/'
    GLOBAL tGfx AS GfxCtl_Struct
    
    '/===========================================================================================/'
    '                               BEGIN
    '/===========================================================================================/'
    
    FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                      BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG
    
    LOCAL WinHndl AS DWORD
    LOCAL tMsg AS TAGMSG
    A$ = DIR$("*" + $GFXE)
    IF A$ <> "" THEN
      KILL A$
    END IF
    
    CALL StartSub(hInstance, WinHndl)
    
    DO
      IF iswindow(WinHndl) = 0 THEN EXIT DO
      getmessage(tMsg, 0, 0, 0)
      translatemessage(tMsg)
      dispatchmessage(tMsg)
    LOOP
    END FUNCTION
    
    '-------------------------------------------------------------------------------------------
    '-------------------------------------------------------------------------------------------
    
    SUB StartSub(BYVAL Inst AS DWORD, MainWin AS DWORD)
    
    LOCAL TipHndl, _
          WinHndl, _
           TbHndl, _
          CtlHndl, _
           KArrow, _
           Istyle, _
           Colour      AS DWORD
    
    LOCAL I            AS LONG
    
    Istyle = %WS_OVERLAPPEDWINDOW OR %WS_THICKFRAME
    Colour = %RGB_GAINSBORO
    MainWin = FN_NewWindow(CODEPTR(MainDlg_CB), $WIN, Colour, 0, _
            Istyle, "DRAW: ", 50, 50, 640, 480, 0, 0)
    
    Istyle = %WS_CHILD OR %SS_NOTIFY OR %SS_SUNKEN OR %DS_SYSMODAL OR %DS_CONTROL _
    OR %WS_DLGFRAME' OR %WS_THICKFRAME
    'or %DS_MODALFRAME
    
    NewGraphic(MainWin, %GFX, "", 0, 0, 100, 100, Istyle, 0) TO I
    
    GrfActivate (MainWin, %GFX)
    GrfClear(%RGB_PEACHPUFF)
    GrfSetRedraw(1)
    showwindow(MainWin, %SW_SHOW)
    END SUB
    
    '-------------------------------------------------------------------------------------------
    '-------------------------------------------------------------------------------------------
    
    FUNCTION MainDlg_CB(BYVAL MainHndl AS DWORD, BYVAL MainMsg AS LONG, BYVAL wParam AS LONG, _
      BYVAL lParam AS LONG) AS LONG
    
    SELECT CASE AS LONG MainMsg
    
    END SELECT
    
    FUNCTION = DefWindowProc(MainHndl, MainMsg, wParam, lParam)
    END FUNCTION
    
    '-------------------------------------------------------------------------------------------
    '-------------------------------------------------------------------------------------------
    
    FUNCTION FN_InitClass ALIAS "Fn_InitClass"(BYVAL ClassStyle AS DWORD, _
             BYVAL CallBackPtr AS DWORD, BYVAL ClsExtra AS DWORD, BYVAL WndExtra AS DWORD, _
             BYVAL AppInst AS DWORD, BYVAL BkgColor AS LONG, _
             BYVAL ClassNamePtr AS STRING) EXPORT AS LONG
    
    LOCAL BrushHndl, _
               Init     AS LONG
    
    LOCAL WinClassz     AS ASCIIZ * 80
    
    LOCAL tClass        AS WNDCLASSEX
    
    WinClassz$ = ClassNamePtr$
    
    tClass.cbSize = SIZEOF(WNDCLASSEX)
    
    Init = GetClassInfoEx(AppInst, WinClassz$, tClass)
    
    IF Init THEN
      FN_InitClass = -Init
      EXIT FUNCTION
    END IF
    
    IF BkgColor = 0 THEN
      BrushHndl = getstockobject(%BLACK_BRUSH)
    ELSEIF BkgColor < 0 THEN
      BrushHndl = getstockobject(%HOLLOW_BRUSH)
    ELSE
      BrushHndl = createsolidbrush(BkgColor)
    END IF
    
    tClass.Style         = ClassStyle
    tClass.lpfnWndProc   = CallBackPtr
    tClass.cbClsExtra    = ClsExtra
    tClass.cbWndExtra    = WndExtra
    tClass.hInstance     = AppInst
    tClass.hIcon         = LoadIcon(AppInst, BYVAL %IDI_APPLICATION)
    tClass.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
    tClass.hbrBackground = BrushHndl
    tClass.lpszMenuName  = 0
    tClass.lpszClassName = VARPTR(WinClassz$)
    tClass.hIconSm       = LoadIcon(AppInst, BYVAL %IDI_APPLICATION)
    
    FN_InitClass = RegisterClassEx(tClass)
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    
    FUNCTION FN_InitWindow ALIAS "FN_InitWindow"(BYVAL ExtraStyle AS DWORD, WinClass AS STRING, _
             WinTitle AS STRING, BYVAL DefStyle AS DWORD, BYVAL Xpos AS LONG, BYVAL Ypos AS LONG, _
             BYVAL CtlWide AS LONG, BYVAL CtlHigh AS LONG, BYVAL Owner AS DWORD, _
             BYVAL CtlId AS DWORD, BYVAL AppInst AS DWORD) EXPORT AS LONG
    
    LOCAL WinHndl       AS DWORD
    
    LOCAL WinClassz, _
          WinTitlez     AS ASCIIZ * 80
    
    WinClassz$ = WinClass$
    WinTitlez$ = WinTitle$
    
    WinHndl =  CreateWindowEx(ExtraStyle, _        'Extended style
                              WinClassz$, _        'windows class name
                              WinTitlez$, _        'title of window
                                DefStyle, _        'window style
                                    Xpos, _        'X position on monitor
                                    Ypos, _        'Y position on monitor
                                 Ctlwide, _        'width of window
                                 Ctlhigh, _        'hight of window
                                   Owner, _        'window parent or owner
                                   CtlId, _        'menu ID in resource or control ID
                                 AppInst, _        'window instance or app instance
                                BYVAL 0)          'extra info
    
    FN_InitWindow = WinHndl
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    
    FUNCTION NewGraphic ALIAS "NewGraphic"(BYVAL ParHndl AS DWORD, BYVAL GfxId AS DWORD, _
      BYVAL Title AS STRING, BYVAL Ulx AS LONG, BYVAL Uly AS LONG, BYVAL XWide AS LONG, _
      BYVAL YHigh AS LONG,BYVAL CtlStyle AS DWORD, BYVAL ExtStyle AS DWORD) EXPORT AS LONG
    
    LOCAL ClassStyle, _
             BmpHndl, _
               BmpDc, _
              OldBmp, _
                Inst, _
             CtlHndl      AS DWORD
    
    LOCAL BrushColor      AS LONG
    
    LOCAL tCli            AS Area_Struct
    
    ClassStyle = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC
    
    BrushColor = getsyscolor(%COLOR_3DFACE)
    
    Inst = getmodulehandle(BYVAL 0)
    Init = FN_InitClass(ClassStyle, _
             CODEPTR(GraficDlg_CB), _
                                 4, _
                                 4, _
                              Inst, _
                        BrushColor, _
                             $GRF)
    
    IF Init = 0 THEN EXIT FUNCTION
    
    ExtStyle = ExtStyle OR %WS_EX_TOPMOST
    IF (CtlStyle AND %WS_THICKFRAME) = %WS_THICKFRAME THEN CtlStyle = ctlStyle XOR %WS_THICKFRAME
    'CtlStyle = CtlStyle XOR %WS_THICKFRAME
    CtlStyle = CtlStyle OR %WS_CHILD OR %WS_VISIBLE OR %DS_CONTROL
    
    CtlHndl = FN_InitWindow(ExtStyle, _
                               $GRF, _
                             Title$, _
                           CtlStyle, _
                                Ulx, _
                                Uly, _
                              XWide, _
                              YHigh, _
                            ParHndl, _
                              GfxId, _
                              Inst)
    
    IF CtlHndl = 0 THEN EXIT FUNCTION
    
    showwindow(CtlHndl, %SW_SHOW)
    dwgetclientrect(CtlHndl, VARPTR(tCli))
    
    tGfx.ParHndl = ParHndl
    tGfx.GfxHndl = CtlHndl
    tGfx.GfxId   = GfxId
    tGfx.GfxClr  = BrushColor
    
    CALL GrfCreateBitMap(BmpHndl, BmpDc, tCli.X1, tCli.Y1, OldBmp)
    tGfx.GfxDc = BmpDc
    
    CALL GrfFilledRect(BmpHndl, 0, 0, 0, tCli.X1, tCli.Y1, BrushColor)
    CALL GrfSaveBitMap(FORMAT$(CtlHndl) + $GFXE, BmpHndl)
    CALL GrfDestroyBmp(BmpHndl, BmpDc, OldBmp)
    
    tGfx.GfxDc = 0
    FN_UpdateWindow(CtlHndl)
    NewGraphic = CtlHndl
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    
    FUNCTION GraficDlg_CB(BYVAL GfxHndl AS DWORD, BYVAL GfxMsg AS LONG, BYVAL wParam AS LONG, _
      BYVAL lParam AS LONG) AS LONG
    
    LOCAL BmpHndl, _
            BmpDc, _
           OldBmp, _
            GfxDc     AS DWORD
    
    LOCAL Xwide, _
          Yhigh       AS LONG
    
    LOCAL BmpName     AS STRING
    
    LOCAL tPaint      AS Paint_Struct
    
    SELECT CASE AS LONG GfxMsg
      CASE %WM_ERASEBKGND
    '    OldBmp = getupdaterect(GfxHndl, varptr(tPaint.X), 0)
    
    '    if tPaint.X = tPaint.X1 then exit select
        'IF OldBmp = 0 THEN EXIT FUNCTION
    
    '    BmpName$ = FORMAT$(GfxHndl) + $GFXE
    '    msgbox BmpName$ + str$(tGfx.GfxHndl)
    '    CALL GrfLoadBmp(Xwide, YHigh, BmpName$, BmpHndl, BmpDc, OldBmp)
    '
    '    IF BmpHndl = 0 THEN EXIT SELECT
    '
    '    GfxDc = wParam
    '
    '    bitblt(GfxDc, 0, 0, Xwide, Yhigh, BmpDc, 0, 0, %SRCCOPY)
    '
    '    CALL GrfDestroyBmp(BmpHndl, BmpDc, OldBmp)
    '
    '    tPaint.X = 0
    '    tPaint.Y = 0
    '    tPaint.X1 = Xwide
    '    tPaint.Y1 = Yhigh
    '    validaterect(GfxHndl, varptr(tPaint.X))
        FUNCTION = 1
        EXIT FUNCTION
    
      CASE %WM_PAINT
        IF tGfx.GfxNow = 0 THEN EXIT SELECT
    
        OldBmp = dwgetupdaterect(GfxHndl, VARPTR(tPaint.X), 0)
    
        IF tPaint.X = tPaint.X1 THEN EXIT SELECT
    '    IF OldBmp = 0 THEN EXIT FUNCTION
    
        BmpName$ = FORMAT$(GfxHndl) + $GFXE
    '    msgbox BmpName$ + str$(tGfx.GfxHndl)
        CALL GrfLoadBmp(Xwide, YHigh, BmpName$, BmpHndl, BmpDc, OldBmp)
    '
        IF BmpHndl = 0 THEN EXIT SELECT
    '
        GfxDc = getdc(GfxHndl)'wParam
    '
        bitblt(GfxDc, tPaint.X, tPaint.Y, tPaint.X1, tPaint.Y1, BmpDc, 0, 0, %SRCCOPY)
    '
        CALL GrfDestroyBmp(BmpHndl, BmpDc, OldBmp)
    '
        tPaint.X = 0
        tPaint.Y = 0
        tPaint.X1 = Xwide
        tPaint.Y1 = Yhigh
        dwvalidaterect(GfxHndl, VARPTR(tPaint.X))
        releasedc(GfxHndl, GfxDc)
        EXIT FUNCTION
    
    END SELECT
    
    FUNCTION = DefWindowProc(GfxHndl, GfxMsg, wParam, lParam)
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    
    SUB GrfCreateBitMap ALIAS "GrfCreateBitMap" (BmpHndl AS LONG, BmpDc AS LONG, _
        BYVAL Xwide AS LONG, BYVAL Yhigh AS LONG, OldObj AS LONG) EXPORT
    
    LOCAL DispHndl, _
            DispDc, _
             TmpDc, _
           BmpWide, _
           BmpHigh    AS LONG
    
    LOCAL tMap        AS BITMAP
    LOCAL tMapInfo    AS BITMAPINFO
    
    BmpWide = Xwide
    BmpHigh = Yhigh
    
    DispHndl = getdesktopwindow()
    DispDc   = getdc(DispHndl)
    Tmpdc    = createcompatibledc(DispDc)
    releasedc(DispHndl, DispDc)
    
    tMapInfo.bmiHeader.biSize        = SIZEOF(tMapInfo.bmiHeader)
    tMapInfo.bmiHeader.biWidth       = BmpWide
    tMapInfo.bmiHeader.biHeight      = -BmpHigh
    tMapInfo.bmiHeader.biPlanes      = 1
    tMapInfo.bmiHeader.biBitCount    = 32
    tMapInfo.bmiHeader.biCompression = %BI_RGB
    
    BmpHndl = dwCreateDIBSection(TmpDC, VARPTR(tMapInfo), %DIB_RGB_COLORS, 0, 0, 0)
    OldObj = selectobject(TmpDc, BmpHndl)
    
    Xwide = BmpWide
    Yhigh = BmpHigh
    BmpDc = TmpDc
    END SUB
    
    '---------------------------------------------------------------------------------
    '---------------------------------------------------------------------------------
    
    SUB GrfDestroyBmp ALIAS "GrfDestroyBmp"(BmpHndl AS LONG, BmpDc AS LONG, _
        BYVAL OldObj AS LONG) EXPORT
    
    selectobject(BmpDc, OldObJ)
    deleteobject(BmpHndl)
    deletedc(BmpDc)
    
    BmpHndl = 0
    BmpDc = 0
    OldObj = 0
    
    END SUB
    
    '---------------------------------------------------------------------------------------------
    '---------------------------------------------------------------------------------------------
    
    SUB GrfSaveBitMap ALIAS "GrfSaveBitMap"(BmpFile AS STRING, BYVAL BmpHndl AS LONG) EXPORT
    
    
    REGISTER I          AS DWORD
    REGISTER J          AS DWORD
    
    LOCAL WinHndl, _
            WinDc, _
          SavHndl, _
            SavDc, _
          OldHndl, _
          Padding       AS LONG
    
    LOCAL Fbytes        AS STRING
    
    LOCAL BmpBytes(), _
          FileBytes()   AS BYTE
    
    LOCAL BgrClrs()     AS DWORD
    
    LOCAL BytPtr        AS BYTE POINTER
    
    LOCAL tMap          AS BITMAP
    LOCAL tMapInfo      AS BITMAPINFO
    LOCAL tSave         AS BitMapFile_Struct
    
    DIM BmpBytes(0)
    DIM FileBytes(0)
    
    'CALL GraphicGetBmpBytes(BmpHndl, tMap.bmWidth, tMap.bmHeight, BmpBytes())
    'CALL GraphicSetUpFileBytes(BmpBytes(), tMap.bmWidth, tMap.bmHeight, Padding, FileBytes())
    
    CALL GrfGetdwBGRColors(BmpHndl, tMap.BmWidth, tMap.BmHeight, BgrClrs())
    CALL GrfDwToByte(BGRClrs(), BmpBytes())
    CALL GrfSetUpFileBytes(BmpBytes(), tMap.bmWidth, tMap.bmHeight, Padding, FileBytes())
    
    '---- FILL the fileheader WITH DATA ------------------------
    tSave.bfType = &h4D42          '&h4D42 = "BM"
    tSave.bfReserved1 = 0
    tSave.bfReserved2 = 0
    tSave.bfSize = SIZEOF(BitMapFile_Struct) + Padding
    tSave.bfOffBits = 54         'number OF bytes to start of bitmap data
    
    '---- FILL the infoheader ------------------------------------
    tSave.biSize = SIZEOF(BITMAPINFOHEADER)
    tSave.biWidth = tMap.bmWidth        'Wwide
    tSave.biHeight = tMap.bmHeight      'Whigh
    tSave.biPlanes = 1                  ' only have one bitplane
    tSave.biBitCount = 24               ' RGB mode IS 24 bits
    tSave.biCompression = %BI_RGB
    tSave.biSizeImage = 0               ' can be 0 for 24 bit images
    tSave.biXPelsPerMeter = &h0EC4      ' Paint and PSP use these values
    tSave.biYPelsPerMeter = &h0EC4      '
    tSave.biClrUsed = 0                 ' RGB MODE has no palette
    tSave.biClrImportant = 0            ' All colors are important
    
    OPEN BmpFile$ FOR BINARY AS #1 BASE = 0
    PUT #1, , tSave
    PUT #1, , FileBytes()
    
    SETEOF #1
    CLOSE #1
    
    END SUB
    
    '-------------------------------------------------------------------------------------------
    '-------------------------------------------------------------------------------------------
    
    SUB GrfGetdwBGRColors ALIAS "GrfGetBGRColors"(BYVAL BmpHndl AS DWORD, BmpWide AS LONG, _
        BmpHigh AS LONG, BgrColors() AS DWORD) EXPORT
    
    LOCAL BmpClrs()   AS DWORD
    
    LOCAL LocPtr      AS DWORD POINTER
    
    LOCAL tMap        AS BITMAP
    
    getobject(BmpHndl, SIZEOF(BITMAP), tMap)
    
    BmpWide = tMap.bmWidth
    BmpHigh = tMap.bmHeight
    LocPtr = tMap.bmBits
    
    REDIM BgrColors(1 TO BmpWide * BmpHigh)
    
    DIM BmpClrs(1 TO BmpWide * BmpHigh) AT LocPtr
    MAT BgrColors() = BmpClrs()
    
    END SUB
    
    '-------------------------------------------------------------------------------------------
    '-------------------------------------------------------------------------------------------
    
    SUB GrfDwToByte ALIAS "GrfDwToByte"(dwBGRColors() AS DWORD, ByteBGRColors() AS BYTE) EXPORT
    
    #REGISTER NONE
    
    REGISTER I        AS DWORD
    REGISTER J        AS DWORD
    
    LOCAL Colour, _
            Ubnd      AS DWORD
    
    LOCAL BytPtr      AS BYTE POINTER
    
    Ubnd = UBOUND(dwBGRColors)
    REDIM ByteBGRColors(0 TO Ubnd * 3 - 1)
    
    BytPtr = VARPTR(Colour)
    J = 0
    FOR I = 1 TO Ubnd
      Colour = dwBGRColors(I)
      ByteBGRColors(J) = @BytPtr[0]
      ByteBGRColors(J + 1) = @BytPtr[1]
      ByteBGRColors(J + 2) = @BytPtr[2]
      J = J + 3
    NEXT I
    
    END SUB
    
    '-------------------------------------------------------------------------------------------
    '-------------------------------------------------------------------------------------------
    
    SUB GrfSetUpFileBytes ALIAS "GrfSetUpFileBytes"(Buffer() AS BYTE, BmpWIDTH AS LONG, _
        BmpHeight AS LONG, Newsize AS LONG, Newbuf() AS BYTE) EXPORT
    
    REGISTER X                AS LONG
    REGISTER Y                AS LONG
    
    LOCAL ScanlineBytes, _
                Padding, _
                    Psw       AS INTEGER
    
    LOCAL Bufpos, _
          Newpos              AS LONG
    
    '---- first make sure the parameters are valid --------------------
    IF (UBOUND(Buffer) < 0) OR (BmpWIDTH = 0) OR (Bmpheight = 0) THEN
      EXIT SUB
    END IF
    
    '--- now we have to FIND how many bytes ---------------------------
    '--- we have TO pad to the next dword boundary --------------------
    Padding = 0
    ScanlineBytes = bmpWIDTH * 3
    
    DO WHILE (ScanlineBytes + Padding ) MOD 4 <> 0  ' DWORD = 4 bytes
      INCR Padding
    LOOP
    
    '---- set the padded scanline width --------------------------------
    Psw = ScanlineBytes + Padding
    
    '---- set the size of the padded buffer -------
    Newsize = BmpHeight * Psw
    REDIM Newbuf(Newsize)
    
    '---- now we loop trough ALL bytes OF the original buffer, ---------
    '---- swap the R AND B bytes and the scanlines ---------------------
    Bufpos = 0
    Newpos = 0
    
    FOR Y = 0 TO BmpHeight - 1
          'Bufpos = Y * 3 * BmpWIDTH
      FOR X = 0 TO 3 * (BmpWIDTH - 1) STEP 3
        Bufpos =  Y * 3 * BmpWIDTH + X              ' position IN original buffer
        Newpos = (BmpHeight - Y - 1 ) * Psw + X    ' position IN padded buffer
    
    '    Newbuf(Newpos) = Buffer(Bufpos + 2)        ' SWAP r AND b
    '    Newbuf(Newpos + 1) = Buffer(Bufpos + 1)    ' g stays
    '    Newbuf(Newpos + 2) = Buffer(Bufpos)        ' SWAP b AND r
    
        Newbuf(Newpos) = Buffer(Bufpos)        ' SWAP r AND b
        Newbuf(Newpos + 1) = Buffer(Bufpos + 1)    ' g stays
        Newbuf(Newpos + 2) = Buffer(Bufpos + 2)        ' SWAP b AND r
    
      NEXT X
    NEXT Y
    
    END SUB
    
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    
    SUB GrfFilledRect ALIAS "GrfFilledRect"(BYVAL WinHndl AS DWORD, BYVAL CtlId AS DWORD, _
      BYVAL FromX AS DWORD, BYVAL FromY AS DWORD, BYVAL ToX AS DWORD, BYVAL ToY AS DWORD, _
      BYVAL FillColor AS LONG) EXPORT
    
    LOCAL BrushHndl     AS DWORD
    
    LOCAL tRect         AS Area_Struct
    
    BrushHndl = createsolidbrush(FillColor)
    
    tRect.X = FromX
    tRect.Y = FromY
    tRect.X1 = ToX
    tRect.Y1 = ToY
    
    dwfillrect(tGfx.GfxDc, VARPTR(tRect), BrushHndl)
    
    deleteobject(BrushHndl)
    
    END SUB
    
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    
    SUB GrfLoadBmp ALIAS "GrfLoadBmp"(Xwide AS LONG, YHigh AS LONG, BYVAL BmpName AS STRING, _
        BmpHndl AS LONG, BmpDc AS LONG, OldObj AS LONG) EXPORT
    
    LOCAL DeskHndl, _
            DeskDc, _
             TmpDc, _
          LoadHndl, _
            LoadDc    AS LONG
    
    LOCAL Inst        AS DWORD
    
    LOCAL Fnamez      AS ASCIIZ * 128
    
    LOCAL tMap        AS BITMAP
    LOCAL tMapInfo    AS BITMAPINFO
    
    Inst = getmodulehandle(BYVAL 0)
    
    Agn: '
    
    Fnamez$ = BmpName$
    LoadHndl = INSTR(-1, UCASE$(BmpName$), ".BMP")
    
    IF LoadHndl THEN
      LoadHndl = loadimage(Inst, Fnamez$, %IMAGE_BITMAP, Xwide, Yhigh, %LR_LOADFROMFILE)
    ELSE
      LoadHndl = loadimage(Inst, Fnamez$, %IMAGE_BITMAP, Xwide, Yhigh, %LR_DEFAULTCOLOR)
    END IF
    
    IF LoadHndl = 0 THEN
      LoadHndl = loadimage(Inst, Fnamez$, %IMAGE_BITMAP, Xwide, Yhigh, %LR_LOADFROMFILE)
    
      IF LoadHndl = 0 THEN
        EXIT SUB
      END IF
    
    END IF
    
    DeskHndl = getdesktopwindow()
    DeskDc   = getdc(DeskHndl)
    LoadDc   = createcompatibledc(DeskDc)
    BmpDc    = createcompatibledc(LoadDc)
    
    releasedc(DeskHndl, DeskDc)
    
    getobject(LoadHndl, SIZEOF(BITMAP), tMap)
    
    Xwide = tMap.bmWidth
    Yhigh = tMap.bmHeight
    
    tMapInfo.bmiHeader.biSize        = SIZEOF(tMapInfo.bmiHeader)
    tMapInfo.bmiHeader.biWidth       = Xwide
    tMapInfo.bmiHeader.biHeight      = -Yhigh
    tMapInfo.bmiHeader.biPlanes      = 1
    tMapInfo.bmiHeader.biBitCount    = 32
    tMapInfo.bmiHeader.biCompression = %BI_RGB
    
    BmpHndl = dwCreateDIBSection(BmpDC, VARPTR(tMapInfo), %DIB_RGB_COLORS, 0, 0, 0)
    
    OldObj = selectobject(BmpDc, BmpHndl)
    DeskDc  = selectobject(LoadDc, LoadHndl)
    
    bitblt(BmpDc, 0, 0, Xwide, Yhigh, LoadDc, 0, 0, %SRCCOPY)
    
    selectobject(LoadDc, DeskDc)
    deleteobject(LoadHndl)
    deletedc(LoadDc)
    
    END SUB
    
    '---------------------------------------------------------------------------------
    '---------------------------------------------------------------------------------
    
    FUNCTION FN_UpdateWindow ALIAS "FN_UpdateWindow"(BYVAL WinHndl AS DWORD) EXPORT AS DWORD
    
    LOCAL tCli  AS Area_Struct
    
    dwgetclientrect(WinHndl, VARPTR(tCli))
    dwinvalidaterect(WinHndl, VARPTR(tCli), 1)
    updatewindow(WinHndl)
    
    FN_UpdateWindow = 1
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    
    FUNCTION GrfActivate ALIAS "GrfActivate"(BYVAL PrntHndl AS DWORD, _
      BYVAL CtlId AS DWORD) EXPORT AS DWORD
    
    LOCAL CtlHndl       AS DWORD
    
    IF CtlId <> 0 THEN
      WINDOW GET HANDLE PrntHndl, CtlId TO CtlHndl
    ELSE
      CtlHndl = PrntHndl
    END IF
    
    IF tGfx.GfxDc THEN
      GrfActivate = tGfx.GfxDc
      EXIT FUNCTION
    END IF
    
    tGfx.GfxDc = getdc(CtlHndl)
    
    GrfActivate = tGfx.GfxDc
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    
    SUB GrfClear ALIAS "GrfClear"(BYVAL ClearClr AS LONG) EXPORT
    
    LOCAL TmpByte     AS BYTE
    
    LOCAL Colour, _
           Xwide, _
           Yhigh      AS LONG
    
    LOCAL BmpHndl, _
            BmpDc, _
           OldBmp, _
            Brush     AS DWORD
    
    LOCAL BmpName     AS STRING
    
    LOCAL dwColors() AS DWORD
    
    LOCAL BytPtr      AS BYTE POINTER
    
    'local tCords      as Area_Struct
    
    IF tGfx.GfxDc = 0 THEN EXIT SUB
    
    IF ClearClr < 0 THEN
      Colour = getsyscolor(%COLOR_3DFACE)
    ELSE
      Colour = ClearClr
    END IF
    
    'Brush = createsolidbrush(%red)
    BmpName$ = FORMAT$(tGfx.GfxHndl) + $GFXE
    CALL GrfLoadBmp(Xwide, Yhigh, BmpName$, BmpHndl, BmpDc, OldBmp)
    
    CALL GrfGetdwBGRColors(BmpHndl, IWide, IHigh, dwColors())
    colour = %RED
    BytPtr = VARPTR(Colour)
    TmpByte = @BytPtr[0]
    @BytPtr[0] = @BytPtr[2]
    @BytPtr[2] = TmpByte
    
    MAT dwColors = CON(Colour)
    
    CALL GrfSetdwBGRColors(BmpHndl, IBmpWide, IBmpHigh, dwColors())
    'msgbox str$(tCords.X1) + str$(tCords.Y1) + str$(Brush) + str$(colour) + str$(%rgb_peachpuff)
    'I = tGfx.GfxDc
    'tGfx.GfxDc = BmpDc
    'GrfFilledRect(tGfx.GfxHndl, tGfx.GfxId, 0, 0, tCords.X1, tCords.Y1, %red)
    'tGfx.GfxDc = I
    'fillrect(BmpDc, varptr(tCords), Brush)
    
    
    CALL GrfSaveBitMap(BmpName$, BmpHndl)
    CALL GrfDestroyBmp(BmpHndl, BmpDc, OldBmp)
    FN_UpdateWindow(tGfx.GfxHndl)
    END SUB
    
    '------------------------------------------------------------------------------
    '------------------------------------------------------------------------------
    
    SUB GrfSetdwBGRColors ALIAS "GrfSetBGRColors"(BYVAL BmpHndl AS DWORD, BmpWide AS LONG, _
        BmpHigh AS LONG, BgrColors() AS DWORD) EXPORT
    
    LOCAL BmpClrs()   AS DWORD
    
    LOCAL LocPtr      AS DWORD POINTER
    
    LOCAL tMap        AS BITMAP
    
    getobject(BmpHndl, SIZEOF(BITMAP), tMap)
    
    BmpWide = tMap.bmWidth
    BmpHigh = tMap.bmHeight
    LocPtr = tMap.bmBits
    
    'REDIM BgrColors(1 TO BmpWide * BmpHigh)
    
    DIM BmpClrs(1 TO BmpWide * BmpHigh) AT LocPtr
    MAT BmpClrs() = BgrColors()
    
    END SUB
    SUB GrfSetRedraw(BYVAL RedrawFlg AS INTEGER)
    
    tGfx.GfxNow = RedrawFlg
    
    END SUB
    
    FUNCTION FN_NewWindow ALIAS "FN_NewWindow"(BYVAL CallbackPtr AS DWORD, _
      BYVAL ClassName AS STRING, BYVAL ClassColor AS LONG, BYVAL ExtStyle AS DWORD, _
      BYVAL WinStyle AS DWORD, BYVAL WinName AS STRING, BYVAL Ulx AS LONG, BYVAL Uly AS LONG, _
      BYVAL WinWide AS LONG, BYVAL WinHigh AS LONG, BYVAL Owner AS DWORD, _
      BYVAL WinId AS DWORD) EXPORT AS DWORD
    
    LOCAL ClsStyle, _
           WinHndl, _
              Init, _
              Inst        AS DWORD
    
    Inst = GetModuleHandle(BYVAL %NULL)
    ClassName$ = RTRIM$(ClassName$, ANY ($NUL + $SPC))
    ClsStyle = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC
    
    Init = FN_InitClass(ClsStyle, _
                     CallBackPtr, _
                               4, _
                               4, _
                            Inst, _
                      ClassColor, _
                      ClassName$)
    
    IF Init = 0 THEN EXIT FUNCTION
    
    WinHndl = FN_InitWindow(ExtStyle, _
                          ClassName$, _
                            WinName$, _
                            WinStyle, _
                                 Ulx, _
                                 Uly, _
                             WinWide, _
                             WinHigh, _
                               Owner, _
                               WinId, _
                                Inst)
    
    FN_NewWindow = WinHndl
    END FUNCTION
    
    '-----------------------------------------------------------------------------------
    '-----------------------------------------------------------------------------------

    Walt Decker

  • #2
    Walter,

    Try setting to tClass.hbrBackground to 0 or return Zero to the window's WM_ERASEBKGND message.

    Regards,


    Pat

    Comment

    Working...
    X