ࡱ> urs  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqtvwxyz{|}~Root Entry FpCompObjnWordDocumentObjectPoolp7p7  FMicrosoft Word 6.0-Dokument MSWordDocWord.Document.69q Oh+'0$ H l   D h$C:\TEST\WINWORD\VORLAGEN\NORMAL.DOT Dateihanling Andreas Grob Andreas Grob@+kܥe5e g000 0 0 0 0 4(FdnR dyTY80 2nt2220 0 22220 0 d  0 0 0 0 22O2Inhaltsverzeichnis  VERZEICHNIS \t "t;1" Programmverknpfung  GEHEZU _Toc312054613  SEITENREF _Toc312054613 3 Fensterhandling  GEHEZU _Toc312054614  SEITENREF _Toc312054614 3 Fenstertitel des aktiven Fensters ermitteln  GEHEZU _Toc312054615  SEITENREF _Toc312054615 4 Schwebendes Fenster  GEHEZU _Toc312054616  SEITENREF _Toc312054616 4 Mauszeiger auf Bereich beschrnken  GEHEZU _Toc312054617  SEITENREF _Toc312054617 4 Mauszeigerposition bestimmen  GEHEZU _Toc312054618  SEITENREF _Toc312054618 5 Mauszeiger auf bestimmte Position setzen  GEHEZU _Toc312054619  SEITENREF _Toc312054619 5 Warten vor dem Weiterfahren  GEHEZU _Toc312054620  SEITENREF _Toc312054620 6 Prfen auf DOS-Anwendung  GEHEZU _Toc312054621  SEITENREF _Toc312054621 6 Mehrfachstart einer Anwendung unterbinden  GEHEZU _Toc312054622  SEITENREF _Toc312054622 6 Feststellen, wie ein Steuerelement den Focus erhalten hat  GEHEZU _Toc312054623  SEITENREF _Toc312054623 7 Selektion in einem Kombinationsfeld  GEHEZU _Toc312054624  SEITENREF _Toc312054624 7 Programmgesteuertes Booten  GEHEZU _Toc312054625  SEITENREF _Toc312054625 8 Screenshot  GEHEZU _Toc312054626  SEITENREF _Toc312054626 8 MS-DOS-Text in Windows-Text umwandeln  GEHEZU _Toc312054627  SEITENREF _Toc312054627 11 Hoch-/Querformat-Umstellung per Programm  GEHEZU _Toc312054628  SEITENREF _Toc312054628 11 Drucker umschalten  GEHEZU _Toc312054629  SEITENREF _Toc312054629 12 Containerobjekte zwischen Formularen verschieben  GEHEZU _Toc312054630  SEITENREF _Toc312054630 14 Shell modal  GEHEZU _Toc312054631  SEITENREF _Toc312054631 16 Mauszeiger verstecken  GEHEZU _Toc312054632  SEITENREF _Toc312054632 16 Schriften vertikal ausgeben  GEHEZU _Toc312054633  SEITENREF _Toc312054633 17 Hotkey  GEHEZU _Toc312054634  SEITENREF _Toc312054634 19 Debug-Fenster lschen  GEHEZU _Toc312054635  SEITENREF _Toc312054635 20 Inhalt Beispieldiskette  GEHEZU _Toc312054636  SEITENREF _Toc312054636 22  Index der benutzten API-Funktionen  INDEX \e " " \h "A" \c "1"  A AnsiToOem 12 B BitBlt 10 C ClipCursorClear 5 ClipCursorRect 5 CreateFontIndirect 19 D DeleteObject 19 E ExitWindows 9 F FindExecutable 4 G GetActiveWindow 5; 8 GetAsyncKeyState 8; 21 GetClientRect 19 GetCursorPos 6 GetDC 10 GetDesktopWindow 10 GetModuleUsage 16 GetProfileString 13; 15 GetTextMetrics 19 GetTickCount 7 GetWindowRect 5; 10 GetWindowTask 7 GetWindowText 5 I IsWinOldApTask 7 L LockWindowUpdate 4 O OemToAnsi 12 P PostMessageByString 14 R ReleaseDC 10 ResetDC 13 S SelectObject 19 SendMessage 8; 21 SetCursorPos 6 SetParent 15 SetWindowPos 5 ShowCursor 17 SwitchToThisWindow 7 T TextOut 19 W WriteProfileString 14  Quellenangabe: Visual Basic Programmer's Guide to the Windows API,Daniel Appleman, Copyright (c) 1993 by Ziff-Davis Press Programmverknpfung Im Dateimanager knnen Sie sogenannte Verknpfungen vornehmen. Dabei bestimmen Sie, welches Programm gestartet werden soll und die angegebene Datei laden soll, wenn die entsprechende Datei geffnet wird. Die Verknpfung erfolgt jeweils ber die Dateiendung. Bei einem Doppelklick auf eine Datei mit der Endung .TXT wird standardmssig das Programm NOTEPAD.EXE gestartet und die angeklickte Datei geladen. Windows bietet nun ein API, um anhand eines Dateinamens den Programmnamen des verknpften ausfhrbaren Programmes ausfindig zu machen. ber die folgende Funktion knnen Sie den zugehrigen Dateinamen in Erfahrung bringen: Declare Function FindExecutable XE "FindExecutable" % Lib "shell.dll" (ByVal lpszFile$, ByVal lpszDir$, ByVal lpszResult$) Function GetLinkedAppName (pfad$) Dim i% Dim Resultat$ Resultat$ = String$(256, " ") i% = FindExecutable%(pfad$, "", Resultat$) GetLinkedAppName = Left$(Resultat$, InStr(Resultat$ + Chr$(0), Chr$(0)) - 1) End Function Damit sind Sie in der Lage, die Dateimanager-Funktionalitt nachzubilden. Erzeugen Sie eine DateiListBox und fgen Sie im Click-Ereignis folgenden Code ein: Sub File1_DblClick () Dim tmp$, i% tmp$ = File1.Path If Right$(tmp$, 1) <> "\" Then tmp$ = tmp$ + "\" On Error Resume Next i% = Shell(Trim$(GetLinkedAppName(tmp$ + File1) + " " + tmp$ + File1), 1) If Err Then MsgBox "Diese Datei ist mit keiner Anwendung verknpft", 48, "Fehler" Exit Sub End If End Sub Fensterhandling Fenster einfrieren. Manchmal kann es wnschenswert sein, den Aufbau eines Fensters zu verstecken. Werden z.B. sehr viele Steuerelemente auf einer Form neu positioniert, so kann man den Aufbau mitverfolgen. Ausserdem dauert es recht lange. Frieren Sie das Fenster vor dem Aufbau ein und geben es erst nach dem Aufbau wieder frei, so gewinnen Sie Zeit und erhalten erst noch ein schneres Finish. Mit dieser Funktion kann auch das Fllen von Listboxen beschleunigt werden. Declare Function LockWindowUpdate XE "LockWindowUpdate"  Lib User (ByVal hWnd As Integer) As Integer Function Freeze(hWnd as Integer) Dim Ret% Ret% = LockWindowUpdate(hWnd%) End Function Function UnFreeze(hWnd%) Dim Ret% Ret% = LockWindowUpdate(0) End Function Nach dem Aufruf von MeltWindow sollten Sie dafr sorgen, dass alle betroffenen Fenster neu gezeichnet werden. Um z.B. die aktive Form einzufrieren, benutzen Sie den Aufruf i% = Freeze((Me.hWnd)). Die doppelten runden Klammern werden bentigt fr die Typumwandlung. Um eine Listbox einzufrieren, benutzen Sie den Aufruf i% = Freeze ((List1. hWnd)). Fenstertitel des aktiven Fensters ermitteln Mittels folgender Funktion knnen Sie den Fenstertitel des gerade aktiven Fensters ermitteln. Dies ist besonders dann interessant, wenn es sich nicht um ein eigenes Fenster handelt. Mit der Routine AppActivate knnen Sie das Fenster zu einem spteren Zeitpunkt wieder aktivieren. Declare Function GetActiveWindow XE "GetActiveWindow"  Lib "User" () As Integer Declare Function GetWindowText XE "GetWindowText"  Lib "User" (ByVal hWnd As Integer, ByVal lpString As String, ByVal aint As Integer) As Integer Function AktFensterTitel$ () Dim Titel$, laenge% Titel$ = Space$(255) laenge% = GetWindowText(GetActiveWindow(), Titel$, 255) AktFensterTitel$ = Left$(Titel$, laenge%) End Function Schwebendes Fenster Manchmal mchte man verhindern, dass ein Fenster durch andere Fenster verdeckt werden kann. Diesen Effekt kann man mittels eines API-Aufrufs erzielen. Die folgende Routine schaltet das aktuelle Fenster (Me) um, so dass es immer im Vordergrund bleibt. Ein erneuter Aufruf der Routine schaltet das aktuelle Fenster wieder in den Normalzustand um. Declare Sub SetWindowPos XE "SetWindowPos"  Lib "User" (Byval hWnd as integer, Byval hWndInsertAfter as Integer, Byval X as Integer, Byval Y as Integer, Byval cx as Integer, Byval cy as Integer, Byval wFlags as Integer) Sub SwitchOnTopMode () Static Modus% If Not Modus% Then SetWindowPos form1.hWnd, -1, 0, 0, 0, 0, &H50 'Immer sichtbar Else SetWindowPos form1.hWnd, -2, 0, 0, 0, 0, &H50 'Normalzustand End If Modus% = Not Modus% End Sub Mauszeiger auf Bereich beschrnken Mittels API-Funktionen kann man den Bereich, der mit dem Mauszeiger erreichbar sein soll, einschrnken. Wollen Sie z.B. erreichen, dass der Anwender nicht mit dem Mauszeiger aus einem Bildfeld herausfahren kann, knnen Sie dies folgendermassen tun. Type RECT left As Integer top As Integer right As Integer bottom As Integer End Type Declare Sub ClipCursorRect XE "ClipCursorRect"  Lib "User" Alias "ClipCursor" (lpRect As RECT) Declare Sub ClipCursorClear XE "ClipCursorClear"  Lib "User" Alias "ClipCursor" (ByVal lpRect&) Declare Sub GetWindowRect XE "GetWindowRect"  Lib "User" (ByVal hWnd%, lpRect As RECT) Sub LimitCursor (hWnd%) Dim r As RECT GetWindowRect hWnd%, r ClipCursorRect r End Sub Sub FreeCursor () ClipCursorClear 0 End Sub Um nun den Mauszeiger-Aktionsbereich festzulegen bergeben Sie der Funktion LimitCursor den Fensterhandle des entsprechenden Bereichs. Bitte beachten Sie unbedingt, dass die Prozedur FreeCursor sptestens beim Verlassen des Programmes aufgerufen wird, denn die Einstellung bleibt sonst auch nach demerlassen des Beispiel, um den Cursor auf die aktuelle Form zu beschrnken: LimitCursor((me.hwnd)) Beispiel, um den Cursor auf das Bildfeld Picture1 zu beschrnken: Limitcursor((picture1.hwnd)) Sie knnen den Bereich, auf den Sie den Mauszeiger beschrnken mchten, auch von Hand bestimmen, indem Sie in der Funktion LimitCursor statt die Funktion GetWindowRect aufzurufen direkt die entsprechenden Werte der Struktur RECT setzen. Dabei mssen Sie aber beachten, dass das API die X/Y-Koordinaten in Pixeln und relativ zum gesamten Bildschirm erwartet. Mauszeigerposition bestimmen Solange der Mauszeiger sich ber einem Formular der eigenen Visual Basic Anwendung befindet, kann man anhand des MouseMove-Ereignisses jeweils herausfinden, wo sich der Mauszeiger gerade befindet. Wird der Mauszeiger jedoch ber ein fremdes Programm oder ber den Desktop bewegt, so kann man mit Visual Basic die aktuelle Position nicht mehr herausfinden. Das Windows-API GetCursorPos XE "GetCursorPos"  hilft bei der Lsung des Problems. Die folgende Prozedur liefert die X/Y-Position des Mauszeigers, egal, wo er sich gerade befindet. Da die Windows-APIs immer in Pixeln arbeiten, knnen Sie beim Aufruf der Routine ber das Flag Twips% angeben, ob die Koordinaten in Twips (Twips% = True) oder in Pixeln (Twips% = False) zurckgegeben werden sollen. Type POINTAPI X As Integer Y As Integer End Type Declare Sub GetCursorPos XE "GetCursorPos"  Lib "User" (lpPoint As POINTAPI) Sub GetMousePos (X%, Y%, Twips%) Dim p As POINTAPI GetCursorPos p If Twips% Then X% = p.X * screen.TwipsPerPixelX Y% = p.Y * screen.TwipsPerPixelY Else X% = p.X Y% = p.Y End If End Sub Mauszeiger auf bestimmte Position setzen Mit dem Windows-API SetCursorPos kann der Mauszeiger per Programm an einen bestimmten Ort auf dem Bildschirm gesetzt werden. Wie bei API-Routinen blich, werden von SetCursorPos die X/Y-Koordinaten in Pixeln und nicht in Twips erwartet. Die Position muss immer auf den ganzen Bildschirm bezogen angegeben werden. Die folgende Funktion ermglicht nun die Positionierung, wobei zwischen Twix und Pixeln umgeschaltet werden kann wie bei der Funktion GetMousePos. Declare Sub SetCursorPos XE "SetCursorPos"  Lib "User" (ByVal X As Integer, ByVal Y As Integer) Sub SetMousePos (X%, Y%, Twips%) Dim p As POINTAPI If Twips% Then p.X = X% / screen.TwipsPerPixelX p.Y = Y% / screen.TwipsPerPixelY Else p.X = X% p.Y = Y% End If SetCursorPos p.X, p.Y End Sub Warten vor dem Weiterfahren In der Multitaskingumgebung von Windows wird es direkt schwierig, ein Programm dazu anzuhalten, eine bestimmte Zeit lang einfach zu warten, bevor es weiter abgearbeitet wird. Mit der folgenden Routine knnen Sie Ihr Programm dazu veranlassen, eine bestimmte Zeit in Millisekunden zu warten. Dazu wird das API GetTickCount XE "GetTickCount"  benutzt, das die Anzahl Millisekunden liefert, seit der die aktuelle Windows-Sitzung luft. ber einen Zhler wird die Mglichkeit einer Endlosschleife vermieden. Diese Massnahme schrnkt jedoch die maximale Wartezeit ein. Declare Function GetTickCount XE "GetTickCount"  Lib "User" () As Long Sub Wait (Millisekunden%) Dim zaehler& Dim StartZeit As Long, EndZeit As Long StartZeit = GetTickCount() Do zaehler& = zaehler& + 1 If (GetTickCount() - StartZeit) > Millisekunden% Then Exit Do Loop Until zaehler& = 60000 End Sub Prfen auf DOS-Anwendung Mit der folgenden Funktion knnen Sie ein Fenster daraufhin untersuchen, ob es eine DOS-Anwendung enthlt oder nicht. Declare Function GetWindowTask XE "GetWindowTask"  Lib "User" (ByVal hWnd As Integer) As Integer Declare Function IsWinOldApTask XE "IsWinOldApTask"  Lib "Kernel" (ByVal hTask As Integer) As Integer Function IsDOS (hWnd As Integer) As Integer IsDOS = IsWinOldApTask(GetWindowTask(hWnd)) End Function Mehrfachstart einer Anwendung unterbinden Oft mchte man verhindern, dass die eigene Anwendung mehrfach gestartet werden kann. Dies selbst ist eigentlich kein Problem; schon etwas kniffliger wird es, wenn man die Erst-Instanz des Programmes aktivieren mchte, bevor man die zustzlich gestartete Anwendung wieder verlsst. Folgende Routine lst das Problem. Die Routine sollte entweder in der Startroutine Sub Main oder im Load-Ereignis der Startform aufgerufen werden. Das benutzte Windows-API gehrt zu den nicht dokumentierten APIs. Declare Sub SwitchToThisWindow XE "SwitchToThisWindow"  Lib "user" (ByVal hWnd%, ByVal StateNormal%) Sub AppActivatePreviousInstance () Dim ThisAppTitle$ If App.PrevInstance Then ThisAppTitle$ = App.Title App.Title = "" On Error Resume Next AppActivate ThisAppTitle$ SwitchToThisWindow GetActiveWindow XE "GetActiveWindow" (), True End End If End Sub Feststellen, wie ein Steuerelement den Focus erhalten hat Um festzustellen, ob ein Steuerelement den Focus durch die Bettigung der TAB-Taste, durch eine ALT-Tastenkombination (Kurztaste), einen Mausklick oder eine Programmanweisung erhalten hat, kann direkt im GotFocus-Ereignis des entsprechenden Steuerelementes folgender Code verwendet werden: Declare Function GetAsyncKeyState XE "GetAsyncKeyState"  Lib "User" (ByVal vKey As Integer) As Integer Global Const ON_TAB = 1 Global Const ON_ALT = 2 Global Const ON_MOUSE = 3 Global Const ON_ELSE = 4 Function GotFocusON () Const KEY_TAB = &H9 Const KEY_MENU = &H12 Const KEY_LBUTTON = &H1 If GetAsyncKeyState(KEY_TAB) = &H8001 Then GotFocusON = ON_TAB ElseIf GetAsyncKeyState(KEY_MENU) = &H8001 Then GotFocusON = ON_ALT ElseIf GetAsyncKeyState(KEY_LBUTTON) = &H8001 Then GotFocusON = ON_MOUSE Else GotFocusON = ON_ELSE End If End Function Tip: Diese Funktion kann Ihnen gute Dienste leisten, wenn Sie nach dem allgemein verwendeten Muster von Windows arbeiten mchten und beim Anspringen eines Textfeldes mittels TAB den Inhalt des Textfeldes markieren mchten. Dies knnen Sie innerhalb des GotFocus-Ereignisses des entsprechenden Textfeldes folgendermassen erreichen (hier am Beispiel des Textfeldes Text1): Sub Text1_GotFocus () If GotFocusON() <> ON_MOUSE Then Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End If End Sub Selektion in einem Kombinationsfeld Vor allem in Datenbankanwendungen muss man oft ein Kombinationsfeld oder ein Listenfeld nach einem bestimmten Eintrag durchsuchen und diesen zum aktuellen Eintrag machen. Dies lsst sich zwar gut mit Visual Basic selbst lsen, doch dauert das Durchsuchen der Listbox nach einem bestimmten Eintrag recht lange. Die folgende Routine liefert eine wesentlich schnellere Lsung ber das Windows-API: Declare Function SendMessage XE "SendMessage"  Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long Global Const WM_USER = &H400 Global Const LB_SELECTSTRING = (WM_USER + 13) Sub SelectListItem (lst As Control, Idx As String) Dim i As Integer i = SendMessage(lst.hWnd, LB_SELECTSTRING, -1, ByVal Idx) End Sub Angenommen, Sie haben ein Kombinationsfeld mit dem Namen Combo1, das unter anderem den Eintrag Test enthlt, so lautet der Aufruf: SelectListItem Combo1, Test System ber WIN.INI-nderung informieren. Wenn eine Anwendung unter Windows nderungen in der WIN.INI-Datei vornimmt, so weiss vor einem Neustart von Windows keine andere Anwendung von den nderungen. Windows stellt nun ein API zur Verfgung, mittels dem alle Anwendungen dazu veranlasst werden knnen, die Eintrge der WIN. INI neu einzulesen. Const HWND_BROADCAST = &HFFFF Const WM_WININICHANGE = &H1A Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long Sub wininichangenotify () Dim i& i& = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, 0) End Sub Programmgesteuertes Booten In Setuproutinen oder bei Werkzeugen zum Umstellen von Grafikauflsungen ist es oft ntig, Windows neu zu starten, damit vorgenommene nderungen in Kraft treten. Manchmal ist es sogar unabdingbar, den Computer einem Warmstart zu unterziehen, um Treiberkonfigurationen oder hnliches zu aktivieren. Die folgende Routine lst das Problem durch ein Windows-API: Declare Function ExitWindows XE "ExitWindows"  Lib "User" (ByVal RestartCode As Long,ByVal DOSReturnCode As Integer) As Integer Sub ExitWin (ByVal nExitOption As Integer) Dim n As Integer n = MsgBox("Hiermit beenden Sie Ihre Windows-Sitzung", 65, "Windows beenden") If n = 2 Then Exit Sub 'Benutzer whlte Nein Select Case nExitOption Case 1 n = ExitWindows(67, 0) 'Warmstart des Computers Case 2 n = ExitWindows(66, 0) 'Windows neu starten Case 3 n = ExitWindows(0, 0) 'Windows verlassen End Select End Sub Folgende Aufrufe fhren zum entsprechenden Ziel: Warmstart des Computers : ExitWin 1 Windows neu starten : ExitWin 2 Windows verlassen : ExitWin 3 Screenshot Im folgenden sollen zwei ab und zu auftauchende Problemlsungen fr das Entwicklerleben aufgezeigt werden. Das erste Problem ist das bernehmen eines beliebigen Fensterinhaltes oder des gesamten Bildschirmes in ein Bildfeld von Visual Basic. Das zweite ist das Ausdrucken des Inhaltes eines Bildfeldes. Mit diesen beiden Funktionen zusammen erstellen wir dann ein Werkzeug, mit dem Bildschirm-Schnappschsse erstellt werden knnen. Um den Inhalt eines Fensters in ein Bildfeld zu bernehmen, bentigt man den Handle des entsprechenden Fensters (ber das API GetDesktopWindow) erhlt man den Handle des gesamten Bildschirms). Anhand dieses Handles bestimmt man den Quell-Devicekontext. Den Ziel-Devicekontext erhlt man ber die hDC-Eigenschaft des Bildfeldes. Mittels dem API BitBlt werden nun aus dem Quell-Devicekontext die Daten in den Ziel-Devicekontext bertragen. Damit alle Daten im Bildfeld Platz haben, wird es vorgngig noch auf die korrekte Grsse gebracht. Darauf bleibt nur noch den Quell-Devicekontext wieder freizugeben. Damit enthlt das Bildfeld den gewnschten Fensterinhalt. Es ist zu beachten, dass die Eigenschaft AutoRedraw des Bildfeldes auf True gesetzt ist! Type lrect Left As Integer Top As Integer right As Integer bottom As Integer End Type Declare Function GetDesktopWindow XE "GetDesktopWindow"  Lib "user" () As Integer Declare Function GetDC XE "GetDC"  Lib "user" (ByVal hWnd%) As Integer Declare Function BitBlt XE "BitBlt"  Lib "GDI" (ByVal hDestDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hScrDC%, ByVal XSrc%, ByVal YScr%, ByVal dwRop&) As Integer Declare Function ReleaseDC XE "ReleaseDC"  Lib "User" (ByVal hW_nd%, ByVal hDC%) As Integer Declare Sub GetWindowRect XE "GetWindowRect"  Lib "User" (ByVal hWnd%, lpRect As lrect) Sub Screenshot (pic As PictureBox, hwndSrc%) Dim hSrcDC% Dim XSrc%, YSrc% Dim nWidth%, nHeight% Dim X%, Y% Dim winSize As lrect Dim hDestDC% Dim dwRop& Dim suc%, dmy% XSrc% = 0 YSrc% = 0 X% = 0 Y% = 0 pic.Top = 0 pic.Left = 0 hSrcDC% = GetDC(hwndSrc%) GetWindowRect hwndSrc%, winSize nWidth% = winSize.right nHeight% = winSize.bottom hDestDC% = pic.hDC pic.Width = nWidth% * screen.TwipsPerPixelX pic.Height = nHeight% * screen.TwipsPerPixelY dwRop& = &HCC0020 suc% = BitBlt(hDestDC%, X%, Y%, nWidth%, nHeight%, hSrcDC%, XSrc%, YSrc%, dwRop&) dmy% = ReleaseDC(hwndSrc%, hSrcDC%) End Sub Nun knnen wir bereits mit dem Aufruf Screenshot me.picture1, hWnd% das durch den Handle hWnd% bestimmte Fenster in das Bildfeld picture1 laden. Der Ausdruck eines Bildfeldes gestaltet sich so, dass zunchst die Eigenschaft ScaleMode sowohl des Bildfeldes als auch des Druckers auf Pixel gesetzt wird, weil das API StretchBlt Pixel-Koordinaten verlangt. Darauf wird ein Speicherbereich bereitgestellt, um das Bild fr die Kopieraktion in den kompatiblen Devicekontext vorzubereiten. ber das API SelectObject wird das Objekt gespeichert. Mittels der Funktion StretchBlt wird nun das Bitmap vom Speicherbereich zum Drucker kopiert. Danach wird der Speicherbereich wieder freigegeben (Zuerst selektiert und dann gelscht). Die folgende Routine erledigt diese Aufgabe: Declare Function CreateCompatibleDC% Lib "GDI" (ByVal hDC%) Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%) 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&) Declare Function DeleteDC% Lib "GDI" (ByVal hDC%) Declare Function Escape% Lib "GDI" (ByVal hDC As Integer, ByVal nEscape As Integer, ByVal nCount As Integer, LpInData As Any, LpOutData As Any) Sub printPicture (pic As Control) Dim hMemoryDC% Dim hOldBitMap% Dim ApiError% Dim prWidth, prHeight Const SRCCOPY = &HCC0020 Const NEWFRAME = 1 Const PIXEL = 3 screen.MousePointer = 11 pic.Picture = pic.Image pic.ScaleMode = PIXEL printer.ScaleMode = PIXEL printer.Print " " If (printer.ScaleWidth - pic.ScaleWidth) < (printer.ScaleHeight - pic.ScaleHeight) Then prWidth = printer.ScaleWidth prHeight = printer.ScaleHeight * (pic.ScaleHeight / pic.ScaleWidth) Else prHeight = printer.ScaleHeight prWidth = printer.ScaleWidth * (pic.ScaleHeight / pic.ScaleWidth) End If hMemoryDC% = CreateCompatibleDC (pic.hDC) hOldBitMap% = SelectObject(hMemoryDC%, pic.Picture) ApiError% = StretchBlt(printer.hDC, 0, 0, prWidth, prHeight, hMemoryDC%, 0, 0, pic.ScaleWidth, pic.ScaleHeight, SRCCOPY) hOldBitMap% = SelectObject(hMemoryDC%, hOldBitMap%) ApiError% = DeleteDC(hMemoryDC%) ' Falls der Ausdruck nicht erfolgt, so entfernen Sie das Hochkomma ' in der folgenden Zeile! 'Debug.Print Escape(printer.hDC, NEWFRAME, 0, Null, Null) printer.EndDoc screen.MousePointer = 1 End Sub Nun ist es ein leichtes, unser Screenshot-Programm zu schreiben. Wir erzeugen eine Form die ein Bildfeld (Picture1) enthlt, dessen AutoRedraw-Eigenschaft auf True und dessen Visible-Eigenschaft auf False gesetzt ist. Dann erstellen wir noch eine Schaltflche (Command1) auf unserem Formular deren Caption-Eigenschaft wir auf Screenshot setzen. Die Form knnen wir so anpassen, dass sie genau dieselbe Grsse wie die Schaltflche hat. In das Click-Ereignis der Schaltflche schreiben wir nun noch folgenden Code: Sub Command1_Click () Dim SrcHwnd% Me.Visible = False DoEvents SrcHwnd% = GetDesktopWindow() Screenshot Me.Picture1, SrcHwnd% printPicture Me.Picture1 Me.Visible = True End Sub Kompilieren Sie das Programm und starten Sie es ausserhalb der Visual Basic-Entwicklungsumgebung. Die Form sorgt selbst dafr, dass sie nicht auf dem Screenshot angezeigt wird. Andreas Grob ist Ing. HTL Inf. und arbeitet als Programmierer/Analytiker bei der Firma Neuro Media AG MS-DOS-Text in Windows-Text umwandeln Der ANSI/ISO Zeichensatz von Windows weicht in den Zeichen ber 127 stark vom PC-Zeichensatz ab. Dies erfahren deutschsprachige Anwender sehr schmerzhaft weil vorallem die schon aus frheren PC-Zeiten berchtigten Umlaute wieder fr Schwierigkeiten sorgen. Ein mit dem DOS-Editor Edit verfasster deutscher Text artet recht schnell in einen Hieroglyphen-Marathon aus. Zur Umwandlung bietet das Windows-API die Hand. Die Funktion OemToAnsi XE "OemToAnsi"  wandelt eine bergbebene Zeichenkette vom PC-Zeichensatz in den ANSI/ISO Zeichensatz von Windows um, whrend AnsiToOem XE "AnsiToOem"  die Rckumwandlung vornimmt. Beide Funktionen bentigen zwei Parameter wovon der erste die umzuwandelnde Zeichenkette und der zweite die Zielzeichenkette ist. Wie bei APIs mit Zeichenketten blich muss die Zielzeichenkette mit der zurckerwarteten Anzahl Zeichen gefllt sein, weil APIs nicht auf das Speichermanagement von Visual Basic zugreifen und einfach voraussetzen, dass der entsprechende Speicherplatz fr die Zeichenkette zur Verfgung steht. Das folgende allgemeine Modul ermglicht die Umwandlung. Declare Function AnsiToOem XE "AnsiToOem"  Lib "Keyboard" (ByVal lpAnsiStr As String, ByVal lpOemStr As String) As Integer Declare Function OemToAnsi XE "OemToAnsi"  Lib "Keyboard" (ByVal lpOemStr As String, ByVal lpAnsiStr As String) As Integer Function AnsiZuOem(Quelltext$) As String Dim i%, Res$ Res$ = String$(Len(Quelltext$), " ") i% = AnsiToOem(Quelltext$, Res$) AnsiZuOem = Res$ End Function Function OemZuAnsi(Quelltext$) As String Dim i%, Res$ Res$ = String$(Len(Quelltext$), " ") i% = OemToAnsi(Quelltext$, Res$) OemZuAnsi = Res$ End Function Hoch-/Querformat-Umstellung per Programm Die einfachste Mglichkeit, den Drucker von Hoch- auf Querformat umzustellen ist die, es dem Benutzer zu berlassen. ber den Standarddialog um den Drucker zu konfigurieren kann der Benutzer beliebige Druckereinstellungen selbst vornehmen. Um diese Mglichkeit zu nutzen muss man lediglich ber das Men File/Add File die Datei CMDIALOG.VBX einbinden, ein Common Dialog Steuerelement auf einem Formular erstellen und dessen Action-Eigenschaft bei Bedarf auf 5 (Printerdialog) setzen. Leider hat dies nun aber auch Nachteile: - Die Wiederherstellung der ursprnglichen Druckerkonfiguration ist nicht mglich. - Die Einstellung wirkt sich auf alle Programme aus, die den Standarddrucker benutzen. - Der Benutzer muss die Einstellung jedesmal manuell vornehmen. Auf der Suche nach einem Weg, der oben genannte Nachteile nicht aufweist, stolperte ich im API -Dschungel ber die Funktion ResetDC. Diese Funktion erlaubt es gezielt auf die Druckerkonfiguration Einfluss zu nehmen, ohne dass der Benutzer hinzugezogen werden msste. Ausserdem bietet es folgende Vorteile: - Die Umstellung kann von einer Seite zur anderen innerhalb desselben Dokumentes erfolgen. - Die Umstellung gilt nur bis zum Ende des aktuellen Dokumentes (EndDoc). - Die Umstellung wirkt sich nicht auf andere Programme aus. Ich habe ein Modul mit zwei Routinen zusammengestellt, das die Umstellung des Druckers auf Hoch- rsp. auf Querformat ermglicht. Um es einzugeben ffnen Sie zuerst ein neues Modul und definieren im Deklarationsteil folgenden Typ: Type DEVMODE ' 68 Bytes dmDeviceName As String * 32 dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmpapersize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmdefaultsource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer End Type Diese Struktur nimmt die Konfiguration des Druckers auf. Dabei nimmt die Variable dmFields eine Sonderstellung ein, denn ber diese Variable wird festgelegt, welche Einstellungen der Struktur bercksichtigt werden sollen. Dies ermglicht es einzelne Einstellungen vorzunehmen, ohne die fr die restlichen Parameter bentigten Werte zu kennen. Nun wird noch das API selbst deklariert: Declare Function ResetDC XE "ResetDC" % Lib "GDI" (ByVal hDC%, lpdm As DEVMODE) Darauf geben Sie die beiden Prozeduren Hochformat und Querformat ein: Sub Querformat () Dim dm As DEVMODE Dim i% dm.dmOrientation = 2 ' Setzt Querformat dm.dmFields = dm.dmFields Or 1 ' Flag DM_ORIENTATION i% = ResetDC%(printer.hDC, dm) End Sub Sub Hochformat () Dim dm As DEVMODE Dim i% dm.dmOrientation = 1 ' Setzt Hochformat dm.dmFields = dm.dmFields Or 1 ' Flag DM_ORIENTATION i% = ResetDC XE "ResetDC" %(printer.hDC, dm) End Sub Nun knnen Sie in Ihrem Programm durch Aufruf der entsprechenden Prozedur den Drucker temporr auf die gewnschte Papierorientation umstellen. Drucker umschalten Manchmal kommt es vor, dass der geplagte Programmierer sich vor dem Problem sieht, von seinem Programm aus auf einen anderen Drucker umzuschalten. Leider bietet Visual Basic nicht die Befehle Setz_Standarddrucker und Lies_Standarddrucker. Also mssen wir sie selbst schreiben. Zuerst noch ein Theorieblock der aber ganz kurz gehalten ist. Der Standarddrucker wird durch den Eintrag Device in der Sektion [windows] der Datei WIN.INI spezifiziert. Will man nun den Standarddrucker ndern, so muss man diesen Eintrag ndern und um die nderung zu aktivieren, muss dem System noch bekanntgegeben werden, dass eine nderung stattgefunden hat. Die Drucker, die auf dem System installiert worden sind, befinden sich in der Datei WIN.INI in der Sektion [devices]. In dem Programm das wir nun erstellen, sollen alle mglichen Drucker in einer Liste aufgefhrt werden und durch Auswahl des entsprechenden Druckers und Klick auf eine Schaltflche soll der Standarddrucker festgelegt werden. Erstellen Sie nun ein Formular das wie folgt aussieht: Nun deklarieren Sie die bentigten Windows API Funktionen im generellen Teil des Formulars: ' Windows API Funktionen Declare Function GetProfileString XE "GetProfileString"  Lib "Kernel" (ByVal AppName$, ByVal KeyName As Any, ByVal Default$, ByVal ReturnedString$, ByVal nSize%) Declare Function WriteProfileString XE "WriteProfileString"  Lib "Kernel" (ByVal AppName$, ByVal KeyName$, ByVal lpString$) Declare Function PostMessageByString XE "PostMessageByString"  Lib "User" Alias "PostMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam$) ' Windows API Konstanten Const HWND_BROADCAST = &HFFFF Const WM_WININICHANGE = &H1A Das API GetProfileString liest aus der Datei WIN.INI den Wert des Topics in der gewnschten Sektion aus whrend WriteProfileString den Wert entsprechend setzt. Das API PostMessageByString wird dazu benutzt, um das System ber die nderung der Datei WIN.INI zu informieren, sodass die Werte der angegebenen Sektion neu eingelesen werden. Nun erstellen wir die Funktion Lies_Standarddrucker, die uns den Wert des Topics device aus der Sektion [windows] der Datei WIN.INI liefert: Function Lies_Standarddrucker$ () Dim temp$, res% 'Herausfinden welcher Drucker als Standarddrucker definiert ist temp$ = String$(255, 0) res% = GetProfileString("windows", "device", "", temp$, Len(temp$)) Lies_Standarddrucker$ = temp$ End Function Die Prozedur Setz_Standarddrucker setzt den Topic device aus der Sektion [windows] der Datei WIN.INI auf den bergebenen Wert: Sub Setz_Standarddrucker (Drucker$) Dim res% ' Neuen Defaultdrucker in die Win.INI schreiben und das System ' ber die nderung informieren res% = WriteProfileString("windows", "device", Drucker$) res% = PostMessageByString XE "PostMessageByString" (HWND_BROADCAST, WM_WININICHANGE, 0, "windows") End Sub Damit sind unsere neuen Befehle bereits fertig. Wir wollen nun die Liste der verfgbaren Drucker in unsere Listbox List1 einlesen. Dies soll die Prozedur Lies_Druckerliste erledigen: Sub Lies_Druckerliste (Druckerliste As ListBox) Dim res%, Drucker$, temp$, Alle_Drucker$ Druckerliste.clear Alle_Drucker$ = String$(4096, 0) res = GetProfileString("devices", 0&, "", Alle_Drucker$, Len(Alle_Drucker$)) If res <> 0 Then Do Drucker$ = Left$(Alle_Drucker$, InStr(Alle_Drucker$, Chr$(0)) - 1) Alle_Drucker$ = Mid$(Alle_Drucker$, InStr(Alle_Drucker$, Chr$(0)) + 1) ' Eintrge fr den entsprechenden Drucker auslesen temp$ = String$(255, 0) res% = GetProfileString("devices", Drucker$, "", temp$, Len(temp$)) Druckerliste.AddItem Drucker$ + "," + temp$ Loop Until Left$(Alle_Drucker$, 1) = Chr$(0) End If End Sub Dadurch, dass in dem ersten Aufruf des APIs GetProfileString XE "GetProfileString"  als zweiter Parameter der Wert 0& bergeben wird, liefert das API alle vorhandenen Topics der angegebenen Sektion zurck. Die einzelnen Topics sind jeweils durch ein CHR$(0) voneinander getrennt. In der Schleife werden nun die einzelnen Werte der Topics in die bergebene Listbox abgefllt. Nun mssen wir dafr sorgen, dass beim Progammstart die Prozedur Lies_Druckerliste ausgefhrt wird. Ausserdem soll der Standarddrucker angezeigt werden und die Liste auch auf den Standarddrucker positioniert werden: Sub Form_Load () Dim i% Lies_Druckerliste list1 label2.Caption = Lies_Standarddrucker$() For i% = 0 To list1.ListCount - 1 If list1.List(i%) = label2.Caption Then list1.ListIndex = i% Exit For End If Next i% End Sub Zu guter Letzt schreiben wir im Click-Ereignis der Schaltflche folgenden Code: Sub Command1_Click () Setz_Standarddrucker (list1) label2.Caption = Lies_Standarddrucker$() End Sub Damit knnen wir mit unserem Programm den Standarddrucker entsprechend der verfgbaren Drucker selbst umstellen und nach Herzenslust drucken. Containerobjekte zwischen Formularen verschieben Eine Rosine im API-Kuchen von Windows stellt die Funktion SetParent dar. Mittels dieser Funktion kann man Steuerelemente modularisieren. Visual Basic verfgt ber sogenannte Containerobjekte. Ein Containerobjekt ist ein Steuerelement innerhalb dem man weitere Steuerelemente plazieren kann. Containerobjekte erkennt man daran, dass bei dessen Veschiebung die darin enthaltenen Steuerelemente mit verschoben werden. So sind z.B. der Rahmen und das Picture Containerobjekte. In Visual Basic sind Containerobjekte selbstndige Fenster mit eigenem Fensterhandle. Sie besitzen ausserdem ein bergeordnetes Fenster (Parent), nmlich das Formular (auch ein Fenster) innerhalb dem sie sich befinden rsp. angezeigt werden. Damit ist Endstation fr Visual Basic. Nun kommt aber Windows zum Zug, denn es liefert ein API, das es ermglicht festzulegen, welches Fenster das bergeordnete Fenster sein soll. Damit hat man eine Mglichkeit Containerobjekte zwischen Formularen zu verschieben und somit steht einer Modularisierung von Containerobjekten nichts mehr im Weg. Als Beispiel fr ein allgemein nutzbares Containerelement wollen wir eine Uhr erstellen, die immer im aktiven Formular links oben angezeigt werden soll. Als Containerelement benutzen wir einen Rahmen. Erstellen Sie also in Visual Basic ein neues Projekt und plazieren Sie in der Form1 einen Rahmen (Frame1) in der linken oberen Ecke. In diesem Rahmen erzeugen Sie ein Bezeichnungsfeld (Label1). Damit haben wir das Containerobjekt mit seinem Inhalt erzeugt. Nun erstellen wir ein neues Modul und deklarieren im generellen Teil das API SetParent: Declare Function SetParent XE "SetParent" % Lib "User" (ByVal hWndChild%, ByVal hWndNewParent%) Im gleichen Modul schreiben wir nun die Prozedur ZeigUhr, die nichts anderes tut, als das bergebene Formular zum Parent des Containerobjektes Frame1 zu machen.. Sub ZeigUhr (frm As Form) Dim Res As Integer Res = SetParent(Form1.Frame1.hWnd, frm.hWnd) End Sub Nun erzeugen Sie ein zweites Formular (Form2). Sobald dieses Formular aktiviert wird, so soll die Uhr auf diesem Formular angezeigt werden. Also schreiben Sie fr die Form2 folgende Ereignisprozedur: Sub Form_Activate () ZeigUhr Me End Sub Hier bleibt noch zu bemerken, dass das Schliessen eines Formulars, das nicht der echte Parent eines enthaltenen Containerobjektes ist fatale Folgen hat. Deshalb muss das Formular Form2 noch mit folgender Ereignisprozedur ergnzt werden, die dafr sorgt, dass beim Entladen des Formulars das Containerobjekt wieder auf das richtige Formular gesetzt wird. Sub Form_Activate () ZeigUhr Me End Sub Damit nun bei der Rckkehr auf das erste Formular die Uhr wieder zurckkehrt, schreiben Sie fr das Formular Form1 dieselbe Ereignisprozedur Form_Activate wie fr das Formular Form2: Sub Form_Activate () ZeigUhr Me End Sub Jetzt mssen Sie noch dafr sorgen, dass das zweite Formular angezeigt wird, z.B. indem Sie folgende Ereignisprozedur fr das Formular Form1 schreiben: Sub Form_Load () Form2.Show End Sub Nun fehlt uns nur noch unsere Uhr. Dazu erzeugen Sie auf dem Formular Form1 einen Zeitmesser (Timer1) und stellen dessen Eigenschaft Interval auf 1000 (entspricht einer Sekunde). Fr den Zeitmesser schreiben Sie folgende Ereignisprozedur die dem Bezeichnungsfeld in unserem Containerobjekt die aktuelle Uhrzeit zuweist. Sub Timer1_Timer () label1.Caption = Time End Sub Beachten Sie hierbei, dass egal welches Fenster gerade das Parentfenster eines Containerobjektes ist, es immer nur ber das Formular in dem es zur Entwicklungszeit erstellt wurde angesprochen wird. Nun knnen Sie das Programm starten und durch abwechselndes Anklicken der zwei Formen feststellen, wie die Uhr sich immer im aktiven Formular befindet. Jedes weitere Formular, welches ebenfalls die Uhr darstellen soll muss einfach dieselben Ereignisprozeduren enthalten wie unser Formular Form2. Damit steht einer allgemeinen Verwendung von Containerelementen nichts mehr im Weg. Es ist sogar denkbar eigene Containerelemente in fremden Fenstern zu plazieren. Dazu msste lediglich der Handle des fremden Fensters bestimmt werden... Shell modal Ein sehr hufiges Problem fr den Visual Basic Programmierer ist das Multitasking von Windows. Dies vor allem dann, wenn es eigentlich unerwnscht ist. Mchte man z.B. mit Visual Basic ein Programm schreiben, das mittels dem MS-DOS-Programm PKZIP.EXE Dateien komprimieren, dann die Grsse der komprimierten Datei bestimmen und falls die Dateilnge grsser ist als eine Diskette in einem Meldungsfenster diesen Umstand anzeigen soll, dann ist das leider mit Windows nicht so einfach zu realisieren. Man kann zwar PKZIP.EXE mit dem Befehl SHELL aufrufen, aber dann fhrt das Programm weiter bevor PKZIP.EXE seine Arbeit beendet hat. Das Ziel ist es nun dafr zu sorgen, dass das aufrufende Programm auf den Abschluss des aufgerufenen Programmes wartet bis es weiterfhrt wie etwa ein modales Dialogfenster. Um dies zu erreichen bentigen wir das Windows-API GetModuleUsage. Dieses API liefert einen Wert zurck, der aussagt wie oft das spezifizierte Modul geladen wurde. Die Deklaration des APIs lautet: Declare Function GetModuleUsage XE "GetModuleUsage"  Lib "KERNEL" (ByVal InstanceID%) As Integer Nun fehlt uns nur noch der ominse bergabeparameter InstanceID%. Dabei handelt es sich um den Handle der das entsprechende Modul spezifiziert. Unter einem Modul ist brigens eine beliebige ausfhrbare Datei oder dynamische Linkbibliothek (DLL) zu verstehen. InstanceID% soll nun also unser aufgerufenes Programm spezifizieren. Nun ist es so, dass der Visual Basic Befehl SHELL mit dem wir das Programm starten als Rckgabewert gerade den Handle des gestarteten Programmes liefert. Dadurch bentigen wir kein weiteres API das uns den bentigten Handle liefert. Die folgende Prozedur dient als allgemeiner Ansatz das Problem zu lsen: Sub ShellModal (Kommandozeile$) Dim Temp%,InstanceID% InstanceID% = Shell(Kommandozeile$, 3) Do Temp% = DoEvents() Loop Until GetModuleUsage(InstanceID%) = 0 End Sub Das Programm erwartet als bergabeparameter die Kommandozeile um das gewnschte Programm zu starten. Selbstverstndlich funktioniert das Programm nicht nur bei DOS-Programmen sondern auch bei Windows-Programmen. In der Variablen InstanceID% wird der Modul-Handle des gestarteten Programmes gespeichert. In einer DoEvents-Schleife wird darauf gewartet, dass der Rckgabewert von GetModuleUsage 0 betrgt. Erst dann wird die Prozedur beendet. Mauszeiger verstecken Windows bietet ein API um den Mauszeiger anzuzeigen oder zu verstecken. Manche Abstrze von Programmen lassen gleich auch den Mauszeiger verschwinden. Es bleibt nichts anderes brig, als Windows zu beenden und wieder zu starten um den Mauszeiger wieder anzuzeigen. Nicht so, wenn man ein Programm schreibt, welches den Mauszeiger wieder einschaltet. Genauso kann es unter Umstnden erwnscht sein, den Mauszeiger zu verstecken wie z.B. bei einem Bildschirmschoner. Mit der folgenden Routine lassen sich beide Varianten realisieren. Declare Function ShowCursor XE "ShowCursor"  Lib "User" (ByVal bShow As Integer) As Integer Const Ein = True Const Aus = False Sub Mauszeiger (Modus%) Dim i% i% = ShowCursor XE "ShowCursor" (Modus%) End Sub Durch den Aufruf Mauscursor Ein kann nun der Mauszeiger eingeschaltet werden, mit Mauscursor Aus kann er ausgeschaltet werden. Schriften vertikal ausgeben Auch wenn man sich im allgemeinen nicht mit den komplizierten Ausgabemechanismen fr Schriftarten unter Windows auseinandersetzten mchte, kommt man manchmal gar nicht darum herum. Ich wollte ein Zeichenprogramm erstellen mit einem vertikalen Lineal links. In den Programmen, die ich als Vorbild genommen hatte, war das Lineal vertikal beschriftet. Visual Basic ermglicht standardmssig nur die horizontale Zeichenausgabe. Um trotzdem in der Lage zu sein, meinem Lineal einen professionellen Touch zu geben, strzte ich mich in die Tiefen der Windows-APIs um Schriftarten vertikal auszugeben. Dabei hatte ich zwei wichtige Erkenntnisse: - Rasterschriften knnen nicht rotiert werden (Alle TrueType-Schriften knnen rotiert werden) - Die Funktionalitt der Eigenschaft AutoRedraw von Bildfeldern muss speziell behandelt werden, da die Windows-APIs ihre Informationen nicht automatisch in das von Visual Basic gespeicherte Bitmap bertragen. Ansonsten befolgte ich die Schritte eine Schriftart auszugeben, wie sie in der einschlgigen Fachliteratur beschrieben sind. So zaubert man nach Schema F jede TrueType-Schrift in der gewnschten Art und Weise auf den Bildschirm oder falls gewnscht auf den Drucker, wenn statt dem Bildfeld das Druckerobjekt Printer angegeben wird. Um die Schrift zu rotieren, bentigt man nur die Strukturvariable lfEscapement aus der Struktur LOGFONT. Diese nimmt den gewnschten Winkel auf, um den die Schrift rotiert werden soll und zwar in 1/10 von 0 bis 3600. Um den Text vertikal auszugeben, muss lfEscapement auf 900 gesetzt werden. Wichtig ist noch, dass die Ausgabekoordinaten sich auf die linke obere Ecke des nicht rotierten Textes bezieht. Ist der Text jedoch um 90 Grad rotiert, so ist dies die Ecke links unten! Damit kann der Text bereits vertikal ausgegeben werden. Ein Bildfeld, das ein Lineal enthlt, hat nun aber mit Vorteil die Eigenschaft AutoRedraw eingeschaltet, um ein mglichst schnelles Bildschirmrollen zu ermglichen. Ist die Eigenschaft AutoRedraw true, dann werden alle ber Visual Basic Methoden ausgegebenen Informationen in einen Zwischenspeicher transferiert, und erst dann wird dieser in das Bildfeld bertragen. Da das API TextOut an diesem Mechanismus vorbeiluft muss man sich eines Tricks bedienen, um die angezeigten Informationen in den Zwischenspeicher zu speichern. Bei einem Bildfeld bezeichnet die Eigenschaft Image das sichtbare Bild und die Eigenschaft Picture das von Visual Basic zwischengespeicherte Abbild. Indem nun die Eigenschaft Image der Eigenschaft Picture zugewiesen wird, wird das Abbild entsprechend dem sichtbaren Bild aktualisiert. Mit dem folgenden allgemeinen Modul kann Text vertikal ausgegeben werden. Der Aufruf lautet wie folgt: WriteVertical (PicText as PictureBox, X!, Y!, Text$) Parameter: PicText: Bildfeld, in dem der Text ausgegeben werden soll X! : X-Koordinate der linken unteren Ecke des auszugebenden Textes Y! : Y-Koordinate der linken unteren Ecke des auszugebenden Textes Text$ : Text der vertikal ausgegeben werden soll Die Prozedur bercksichtigt automatisch die Einstellung der AutoRedraw-Eigenschaft des bergebenen Bildfeldes. Schritt fr Schritt Anleitung: Erstellen Sie ein neues Projekt und erzeugen Sie in der Form das Bildfeld Picture1, das den gewnschten Text anzeigen soll. Setzen Sie die Eigenschaft ScaleMode des Bildfeldes auf Pixels (3) und whlen Sie als FontName eine TrueType-Schriftart. Daneben erzeugen Sie eine Schaltflche Command1. Wenn diese Schaltflche angeklickt wird, soll der Text Hallo in dem Bildfeld ausgegeben werden. Dazu schreiben Sie folgenden Code in die entsprechende Ereignisroutine der Form1: Sub Command1_Click () WriteVertical picture1, 1, picture1.ScaleHeight - 1, "Hallo" End Sub Dann erstellen Sie ein Modul und fgen folgenden Code in das Modul ein (Tip: kopieren Sie die Konstanten, Typen und Deklarationen aus der Hilfedatei WIN31API.HLP im Unterverzeichnis WINAPI von Visual Basic): Global Const LF_FACESIZE = 32 Type TEXTMETRIC tmHeight As Integer tmAscent As Integer tmDescent As Integer tmInternalLeading As Integer tmExternalLeading As Integer tmAveCharWidth As Integer tmMaxCharWidth As Integer tmWeight As Integer tmItalic As String * 1 tmUnderlined As String * 1 tmStruckOut As String * 1 tmFirstChar As String * 1 tmLastChar As String * 1 tmDefaultChar As String * 1 tmBreakChar As String * 1 tmPitchandFamily As String * 1 tmCharSet As String * 1 tmOverhang As Integer tmDigitizedAspectX As Integer tmDigitizedAspectY As Integer End Type Type logfont lfHeight As Integer lfWidth As Integer lfEscapement As Integer lfOrientation As Integer lfWeight As Integer lfItalic As String * 1 lfUnderline As String * 1 lfStrikeOut As String * 1 lfCharSet As String * 1 lfOutPrecision As String * 1 lfClipPrecision As String * 1 lfQuality As String * 1 lfPitchandFamily As String * 1 lfFaceName As String * LF_FACESIZE End Type Type rect left As Integer top As Integer right As Integer bottom As Integer End Type Declare Function CreateFontIndirect XE "CreateFontIndirect"  Lib "GDI" (lpLogFont As logfont) As Integer Declare Function DeleteObject XE "DeleteObject"  Lib "GDI" (ByVal hObject As Integer) As Integer Declare Sub GetClientRect XE "GetClientRect"  Lib "User" (ByVal hWnd As Integer, lpRect As rect) Declare Function SelectObject XE "SelectObject"  Lib "GDI" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer Declare Function TextOut XE "TextOut"  Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal lpString As String, ByVal nCount As Integer) As Integer Declare Function GetTextMetrics XE "GetTextMetrics"  Lib "GDI" (ByVal hDC As Integer, lpMetrics As TEXTMETRIC) As Integer Sub WriteVertical (PicText As PictureBox, X!, Y!, Text$) Dim tm As TEXTMETRIC Dim r$ Dim crlf$ Dim oldfont% Dim tbuf As String * 80 Dim FontToUse% Dim lf As LOGFONT Dim oldhdc% Dim rc As RECT Dim di% di% = GetTextMetrics(PicText.hDC, tm) crlf$ = Chr$(13) + Chr$(10) If FontToUse% <> 0 Then di% = DeleteObject(FontToUse%) lf.lfHeight = tm.tmHeight * 1.1 lf.lfWidth = tm.tmAveCharWidth * .9 lf.lfEscapement = 900 lf.lfWeight = tm.tmWeight lf.lfItalic = tm.tmItalic lf.lfUnderline = tm.tmUnderlined lf.lfStrikeOut = tm.tmStruckOut lf.lfOutPrecision = Chr$(0) lf.lfClipPrecision = Chr$(0) lf.lfQuality = Chr$(0) lf.lfPitchAndFamily = tm.tmPitchAndFamily lf.lfCharSet = tm.tmCharSet lf.lfFaceName = PicText.FontName + Chr$(0) FontToUse% = CreateFontIndirect(lf) If FontToUse% = 0 Then Exit Sub oldhdc% = SelectObject(PicText.hDC, FontToUse%) GetClientRect PicText.hWnd, rc di% = TextOut(PicText.hDC, X!, Y!, (Text$ + Chr$(0)), Len(Text$)) di% = SelectObject(PicText.hDC, oldhdc%) If FontToUse% <> 0 Then di% = DeleteObject(FontToUse%) If PicText.AutoRedraw Then PicText.Picture = PicText.Image End Sub Wenn Sie nun das Programm starten und auf die Befehlsschaltflche klicken wird im Bildfeld vertikal Hallo ausgegeben, vorausgesetzt die Eigenschaft FontName des Bildfeldes enthlt den Namen einer Vektorschrift (Rasterschriften knnen nicht rotiert werden). Hotkey Es ist mit einem Visual Basic Programm sehr komfortabel mglich die Tastatur zu berwachen, solange das Programm den Focus besitzt. Aber wehe es sollen auch Tastendrcke abgefangen werden, wenn das Programm den Focus nicht hat. Angenommen es stellt sich das Problem, dass eine Visual Basic Adressverwaltung resident geladen ist und mittels der Tastenkombination Ctrl+A aufgerufen werden soll, wenn man z.B. in Write einen Brief erfasst, so hat man Mhe dies mit Visual Basic Bordmitteln zu realisieren. Hierbei hilft das Windows-API GetAsyncKeyState. Mit diesem API kann bestimmt werden, ob seit dem letzten Aufruf von GetAsyncKeyState eine bestimmte Taste gedrckt worden ist, und ob diese Taste im Augenblick gerade noch gedrckt ist. Die Definition des API lautet: Declare Function GetAsyncKeyState Lib User (ByVal vKey%) Das API bentigt als Parameter den virtuellen Tastenkode dessen Status berprft werden soll. Die entsprechenden Konstanten beginnen mit VK_... und Sie finden die Konstanten in der Hilfedatei win31api.hlp unter Global Constants. Der Rckgabewert des API hat das Bit 0 gesetzt, wenn die Taste seit dem letzten Aufruf von GetAsyncKeyState gedrckt wurde und das Bit 15 ist gesetzt, wenn die Taste im Augenblick der Abfrage gedrckt war. Im folgenden Beispiel soll ein Formular per Hotkey falls es minimiert ist wieder geffnet werden und falls es unsichtbar ist wieder angezeigt werden. Mittels zwei Kombinationslisten kann der gewnschte Hotkey ausgewhlt werden, wobei die Listen nur eine Auswahl der mglichen Tastenkodes enthalten. ber ein Timer-Steuerelement wird alle 500 Millisekunden das API GetAsyncKeyState aufgerufen und falls die Tasten gedrckt wurden das Formular angezeigt: Erstellen Sie ein Formular das zwei Kombinationslisten Combo1 und Combo2 ,eine Schaltflche Command1 und einen Timer Timer1 enthlt, dessen Intervall z.B. auf 500 eingestellt ist (siehe Bild 1). Geben Sie nun das Listing 1 ein. Declare Function GetAsyncKeyState XE "GetAsyncKeyState"  Lib "User" (ByVal vKey As Integer) As Integer Sub Add2Combo (cmb As combobox, inhalt$, wert%) cmb.AddItem inhalt$ cmb.itemdata(cmb.newindex) = wert% End Sub Sub Form_Load () Dim i% Add2Combo Combo1, "(keine)", &H0 Add2Combo Combo1, "Shift", &H10 Add2Combo Combo1, "Ctrl", &H11 Add2Combo Combo1, "Alt", &H12 Combo1.ListIndex = 0 For i% = Asc("A") To Asc("Z") Add2Combo Combo2, Chr$(i%), i% Next i% For i% = 1 To 24 Add2Combo Combo2, "F" & Format$(i%), 111 + i% Next i% Combo2.ListIndex = 0 End Sub Sub Timer1_Timer () Dim ctrl%, taste% If Me.Combo1.ItemData(Me.Combo1.ListIndex) = 0 Then ctrl% = 1 Else ctrl% = GetAsyncKeyState(Me.Combo1.ItemData(Me.Combo1.ListIndex)) End If taste% = GetAsyncKeyState(Me.Combo2.ItemData(Me.Combo2.ListIndex)) If ctrl% <> 0 And taste% <> 0 Then Me.Show If Me.WindowState = 1 Then Me.WindowState = 0 End If End If End Sub Sub Command1_Click () Me.Hide End Sub Debug-Fenster lschen Wie komfortabel ist es doch ber den Befehl Debug.Print Debugginginformationen im Debugfenster auszugeben. Doch nach ein zwei Lufen steht man bald einmal vor dem Problem, welche Ausgaben zum vorhergehenden Lauf und welche zum aktuellen gehren. Natrlich kann man jedesmal vor Programmstart den Inhalt des Debugfensters markieren und mit der Deletetaste lschen. Doch wer denkt schon jedesmal daran. Also soll die Arbeit doch vom Programm bernommen werden! Die folgende kleine Routine bernimmt die Aufgabe. Wird sie z.B. im Form_Load-Ereignis aufgerufen, so lscht sie den gesamten Inhalt des Debugfensters. Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer Declare Function SendMessage XE "SendMessage"  Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long Declare Function GetWindow Lib "User" (ByVal hWnd%, ByVal wCmd%) As Integer Sub Debug_Clear () Dim hWndVB%, hWndDebug%, res% ' bestimmen des Handles des Debug-Fensters (Fensterklasse = OFEDT) hWndVB% = FindWindow("OFEDT", 0&) ' Wurde das Fenster nicht gefunden luft das Programm nicht in der ' Entwicklungsumgebung If hWndVB% = 0 Then Exit Sub ' bestimmen des Handles des Kindfensters (Das Textfenster des Debug-Fensters) hWndDebug% = GetWindow(hWndVB%, 5) ' Wurde kein Fensterhandle gefunden, existiert das Debug-Fenster nicht If hWndDebug% = 0 Then Exit Sub ' Text des Debug-Fensters auf eine Nullzeichenkette setzen res% = SendMessage(hWndDebug%, &HC, 0, 0&) End Sub Inhalt Beispieldiskette Verzeichnis Beschreibung API Funktion 1. Anltng Beschreibung der API Funktionen 2. Bitblt Grafische Anzeige von Bitmaps BitBlt StretchBlt 3. Clipreg Bestimmte Bereiche in einer Form mit Grafik fllen SelectClipRgn GetClientRect CreateEllipticRgnIndirect 4. Cursor Cursorform auf Knopfdruck ndern GlobalLock GlobalUnLock CreateCursor GetWindowWord SetClassWord GetClassWord GetBitmapBits 5. Devcont Form oder Printer Context anzeigen GetDeviceCaps 6. Dragdrop Beispiel von Drag and Drop DragAcceptFiles PeekMessage DragQueryFile DragFinish 5. Drucker2 Aktuellen Drucker wechseln GetProfileString GetPrivateProfileString WriteProfileString WritePrivateProfileString 6. Exeicon Programme ber VB Form ausfhren GetModuleUsage 7.Fltask Alle Objekte auf dem Bildschirm in Bewegung bringen GetWindow GetWindowText GetWindowTextLength GetDeviceCaps FindWindow MoveTo MoveWindow 8. Font Informationen ber Schriftarten anzeigen SetMapMode GetMapMode 9. Log Texteditor um kleinere Textdateien zu editieren GetModuleFileName GetClassWord GetActiveWindow isWindow GetWindowTask 10. Lstsuch Schnelles suchen nach einem Eintrag in einer List Box SendMessage GetCurrentTime 11. Maskdemo Zwei Bitmaps bereinander in neuen Bereich kopieren BitBlt 12. Menu Darstellen von Bitmaps in einem Menu GetMenu GetsubMenu GetMenuItemID ModifyMenu GetMenuItemBitmaps 13. Nomdi Beispiel einer Toolbox die immer im Vordergrund bleibt SetParent 14. Puzzle Aus einem bestehenden Bitmap wird ein Puzzle erstellt GetObjectAPI CreateDIBitmap CreatePatternBrush GetClientRect CreateCompatibleDC StretchBlt PatBlt SelectObject 15 Q2\Drucker Feststellen was fr Drucker zur Verfgung stehen und den Default wechseln GetProfileString WriteProfileString PostMessageByString 16 Q2\handle Feststellen welche Windows Applikationen aktiv sind und Informationen ber diese Applikationen anzeigen GetParent GetWindow GetWindowWord FlashWindow GetModuleFileName GetClassName GetDeskTopWindow ShowWindow ApiSetFocus 17 Q2\Point Zeigt die Adresse einer Variablen im Speicher an PointerToObject DeRefString 18 Q3\Sysinfo Liefert System Informationen RemoveMenu GetVersion GetNumTasks GetFreeSpace GetCurrentTime GetSubMenu GetSystemMenu GetWinFlags 19. Setparent Bewegt ein Frame von einer Form in eine andere SetParent 20. Sysinfo Zeigt System Informationen an GetWinFlags GetFreeSystemResources GetFreeSpace 21. Task Anzeigen der aktiven Applikationen GetWindow GetWindowText GetWindowTextLength 22. Textvert Schrift vertikal darstellen DeleteObject CreateFontIndirect GetClientRect SelectObject TextOut GetTextMetrics 23. Tools\Apix Zusammenfassung aller API Funktionen GetFocus SendMessage 24. Top Form die immer im Vordergrund bleibt GetVersion SetWindowPos 25. Waitdos Dos Befehle ausfhren GetModuleUsage Neuro Media AG API Kurs 14. Dezember 1994 ( 01 715 43 33 / FAX: 01 715 43 40 Seite  SEITE 1 .A.A .Aࡱ> SummaryInformation(@xJv@+k@Microsoft Word 6.02ࡱ> +,@AXYrstv 56MNghikCD[\uvwyGH_`yz{} uD[[ uDU[U[[c\+,EFGIef}~679;ef}~  1 2 K L N P ] ^ u v   1 2 4 6 > ? V W p q s u [ uD[b        9 : ; W X Y   %&=>,-AB`a9 : O P !!Y#Z###&&&&&&(((())++++,,#.$.).5.C]c]cC uDC uDc uDUcUcc uDU[ uD[R5.7.8.6/7/J/K/[0\0 1 11 1o1p111 2!2X4Y4r4s4555555;7<7S7T7Z9[9_9V;W;$=%=7=8=AAACBCTCUCLEMEEE K K$K%KUKVKbKcKKKKKYLZLjLkLLLLLwOxO[[^^^^^^3_4_9_B_D_E_^a_aoapaaaaC]cU]c uDCC^aakkEmFmTmUmmmo o.o/oIoKotttt7u8uQuRuuuuuzzzz~~~~ȉɉ [\pqµõֵ׵67EF !#$I]Ucc^cC]c uDC[ 9uP&]uDP&]J(]] w!lz~J<Q 7 v  9 : Y [ h j t v R'KR'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R',  # 2 ; O a y    - 8 : J \ k x La7R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'KR'R'R'R',7,u`u!!A#B#Y#####%A%4(n(o())+,,,/[0u00 2K2:455R' R'R'R'R'R'R'R'R' R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'KR'R'R'R'R'R'-57Z9:V;{;=z>{>w@AA%CLEEEEJwO P{R|RXZ[\\CaDaccceeffffg3h}hhiiiiiR'R'uR'R'R'R'R' R'R'R'R'R'R' R'R'R'R'*R'R' R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'-ij-jJj_j|jjjjjjk @Kȫ <ˬ̬Sԯկ4Mn˰;YvױR'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'-ױ /QZ[hв!?[|ݳ ,?TjstߴBζJKǷ R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'- /;@jŸ+Igй :Zպ ,rڻ"#$%,$h45eR'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'-e{)I`a1E{$IUtLMR'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'-P9~+t "#$JKuv,-crR'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'  *4BR_` Vjz Wfx.?@AwR'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'  +=Tez/DZ[)<JXY&3CQRR'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R' ,/?UV()*bqr R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'R'%& ' ( ) / p#Q'$p#'$$& ' ( ) / p#Q'  " R''K@Standarda&A@&Absatz-StandardschriftartOc]& @&Index 18Q' & @&Index 28Q' & @&Index 3X8Q' & @&Index 4 8Q' &@&Index 58Q' &@&Index 68Q' &@&Index 7x8Q' &@&Index 8@8Q' &@&Index 98Q' *!@*IndexberschriftxxUVOtU0@0 Verzeichnis 1xxQ' U[(@( Verzeichnis 2 Q' Z*@* Verzeichnis 3 Q' V,@, Verzeichnis 4 Q' c,@, Verzeichnis 5 XQ' c,@, Verzeichnis 6  Q' c,@, Verzeichnis 7 !Q' c,@, Verzeichnis 8 "Q' c,@, Verzeichnis 9 #xQ' c$@B$ Kopfzeile $p#" @R"Fuzeile %p#)@a SeitenzahlY  ,   Y\ M v)4=IR_jv(nrJn;+ #,CA   1!I-fi 5.a9nopqrs 75isCױ e tuvwxyz{|}~+@Xrtu5MgijC[uwxG_y{|+EGHe}69:e}1KNO]u145>Vpst:W  2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%D2%DYaci!R _Toc312054613 _Toc312054614 _Toc312054615 _Toc312054616 _Toc312054617 _Toc312054618 _Toc312054619 _Toc312054620 _Toc312054621 _Toc312054622 _Toc312054623 _Toc312054624 _Toc312054625 _Toc312054626 _Toc312054627 _Toc312054628 _Toc312054629 _Toc312054630 _Toc312054631 _Toc312054632 _Toc312054633 _Toc312054634 _Toc312054635 _Toc312054636M va$"&)\-!/2W8>BY`l(řJ%  ` +t@"&)t-J/2z8>BY`lXڙe+!O Carla Bellini-\\COMPUTER1\GLOBAL\APIKURS\TIPSGROB\APIM2.DOC Carla Bellini-\\COMPUTER1\GLOBAL\APIKURS\TIPSGROB\APIM2.DOC Carla Bellini-\\COMPUTER1\GLOBAL\APIKURS\TIPSGROB\APIM2.DOC Carla Bellini-\\COMPUTER1\GLOBAL\APIKURS\TIPSGROB\APIM2.DOC Carla Bellini-\\COMPUTER1\GLOBAL\APIKURS\TIPSGROB\APIM2.DOC Carla Bellini-\\COMPUTER1\GLOBAL\APIKURS\TIPSGROB\APIM2.DOC Carla Bellini-\\COMPUTER1\GLOBAL\APIKURS\TIPSGROB\APIM2.DOC Carla Bellini-\\COMPUTER1\GLOBAL\APIKURS\TIPSGROB\APIM2.DOC Carla Bellini-\\COMPUTER1\GLOBAL\APIKURS\TIPSGROB\APIM2.DOC Andreas Grob#\\COMPUTER1\VBCD\CD\INFO\APIDOC.DOC@\\COMPUTER4\HPNe00:winspool\\COMPUTER4\HP |pK A4 )QQ   N N N'\\COMPUTER4\HP |pK A4 )QQ   N N N' nTimes New Roman Symbol &Arial5Courier New&Monospaced &AmyWingdings"!!!8 Dateihanling Andreas Grob Andreas Grobࡱ> u