Tisk ASCII tabulky

Postup:
Otev°ete nov² formulß° a nov² modul.

Do modulu deklarujte nßsledujφcφ funkce:
Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
* ka₧dß deklarace musφ b²t napsßna celß na samostatnΘ °ßdce

Na udßlost Click formulß°e vlo₧te nßsledujφcφ k≤d:
Private Sub Form_Click()

   Const OEM_FIXED_FONT = 10
   Const PIXEL = 3

   Dim hOEM As Long 'Ukazatel na  OEM Font Object
   Dim Y, H As Single
   Dim PreviousObject As Long

   'ulo₧enφ scale m≤du aby se pozd∞ji nechal obnovit
   Saved% = Form1.ScaleMode
   'zm∞na scale m≤du
   Form1.ScaleMode = PIXEL
   'ZjiÜt∞nφ Üφ°ky znaku a odsazenφ
   H = Form1.TextHeight(Chr$(200)) - 1
   'ZjiÜt∞nφ ukazatele na po₧adovan² font
   hOEM = GetStockObject(OEM_FIXED_FONT)
   'V²b∞r objektu respondujφcφho s fontem
   PreviousObject = SelectObject(Form1.hdc, hOEM)
   'Pokud ·sp∞Ünost, pak tisk sady
   If PreviousObject Then
       'nastavenφ okraj∙
        Edge$ = " "
       'inicializace v²stupnφ polohy
        xMark = 10
        yMark = 10
        'nastavenφ kurzoru a tisk hornφho okraje
        Form1.CurrentX = xMark
      Form1.CurrentY = yMark
      T$ = " " + Edge$ + " "
      ret% = TextOut(Form1.hdc, yMark, xMark, T$, Len(T$))
       'Cyklus pro 256 znak∙, zaΦßtek od 0
        For Row% = 0 To 15
           'p°φprava levΘho okraje
          T$ = Mid$(Edge$, (Row% * 2) + 1, 2)
           'vytvo°enφ °et∞zce znak∙
             For Col% = 0 To 15
               Ch = (Row% * 16) + Col%
                   T$ = T$ + Chr$(Ch) + " "
            Next
            'p°φprava pravΘho okraje
            T$ = T$ + Mid$(Edge$, (Row% * 2) + 1, 2)
          'p°φprava pro zobrazenφ na dalÜφm °ßdku
             xMark = xMark + H
           'tisk °et∞zce znak∙
             ret% = TextOut(Form1.hdc, yMark, xMark, T$, Len(T$))
      Next
      'p°φprava pro tisk na dalÜφm °ßdku
       xMark = xMark + H
      'tisk spodnφho okraje
       T$ = " " + Edge$ + " "
       ret% = TextOut(Form1.hdc, yMark, xMark, T$, Len(T$))
       'obnovenφ p∙vodnφho fontu
       hOEM = SelectObject(Form1.hdc, PreviousObject)
  Else
       'v²b∞r objektu nebyl ·sp∞Ün²
       MsgBox "Nemohu nalΘzt OEM Fonty", 48
  End If
   'reset scale m≤du
   Form1.ScaleMode = Saved%

End Sub

Spus¥e aplikaci. Po kliknutφ na formulß° se na n∞m vypφÜe sada ASCII znak∙.

Zp∞t