Programming Tool Box/SIMS_2.iso/info/api/apidoc.txt

Text File | 1995-02-27 | 53.2 KB | 1,284 lines

Inhaltsverzeichnis

Programmverknⁿpfung    3
Fensterhandling    3
Fenstertitel des aktiven Fensters ermitteln    4
Schwebendes Fenster    4
Mauszeiger auf Bereich beschrΣnken    4
Mauszeigerposition bestimmen    5
Mauszeiger auf bestimmte Position setzen    5
Warten vor dem Weiterfahren    6
Prⁿfen auf DOS-Anwendung    6
Mehrfachstart einer Anwendung unterbinden    6
Feststellen, wie ein Steuerelement den Focus erhalten hat    7
Selektion in einem Kombinationsfeld    7
Programmgesteuertes Booten    8
Screenshot    8
MS-DOS-Text in Windows-Text umwandeln    11
Hoch-/Querformat-Umstellung per Programm    11
Drucker umschalten    12
Containerobjekte zwischen Formularen verschieben    14
Shell modal    16
Mauszeiger verstecken    16
Schriften vertikal ausgeben    17
Hotkey    19
Debug-Fenster l÷schen    20
Inhalt Beispieldiskette    22


Index der benutzten API-Funktionen



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


Programmverknⁿpfung
Im Dateimanager k÷nnen Sie sogenannte Verknⁿpfungen vornehmen. Dabei bestimmen Sie, welches Programm gestartet
werden soll und die angegebene Datei laden soll, wenn die entsprechende Datei ge÷ffnet wird. Die Verknⁿpfung erfolgt
jeweils ⁿber die Dateiendung. Bei einem Doppelklick auf eine Datei mit der Endung .TXT wird standardmΣssig das
Programm NOTEPAD.EXE gestartet und die angeklickte Datei geladen. Windows bietet nun ein API, um anhand eines
Dateinamens den Programmnamen des verknⁿpften ausfⁿhrbaren Programmes ausfindig zu machen. ▄ber die folgende
Funktion k÷nnen Sie den zugeh÷rigen Dateinamen in Erfahrung bringen:

Declare Function 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-FunktionalitΣt nachzubilden. Erzeugen Sie eine DateiListBox und fⁿgen 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 verknⁿpft", 48, "Fehler"
    Exit Sub
  End If
End Sub

Fensterhandling
Fenster einfrieren. Manchmal kann es wⁿnschenswert 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 sch÷neres Finish. Mit dieser Funktion kann auch das Fⁿllen von Listboxen beschleunigt werden.

Declare Function 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 dafⁿr 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
ben÷tigt fⁿr die Typumwandlung. Um eine Listbox einzufrieren, benutzen Sie den Aufruf i% = Freeze ((List1. hWnd)).


Fenstertitel des aktiven Fensters ermitteln
Mittels folgender Funktion k÷nnen 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 k÷nnen Sie das Fenster zu
einem spΣteren Zeitpunkt wieder aktivieren.

Declare Function GetActiveWindow Lib "User" () As Integer

Declare Function 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 m÷chte 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 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 beschrΣnken
Mittels API-Funktionen kann man den Bereich, der mit dem Mauszeiger erreichbar sein soll, einschrΣnken. Wollen Sie
z.B. erreichen, dass der Anwender nicht mit dem Mauszeiger aus einem Bildfeld herausfahren kann, k÷nnen Sie dies
folgendermassen tun.

Type RECT
    left As Integer
    top As Integer
    right As Integer
    bottom As Integer
End Type

Declare Sub ClipCursorRect Lib "User" Alias "ClipCursor" (lpRect As RECT)

Declare Sub ClipCursorClear Lib "User" Alias "ClipCursor" (ByVal lpRect&)

Declare Sub 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 spΣtestens beim Verlassen des
Programmes aufgerufen wird, denn die Einstellung bleibt sonst auch nach demerlassen des Beispiel, um den Cursor auf die
aktuelle Form zu beschrΣnken:

LimitCursor((me.hwnd))

Beispiel, um den Cursor auf das Bildfeld Picture1 zu beschrΣnken:

Limitcursor((picture1.hwnd))

Sie k÷nnen den Bereich, auf den Sie den Mauszeiger beschrΣnken m÷chten, auch ävon Handô bestimmen, indem Sie in der
Funktion LimitCursor statt die Funktion GetWindowRect aufzurufen direkt die entsprechenden Werte der Struktur RECT
setzen. Dabei mⁿssen 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 hilft bei der L÷sung 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, k÷nnen Sie
beim Aufruf der Routine ⁿber das Flag Twips% angeben, ob die Koordinaten in Twips (Twips% = True) oder in Pixeln
(Twips% = False) zurⁿckgegeben werden sollen.

Type POINTAPI
    X As Integer
    Y As Integer
End Type

Declare Sub 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
erm÷glicht nun die Positionierung, wobei zwischen Twix und Pixeln umgeschaltet werden kann wie bei der Funktion
GetMousePos.

Declare Sub 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 k÷nnen Sie Ihr Programm dazu
veranlassen, eine bestimmte Zeit in Millisekunden zu warten. Dazu wird das API GetTickCount benutzt, das die Anzahl
Millisekunden liefert, seit der die aktuelle Windows-Sitzung lΣuft. ▄ber einen ZΣhler wird die M÷glichkeit einer
Endlosschleife vermieden. Diese Massnahme schrΣnkt jedoch die maximale Wartezeit ein.

Declare Function 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

Prⁿfen auf DOS-Anwendung
Mit der folgenden Funktion k÷nnen Sie ein Fenster daraufhin untersuchen, ob es eine DOS-Anwendung enthΣlt oder nicht.

Declare Function GetWindowTask Lib "User" (ByVal hWnd As Integer) As Integer

Declare Function 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 m÷chte 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 m÷chte, bevor man die
zusΣtzlich gestartete Anwendung wieder verlΣsst. Folgende Routine l÷st das Problem. Die Routine sollte entweder in der
Startroutine Sub Main oder im Load-Ereignis der Startform aufgerufen werden. Das benutzte Windows-API geh÷rt zu den
nicht dokumentierten APIs.

Declare Sub 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(), True
    End
  End If
End Sub

Feststellen, wie ein Steuerelement den Focus erhalten hat
Um festzustellen, ob ein Steuerelement den Focus durch die BetΣtigung 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 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 m÷chten und beim Anspringen eines Textfeldes mittels TAB den Inhalt des Textfeldes markieren m÷chten. Dies
k÷nnen 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 lΣsst sich zwar gut mit Visual Basic selbst l÷sen, doch
dauert das  Durchsuchen der Listbox nach einem bestimmten Eintrag recht lange. Die folgende Routine liefert eine
wesentlich schnellere L÷sung ⁿber das Windows-API:

Declare Function 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 enthΣlt, 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 Verfⁿgung, mittels dem alle Anwendungen dazu veranlasst werden k÷nnen, die EintrΣge 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 Grafikaufl÷sungen ist es oft n÷tig, 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 l÷st das Problem durch ein
Windows-API:

Declare Function 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 wΣhlte 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 fⁿhren 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 Probleml÷sungen fⁿr 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-Schnappschⁿsse erstellt werden k÷nnen.
Um den Inhalt eines Fensters in ein Bildfeld zu ⁿbernehmen, ben÷tigt man den Handle des entsprechenden Fensters (ⁿber
das API GetDesktopWindow) erhΣlt man den Handle des gesamten Bildschirms). Anhand dieses Handles bestimmt man
den Quell-Devicekontext. Den Ziel-Devicekontext erhΣlt 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 vorgΣngig noch auf die korrekte Gr÷sse gebracht. Darauf bleibt nur noch den Quell-
Devicekontext wieder freizugeben. Damit enthΣlt das Bildfeld den gewⁿnschten 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 Lib "user" () As Integer
Declare Function GetDC Lib "user" (ByVal hWnd%) As Integer
Declare Function 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 Lib "User" (ByVal hW_nd%, ByVal hDC%) As Integer
Declare Sub 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 k÷nnen 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 zunΣchst 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 fⁿr 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 gel÷scht). 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)
enthΣlt, dessen AutoRedraw-Eigenschaft auf True und dessen Visible-Eigenschaft auf False gesetzt ist. Dann erstellen wir
noch eine SchaltflΣche (Command1) auf unserem Formular deren Caption-Eigenschaft wir auf äScreenshotô setzen. Die
Form k÷nnen wir so anpassen, dass sie genau dieselbe Gr÷sse wie die SchaltflΣche hat. In das Click-Ereignis der
SchaltflΣche 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 dafⁿr, 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 frⁿheren PC-Zeiten berⁿchtigten Umlaute wieder
fⁿr 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 wandelt eine
ⁿbergbebene Zeichenkette vom PC-Zeichensatz in den ANSI/ISO Zeichensatz von Windows um, wΣhrend AnsiToOem die
Rⁿckumwandlung vornimmt. Beide Funktionen ben÷tigen 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 zurⁿckerwarteten Anzahl Zeichen gefⁿllt sein, weil APIs nicht auf das Speichermanagement von Visual Basic zugreifen
und einfach voraussetzen, dass der entsprechende Speicherplatz fⁿr die Zeichenkette zur Verfⁿgung steht. Das folgende
allgemeine Modul erm÷glicht die Umwandlung.

Declare Function AnsiToOem Lib "Keyboard" (ByVal lpAnsiStr As String, ByVal
lpOemStr As String) As Integer
Declare Function 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 M÷glichkeit, 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 M÷glichkeit 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 ursprⁿnglichen Druckerkonfiguration ist nicht m÷glich.
- 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 mⁿsste. 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
erm÷glicht. 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 berⁿcksichtigt werden sollen. Dies erm÷glicht
es einzelne Einstellungen vorzunehmen, ohne die fⁿr die restlichen Parameter ben÷tigten Werte zu kennen.
Nun wird noch das API selbst deklariert:

Declare Function 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%(printer.hDC, dm)
End Sub

Nun k÷nnen Sie in Ihrem Programm durch Aufruf der entsprechenden Prozedur den Drucker temporΣr auf die gewⁿnschte
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 mⁿssen 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 m÷glichen Drucker in einer Liste aufgefⁿhrt werden und durch
Auswahl des entsprechenden Druckers und Klick auf eine SchaltflΣche soll der Standarddrucker festgelegt werden.
Erstellen Sie nun ein Formular das wie folgt aussieht:

Nun deklarieren Sie die ben÷tigten Windows API Funktionen im generellen Teil des Formulars:

' Windows API Funktionen
Declare Function GetProfileString Lib "Kernel" (ByVal AppName$, ByVal KeyName As
Any, ByVal Default$, ByVal ReturnedString$, ByVal nSize%)
Declare Function WriteProfileString Lib "Kernel" (ByVal AppName$, ByVal KeyName$,
ByVal lpString$)
Declare Function 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 gewⁿnschten Sektion aus wΣhrend
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(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
End Sub

Damit sind unsere neuen Befehle bereits fertig. Wir wollen nun die Liste der verfⁿgbaren 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)

      ' EintrΣge fⁿr 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 APIÆs GetProfileString als zweiter Parameter der Wert 0& ⁿbergeben wird, liefert
das API alle vorhandenen Topics der angegebenen Sektion zurⁿck. 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 abgefⁿllt.
Nun mⁿssen wir dafⁿr sorgen, dass beim Progammstart die Prozedur Lies_Druckerliste ausgefⁿhrt 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 SchaltflΣche folgenden Code:

Sub Command1_Click ()

  Setz_Standarddrucker (list1)
  label2.Caption = Lies_Standarddrucker$()
End Sub

Damit k÷nnen wir mit unserem Programm den Standarddrucker entsprechend der verfⁿgbaren 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 verfⁿgt ⁿ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 selbstΣndige Fenster mit eigenem Fensterhandle. Sie besitzen
ausserdem ein ⁿbergeordnetes Fenster (Parent), nΣmlich das Formular (auch ein Fenster) innerhalb dem sie sich befinden
rsp. angezeigt werden. Damit ist Endstation fⁿr Visual Basic. Nun kommt aber Windows zum Zug, denn es liefert ein API,
das es erm÷glicht festzulegen, welches Fenster das ⁿbergeordnete Fenster sein soll. Damit hat man eine M÷glichkeit
Containerobjekte zwischen Formularen zu verschieben und somit steht einer Modularisierung von Containerobjekten nichts
mehr im Weg.
Als Beispiel fⁿr 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% 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 fⁿr 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 ergΣnzt
werden, die dafⁿr 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 Rⁿckkehr auf das erste Formular die Uhr wieder zurⁿckkehrt, schreiben Sie fⁿr das Formular Form1
dieselbe Ereignisprozedur Form_Activate wie fⁿr das Formular Form2:

Sub Form_Activate ()
  ZeigUhr Me
End Sub

Jetzt mⁿssen Sie noch dafⁿr sorgen, dass das zweite Formular angezeigt wird, z.B. indem Sie folgende Ereignisprozedur fⁿr
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). Fⁿr 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 k÷nnen 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 mⁿsste lediglich der Handle des fremden Fensters bestimmt
werden...

Shell modal
Ein sehr hΣufiges Problem fⁿr den Visual Basic Programmierer ist das Multitasking von Windows. Dies vor allem dann,
wenn es eigentlich unerwⁿnscht ist. M÷chte man z.B. mit Visual Basic ein Programm schreiben, das mittels dem MS-DOS-
Programm PKZIP.EXE Dateien komprimieren, dann die Gr÷sse der komprimierten Datei bestimmen und falls die
DateilΣnge gr÷sser 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 fΣhrt das
Programm weiter bevor PKZIP.EXE seine Arbeit beendet hat.
Das Ziel ist es nun dafⁿr zu sorgen, dass das aufrufende Programm auf den Abschluss des aufgerufenen Programmes wartet
bis es weiterfΣhrt wie etwa ein modales Dialogfenster.
Um dies zu erreichen ben÷tigen wir das Windows-API GetModuleUsage. Dieses API liefert einen Wert zurⁿck, der aussagt
wie oft das spezifizierte Modul geladen wurde. Die Deklaration des APIÆs lautet:

Declare Function GetModuleUsage Lib "KERNEL" (ByVal InstanceID%) As Integer

Nun fehlt uns nur noch der omin÷se ▄bergabeparameter InstanceID%. Dabei handelt es sich um den Handle der das
entsprechende Modul spezifiziert. Unter einem Modul ist ⁿbrigens eine beliebige ausfⁿhrbare 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 Rⁿckgabewert gerade den Handle des
gestarteten Programmes liefert. Dadurch ben÷tigen wir kein weiteres API das uns den ben÷tigten Handle liefert. Die
folgende Prozedur dient als allgemeiner Ansatz das Problem zu l÷sen:

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 gewⁿnschte Programm zu starten.
SelbstverstΣndlich 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 Rⁿckgabewert von GetModuleUsage 0 betrΣgt. Erst dann wird die Prozedur beendet.

Mauszeiger verstecken
Windows bietet ein API um den Mauszeiger anzuzeigen oder zu verstecken. Manche Abstⁿrze 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 UmstΣnden erwⁿnscht sein, den Mauszeiger zu verstecken wie z.B. bei einem
Bildschirmschoner. Mit der folgenden Routine lassen sich beide Varianten realisieren.

Declare Function ShowCursor Lib "User" (ByVal bShow As Integer) As Integer
Const Ein = True
Const Aus = False

Sub Mauszeiger (Modus%)
  Dim i%
  i% = 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 fⁿr Schriftarten unter Windows
auseinandersetzten m÷chte, 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 erm÷glicht standardmΣssig nur die horizontale Zeichenausgabe. Um trotzdem in der Lage zu sein, meinem
Lineal einen professionellen Touch zu geben, stⁿrzte ich mich in die Tiefen der Windows-APIs um Schriftarten vertikal
auszugeben.
Dabei hatte ich zwei wichtige Erkenntnisse:
- Rasterschriften k÷nnen nicht rotiert werden (Alle TrueType-Schriften k÷nnen rotiert werden)
- Die FunktionalitΣt 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 einschlΣgigen Fachliteratur beschrieben sind.
So zaubert man nach Schema F jede TrueType-Schrift in der gewⁿnschten Art und Weise auf den Bildschirm oder falls
gewⁿnscht auf den Drucker, wenn statt dem Bildfeld das Druckerobjekt Printer angegeben wird.
Um die Schrift zu rotieren, ben÷tigt man nur die Strukturvariable lfEscapement aus der Struktur LOGFONT. Diese nimmt
den gewⁿnschten 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 enthΣlt, hat nun aber mit Vorteil die
Eigenschaft AutoRedraw eingeschaltet, um ein m÷glichst schnelles Bildschirmrollen zu erm÷glichen. 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 vorbeilΣuft
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 berⁿcksichtigt automatisch die Einstellung der AutoRedraw-Eigenschaft des ⁿbergebenen Bildfeldes.

Schritt fⁿr Schritt Anleitung:

Erstellen Sie ein neues Projekt und erzeugen Sie in der Form das Bildfeld Picture1, das den gewⁿnschten Text anzeigen
soll. Setzen Sie die Eigenschaft ScaleMode des Bildfeldes auf  Pixels (3) und wΣhlen Sie als FontName eine TrueType-
Schriftart. Daneben erzeugen Sie eine SchaltflΣche Command1. Wenn diese SchaltflΣche 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 fⁿgen 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 Lib "GDI" (lpLogFont As logfont) As Integer
Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
Declare Sub GetClientRect Lib "User" (ByVal hWnd As Integer, lpRect As rect)
Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer, ByVal hObject As
Integer) As Integer
Declare Function 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 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 BefehlsschaltflΣche klicken wird im Bildfeld vertikal Hallo ausgegeben,
vorausgesetzt die Eigenschaft FontName des Bildfeldes enthΣlt den Namen einer Vektorschrift (Rasterschriften k÷nnen
nicht rotiert werden).

Hotkey
Es ist mit einem Visual Basic Programm sehr komfortabel m÷glich die Tastatur zu ⁿberwachen, solange das Programm den
Focus besitzt. Aber wehe es sollen auch Tastendrⁿcke  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 Mⁿhe 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 gedrⁿckt worden ist, und ob diese Taste im Augenblick gerade noch gedrⁿckt ist.
Die Definition des API lautet:
Declare Function GetAsyncKeyState Lib äUserô (ByVal vKey%)
Das API ben÷tigt als Parameter den virtuellen Tastenkode dessen Status ⁿberprⁿft werden soll. Die entsprechenden
Konstanten  beginnen mit VK_... und Sie finden die Konstanten in der Hilfedatei win31api.hlp unter äGlobal Constantsô.
Der Rⁿckgabewert des API hat das Bit 0 gesetzt, wenn die Taste seit dem letzten Aufruf von GetAsyncKeyState gedrⁿckt
wurde und das Bit 15 ist gesetzt, wenn die Taste im Augenblick der Abfrage gedrⁿckt war.
Im folgenden Beispiel soll ein Formular per Hotkey falls es minimiert ist wieder ge÷ffnet werden und falls es unsichtbar ist
wieder angezeigt werden. Mittels zwei Kombinationslisten kann der gewⁿnschte Hotkey ausgewΣhlt werden, wobei die
Listen nur eine Auswahl der m÷glichen Tastenkodes enthalten. ▄ber ein Timer-Steuerelement wird alle 500 Millisekunden
das API GetAsyncKeyState aufgerufen und falls die Tasten gedrⁿckt wurden das Formular angezeigt:

Erstellen Sie ein Formular das zwei Kombinationslisten Combo1 und Combo2 ,eine SchaltflΣche Command1 und einen
Timer Timer1 enthΣlt, dessen Intervall z.B. auf 500 eingestellt ist  (siehe Bild 1).
Geben Sie nun das Listing 1 ein.

Declare Function 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 l÷schen
Wie komfortabel ist es doch ⁿber den Befehl Debug.Print Debugginginformationen im Debugfenster auszugeben. Doch
nach ein zwei LΣufen steht man bald einmal vor dem Problem, welche Ausgaben zum vorhergehenden Lauf und welche
zum aktuellen geh÷ren. Natⁿrlich kann man jedesmal vor Programmstart den Inhalt des Debugfensters markieren und mit
der Deletetaste l÷schen. 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 l÷scht
sie den gesamten Inhalt des Debugfensters.

Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal
lpWindowName As Any) As Integer
Declare Function 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 lΣuft 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 fⁿllen    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 ausfⁿhren    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 fⁿr Drucker zur Verfⁿgung 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 ausfⁿhren    GetModuleUsage


Neuro Media AG    API Kurs    14. Dezember 1994





( 01 715 43 33 / FAX: [phone]        Seite 1