Início![[Resolvido]Mudar o icone do BD Empty](https://2img.net/i/empty.gif)
Pablo Weber 12/1/2011, 22:36Olá pessoal, gostaria de saber se existe uma maneira de mudar o ícone do BD, só para não ficar com aquela aparencia igual a todos os arquivos do access. E também como vocês fazem para configurar o BD de modo que ao abrir, não precise aparecer os menus do access, por exemplo, fazer que abra somente a tela em questão, como um software mesmo.
4 participantes
[Resolvido]Mudar o icone do BD
Pablo Weber- Intermediário
- Respeito às regras :
Sexo :
Localização :
Mensagens : 195
Registrado : 22/11/2010
JPaulo- Moderador
- Respeito às regras :
Sexo :
Localização :
Mensagens : 11026
Registrado : 04/11/2009
Veja este exemplo que esconde a janela do Access.
http://maximoaccess.forumeiros.com/t1451-ajusta-formulario-a-tela-sem-a-alterar
http://maximoaccess.forumeiros.com/t1451-ajusta-formulario-a-tela-sem-a-alterar
.................................................................................
Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.
Pay-Pal R$ Aqui
Pay-Pal € Aqui
Ou ainda: Aqui (Novo)
Sucesso e Bons Estudos
Success and Good Studies
![[Resolvido]Mudar o icone do BD Folder_announce_new](https://2img.net/i/fa/subsilver/folder_announce_new.gif)
Utilize o Sistema de Busca do Fórum... 102 Códigos VBA Gratuitos... Instruções SQL como utilizar...
vieirasoft- Developer
- Respeito às regras :
Sexo :
Localização :
Mensagens : 7304
Registrado : 11/05/2010
O Ícone é padrão do access. Você pode mudar nos formulários e nos relatórios, na barra do título da aplicação através, por exemplo da caixa arranque em ferramentas.
Para simular um executável com o access você pode fazer recurso de uma API do Windows
Option Compare Database
Option Explicit
'Autor da função base: Indeterminado
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
'Constantes
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Function AccessTransparente(Nivel As Integer)
'Adaptación: Byron Contreras, febrero 08, byronlcl@gmail.com
'Objetivo: Ajustar el nivel de transparencia de la ventana principal
' de access. El nivel de transparencia debe estar entre 0 a 250
'.............................................................................
Dim lngHwnd As Long
If Nivel < 0 Or Nivel > 250 Then Exit Function
lngHwnd = Application.hWndAccessApp
SetWindowLong lngHwnd, GWL_EXSTYLE, GetWindowLong(lngHwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes lngHwnd, 0, Nivel, LWA_ALPHA
End Function
'
'Ejemplo de uso:
'Private Sub Form_Load()
'Call AccessTransparente(175)
'End Sub
Para simular um executável com o access você pode fazer recurso de uma API do Windows
Option Compare Database
Option Explicit
'Autor da função base: Indeterminado
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
'Constantes
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Function AccessTransparente(Nivel As Integer)
'Adaptación: Byron Contreras, febrero 08, byronlcl@gmail.com
'Objetivo: Ajustar el nivel de transparencia de la ventana principal
' de access. El nivel de transparencia debe estar entre 0 a 250
'.............................................................................
Dim lngHwnd As Long
If Nivel < 0 Or Nivel > 250 Then Exit Function
lngHwnd = Application.hWndAccessApp
SetWindowLong lngHwnd, GWL_EXSTYLE, GetWindowLong(lngHwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes lngHwnd, 0, Nivel, LWA_ALPHA
End Function
'
'Ejemplo de uso:
'Private Sub Form_Load()
'Call AccessTransparente(175)
'End Sub
criquio- Moderador Global
- Respeito às regras :
Sexo :
Localização :
Mensagens : 11229
Registrado : 30/12/2009
Módulo para alterar o ícone que aparece nos forms, relatórios, na barra de tarefas e no Alt+Tab, alem do Gerenciador de tarefas. Tambem muda o nome que aparece no aplicativo e nas outras dependências mencionadas.
OBS.: Para que o ícone apareça nos forms e relatórios, você precisa entrar nas configurações específicas para o aplicativo atual e marcar essa opção.
Option Compare Database
Option Explicit
Public strCaminho As String
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_GETICON = &H7F
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
Private Const IMAGE_ENHMETAFILE = 3
Private Const LR_DEFAULTCOLOR = &H0
Private Const LR_MONOCHROME = &H1
Private Const LR_COLOR = &H2
Private Const LR_COPYRETURNORG = &H4
Private Const LR_COPYDELETEORG = &H8
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADTRANSPARENT = &H20
Private Const LR_DEFAULTSIZE = &H40
Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const LR_CREATEDIBHeader = &H2000
Private Const LR_COPYFROMRESOURCE = &H4000
Private Const LR_SHARED = &H8000
Function CurrentDbDir() As String
Dim strName As String
strName = CurrentDb.Name
CurrentDbDir = Left(strName, Len(strName) - Len(Dir(strName)))
End Function
Function DefinirNomeAplicativo()
Dim intX As Integer
strCaminho = CurrentDbDir + "Icon.ico"
intX = AlterarPropriedade("AppTitle", dbText, "Boletim de rejeição")
intX = AlterarPropriedade("AppIcon", dbText, strCaminho)
RefreshTitleBar
End Function
Function AlterarPropriedade(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
On Error Resume Next
Dim prp As Property, db As DAO.Database
Const conPropNotFoundError = 3270
Set db = CurrentDb
On Error GoTo Change_Err
db.Properties(strPropName) = varPropValue
AlterarPropriedade = True
Change_Bye:
Set db = Nothing
Exit Function
Change_Err:
If Err = conPropNotFoundError Then '
Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
db.Properties.Append prp
Resume Next
Else
AlterarPropriedade = False
Resume Change_Bye
End If
End Function
No evento "Ao carregar" do form principal:
Call DefinirNomeAplicativo
OBS.: Para que o ícone apareça nos forms e relatórios, você precisa entrar nas configurações específicas para o aplicativo atual e marcar essa opção.
Option Compare Database
Option Explicit
Public strCaminho As String
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_GETICON = &H7F
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1
Private Const IMAGE_BITMAP = 0
Private Const IMAGE_ICON = 1
Private Const IMAGE_CURSOR = 2
Private Const IMAGE_ENHMETAFILE = 3
Private Const LR_DEFAULTCOLOR = &H0
Private Const LR_MONOCHROME = &H1
Private Const LR_COLOR = &H2
Private Const LR_COPYRETURNORG = &H4
Private Const LR_COPYDELETEORG = &H8
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADTRANSPARENT = &H20
Private Const LR_DEFAULTSIZE = &H40
Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const LR_CREATEDIBHeader = &H2000
Private Const LR_COPYFROMRESOURCE = &H4000
Private Const LR_SHARED = &H8000
Function CurrentDbDir() As String
Dim strName As String
strName = CurrentDb.Name
CurrentDbDir = Left(strName, Len(strName) - Len(Dir(strName)))
End Function
Function DefinirNomeAplicativo()
Dim intX As Integer
strCaminho = CurrentDbDir + "Icon.ico"
intX = AlterarPropriedade("AppTitle", dbText, "Boletim de rejeição")
intX = AlterarPropriedade("AppIcon", dbText, strCaminho)
RefreshTitleBar
End Function
Function AlterarPropriedade(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
On Error Resume Next
Dim prp As Property, db As DAO.Database
Const conPropNotFoundError = 3270
Set db = CurrentDb
On Error GoTo Change_Err
db.Properties(strPropName) = varPropValue
AlterarPropriedade = True
Change_Bye:
Set db = Nothing
Exit Function
Change_Err:
If Err = conPropNotFoundError Then '
Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
db.Properties.Append prp
Resume Next
Else
AlterarPropriedade = False
Resume Change_Bye
End If
End Function
No evento "Ao carregar" do form principal:
Call DefinirNomeAplicativo
.................................................................................
Meu novo site: www.vcssistemas.com.br Clique aqui e veja um vídeo que explica como fazer pesquisas no forum. DICA: Quando precisar inserir um exemplo do seu aplicativo, siga os procedimentos abaixo: 1 - faça uma cópia do aplicativo 2 - retire tudo que não for necessário à solução do problema, exceto o que o aplicativo precisar para funcionar 3 - use o Compactar/Reparar 4 - compacte o aplicativo em zip ou rar (zip para postagem como anexo na mensagem) Agradeça a quem lhe ajudou, clicando no joinha de uma das mensagens do usuário. Positive as mensagens que achar útil, no canto superior direito delas. |
JPaulo- Moderador
- Respeito às regras :
Sexo :
Localização :
Mensagens : 11026
Registrado : 04/11/2009
Alterar o icon do banco;
Num modulo:
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, LParam As Any) As Long
Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
Dim lIcon As Long
Dim lResult As Long
Dim X As Long, Y As Long
X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)
End Function
Chamar a função:
Private Sub Form_Open(Cancel As Integer)
SetFormIcon Me.hWnd, Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name))) & "\SeuIcon.ico"
End Sub
Num modulo:
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, LParam As Any) As Long
Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
Dim lIcon As Long
Dim lResult As Long
Dim X As Long, Y As Long
X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)
End Function
Chamar a função:
Private Sub Form_Open(Cancel As Integer)
SetFormIcon Me.hWnd, Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name))) & "\SeuIcon.ico"
End Sub
.................................................................................
Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.
Pay-Pal R$ Aqui
Pay-Pal € Aqui
Ou ainda: Aqui (Novo)
Sucesso e Bons Estudos
Success and Good Studies
Utilize o Sistema de Busca do Fórum... 102 Códigos VBA Gratuitos... Instruções SQL como utilizar...
Pablo Weber- Intermediário
- Respeito às regras :
Sexo :
Localização :
Mensagens : 195
Registrado : 22/11/2010
Caramba achei que fosse mais simples, acho que vou continuar com o default mesmo.Mesmo assim obrigado a todos.
vieirasoft- Developer
- Respeito às regras :
Sexo :
Localização :
Mensagens : 7304
Registrado : 11/05/2010
Por isso eu gosto de exemplos práticos. Este leva 3 por 1. Coloca o ícone, faz o resize a qualquer resolução e simula um exe.