PDA

Vollständige Version anzeigen : VB zu VBA: Farbverlauf als Hintergrund im Formular


horse79
01.10.2002, 16:38
Hallo,

wie kann ich denn als Hintergrund eines Formulares einen Farbverlauf realisieren? Entweder von oben nach unten oder von links nach rechts? Ich hab irgendwo in VB schonmal sowas gesehen, folglich sollte es ja auch über VBA realisierbar sein. Und welche Farben würdet Ihr zwecks guter Lesbarkeit und Ergonomie empfehlen?

Vielen Dank

Phillip-Berlin
01.10.2002, 17:38
ich habe das bisher mit einem verknüpften oder eingebetteten bild gemacht ..
soweit mir bekannt gibt es dafür keine funktion die access mitbringen würde ??

insgesamt würde ich mit einfarbigen hintergründen arbeiten ... die "bildvariante" finde ich eher nicht so gut

A.S.
01.10.2002, 17:41
Hallo Sven,

in mienem Archiv ausgegraben:

Erstelle ein Projekt mit einer Form und einem Command-Button (Command1).
Füge anschließend nachfolgenden Code ein:

DefLng A-Z

Sub Farbverlauf(obj As Object, Optional _
vRed As Variant, Optional vGreen As Variant, _
Optional vBlue As Variant, Optional vVert As Variant, _
Optional vHoriz As Variant, Optional vLightToDark _
As Variant)

' Standardvorgabe der Optionalen Parameter
If IsMissing(vRed) Then vRed = False
If IsMissing(vBlue) Then vBlue = False
If IsMissing(vGreen) Then vGreen = False
If Not vRed And Not vGreen Then vBlue = True
If IsMissing(vVert) Then vVert = False
If IsMissing(vHoriz) Then vHoriz = Not vVert
If Not vVert And Not vHoriz Then vHoriz = True
If IsMissing(vLightToDark) Then vLightToDark = True

On Error Resume Next
With obj
Dim fAutoRedraw As Boolean, _
ordDrawStyle As Integer
Dim ordDrawMode As Integer, iDrawWidth As Integer
Dim ordScaleMode As Integer
Dim rScaleWidth As Single, rScaleHeight As Single
fAutoRedraw = .AutoRedraw: iDrawWidth = _
.DrawWidth
ordDrawStyle = .DrawStyle: ordDrawMode = _
.DrawMode
rScaleWidth = .ScaleWidth: rScaleHeight = _
.ScaleHeight
ordScaleMode = .ScaleMode
If Err Then Exit Sub
On Error GoTo 0
fAutoRedraw = .AutoRedraw
.AutoRedraw = True
.DrawWidth = 2
.DrawStyle = vbInsideSolid: .DrawMode = vbCopyPen
.ScaleMode = vbPixels
.ScaleWidth = 256 * 2: .ScaleHeight = 256 * 2

Dim clr As Long, i As Integer, x As Integer, _
y As Integer
Dim iRed As Integer, iGreen As Integer, _
iBlue As Integer

For i = 0 To 255
If vLightToDark Then
If vRed Then iRed = 255 - i
If vBlue Then iBlue = 255 - i
If vGreen Then iGreen = 255 - i
Else
If vRed Then iRed = i
If vBlue Then iBlue = i
If vGreen Then iGreen = i
End If
clr = RGB(iRed, iGreen, iBlue)
If vVert Then
obj.Line (0, y)-(.ScaleWidth, _
y + 2), clr, BF
y = y + 2
End If
If vHoriz Then
obj.Line (x, 0)-(x + 2, _
.ScaleHeight), clr, BF
x = x + 2
End If
Next
.AutoRedraw = fAutoRedraw: .DrawWidth = _
iDrawWidth
.DrawStyle = ordDrawStyle: .DrawMode = _
ordDrawMode
.ScaleMode = ordScaleMode
.ScaleWidth = rScaleWidth: .ScaleHeight = _
rScaleHeight
End With
End Sub

Private Sub Command1_Click()
Static Farben
Farben = Farben + 1
Select Case Farben
Case 1
'Gruen nach Schwarz von Rechts unten nach links oben
Command1.Caption = "Grün nach Schwarz"
Farbverlauf Me, False, True, False, True, True, False
Case 2
'Gelb nach Schwarz von Rechts unten nach links oben
Command1.Caption = "Gelb nach Schwarz"
Farbverlauf Me, True, True, False, True, False, True
Case 3
'Blau nach Schwarz von Rechts unten nach links oben
Command1.Caption = "Blau nach Schwarz"
Farbverlauf Me, False, False, False, True, True, False
Case 4
'Hellblau nach Schwarz von Rechts unten nach links oben
Command1.Caption = "Hellblau nach Schwarz"
Farbverlauf Me, False, True, True, True, False, True
Farben = 0
End Select

'Sytnax : Farbverlauf (ROT, GRUEN, BLAU, Horizontal, 'Vertikal, Winkel)
'Default Werte :
'- Rot = False
'- Gruen = False
'- Blau = True
'- Horizontal = True
'- Vertikal = False
'- Winkel = False

End Sub

Viel Spass beim Umsetzen in VBA.

Gruß

Arno

horse79
02.10.2002, 07:45
Vielen Dank,

ich werde es testen...

horse79
02.10.2002, 08:26
Hallo,

ich habe ein Modul erstellt:


Sub Farbverlauf(obj As Object, Optional vRed As Variant,
Optional vGreen As Variant, Optional vBlue As Variant,
Optional vVert As Variant, Optional vHoriz As Variant, Optional vLightToDark As Variant)

' Standardvorgabe der Optionalen Parameter
If IsMissing(vRed) Then vRed = False
If IsMissing(vBlue) Then vBlue = False
If IsMissing(vGreen) Then vGreen = False
If Not vRed And Not vGreen Then vBlue = True
If IsMissing(vVert) Then vVert = False
If IsMissing(vHoriz) Then vHoriz = Not vVert
If Not vVert And Not vHoriz Then vHoriz = True
If IsMissing(vLightToDark) Then vLightToDark = True

On Error Resume Next

With obj
Dim fAutoRedraw As Boolean, ordDrawStyle As Integer
Dim ordDrawMode As Integer, iDrawWidth As Integer
Dim ordScaleMode As Integer
Dim rScaleWidth As Single, rScaleHeight As Single

fAutoRedraw = .AutoRedraw
iDrawWidth = .DrawWidth
ordDrawStyle = .DrawStyle
ordDrawMode = .DrawMode
rScaleWidth = .ScaleWidth
rScaleHeight = .ScaleHeight
ordScaleMode = .ScaleMode

If Err Then Exit Sub
On Error GoTo 0

fAutoRedraw = .AutoRedraw
.AutoRedraw = True
.DrawWidth = 2
.DrawStyle = vbInsideSolid
.DrawMode = vbCopyPen
.ScaleMode = vbPixels
.ScaleWidth = 256 * 2
.ScaleHeight = 256 * 2

Dim clr As Long, i As Integer, x As Integer, y As Integer
Dim iRed As Integer, iGreen As Integer, iBlue As Integer

For i = 0 To 255
If vLightToDark Then
If vRed Then iRed = 255 - i
If vBlue Then iBlue = 255 - i
If vGreen Then iGreen = 255 - i
Else
If vRed Then iRed = i
If vBlue Then iBlue = i
If vGreen Then iGreen = i
End If

clr = RGB(iRed, iGreen, iBlue)

If vVert Then
obj.Line (0, y)-(.ScaleWidth, y + 2), clr, BF
y = y + 2
End If

If vHoriz Then
obj.Line (x, 0)-(x + 2, .ScaleHeight), clr, BF
x = x + 2
End If

Next

.AutoRedraw = fAutoRedraw
.DrawWidth = iDrawWidth
.DrawStyle = ordDrawStyle
.DrawMode = ordDrawMode
.ScaleMode = ordScaleMode
.ScaleWidth = rScaleWidth
.ScaleHeight = caleHeight
End With

End Sub

Ich bekomme jetzt die Fehlermeldung bei:

.DrawStyle = vbInsideSolid

Fehlermeldung: Variable nicht definiert.

Ich denke dies ist eine Funktion die in VB vorhanden ist, aber nicht in VBA. Hat jemand diese Funktion für VBA bzw. weiß was diese bedeutet?

Vielen Dank :top:

Manuela Kulpa
02.10.2002, 16:39
<font face="Verdana" size="2">Jepp, Sven, du hast recht :) ! Nimm mal anstatt .DrawStyle = vbInsideSolid lieber .DrawStyle = 6!

slg</font>

horse79
04.10.2002, 07:40
Hallo Manuela,

erstmal vielen Dank.


.DrawMode = vbCopyPen
.ScaleMode = vbPixels

Hättest Du mir hierfür auch noch die entsprechenden Zahlen?

Vielen Dank :top:

Karlheinz
04.10.2002, 08:00
Hallo Sven,

DrawMode=13
ScaleMode=3

müssten in Acc die entsprechenden Zahlen sein.

Gruß Karlheinz

horse79
04.10.2002, 08:13
Hi,

vielen Dank. Das Modul bringt keinen Kompilierfehler mehr :top:

Wenn ich aber in meinem Form den Code ausführe ändert sich nur die Caption der Befehlsschaltfläche, aber nicht die Hintergrundfarbe des Forms. Es erscheint aber auch keine Fehlermeldung...


Private Sub Befehl0_Click()

Static Farben
Farben = Farben + 1

Select Case Farben

Case 1
'Gruen nach Schwarz von Rechts unten nach links oben
Befehl0.Caption = "Grün nach Schwarz"
Farbverlauf Me, False, True, False, True, True, False

Case 2
'Gelb nach Schwarz von Rechts unten nach links oben
Befehl0.Caption = "Gelb nach Schwarz"
Farbverlauf Me, True, True, False, True, False, True

Case 3
'Blau nach Schwarz von Rechts unten nach links oben
Befehl0.Caption = "Blau nach Schwarz"
Farbverlauf Me, False, False, False, True, True, False

Case 4
'Hellblau nach Schwarz von Rechts unten nach links oben
Befehl0.Caption = "Hellblau nach Schwarz"
Farbverlauf Me, False, True, True, True, False, True
Farben = 0

End Select

'Sytnax : Farbverlauf (ROT, GRUEN, BLAU, Horizontal,
'Vertikal, Winkel)
'Default Werte :
'- Rot = False
'- Gruen = False
'- Blau = True
'- Horizontal = True
'- Vertikal = False
'- Winkel = False

End Sub

Und hier noch das Modul:


Sub Farbverlauf(obj As Object, Optional vRed As Variant,
Optional vGreen As Variant, Optional vBlue As Variant,
Optional vVert As Variant, Optional vHoriz As Variant, Optional vLightToDark As Variant)

' Standardvorgabe der Optionalen Parameter
If IsMissing(vRed) Then vRed = False
If IsMissing(vBlue) Then vBlue = False
If IsMissing(vGreen) Then vGreen = False
If Not vRed And Not vGreen Then vBlue = True
If IsMissing(vVert) Then vVert = False
If IsMissing(vHoriz) Then vHoriz = Not vVert
If Not vVert And Not vHoriz Then vHoriz = True
If IsMissing(vLightToDark) Then vLightToDark = True

On Error Resume Next

With obj
Dim fAutoRedraw As Boolean, ordDrawStyle As Integer
Dim ordDrawMode As Integer, iDrawWidth As Integer
Dim ordScaleMode As Integer
Dim rScaleWidth As Single, rScaleHeight As Single

fAutoRedraw = .AutoRedraw
iDrawWidth = .DrawWidth
ordDrawStyle = .DrawStyle
ordDrawMode = .DrawMode
rScaleWidth = .ScaleWidth
rScaleHeight = .ScaleHeight
ordScaleMode = .ScaleMode

If Err Then Exit Sub
On Error GoTo 0

fAutoRedraw = .AutoRedraw
.AutoRedraw = True
.DrawWidth = 2
.DrawStyle = 6
.DrawMode = 13
.ScaleMode = 3
.ScaleWidth = 256 * 2
.ScaleHeight = 256 * 2

Dim clr As Long, i As Integer, x As Integer, y As Integer
Dim iRed As Integer, iGreen As Integer, iBlue As Integer

For i = 0 To 255
If vLightToDark Then
If vRed Then iRed = 255 - i
If vBlue Then iBlue = 255 - i
If vGreen Then iGreen = 255 - i
Else
If vRed Then iRed = i
If vBlue Then iBlue = i
If vGreen Then iGreen = i
End If

clr = RGB(iRed, iGreen, iBlue)

If vVert Then
obj.Line (0, y)-(.ScaleWidth, y + 2), clr, BF
y = y + 2
End If

If vHoriz Then
obj.Line (x, 0)-(x + 2, .ScaleHeight), clr, BF
x = x + 2
End If

Next

.AutoRedraw = fAutoRedraw
.DrawWidth = iDrawWidth
.DrawStyle = ordDrawStyle
.DrawMode = ordDrawMode
.ScaleMode = ordScaleMode
.ScaleWidth = rScaleWidth
.ScaleHeight = rScaleHeight
End With

End Sub

horse79
04.10.2002, 08:43
Es ist doch noch ein Fehler im Modul, ich habe die On Error-Zeile übersehen... :holy:

Der Fehler tritt hier auf:

fAutoRedraw = .AutoRedraw

Anwendungs- oder objektdefinierter Fehler...

horse79
11.10.2002, 11:28
hopp

{//Modianmerkung// Hi Sven, habe 'mal ein paar "hepps" und "hopps" rausgenommen, damit die Zahl der Antworten nicht vom reinschauen abhält ;) Gruß Arno//}

[ 11. Oktober 2002: Beitrag editiert von: A.S. ]</p>

Nouba
15.10.2002, 20:14
Hallo Sven,

das ist zwar nicht ganz das Gesuchte, vielleicht nutzen die Routinen aber etwas. <a href="http://www.mvps.org/access/api/api0035.htm" target="_blank">Put an image in Access window</a>

Auf der selben Site steht auch noch folgende Info: <blockquote><font size="1" face="Arial, Verdana, Helvetica, sans-serif">Zitat:</font><hr>The main issue in drawing on Access forms is working with the right hWnd and hDC. The built in hWnd property of a form is actually bound to the form's RecordSelector window. The client area of a form is a different window whose hWnd we have to locate in order to draw successfully. But that's not all! To maintain that image on the form, you have to basically redraw that image each time the window receives a WM_PAINT message from Windows. This means that you have to subclass the window, a technique that's<hr></blockquote>nachzulesen in <a href="http://www.mvps.org/access/api/api0053.htm" target="_blank">Drawing images on an Access form</a>