APIを使った印刷(文字列・楕円)          <TOP>


EnumPrinters 使用可能なプリンタ・プリントサーバーなどを列挙 
CopyMemory ある位置から別の位置にメモリブロックを移動 
SetDefaultPrinter 通常使うプリンタの設定 
CreateDC デバイスコンテキストを、指定された名前で作成 
DeleteDC 指定されたデバイスコンテキストを削除 
GetDeviceCaps デバイス固有の情報を取得 
DeleteObject システムリソースを解放 
SelectObject 指定されたデバイスコンテキストのオブジェクトを選択 
TextOut 文字を描画 
Ellipse 楕円の描画 
GetTextExtentPoint32 文字列全体の幅と高さを取得 
StartDoc 印刷ジョブを開始 
StartPage プリンタドライバがデータを受け取る準備 
EndDoc 印刷ジョブを終了 
EndPage 1ページ書き込みの終了を通知 
CreatePen 論理ペンを作成 
 
接続されているプリンタを列挙し、指定したプリンタに指定文字列、楕円を印刷しています。印刷例は実線を指定した場合。
  
 
'================================================================
'= 文字列・楕円の印刷
'=    (CreatePen.bas)
'================================================================
#include "Windows.bi"

Type POINTAPI
    X As Long
    Y As Long
End Type
 
Type DOCINFO
    cbSize       As Long
    lpszdiName   As Long
    lpszOutput   As Long
    lpszDataType As Long
    fwType       As Long
End Type
 
Type PRINTER_INFO_5
    pPrinterName As Long
    pPortName    As Long
    Attributes   As Long
    DeviceNotSelectedTimeOut As Long
    TransmissionRetryTimeOut As Long
End Type

' 使用可能なプリンタ・プリントサーバーなどを列挙する
Declare Function Api_EnumPrinters& Lib "winspool.drv" Alias "EnumPrintersA" (ByVal Flags&, ByVal Name$, ByVal Level&, pPrinterEnum As Any, ByVal cbBuf&, pcbNeededed&, pcReturned&)

' ある位置から別の位置にメモリブロックを移動
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)

' 通常使うプリンタの設定
Declare Function Api_SetDefaultPrinter& Lib "winspool.drv" Alias "SetDefaultPrinterA" (ByVal pszPrinter$)

' 指定されたデバイスのデバイスコンテキストを、指定された名前で作成
Declare Function Api_CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName$, lpDeviceName As Any, lpOutput As Any, ByVal lpInitData As Any)

' 指定されたデバイスコンテキストを削除
Declare Function Api_DeleteDC& Lib "gdi32" Alias "DeleteDC" (ByVal hDC&)

' デバイス固有の情報を取得
Declare Function Api_GetDeviceCaps& Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC&, ByVal nIndex&)

' ペン、ブラシ、フォント、ビットマップ、リージョン、パレットのいずれかの論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放。オブジェクトを削除した後は、指定されたハンドルは無効になる
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' 文字を描画
Declare Function Api_TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC&, ByVal nXStart&, ByVal nYStart&, ByVal lpString$, ByVal cbString&)

' 楕円の描画
Declare Function Api_Ellipse& Lib "gdi32" Alias "Ellipse" (ByVal hDC&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)

' 文字列全体の幅と高さを取得
Declare Function Api_GetTextExtentPoint32& Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC&, ByVal lpsz$, ByVal cbString&, lpSize As POINTAPI)

' 印刷ジョブを開始
Declare Function Api_StartDoc& Lib "gdi32" Alias "StartDocA" (ByVal hDC&, lpdi As DOCINFO)

' プリンタドライバがデータを受け取る準備をさせる
Declare Function Api_StartPage& Lib "gdi32" Alias "StartPage" (ByVal hDC&)

' 印刷ジョブを終了
Declare Function Api_EndDoc& Lib "gdi32" Alias "EndDoc" (ByVal hDC&)

' 1ページ書き込みの終了を通知
Declare Function Api_EndPage& Lib "gdi32" Alias "EndPage" (ByVal hDC&)

' 論理ペンを作成
Declare Function Api_CreatePen& Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle&, ByVal nWidth&, ByVal crColor&)

#define DI_COMPAT 4                     'システムイメージで描画する
#define DI_DEFAULTSIZE 8                'widthとheightが0である場合、アイコン(マウスカーソル)をデフォルトのサイズで描画
#define DI_IMAGE 2                      'イメージを使ってアイコン(またはマウスカーソル)を描画
#define DI_MASK 1                       'マスクを使ってアイコン(またはマウスカーソル)を描画
#define DI_NORMAL 3                     'DI_IMAGE と DI_MASK の組み合わせ

#define PHYSICALHEIGHT 111              '物理的高さ(単位ピクセル)
#define PHYSICALOFFSETX 112             '実際に印刷可能なX方向のマージン
#define PHYSICALOFFSETY 113             '実際に印刷可能なY方向のマージン
#define PHYSICALWIDTH 110               '物理的幅(単位ピクセル)

#define PS_DASH 1                       '破線のペンを作成(-------)
#define PS_DASHDOT 3                    '一点鎖線のペンを作成(-・-・-・-)
#define PS_DASHDOTDOT 4                 '二点鎖線のペンを作成(-・・-・・-)
#define PS_DOT 2                        '点線のペンを作成(・・・・・・・)
#define PS_SOLID 0                      '実線のペンを作成

#define PRINTER_ENUM_DEFAULT &H1        'デフォルトのプリンタに関する情報を列挙
#define PRINTER_ENUM_LOCAL &H2          'Nameの設定を無視して、ローカルプリンタを列挙
#define PRINTER_ENUM_NAME &H8           'Nameで指定されたプリンタを列挙
#define PRINTER_ENUM_SHARED &H20        '共有属性を持つプリンタを列挙
#define MAX_DEVICENAME 64

Var Shared Combo1 As Object
Var Shared Button1 As Object
Var Shared Radio(4) As Object

Combo1.Attach GetDlgItem("Combo1") : Combo1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
For i = 0 To 4
    Radio(i).Attach GetDlgItem("Radio" & Trim$(Str$(i + 1))) : Radio(i).SetFontSize 14
Next i

Var Shared PrinterName As String

'================================================================
'=
'================================================================
Declare Function Index bdecl () As Integer
Function Index()
    Index = Val(Mid$(GetDlgRadioSelect("Radio1"), 6)) - 1
End Function

'================================================================
'= 接続プリンタを列挙
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var PrintServer As String
    Var Needed As Long
    Var Returned As Long
    Var Level As Long
    Var CT As Long
    Var Ret As Long

    'ローカルプリンタから検索
    PrintServer = ""

    'PRINTER_INFO_5構造体を受け取る
    Level = 5

    'バッファに必要なバイト数を調べる
    Ret = Api_EnumPrinters(PRINTER_ENUM_NAME, PrintServer, Level, Chr$(0), 0, Needed, Returned)
    If Needed = 0 Then End

    '全プリンタ情報を得る
    Var Buffer(Needed-1) As Byte
    Ret = Api_EnumPrinters(PRINTER_ENUM_NAME, PrintServer, Level, Buffer(0), Needed, Needed, Returned)

    '構造体リストの準備
    Var PI_5(Returned - 1) As PRINTER_INFO_5

    For CT = 0 To Returned - 1

        'バッファから構造体1つ分を抜き取る
        CopyMemory PI_5(CT), Buffer(CT * Len(PI_5(CT))), Len(PI_5(CT))

        'プリンタ名を得る
        PrinterName = String$(MAX_DEVICENAME, Chr$(0))
        CopyMemory PrinterName, ByVal PI_5(CT).pPrinterName, Len(PrinterName)
        PrinterName = KLeft$(PrinterName, kInStr(1, PrinterName, Chr$(0)) - 1)

        Combo1.AddString PrinterName
    Next
End Sub

'================================================================
'= デフォルトプリンタの設定
'================================================================
Declare Sub Combo1_Change edecl ()
Sub Combo1_Change()
    Var hPrinter As Long
    Var Ret As Long

    PrinterName = Combo1.GetText(Combo1.GetCursel)

    Ret = Api_SetDefaultPrinter(PrinterName)
End Sub

'================================================================
'= 印刷(文字列と、それを囲む楕円)
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var di As DOCINFO
    Var pa As POINTAPI
    Var PrinterDC As Long
    Var hPen As Long
    Var hOldPen As Long
    Var OutStr As String
    Var tLeft As Long
    Var tTop As Long
    Var tWidth As Long
    Var tHeight As Long
    Var pWidth As Long
    Var pHeight As Long
    Var pxMargin As Long
    Var pyMargin As Long
    Var Ret As Long
 
    If Combo1.GetWindowText = "" Then Exit Sub

    'プリンタのデバイスコンテキストを取得
    PrinterDC = Api_CreateDC(ByVal 0, PrinterName, Chr$(0), ByVal 0)
    If PrinterDC = 0 Then Exit Sub

    OutStr = "FB Programming Tips" & Chr$(0)
   
    pWidth = Api_GetDeviceCaps(PrinterDC, PHYSICALWIDTH)
    pHeight = Api_GetDeviceCaps(PrinterDC, PHYSICALHEIGHT)
   
    pyMargin = Api_GetDeviceCaps(PrinterDC, PHYSICALOFFSETY)
    pxMargin = Api_GetDeviceCaps(PrinterDC, PHYSICALOFFSETX)
   
    di.cbSize = Len(di)
    di.lpszdiName = StrAdr(OutStr)
   
    Ret = Api_StartDoc(PrinterDC, di)
    Ret = Api_StartPage(PrinterDC)
   
    hPen = Api_CreatePen(Index, 0, RGB(255, 0, 0))
    hOldPen = Api_SelectObject(PrinterDC, hPen)

    '文字サイズを取得
    Ret = Api_GetTextExtentPoint32(PrinterDC, OutStr, Len(OutStr), pa)
   
    tWidth = pa.X
    tHeight = pa.Y
    tTop = (pHeight - (2 * pyMargin) - pa.Y) / 2
    tLeft = (pWidth - (2 * pxMargin) - pa.X) / 2
   
    '文字を囲む楕円を描画
    Ret = Api_Ellipse(PrinterDC, tLeft - 50, tTop - 50, tLeft + 50 + tWidth, tTop + 50 + tHeight)

    '文字列を描画
    OutStr = Left$(OutStr, Instr(OutStr, Chr$(0)) - 1)
    Ret = Api_TextOut(PrinterDC, tLeft, tTop, OutStr, Len(OutStr))
   
    Ret = Api_EndPage(PrinterDC)
    Ret = Api_EndDoc(PrinterDC)
    Ret = Api_DeleteObject(hPen)
    Ret = Api_DeleteDC(PrinterDC)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End