| 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 : |
 |