sexta-feira, 10 de dezembro de 2010

Alterar cor ToolBar

With this code you can change a Toolbar backcolor (Windows Common Controls 5 or 6).
You can also use a picture (bitmap) as background, here I'll do both things.
I recommend downloading the example attached, but I'll also show the code here, I used Common Controls 6 toolbars for this example, minor changes are needed if you want to use Common Controls 5 toolbars.

image 

IN THE FORM
- Add 2 Toolbars, change Toolbar1 style to FLAT, Toolbar2 style must remain STANDARD
- Add a Picture box and add a picture to it.
- Paste this code:

VB Code:

 

Option Explicit
Private Sub Form_Load()
    ApplyChanges
End Sub
Private Sub ApplyChanges()
'=========================
    Dim LngNew As Long
    'Use a picture with the FLAT TB (Toolbar1)
    LngNew = CreatePatternBrush(Picture1.Picture.Handle) 'Creates the background from a Picture Handle
    ChangeTBBack Toolbar1, LngNew, enuTB_FLAT   
    'Change Backcolor of the STANDARD TB (Toolbar2)
    LngNew = CreateSolidBrush(RGB(240, 120, 120))        'Creates the background from a Color (Long)
    ChangeTBBack Toolbar2, LngNew, enuTB_STANDARD
    'Refresh Screen to see changes
    InvalidateRect 0&, 0&, False
End Sub

IN A MODULE

VB Code:

 

Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _

    ByVal hWnd1 As Long, ByVal hWnd2 As Long, _

    ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" ( _

                ByVal hwnd As Long, ByVal nindex As Long, ByVal dwnewlong As Long) As Long

Public Declare Function InvalidateRect Lib "user32" _

                (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long

Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Public Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long

 

Public Enum enuTBType

    enuTB_FLAT = 1

    enuTB_STANDARD = 2

End Enum

 

Private Const GCL_HBRBACKGROUND = (-10)

 

Public Sub ChangeTBBack(TB As Object, PNewBack As Long, pType As enuTBType)

Dim lTBWnd      As Long

    Select Case pType

        Case enuTB_FLAT     'FLAT Button Style Toolbar

            'Apply directly to TB Hwnd

            DeleteObject SetClassLong(TB.hwnd, GCL_HBRBACKGROUND, PNewBack)       

        Case enuTB_STANDARD 'STANDARD Button Style Toolbar

            lTBWnd = FindWindowEx(TB.hwnd, 0, "msvb_lib_toolbar", vbNullString) 'Find Hwnd first

            DeleteObject SetClassLong(lTBWnd, GCL_HBRBACKGROUND, PNewBack)      'Set new Back

    End Select

End Sub

'==========================================================================' If you want to use Win Common Control 5 Toolbars, use "ToolbarWindow32" instead of

' "msvb_lib_toolbar". Win Common Control 5 Toolbars can't be FLAT, they are always STANDARD,

' so use enuTB_STANDARD when you call this

'==========================================================================


More info about this
- This will also work with xp styles (manifest file).
- If the picture is smaller than the toolbar the pattern will be repeated, if its too big, you will see just part of it, so I recomend to make your bmp or jpg picture the same size of the toolbar. You can also let it repeat the pattern as I did in the project attached.
- Changes will remain visible in design mode until you close VB IDE.
- If you apply this to a toolbar in your app with a given style (i.e: Flat) all the flat toolbars and the controls that contain flat toolbars with the same Comon Controls version will also be modified, (but JUST inside your app).
Example: Common Dialog Control uses a vertical toolbar (WCC version 5).

quinta-feira, 9 de dezembro de 2010

Processos em execução

Para listar os processos em execução no Visual Basic 6 faça conforme abaixo:

Crie um novo projeto e no form coloque um CommandButtom e um Listbox, copie e cole o código abaixo no evento click do CommandButton conforme abaixo:

 

Private Sub Command1_Click()

    Dim p, lista

    Set lista = GetObject("winmgmts:").InstancesOf("Win32_Process")

    For Each p In lista

       List1.AddItem " " & p.Name

    Next

End Sub

Resultado:

image

quarta-feira, 8 de dezembro de 2010

Update com subselect

--Este script faz acesso full e demora muito a ser executado

 

UPDATE COR_MERCADORIA C

       SET C.DFLT_OM_CODIGO = (SELECT  DISTINCT D.OM_CODIGO

                           FROM COR_IDF D

                          WHERE D.DOF_SEQUENCE||D.CODIGO_DO_SITE IN (

                                                             SELECT A.DOF_SEQUENCE||A.CODIGO_DO_SITE

                                                               FROM COR_DOF A

                                                              WHERE A.DT_FATO_GERADOR_IMPOSTO BETWEEN DATAINICIAL AND DATAFINAL)

                            AND D.OM_CODIGO IN (1,2,0)

                            AND C.MERC_CODIGO = D.MERC_CODIGO)

        WHERE C.MERC_CODIGO =

        (SELECT  DISTINCT D.MERC_CODIGO

                           FROM COR_IDF D

                          WHERE D.DOF_SEQUENCE||D.CODIGO_DO_SITE IN (

                                                             SELECT A..DOF_SEQUENCE||A.CODIGO_DO_SITE

                                                               FROM COR_DOF A

                                                              WHERE A.DT_FATO_GERADOR_IMPOSTO BETWEEN DATAINICIAL AND DATAFINAL)

                            AND D.OM_CODIGO IN (1,2,0)

                            AND D.MERC_CODIGO = C.MERC_CODIGO);

 

--Este script faz a mesma coisa do que o de cima, porém sem fazer acesso full, assim fica muito mais rápido

 

DECLARE

CURSOR IDF_OM IS

SELECT DISTINCT D.OM_CODIGO, D.MERC_CODIGO

       FROM COR_IDF D, COR_DOF A

       WHERE D.DOF_SEQUENCE||D.CODIGO_DO_SITE = A.DOF_SEQUENCE||A.CODIGO_DO_SITE

         AND A.DT_FATO_GERADOR_IMPOSTO BETWEEN DATAINICIAL AND DATAFINAL

         AND D.MERC_CODIGO IS NOT NULL;

IDF_OM_DADOS  IDF_OM%rowtype;                           

BEGIN

     Open IDF_OM;

     LOOP

          fetch IDF_OM into IDF_OM_DADOS;

          EXIT WHEN IDF_OM%NOTFOUND;

         

          UPDATE COR_MERCADORIA SET DFLT_OM_CODIGO = IDF_OM_DADOS.OM_CODIGO WHERE MERC_CODIGO = IDF_OM_DADOS.MERC_CODIGO;

         -- DBMS_OUTPUT.PUT_LINE ('GRAVADO : ' || IDF_OM_DADOS.OM_CODIGO||' - '|| IDF_OM_DADOS.MERC_CODIGO);         

         

     END LOOP;

     COMMIT;

     CLOSE IDF_OM;

END;

 

Related Posts Plugin for WordPress, Blogger...