Programming Languages Suite

home *** CD-ROM | disk | FTP | other *** search

/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / COMPTOOL / CALLDLLS / CALLDLLS.FRM (.txt) next >

Wrap

Visual Basic Form | 1996-11-15 | 19.5 KB | 591 lines

VERSION 5.00 Begin VB.Form frmCallDlls BorderStyle = 1 'Fixed Single Caption = "Calling DLL Procedures" ClientHeight = 1935 ClientLeft = 4305 ClientTop = 5280 ClientWidth = 5520 ClipControls = 0 'False BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False PaletteMode = 1 'UseZOrder ScaleHeight = 1935 ScaleWidth = 5520 StartUpPosition = 2 'CenterScreen WhatsThisHelp = -1 'True Begin VB.PictureBox picSprite AutoRedraw = -1 'True AutoSize = -1 'True Height = 540 Left = 960 Picture = "CALLDLLS.frx":0000 ScaleHeight = 32 ScaleMode = 3 'Pixel ScaleWidth = 32 TabIndex = 25 Top = 1920 Visible = 0 'False Width = 540 End Begin VB.PictureBox picCopy AutoRedraw = -1 'True BorderStyle = 0 'None Height = 495 Left = 1680 ScaleHeight = 33 ScaleMode = 3 'Pixel ScaleWidth = 33 TabIndex = 24 Top = 1920 Visible = 0 'False Width = 495 End Begin VB.PictureBox picMask AutoRedraw = -1 'True AutoSize = -1 'True Height = 540 Left = 240 Picture = "CALLDLLS.frx":030A ScaleHeight = 32 ScaleMode = 3 'Pixel ScaleWidth = 32 TabIndex = 23 Top = 1920 Visible = 0 'False Width = 540 End Begin VB.CommandButton cmdBitBlt Caption = "BitBlt" Height = 495 Left = 4680 TabIndex = 22 Top = 1320 Width = 735 End Begin VB.Frame fraInfo Caption = "Instructions" ClipControls = 0 'False Height = 1695 Index = 0 Left = 120 TabIndex = 0 Top = 120 Width = 4455 Begin VB.Label lblInfo Caption = "Click the right mouse button on the icons to the right." Height = 495 Index = 1 Left = 840 TabIndex = 1 Top = 480 Width = 2415 End End Begin VB.Timer tmrBounce Enabled = 0 'False Interval = 1 Left = 2520 Top = 2040 End Begin VB.Frame fraInfo Caption = "Operating System" ClipControls = 0 'False Height = 1695 Index = 1 Left = 120 TabIndex = 2 Top = 120 Visible = 0 'False Width = 4455 Begin VB.Label lblInfo AutoSize = -1 'True Caption = "(Enhanced mode)" Height = 195 Index = 3 Left = 360 TabIndex = 8 Top = 600 Width = 1500 End Begin VB.Label lblInfo AutoSize = -1 'True Caption = "Disk Operating System 5.0" Height = 195 Index = 4 Left = 240 TabIndex = 4 Top = 960 Width = 2265 End Begin VB.Label lblInfo AutoSize = -1 'True Caption = "Microsoft Windows Version 3.1" Height = 195 Index = 2 Left = 240 TabIndex = 3 Top = 360 Width = 2640 End End Begin VB.Frame fraInfo Caption = "General Info" ClipControls = 0 'False Height = 1695 Index = 4 Left = 120 TabIndex = 13 Top = 120 Visible = 0 'False Width = 4455 Begin VB.Label lblInfo Caption = "Keyboard:" Height = 435 Index = 14 Left = 120 TabIndex = 17 Top = 1080 Width = 4230 End Begin VB.Label lblInfo AutoSize = -1 'True Caption = "Language:" Height = 195 Index = 13 Left = 120 TabIndex = 16 Top = 840 Width = 915 End Begin VB.Label lblInfo AutoSize = -1 'True Caption = "Mouse:" Height = 195 Index = 12 Left = 120 TabIndex = 15 Top = 360 Width = 630 End Begin VB.Label lblInfo AutoSize = -1 'True Caption = "Network:" Height = 195 Index = 11 Left = 120 TabIndex = 14 Top = 600 Width = 780 End End Begin VB.Frame fraInfo Caption = "Processor Type and Memory Statistics" ClipControls = 0 'False Height = 1695 Index = 2 Left = 120 TabIndex = 5 Top = 120 Visible = 0 'False Width = 4455 Begin VB.Timer tmrSysInfo Interval = 1 Left = 3840 Top = 240 End Begin VB.Shape shpFrame Height = 255 Index = 3 Left = 1080 Top = 1320 Width = 3135 End Begin VB.Shape shpBar BackStyle = 1 'Opaque DrawMode = 7 'Invert Height = 255 Index = 3 Left = 1080 Top = 1320 Width = 1695 End Begin VB.Label lblResInfo Alignment = 2 'Center Caption = "pagefile" Height = 255 Index = 3 Left = 1080 TabIndex = 27 Top = 1320 Width = 3135 End Begin VB.Label lblR Caption = "PageFile" Height = 255 Index = 3 Left = 240 TabIndex = 26 Top = 1320 Visible = 0 'False Width = 855 End Begin VB.Shape shpFrame Height = 255 Index = 1 Left = 1080 Top = 840 Width = 3135 End Begin VB.Shape shpBar BackStyle = 1 'Opaque DrawMode = 7 'Invert Height = 255 Index = 1 Left = 1080 Top = 840 Width = 1695 End Begin VB.Shape shpFrame Height = 255 Index = 2 Left = 1080 Top = 1080 Width = 3135 End Begin VB.Shape shpBar BackStyle = 1 'Opaque DrawMode = 7 'Invert Height = 255 Index = 2 Left = 1080 Top = 1080 Width = 1695 End Begin VB.Label lblResInfo Alignment = 2 'Center Caption = "virtual" Height = 255 Index = 2 Left = 1080 TabIndex = 21 Top = 1080 Width = 3135 End Begin VB.Label lblResInfo Alignment = 2 'Center Caption = "physical" Height = 255 Index = 1 Left = 1080 TabIndex = 20 Top = 840 Width = 3135 End Begin VB.Label lblR Caption = "Physical" Height = 255 Index = 1 Left = 240 TabIndex = 19 Top = 840 Width = 855 End Begin VB.Label lblR Caption = "Virtual" Height = 255 Index = 2 Left = 240 TabIndex = 18 Top = 1080 Width = 855 End Begin VB.Label lblInfo AutoSize = -1 'True Caption = "CPU: 486 (with Math Coprocessor)" Height = 195 Index = 5 Left = 240 TabIndex = 7 Top = 240 Width = 2940 End Begin VB.Label lblInfo AutoSize = -1 'True Caption = "Memory Free" Height = 195 Index = 6 Left = 240 TabIndex = 6 Top = 480 Width = 1095 End End Begin VB.Frame fraInfo Caption = "Video" ClipControls = 0 'False Height = 1695 Index = 3 Left = 120 TabIndex = 9 Top = 120 Visible = 0 'False Width = 4455 Begin VB.Label lblInfo AutoSize = -1 'True Caption = "Colors:" Height = 195 Index = 10 Left = 240 TabIndex = 12 Top = 1320 Width = 600 End Begin VB.Label lblInfo AutoSize = -1 'True Caption = "Resolution" Height = 195 Index = 9 Left = 240 TabIndex = 11 Top = 960 Width = 915 End Begin VB.Label lblInfo Caption = "Video Driver:" Height = 495 Index = 8 Left = 240 TabIndex = 10 Top = 360 Width = 3975 End End Begin VB.Image ImgIcon Height = 480 Index = 1 Left = 4800 Picture = "CALLDLLS.frx":0614 Top = 720 Width = 480 End Begin VB.Image ImgIcon Height = 480 Index = 0 Left = 4800 Picture = "CALLDLLS.frx":091E Top = 120 Width = 480 End Attribute VB_Name = "frmCallDlls" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim dx As Integer, dy As Integer, X As Integer, Y As Integer Dim PicWidth As Integer, PicHeight As Integer Dim RightEdge As Integer, BottomEdge As Integer Private Sub cmdBitBlt_Click() Dim t As Integer If tmrBounce.Enabled Then tmrBounce.Enabled = False Refresh Else ScaleMode = PIXELS dx = 15 dy = 15 tmrBounce.Enabled = True PicWidth = picSprite.ScaleWidth PicHeight = picSprite.ScaleHeight picCopy.Width = PicWidth picCopy.Height = PicHeight t = BitBlt(picCopy.hDC, 0, 0, PicWidth, PicHeight, hDC, X, Y, SRCCOPY) End If End Sub Private Sub FillSysInfo() Dim FreeSpace As Currency, FreeBlock As Currency, strTmp As String Dim YourMem As MEMORYSTATUS, myVer As MYVERSION fraInfo(4).Visible = False 'Operating System Info. Dim YourSystem As SystemInfo GetSystemInfo YourSystem myVer = WindowsVersion() If myVer.lMajorVersion = 4 Then If myVer.lExtraInfo = VER_PLATFORM_WIN32_NT Then strTmp = "Windows NT version : " ElseIf myVer.lExtraInfo = VER_PLATFORM_WIN32_WINDOWS Then strTmp = "Windows 95 version : " End If Else strTmp = "Windows version : " End If lblInfo(2).Caption = strTmp & myVer.lMajorVersion & "." & myVer.lMinorVersion lblInfo(3).Caption = "" lblInfo(4).Caption = "" ' CPU Info. lblInfo(5).Caption = "CPU: " & YourSystem.dwProcessorType ' Video info. lblInfo(8).Visible = False lblInfo(9).Caption = "Resolution: " & Screen.Width \ Screen.TwipsPerPixelX & " x " & Screen.Height \ Screen.TwipsPerPixelY lblInfo(10).Caption = "Colors: " & DeviceColors((hDC)) ' General info. If GetSystemMetrics(SM_MOUSEPRESENT) Then lblInfo(11).Caption = "Mouse: " & GetSysIni("boot.description", "mouse.drv") Else lblInfo(11).Caption = "No mouse" End If lblInfo(12).Caption = "Network: " & GetSysIni("boot.description", "network.drv") lblInfo(13).Caption = "Language: " & GetSysIni("boot.description", "language.dll") lblInfo(14).Caption = "Keyboard: " & GetSysIni("boot.description", "keyboard.typ") End Sub Private Sub Form_Load() Show ' Make sure this form has an hWnd, etc. Load frmMenus Icon = ImgIcon(1).Picture FillSysInfo frmMenus.mnuSysInfo(3).Visible = False End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) End End Sub Private Sub Form_Resize() Dim t As Integer, hDC As Long If WindowState = MINIMIZED Then RightEdge = Screen.Width \ Screen.TwipsPerPixelX BottomEdge = Screen.Height \ Screen.TwipsPerPixelY If tmrBounce.Enabled Then hDC = GetDC(GetDesktopWindow()) t = BitBlt(picCopy.hDC, 0, 0, PicWidth, PicHeight, hDC, X, Y, SRCCOPY) ReleaseDC GetDesktopWindow(), hDC End If Else ScaleMode = PIXELS RightEdge = ScaleWidth BottomEdge = ScaleHeight If tmrBounce.Enabled Then hDC = GetDC(GetDesktopWindow()) t = BitBlt(hDC, X, Y, PicWidth, PicHeight, picCopy.hDC, 0, 0, SRCCOPY) ReleaseDC GetDesktopWindow(), hDC End If End If End Sub Private Sub ImgIcon_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) Dim IX As Integer, IY As Integer 'hMenu and hSubMenu must be long to run on 32-bit Dim hMenu As Long, hSubMenu As Long, R As Integer Dim menRect As Rect If Button And 2 Then ScaleMode = TWIPS menRect.Left = 0 menRect.Top = 0 menRect.Right = Screen.Width / Screen.TwipsPerPixelX menRect.Bottom = Screen.Height / Screen.TwipsPerPixelY IX = (X + Left + ImgIcon(Index).Left) \ Screen.TwipsPerPixelX IY = (Y + Top + ImgIcon(Index).Top + ImgIcon(Index).Height) \ Screen.TwipsPerPixelY hMenu = GetMenu(frmMenus.hWnd) hSubMenu = GetSubMenu(hMenu, Index) R = TrackPopupMenu(hSubMenu, 2, IX, IY, 0, frmMenus.hWnd, menRect) End If ' Refresh SysInfo If Index = 2 Then FillSysInfo End If End Sub Private Sub tmrBounce_Timer() 'Following are static only to improve speed Static NewX As Integer, NewY As Integer, temp As Integer Static hDC As Long, releaseit As Integer 'Calculate new position ScaleMode = PIXELS temp = X + dx If temp + PicWidth \ 2 > RightEdge Then dx = -Abs(dx) ElseIf temp < 0 Then dx = Abs(dx) End If NewX = X + dx temp = Y + dy If temp + PicHeight \ 2 > BottomEdge Then dy = -Abs(dy) ElseIf temp < 0 Then dy = Abs(dy) End If NewY = Y + dy If WindowState = MINIMIZED Then hDC = GetDC(GetDesktopWindow()) releaseit = True Else hDC = Me.hDC releaseit = False End If 'Now perform "transparent" BitBlts: '1 Copy old background back over sprite's old position '2 Copy the background where the sprite will go '3 Draw the mask '4 Draw the sprite temp = BitBlt(hDC, X, Y, PicWidth, PicHeight, picCopy.hDC, 0, 0, SRCCOPY) temp = BitBlt(picCopy.hDC, 0, 0, PicWidth, PicHeight, hDC, NewX, NewY, SRCCOPY) temp = BitBlt(hDC, NewX, NewY, PicWidth, PicHeight, picMask.hDC, 0, 0, SRCAND) temp = BitBlt(hDC, NewX, NewY, PicWidth, PicHeight, picSprite.hDC, 0, 0, SRCINVERT) X = NewX Y = NewY If releaseit Then ReleaseDC GetDesktopWindow(), hDC End Sub Private Sub tmrSysInfo_Timer() Dim YourMemory As MEMORYSTATUS Dim intX As Integer Dim lWidth As Integer If fraInfo(RES_INFO).Visible Then For intX = 1 To 3 lblR(intX).Visible = True lblResInfo(intX).Visible = True shpBar(intX).Visible = True shpFrame(intX).Visible = True Next intX Else For intX = 1 To 3 lblR(intX).Visible = False lblResInfo(intX).Visible = False shpBar(intX).Visible = False shpFrame(intX).Visible = False Next intX End If YourMemory.dwLength = Len(YourMemory) GlobalMemoryStatus YourMemory With YourMemory lblInfo(6).Caption = "Physical Memory Available(KB) : " & (.dwAvailPhys / 1024) ' Check width before setting to try and cut down on screen "flashing" lWidth = shpFrame(1).Width * (.dwAvailPhys / .dwTotalPhys) If lWidth <> shpBar(1).Width Then shpBar(1).Width = lWidth End If lWidth = shpFrame(2).Width * (.dwAvailVirtual / .dwTotalVirtual) If lWidth <> shpBar(2).Width Then shpBar(2).Width = lWidth End If lWidth = shpFrame(3).Width * (.dwAvailPageFile / .dwTotalPageFile) If lWidth <> shpBar(3).Width Then shpBar(3).Width = lWidth End If End With End Sub