vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Erstellen von dynamischen Kontextmen?s - wann immer Sie sie brauchen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Fortgeschrittene Programmierung
Re: Bereich in Picturebox farblich hervorheben 
Autor: Zardoz
Datum: 09.10.18 17:12

Hallo HarryLobster,
sieh' dir mal das an:
http://www.activevb.de/tipps/vb6tipps/tipp0740.html
http://www.activevb.de/cgi-bin/upload/download.pl?id=3348
https://www.vb-paradise.de/index.php/Thread/100377-Halbtransparente-Objekte-mit-Polygon-Funktion-aus-gdi32-dll/?postID=855539#post855539

Probier' mal dies:
Controls: 1 * Button, 1 * Picturebox
' © 2018 by Zardoz
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
  ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As _
Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal _
hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As _
Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As _
  Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal _
  hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) _
  As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As _
RECT, ByVal hBrush As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As _
Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) _
As Long
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdcDest As Long, _
  ByVal XDest As Long, ByVal YDest As Long, ByVal WidthDest As Long, _
  ByVal HeightDest As Long, ByVal hDCSrc As Long, ByVal xSrc As Long, _
  ByVal ySrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long, _
  ByVal Blendfunc As Long) As Long
 
Private Sub Form_Load()
 
  Dim W&, H&, Dat1$, TmpPic As StdPicture
 
  Dat1 = "D:\EinBild.Jpeg" ' Bildpfad hier einsetzen
  Set TmpPic = LoadPicture(Dat1)
  Me.ScaleMode = vbPixels
  Command1.Move 4, 4
  Command1.Caption = "Zeichne"
  With Picture1
    .BorderStyle = vbBSNone
    .ScaleMode = vbPixels
    W = Int(0.5 + .ScaleX(TmpPic.Width, vbHimetric))
    H = Int(0.5 + .ScaleX(TmpPic.Width, vbHimetric))
    .Move 4, 8 + Command1.Height, W, H
    .AutoRedraw = True
    .PaintPicture TmpPic, 0, 0
  End With
  Set TmpPic = LoadPicture()
 
End Sub
 
Private Sub Command1_Click()
 
  Dim XPos&, YPos&, Breite&, Hoehe&
 
  XPos = 100
  YPos = 50
  Breite = 150
  Hoehe = 70
  Call ZeichneRechteck(Picture1, XPos, YPos, Breite, Hoehe, vbYellow)
 
  XPos = 120
  YPos = 200
  Breite = 80
  Hoehe = 112
  Call ZeichneRechteck(Picture1, XPos, YPos, Breite, Hoehe, vbRed, 200)
 
  Picture1.Refresh
 
End Sub
 
Private Sub ZeichneRechteck(Ziel As PictureBox, XPos As Long, YPos As Long, _
  Breite As Long, Hoehe As Long, Farbe As Long, Optional Alpha As Long = 128)
 
  Dim Desthdc&, P1hdc&, P1OldHandle&, Brush1&, R1 As RECT
 
  Call SetRect(R1, XPos, YPos, XPos + Breite, YPos + Hoehe)
  Brush1 = CreateSolidBrush(Farbe)
  Desthdc = Ziel.hdc
  P1hdc = CreateCompatibleDC(0)
  P1OldHandle = SelectObject(P1hdc, CreateCompatibleBitmap(Desthdc, Breite, _
    Hoehe))
  Call BitBlt(P1hdc, 0, 0, Breite, Hoehe, Desthdc, XPos, YPos, vbSrcCopy)
  Call FillRect(Desthdc, R1, Brush1)
  Call AlphaBlend(Desthdc, XPos, YPos, Breite, Hoehe, _
    P1hdc, 0, 0, Breite, Hoehe, Alpha * &H10000)
  Call DeleteObject(SelectObject(P1hdc, P1OldHandle))
  Call DeleteDC(P1hdc)
  Call DeleteObject(Brush1)
 
End Sub

Gruss,

Zardoz

alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Bereich in Picturebox farblich hervorheben1.018HarryLobster08.10.18 09:22
Re: Bereich in Picturebox farblich hervorheben630Zardoz08.10.18 13:40
Re: Bereich in Picturebox farblich hervorheben628HarryLobster09.10.18 12:56
Re: Bereich in Picturebox farblich hervorheben679Zardoz09.10.18 17:12
Re: Bereich in Picturebox farblich hervorheben606HarryLobster10.10.18 11:21

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel