'================================================================
'= 印刷デバイスの曲線描画能力を取得
'=    (CURVECAPS.bas)
'================================================================
#include "Windows.bi"

Type PRINTER_INFO_5
    pPrinterName As Long
    pPortName    As Long
    Attributes   As Long
    DeviceNotSelectedTimeOut As Long
    TransmissionRetryTimeOut As Long
End Type

#define PRINTER_ENUM_NAME &H8           'Nameで指定されたプリンタを列挙
#define MAX_DEVICENAME 64               '
#define CURVECAPS 28                    'デバイスがサポートする曲線描画能力
#define CC_CHORD 4                      '弓形をサポート
#define CC_CIRCLES 1                    '円をサポート
#define CC_ELLIPSES 8                   '楕円をサポート
#define CC_INTERIORS 128                '内部の塗りつぶしをサポート
#define CC_NONE 0                       '曲線をサポートしない
#define CC_PIE 2                        '扇形をサポート
#define CC_ROUNDRECT 256                '角の丸い矩形をサポート
#define CC_STYLED 32                    'スタイルを持つ境界線をサポート
#define CC_WIDE 16                      '太い境界線をサポート
#define CC_WIDESTYLED 64                'スタイルを持つ太い境界線をサポート

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

' メモリブロックを別の領域に移動する
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)

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

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

Var Shared Combo1 As Object
Var Shared List1 As Object

Combo1.Attach GetDlgItem("Combo1") : Combo1.SetFontSize 14
List1.Attach GetDlgItem("List1") : List1.SetFontSize 14
List1.SetWindowSize 206, 90

Var Shared PrinterName As String

'================================================================
'=
'================================================================
Declare Sub Mainform_Start edecl ()
Sub Mainform_Start()
    Var PrintServer As String
    Var Need As Long
    Var Returned As Long
    Var Level As Long
    Var CT As Long
    Var Ret As Long

    'ローカルプリンタから検索(サーバー名 \\xxx 指定可)
    PrintServer = ""

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

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

    '全プリンタ情報を得る
    Var Buffer(Need - 1) As byte
    Ret = Api_EnumPrinters(PRINTER_ENUM_NAME, PrintServer, Level, Buffer(0), Need, Need, 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 phDC As Long
    Var Ret As Long
    
    'プリンタ名から、そのデバイスコンテキストを作成
    phDC = Api_CreateDC("WinSpool", PrinterName, ByVal 0, 0)
    
    'リストボックスを初期化
    List1.Resetcontent

    '曲線描画能力を取得
    Ret = Api_GetDeviceCaps(phDC, CURVECAPS)

    '曲線描画能力を表示
    If Ret And CC_CIRCLES    Then List1.AddString "CIRCLES"
    If Ret And CC_PIE        Then List1.AddString "PIE"
    If Ret And CC_CHORD      Then List1.AddString "CHORD"
    If Ret And CC_ELLIPSES   Then List1.AddString "ELLIPSES"
    If Ret And CC_WIDE       Then List1.AddString "WIDE"
    If Ret And CC_STYLED     Then List1.AddString "STYLED"
    If Ret And CC_WIDESTYLED Then List1.AddString "WIDESTYLED"
    If Ret And CC_INTERIORS  Then List1.AddString "INTERIORS"
    If Ret And CC_ROUNDRECT  Then List1.AddString "ROUNDRECT"
End Sub

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