Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: RTF-Druckvorschau
Autor: Norbert
Datum: 07.05.02 20:19
Vielleicht hilft Dir das, das ist ein Blur-Algorithmus: Option Explicit Private Declare Function VarPtrArray Lib "msvbvm50.dll" _ Alias "VarPtr" (ptr() As Any) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias _ "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal _ ByteLen 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 GetObject Lib "gdi32" Alias _ "GetObjectA" (ByVal hObject As Long, ByVal nCount _ As Long, lpObject As Any) As Long Private Type SAFEARRAYBOUND cElements As Long lLbound As Long End Type Private Type SAFEARRAY1D cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long Bounds(0 To 0) As SAFEARRAYBOUND End Type Private Type SAFEARRAY2D cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long Bounds(0 To 1) As SAFEARRAYBOUND End Type Private Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End Type Private Const SRCCOPY = &HCC0020 Dim aa As Long, bb As Long Private Sub DoBlur(bPic As PictureBox) Dim Pict() As Byte Dim av As Long Dim ptr As Long Dim safe As SAFEARRAY1D, bmp As BITMAP Call GetObject(bPic.Picture, Len(bmp), bmp) With safe .cbElements = 1 .cDims = 1 .Bounds(0).lLbound = 0 .Bounds(0).cElements = bmp.bmHeight * bmp.bmWidthBytes .pvData = bmp.bmBits End With Call CopyMemory(ByVal VarPtrArray(Pict), VarPtr(safe), 4) On Error Resume Next 'Blur algo ptr = bmp.bmWidthBytes + 3 For aa = 1 To bmp.bmHeight - 3 For bb = 0 To bmp.bmWidthBytes ptr = ptr + 1 av = Pict(ptr - bmp.bmWidthBytes) av = av + Pict(ptr - 3) av = av + Pict(ptr + 3) av = av + Pict(ptr + bmp.bmWidthBytes) Pict(ptr) = av 4 Next bb Next aa Call CopyMemory(ByVal VarPtrArray(Pict), 0&, 4) End Sub Private Sub Command2_Click() Call SavePicture(Picture2.Picture, App.Path & "Temp.BMP") Picture2.Picture = LoadPicture(App.Path & "Temp.BMP") Call DoBlur(Picture2) Image1.Picture = Picture1.Image Image2.Picture = Picture2.Image End Sub Private Sub Form_Load() Dim oFS As Integer oFS = 11 Picture1.FontSize = oFS Picture1.CurrentY = 400 Picture1.CurrentX = 100 Picture1.Print "Dieses Beispiel stammt von" Picture1.CurrentY = 2400 Picture1.CurrentX = 100 Picture1.FontSize = 18 Picture1.Print "Blur und Preview" Picture1.CurrentY = 2800 Picture1.CurrentX = 100 Picture1.Print "Demo in VB." Picture1.FontSize = oFS Picture1.CurrentY = 3400 Picture1.CurrentX = 100 Picture1.Print "Viel Spaß beim testen," Picture1.CurrentY = 3700 Picture1.CurrentX = 100 Picture1.Print "Dirk Lietzow" Picture2.Picture = Picture1.Image Image1.Picture = Picture1.Image Image2.Picture = Picture2.Image End Sub Private Sub Picture1_Click() Picture2.Picture = Picture1.Image Image1.Picture = Picture1.Image Image2.Picture = Picture2.Image End Sub Private Sub Picture2_Click() Picture2.Picture = Picture1.Image Image1.Picture = Picture1.Image Image2.Picture = Picture2.Image End Sub

RTF-Druckvorschau	105	Dirk	06.05.02 14:25
Re: RTF-Druckvorschau	67	Norbert	07.05.02 20:19
Re: RTF-Druckvorschau	80	Dirk	08.05.02 12:24
Re: RTF-Druckvorschau	63	Dirk	13.05.02 13:59
Re: RTF-Druckvorschau	524	Alexander	15.12.02 16:41

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übersicht

Suchen