プログラム講座 中級編9
- インターネットテーブルアート -
 中級編9です。今回はちょっと趣向を変えてインターネット向けのアプリケーションを作ってみます。といってもTCP/IPやサーバーなどは全く関係ありません。PICT画像をテーブルタグを使用して表現しようというものです。元は$4-mailinglistからのアイデアで、それを実現したものです。テーブル内の文字を指定できるようにしてありますが、文字ではなく4*4ドットの画像くらいにすると極美麗なテーブルアートが実現できます。
◆テーブルタグについて
 Netscape 2.0以降でテーブルが扱えるようになりました。Netscape 3.0, Explorer 3.0ではテーブル内でも背景色が指定できるようになりました。Netscape 2.0でも使えるように、今回作成するプログラムでは文字に色を付けてテーブルアートを実現します。文字ではなく画像と背景色で実現する場合は、テーブル内を<IMG SRC="dot.gif' width=4 height=4>のように画像の幅を指定します。4*4ドットくらいにすると綺麗に見えますが、かなりテーブル構築に時間がかかりますので注意してください。
 テーブルタグは以下のようになっています。
| <TABLE>〜</TABLE> | 囲まれた部分が表になります | 
| <TR>〜</TR> | 囲まれた部分が横1行を示します | 
| <TD>〜</TD> | 1項目を表します | 
| <TH>〜</TH> | 見出し項目を表します | 
◆簡単に変換して簡単に作る
 このテーブルアートを実現するとしてもテーブルタグを手で入力したり後で修正したりするのは面倒です。そこでPICT画像を読み込んで、その画像データを読み込んで自動的にテーブルタグを生成するようにします。PICT画像の読み込みと表示に関しては初級編、中級編で何回もやっているので、そちらを参考にしてください。
 HTMLのタグで色を表現する場合は以下のようになります。
#RRGGBB
RRは赤の成分、GGは緑の成分、BBは青の成分で値は0〜255になります。これは16進数で表現されるため&H00〜&HFFになります。例えば白であれば
#FFFFFF
 となります。暗い赤色であれば
#800000
 となります。16進数のアルファベット(A,B,C,D,E,F)は大文字でも小文字でも構いません。そして重要なことは、RGBそれぞれ2桁の16進数になるという事です。
 読み込んだPICT画像は32ビットのオフスクリーンを確保してフルカラー画像として読み出せるようにします。というのも256カラーパレットでは変換が面倒になるためです(この場合はカラールックアップテーブルの値とオフスクリーンに格納されているカラーパレット番号から割り出す事になります。256色カラーパレットについては、別の機会に解説する予定です(かなり先の事になりますが))。
 オフスクリーンの色情報を読み込むには、画像加工処理ソフトを作成する時に使った関数をそのまま流用します(手抜き)。流用できるものは流用するようにしましょう。色情報はRGBで返ってきますので、これを16進数に変換すればできあがります。が、実際にHEX$命令で変換してみると1桁の数値の場合(0〜9)、本当は2桁の16進数にならなければいけないのに1桁の値になってしまいます。0〜9の場合は先頭に0を付加するという作業が必要になります。if〜then命令を使う方法もありますが、RIGHT$を使うと簡単に実現できます。具体的には以下のようになります。
rr$ = "0"+HEX$(gR)
rr$ = RIGHT$(rr$,2)
 どうなるのかを2と36の場合で追ってみます。
 2 -> "02" -> "02"
36 -> "036" -> "36"
 先頭に0をくっつけて右側から2桁抜き出せばOKというわけです。
◆プログレスバー(進行状況を示すゲージ)
 あとはテーブルタグの規則に従って書き出せばおしまいです。
で、実際に変換してみると・・・いや遅い、遅い。プログラムの作り方にもよりますが、これではハングアップしたかと思ってしまいます。そこで、今回は「プログレスバー」という進行状況を表すゲージを付けてみました。
a = INT(6 + (y*200) / gImageY)
BOX FILL 6,25 TO a,39
 どうやって進行状況を割り出すか?ですが画像の縦の長さ分繰り返せば終わりです。という事は、何ライン目を処理しているかでわり算してやれば%(パーセンテージ)で進行具合を求めることが出来ます。後はこの求めた%(パーセンテージ)にゲージの横表示ドット数をかけ算すればできあがりです。ゲージ程度ならばToolboxを呼び出さなくてもBOX FILL命令で十分でしょう。
◆終わりに
 たまには、こういう変なソフトもよいのではないでしょうか。サンプルも用意しておきましたのでご覧ください。
◆今回のプログラムリスト
'----------------------------------------------------
' "PICT to Table ART   ...1997 Program By KaZuhiro FuRuhata"
'----------------------------------------------------
RESOURCES "about.res":                            ' "リソースファイルを読み込む"
'--------------------- "定数"-------------------------
_fileMenu = 1:                                    ' "ファイルメニュー"
_editMenu = 2:                                    ' "エディット(編集)メニュー"
_effectMenu = 3:                                  ' "加工メニュー"
_fileOpen = 1:                                    ' "ファイルメニュー:開く"
_fileSave = 3:                                    ' "ファイルメニュー:保存"
_fileQuit = 5:                                    ' "ファイルメニュー:終了"
'----------------- "グローバル変数"-------------------
DIM cport&
gRowBytes% = 0:                                   ' "オフスクリーンのrowBytes"
gGRAM& = 0:                                       ' "オフスクリーンのアドレス"
gImageX = 320:                                    ' "画像の横の長さ"
gImageY = 240:                                    ' "画像の縦の長さ"
gOffScreen& = 0:                                  ' "0の時は確保されていない!"
gR = 0:                                           '"赤色"
gG = 0:                                           '"緑色"
gB = 0:                                           '"青色"
gQuit_flag = _false:                              '"終了フラグ"
theValue$ = "■":                                 ' "テーブル内の文字"
END GLOBALS:                                      ' "グローバル変数定義の終了宣言"
'-----------------------------------------------
' "オフスクリーンのrowBytesを求める"
'-----------------------------------------------
CLEAR LOCAL
LOCAL FN getRowBytes
  PixMapH& = FN GETGWORLDPIXMAP(gOffScreen&):     ' "オフスクリーンの画像ハンドルを求める"
  err% = FN LOCKPIXELS(PixMapH&):                 ' "画像ハンドルをロック!"
  LONG IF err%
    gGRAM& = FN GETPIXBASEADDR(PixMapH&):         ' "画像が格納されている先頭のアドレスを求める"
    gRowBytes% = {[PixMapH&] + _rowBytes} AND &H3FFF:' "rowBytesを求める"
  END IF
END FN
' -----------------------------------------------
'  "オフスクリーンを確保する"
' gOffScreen& = "オフスクリーンのアドレス"
' -----------------------------------------------
CLEAR LOCAL
LOCAL FN setOffscreen
  DIM rect;8
  
  LONG IF gOffScreen& > 0
    CALL DISPOSEGWORLD(gOffScreen&):              ' "オフスクリーンを破棄"
    WINDOW CLOSE #1:                              ' "ウィンドウを閉じて、新しいウィンドウを開く"
    WINDOW #1,"Image Effecter",(16,45)-(16+gImageX,45+gImageY),_docNoGrow
  END IF
  CALL SETRECT(rect,0,0,gImageX,gImageY):         '"最初は320x240の画面を作成"
  err% = FN NEWGWORLD(gOffScreen&,32,rect,0,0,0):' "オフスクリーンを確保する"
  LONG IF err%
    BEEP:                                         ' "本当はアラートを出してメモリ不足の旨をユーザーに知らせるべきです"
    BEEP                                          ' "リソースエディタで128番のアラートでも作ってerr% = FN ALERT(128,0)とでもしましょう"
    END:                                          ' "多くの場合、メモリ不足"
  END IF
  FN getRowBytes:                                 ' "rowBytesを求める"
END FN
'-------------------------------------------------------------
' "PICTファイルをオープンしてオフスクリーンに描画する"
'-------------------------------------------------------------
CLEAR LOCAL
LOCAL FN openPictFile
  DIM rect;8
  
  f$ = FILES$(_fOpen,"PICT",,vRefNum%):           ' "ファイル選択ダイアログの表示"
  LONG IF f$<>""
    OPEN "I",#1, f$,,vRefNum%:                    ' "PICTファイルオープン"
    fileSize& = LOF(1,1):                         ' "ファイルサイズを求める"
    pictHandle& = FN NEWHANDLE(fileSize&+4)
    LONG IF pictHandle&
      err = FN HLOCK(pictHandle&):                ' "PICTハンドルをロック!"
      LONG IF err = 0
        READ FILE#1, [pictHandle&], fileSize&:    ' "ファイルサイズ分だけファイルから読み込む"
        BLOCKMOVE [pictHandle&]+512,[pictHandle&],fileSize& - 512:' "先頭512バイトを消す"
        err = FN HUNLOCK(pictHandle&):            ' "ハンドルロック解除"
        err = FN SETHANDLESIZE(pictHandle&, fileSize&-512):' "メモリサイズを512減らす"
        err = FN HLOCK(pictHandle&):              ' "ハンドルをロック!"
        rect;8 = [pictHandle&]+_picFrame:         ' "PICTの画像の矩形を取り出す"
        gImageX = rect.right:                     ' "右側の座標を取り出す"
        gImageY = rect.bottom:                    ' "下側の座標を取り出す"
        '----------------------------------------------------
        FN setOffscreen:                          ' "オフスクリーンを確保する!"
        CALL SETGWORLD(gOffScreen&,0):            '"オフスクリーンに切り替える"
        CALL DRAWPICTURE(pictHandle&,rect)
        CALL SETGWORLD(cport&,0):                 '"ウィンドウに切り替える"
        '----------------------------------------------------
        err = FN HUNLOCK(pictHandle&)
      END IF
      err = FN DISPOSHANDLE(pictHandle&):         ' "PICTハンドルを破棄"
    XELSE 
      BEEP:                                       ' "ハンドルが確保できない〜エラーいこっちゃ"
    END IF
    CLOSE #1:                                     ' "ファイルを閉じる"
  END IF
END FN
'--------------------------------
' "オフスクリーンからウィンドウへ転送"
'--------------------------------
CLEAR LOCAL
LOCAL FN transfer
  DIM rect;8
  
  LONG IF gOffScreen& > 0
    CALL SETRECT(rect,0,0,gImageX,gImageY):       ' "転送サイズを設定"
    CALL COPYBITS(#gOffScreen&+2,#cport&+2,rect,rect,_srcCopy,0):' "オフスクリーンからウィンドウに転送!"
  END IF
END FN
'-----------------------------------------------
' "オフスクリーンのカラーを読み出す"
'-----------------------------------------------
CLEAR LOCAL
LOCAL FN myPOINT(x,y)
  LONG IF gRowBytes% > 0
    adrs& = gGRAM& + y*gRowBytes% + x*4:          '"32ビットオフスクリーンなので1pixel=4byte。そのため4倍している"
    gR = PEEK(adrs&+1):                           ' "32ビットオフスクリーンはaRGB順に並んでいる。"
    gG = PEEK(adrs&+2)
    gB = PEEK(adrs&+3)
  END IF
END FN
'-----------------------------------------------
' "オフスクリーンに点を表示する"
'-----------------------------------------------
CLEAR LOCAL
LOCAL FN myPSET(x,y)
  LONG IF gRowBytes% > 0
    adrs& = gGRAM& + y*gRowBytes% + x*4:          '"32ビットオフスクリーンなので1pixel=4byte。そのため4倍している"
    POKE adrs&,0 :                                '"未使用領域(フォトショップ等ではαチャンネル保存用として使用される事もある)"
    POKE adrs&+1,gR:                              ' "32ビットオフスクリーンはaRGB順に並んでいる。"
    POKE adrs&+2,gG
    POKE adrs&+3,gB
  END IF
END FN
'--------------------------------------------------------
' "自前で画面を消去する"
' "勉強用なので、非常に低速な方法でやっている上に前々からの流用だ(笑)"
'--------------------------------------------------------
CLEAR LOCAL
LOCAL FN myCLS
  gR = 255
  gG = 255
  gB = 255
  FOR y = 0 TO gImageY-1
    FOR x = 0 TO gImageX-1
      FN myPSET(x,y)
    NEXT x
  NEXT y
END FN
'===============================================
'   "データ書き出し"
' "ここでテーブルタグに書き出します"
'===============================================
CLEAR LOCAL
LOCAL FN writeData
  WINDOW #2,"進行じょ〜きょ〜",(0,0)-(210,48),_dialogMovable
  CALL MOVETO(2,14)
  CALL DRAWSTRING("すすみ具合")
  BOX 5,24 TO 205,40
  COLOR _zRed
  PRINT #1,"";
  
  FOR y = 0 TO gImageY-1:                         ' 
    PRINT #1,"";
    FOR x = 0 TO gImageX-1
      FN myPOINT(x,y)
      saveR = gR
      saveG = gG
      saveB = gB
      FN myPOINT(x,y)
      rr$ = "0"+HEX$(gR)
      gg$ = "0"+HEX$(gG)
      bb$ = "0"+HEX$(gB)
      rr$ = RIGHT$(rr$,2)
      gg$ = RIGHT$(gg$,2)
      bb$ = RIGHT$(bb$,2)
      PRINT #1,"| ";theValue$;"";
    NEXT
    PRINT #1," | 
";CHR$(13);
    a = INT(6 + (y*200) / gImageY)
    BOX FILL 6,25 TO a,39
  NEXT
  WINDOW CLOSE #2
  PRINT #1,"
"
  BEEP:                                           ' "加工が終了したことをビープ音で知らせる!"
  FN transfer
END FN
'--------------------------------------------------------
'   "データの保存"
' "とりあえずTeachTEXTのファイルで保存"
'--------------------------------------------------------
CLEAR LOCAL
LOCAL FN savePict
  DIM header%(256), rect;8
  
  DEF OPEN "TEXTttxt":                            ' "ファイルタイプをPICTにする"
  saveFile$ = FILES$(_fSave,"保存ファイル名:","?.html",volRefNum%)
  LONG IF LEN(saveFile$):                         '"ファイル名の長さが1以上、つまりファイル名が入力された場合"
    OPEN "O",#1,saveFile$,,volRefNum%:            '"保存するファイル名で新規に開く"
    FN writeData
    CLOSE #1:                                     '"ファイルを閉じます"
  END IF
END FN
'--------------------------------------------------------
' "アップデートなどのイベントを取得する"
'--------------------------------------------------------
CLEAR LOCAL
LOCAL FN doDialog
  evnt = DIALOG(0)
  id = DIALOG(evnt):                              '"発生したイベントの種類"
  SELECT evnt
    CASE _wndRefresh:                             '"ウィンドウリフレッシュ(アップデートイベント)"
      FN transfer:                                '"アップデートイベントなので画面を再描画がする"
  END SELECT
END FN
'--------------------------------------------------------
' "アバウト画面の表示"
'--------------------------------------------------------
CLEAR LOCAL
LOCAL FN about
  err = FN ALERT(128,0)
END FN
'--------------------------------------------------------
' "タグの設定"
'--------------------------------------------------------
LOCAL FN setTAG
  editText_Number = 3:                            ' "数値入力の項目番号(リソース番号じゃなくて項目番号)"
  set_dialog = 129:                               ' "タグの中の文字を設定するダイアログのリソース番号"
  
  dPtr& = FN GETNEWDIALOG(set_dialog,0,-1):       ' "リソース(id=129)からダイアログを作成&表示"
  DO
    CALL MODALDIALOG(0,item%):                    ' "押された項目番号が入る"
  UNTIL item% = 1:                                ' "[設定]ボタン(id=1にしてある)が押されるまで繰り返す"
  CALL GETDITEM(dPtr&,editText_Number,itemType%,itemHandle&,itemRect):' "ダイアログの項目のハンドルを得るため"
  CALL GETITEXT(itemHandle&,theValue$):           ' "ダイアログの項目から文字列を得る"
  CALL DISPOSDIALOG(dPtr&):                       ' "不要になったのでダイアログを破棄"
  
END FN
'--------------------------------------------------------
' "メニューを構築する"
'--------------------------------------------------------
CLEAR LOCAL
LOCAL FN initMenu
  APPLE MENU "変換するやつについて(笑)..."
  
  '"ファイルメニュー"
  MENU _fileMenu,0,_enable,"ファイル"
  MENU _fileMenu,_fileOpen,_enable,"/O開く..."
  MENU _fileMenu,2,_enable,";"
  MENU _fileMenu,_fileSave,_enable,"/SHTMLで保存..."
  MENU _fileMenu,4,_enable,";"
  MENU _fileMenu,_fileQuit,_enable,"/Q終 了"
  
  ' "クリップボード等のコピー&ペーストを行う場合は EDIT MENU 2 とします。
  MENU _editMenu,0,_disable,"編集"
  MENU _editMenu,1,_disable,"取り消し"
  MENU _editMenu,2,_disable,";"
  MENU _editMenu,3,_disable,"/Xカット"
  MENU _editMenu,4,_disable,"/Cコピー"
  MENU _editMenu,5,_disable,"/Vペースト"
  MENU _editMenu,6,_disable,"消去"
  MENU _editMenu,7,_disable,";"
  MENU _editMenu,8,_disable,"/A全てを選択"
  
  ' "タグ設定メニュー"
  MENU 3,0,_enable,"文字設定"
  MENU 3,1,_enable,"/Dテーブル内の文字設定..."
  
END FN
'---------------------------------------------
' "メニューの選択"
'---------------------------------------------
CLEAR LOCAL
LOCAL FN doMenus
  menuID = MENU(_menuID):                         '"選択されたメニューバー項目の番号"
  itemID = MENU(_itemID):                         '"プルダウンメニューで選択された項目番号"
  
  SELECT menuID
    CASE _appleMenu:                              ' "アバウト画面の表示(_appleMenuはあらかじめ定義されています)"
      FN about
    CASE _fileMenu :                              ' "ファイルメニュー"
      SELECT itemID
        CASE _fileOpen:                           ' "画像を読み込む(開く)"
          FN openPictFile
        CASE _fileSave:                           ' "画像の保存"
          FN savePict
        CASE _fileQuit:                           ' "終了が選択された"
          gQuit_flag = _true
      END SELECT
    CASE 3:
      SELECT itemID
        CASE 1:
          FN setTAG
      END SELECT
      'headerType% = itemID - 1
      'DEF CHECKONEITEM(3,itemID)
  END SELECT
  MENU:                                           ' "これがないとメニューバーの項目が強調表示されたままになってしまいます"
END FN
WINDOW OFF
WINDOW #1,"変換元のいめ〜じ",(0,0)-(gImageX, gImageY),_docNoGrow
CALL GETPORT(cport&):                             ' "ウィンドウのグラフポートを確保"
ON MENU FN doMenus:                               '"メニューが選択された時の飛び先"
ON DIALOG FN doDialog:                            '"ダイアログイベントが発生した時の飛び先"
FN initMenu:                                      '"メニューの初期化"
FN setOffscreen:                                  '"オフスクリーンの確保"
FN myCLS:                                         '"画面を消去します"
FN transfer:                                      '"オフスクリーンからウィンドウへ画像を転送"
DO
  HANDLEEVENTS:                                   ' "イベント処理は自動"
UNTIL gQuit_flag
CALL DISPOSEGWORLD(gOffScreen&):                  ' "オフスクリーンの破棄"
END