VB-Homepage Tipp 071

Bitmaps als verkl. Abbildung darstellen und spiegeln

Eigentlich sind dies gleich zwei Tipps und zwar Nummer eins,
die Darstellungen von Grafiken als sogenannte Trubnails
(verkleinerte Darstellung)
und als zweites die Möglichkeit Grafiken zu spiegeln
(also Flip und Mirror).
Letzteres entstammt einem Tipp von Jürgen Anke aus BasicPro.

trubnail.vbp
Form=trubnail.frm
ProjWinSize=124,481,248,215
ProjWinShow=2
IconForm="Form1"
ExeName32="trubnail.exe"
Name="Projekt1"
HelpContextID="0"
StartMode=0
VersionCompatible32="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName=""

trubnail.frm
VERSION 4.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "TRUBNAIL (Grafiken verkleinert darstellen)"
ClientHeight = 4545
ClientLeft = 1140
ClientTop = 1515
ClientWidth = 10050
Height = 4950
Left = 1080
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4545
ScaleWidth = 10050
Top = 1170
Width = 10170
Begin VB.PictureBox Picture1
AutoSize = -1 'True
Height = 2895
Left = 5640
ScaleHeight = 189
ScaleMode = 3 'Pixel
ScaleWidth = 277
TabIndex = 5
Top = 1440
Width = 4215
End
Begin VB.CommandButton Command1
Caption = "Grafik in Orginalgröße drehen nicht bei Großformaten ausführen"
Height = 735
Left = 6720
TabIndex = 4
Top = 600
Width = 2415
End
Begin VB.FileListBox File1
Height = 3375
Left = 2640
Pattern = "*.gif;*.bmp;*.wmf"
TabIndex = 2
Top = 960
Width = 2775
End
Begin VB.DriveListBox Drive1
Height = 315
Left = 2640
TabIndex = 1
Top = 240
Width = 2775
End
Begin VB.DirListBox Dir1
Height = 1605
Left = 240
TabIndex = 0
Top = 2640
Width = 2295
End
Begin VB.Line Line1
X1 = 5520
X2 = 5520
Y1 = 120
Y2 = 4440
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "A.Gamper - http://vb-homepage"
Height = 255
Left = 6000
TabIndex = 3
Top = 120
Width = 3855
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 1995
Left = 240
Top = 240
Width = 1995
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
#If Win32 Then
DefLng A-Z 'SysInt
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
#ElseIf Win16 Then
DefInt A-Z 'SysInt
Private Declare Function StretchBlt% Lib "GDI" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal nSrcWidth%, ByVal nSrcHeight%, ByVal dwRop&)
#End If
Const SRCCOPY = &HCC0020
Sub Wartezeit(Sekunden)
Dim Start As Single
Dim iT As Integer
Start = Timer
While Timer < Start + Sekunden
iT = DoEvents()
Wend
End Sub
Private Sub Command1_Click()
Picture1.Picture = Image1.Picture
Dim w, h 'As SysInt
w = Picture1.ScaleWidth
h = Picture1.ScaleHeight
Call StretchBlt(Picture1.hDC, w, 0, -w, h, Picture1.hDC, 0, h, w, -h, SRCCOPY)
Wartezeit 2
Call StretchBlt(Picture1.hDC, 0, h, w, -h, Picture1.hDC, 0, 0, w, h, SRCCOPY)
Wartezeit 2Call StretchBlt(Picture1.hDC, w, 0, -w, h, Picture1.hDC, 0, 0, w, h, SRCCOPY)
End Sub
Private Sub Dir1_Change()
File1 = Dir1
End Sub
Private Sub Drive1_Change()
File1 = Drive1
Dir1 = Drive1
End Sub
Private Sub File1_Click()
Dim pfad$
'ausschalten der Anzeige Image - da Datei erst im Großformat geladen wird
Image1.Visible = False
'Übernahme der Auswahl
pfad = Dir1 & "\" & File1
Image1.Picture = LoadPicture(pfad)
'notwendig, damit Grafik in der Größe geändert werden kann.
Image1.Stretch = True
'damit jedes weitere Grafikladen gleiche Imagegröße als Ausgangspunkt erhält
Image1.Height = 2000
Image1.Width = 2000
'Anzeige des fertigen Trubnails
Image1.Visible = True
End Sub

Tipp-Download

Quelle :

Zurück zur Übersichtsseite