teacup. [ 掲示板 ] [ 掲示板作成 ] [ 有料掲示板 ] [ ブログ ]

 投稿者
  題名
  内容 入力補助画像・ファイル<IMG>タグが利用可能です。(詳細)
    
 URL
[ ケータイで使う ] [ BBSティッカー ] [ 書込み通知 ] [ 検索 ]

スレッド一覧

  1. スレッドが使えます(2)
  2. Paract BASIC(22)
  3. Amusement_Program(10)
  4. 改修予定のJIS非互換(3)
  5. 複数ページ長編プログラム(新規投稿)(16)
  6. 「十進BASIC第2掲示板」投稿記事リスト(17)
  7. Full BASIC互換ライブラリ(8)
  8. 「十進BASIC掲示板過去ログ」インデックス(トピック)(17)
  9. 人の色覚の数理(14)
  10. 「十進BASIC掲示板過去ログ」インデックス(ツリー)(91)
スレッド一覧(全10)  他のスレッドを探す  スレッド作成

*掲示板をお持ちでない方へ、まずは掲示板を作成しましょう。無料掲示板作成


行列の掛け算式

 投稿者:しばっち  投稿日:2019年10月13日(日)19時26分29秒
返信・引用 編集済
  MathMLを使用してWebブラウザー上で数式を美麗に表示します。

https://6317.teacup.com/basic/bbs/4281
行列の掛け算式をWebブラウザー上で表示させます。

LET NN=4
LET MM=3
PUBLIC STRING A$(10,26,26),X$(26,26),SS$
DIM A(MM+1)
LET S$="abcdefghijklmnopqrstuvwxyz"
OPEN #1:NAME "行列掛け算.html"
ERASE #1
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:"<head>"
PRINT #1:"    <title>行列掛け算</title>"
PRINT #1:"    <script async src=";CHR$(34);"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/MathJax.js?config=TeX-MML-AM_CHTML";CHR$(34);"></script>"
PRINT #1:"</head>"
PRINT #1:"<body>"
PRINT #1:"<h1>行列掛け算</h1>"
FOR M=1 TO MM
   FOR I=1 TO NN
      FOR J=1 TO NN
         LET A$(M,I,J)="<msub><mi>"&S$(M:M)&"</mi><mn>"&STR$(I)&STR$(J)&"</mn></msub>"
      NEXT J
   NEXT I
NEXT M
FOR I=2 TO NN
   FOR P=2 TO MM
      PRINT #1:"<math>"
      CALL RECURSIVE(1,P+1,I,A)
      FOR M=1 TO P
         PRINT #1:"<mfenced>"
         PRINT #1:"<mtable>"
         FOR J=1 TO I
            PRINT #1:"<mtr>"
            FOR K=1 TO I-1
               PRINT #1:"<mtd>"
               PRINT #1:A$(M,J,K)
               PRINT #1:"</mtd>"
            NEXT K
            PRINT #1:"<mtd>"
            PRINT #1:A$(M,J,I)
            PRINT #1:"</mtd>"
            PRINT #1:"</mtr>"
         NEXT   J
         PRINT #1:"</mtable>"
         PRINT #1:"</mfenced>"
      NEXT    M
      PRINT #1:"</math>"
      PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
      PRINT #1:"<math>"
      PRINT #1:"<mo>=</mo>"
      CALL DISPLAY(I,X$,#1)
      PRINT #1:"</math>"
      PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
      PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
      PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
   NEXT P
NEXT I
PRINT #1:"</body>"
PRINT #1:"</html>"
CLOSE #1
END

EXTERNAL SUB RECURSIVE(NN,N,M,A())
IF N<NN THEN
   LET SS$=SS$&"<mo>+</mo><mi>"&A$(1,A(1),A(3))&"</mi>"
   FOR J=2 TO N-2
      LET SS$=SS$&"<mi>"&A$(J,A(J+1),A(J+2))&"</mi>"
   NEXT J
   LET SS$=SS$&"<mi>"&A$(N-1,A(N),A(2))&"</mi>"
   LET FL=0
   FOR J=3 TO N
      IF A(J)<>M THEN LET FL=1
   NEXT J
   IF FL=0 THEN
      LET SS$(1:10)=""
      LET X$(A(1),A(2))=SS$
      LET SS$=""
   END IF
ELSE
   FOR I=1 TO M
      LET A(NN)=I
      CALL RECURSIVE(NN+1,N,M,A)
   NEXT I
END IF
END SUB

EXTERNAL  SUB DISPLAY(N,P$(,),#1)
PRINT #1:"<mfenced>"
PRINT #1:"<mtable>"
FOR I=1 TO N
   PRINT #1:"<mtr>"
   FOR J=1 TO N-1
      PRINT #1:"<mtd>"
      PRINT #1:P$(I,J)
      PRINT #1:"</mtd>"
   NEXT J
   PRINT #1:"<mtd>"
   PRINT #1:P$(I,N)
   PRINT #1:"</mtd>"
   PRINT #1:"</mtr>"
NEXT I
PRINT #1:"</mtable>"
PRINT #1:"</mfenced>"
END SUB
 
 

数値積分公式

 投稿者:しばっち  投稿日:2019年10月13日(日)19時25分53秒
返信・引用 編集済
  MathMLを使用してWebブラウザー上で数式を美麗に表示します。

https://6317.teacup.com/basic/bbs/213
数値積分公式をWebブラウザー上で表示させます。

OPTION ARITHMETIC RATIONAL
OPTION BASE 0
PUBLIC NUMERIC MAXLEVEL
LET MAXLEVEL=20
DIM X(1),Y(MAXLEVEL+1),L(MAXLEVEL+1)
OPEN #1:NAME "数値積分公式.html"
ERASE #1
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:"<head>"
PRINT #1:"    <title>数値積分公式</title>"
PRINT #1:"    <script async src=";CHR$(34);"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/MathJax.js?config=TeX-MML-AM_CHTML";CHR$(34);"></script>"
PRINT #1:"</head>"
PRINT #1:"<body>"
PRINT #1:"<h1>数値積分公式</h1>"
FOR N=1 TO MAXLEVEL
   FOR I=0 TO N
      CALL CLR(Y)
      LET P=1
      LET Y(0)=1
      FOR J=0 TO N
         IF I<>J THEN
            LET X(0)=-J
            LET X(1)=1
            CALL MUL(Y,X)
            LET P=P*(I-J)
         END IF
      NEXT J
      CALL INTEGRAL(Y)
      LET L(I)=HORNER(Y,N)/P
   NEXT I
   PRINT #1:"<math>"
   PRINT #1:"<msubsup>"
   PRINT #1:"    <mo>∫</mo>"
   PRINT #1:"    <mi>x0</mi>"
   PRINT #1:"    <mi>x";STR$(N);"</mi>"
   PRINT #1:"</msubsup>"
   PRINT #1:"<mi>f</mi>"
   PRINT #1:"<mfenced>"
   PRINT #1:"    <mi>x</mi>"
   PRINT #1:"</mfenced>"
   PRINT #1:"<mrow>"
   PRINT #1:"    <mi>d</mi>"
   PRINT #1:"    <mi>x</mi>"
   PRINT #1:"</mrow>"
   PRINT #1:"<mo>=</mo>"
   FOR I=0 TO N
      IF L(I)<0 THEN
         PRINT #1:"<mo>-</mo>"
      ELSE
         IF I<>0 THEN PRINT #1:"<mo>+</mo>"
      END IF
      IF ABS(DENOM(L(I)))=1 THEN
         PRINT #1:"    <mn>";STR$(ABS(L(I)));"</mn>"
      ELSE
         PRINT #1:"<mfrac>"
         PRINT #1:"    <mn>";STR$(ABS(NUMER(L(I))));"</mn>"
         PRINT #1:"    <mn>";STR$(ABS(DENOM(L(I))));"</mn>"
         PRINT #1:"</mfrac>"
      END IF
      PRINT #1:"<mi>h</mi>"
      PRINT #1:"<mi>f</mi>"
      PRINT #1:"<mfenced>"
      PRINT #1:"    <mi>x";STR$(I);"</mi>"
      PRINT #1:"</mfenced>"
   NEXT I
   PRINT #1:"</math>"
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
NEXT N
PRINT #1:"</body>"
PRINT #1:"</html>"
CLOSE #1
END

EXTERNAL SUB MUL(A(),B())
OPTION ARITHMETIC RATIONAL
OPTION BASE 0
DIM C(MAXLEVEL)
FOR I=0 TO 1
   FOR J=0 TO MAXLEVEL-I
      LET C(I+J)=C(I+J)+A(J)*B(I)
   NEXT J
NEXT I
CALL COPY(A,C)
END SUB

EXTERNAL FUNCTION HORNER(A(),XX)
OPTION ARITHMETIC RATIONAL
LET N=DIMCHECK(A)
LET Y=A(N)
FOR I=N-1 TO 0 STEP-1
   LET Y=Y*XX+A(I)
NEXT I
LET HORNER=Y
END FUNCTION

EXTERNAL SUB COPY(X(),Y())
OPTION ARITHMETIC RATIONAL
MAT X=Y
END SUB


EXTERNAL FUNCTION DIMCHECK(X())
OPTION ARITHMETIC RATIONAL
FOR N=MAXLEVEL TO 0 STEP-1
   IF X(N)<>0 THEN EXIT FOR
NEXT N
LET DIMCHECK=N
END FUNCTION

EXTERNAL SUB CLR(X())
OPTION ARITHMETIC RATIONAL
MAT X=ZER
END SUB

EXTERNAL SUB INTEGRAL(A())
OPTION ARITHMETIC RATIONAL
OPTION BASE 0
DIM B(MAXLEVEL)
FOR I=MAXLEVEL-1 TO 0 STEP-1
   LET B(I+1)=A(I)/(I+1)
NEXT I
CALL COPY(A,B)
END SUB
 

数値微分公式

 投稿者:しばっち  投稿日:2019年10月13日(日)19時25分24秒
返信・引用 編集済
  MathMLを使用してWebブラウザー上で数式を美麗に表示します。

https://decimalbasic.ninja-web.net/log/article/b/basic/106/jiiymf/jiiymf.html
数値微分公式をWebブラウザー上で表示させます。

OPTION ARITHMETIC RATIONAL
OPTION BASE 0
PUBLIC NUMERIC MAXLEVEL
LET MAXLEVEL=51
DIM X(1),Y(MAXLEVEL),L(MAXLEVEL),M(MAXLEVEL)
INPUT PROMPT "微分階数=":NN
IF MOD(NN,2)=0 THEN LET N1=1 ELSE LET N1=2
OPEN #1:NAME "数値"&STR$(NN)&"次微分公式.html"
ERASE #1
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:"<head>"
PRINT #1:"    <title>数値"&STR$(NN)&"次微分公式</title>"
PRINT #1:"    <script async src=";CHR$(34);"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/MathJax.js?config=TeX-MML-AM_CHTML";CHR$(34);"></script>"
PRINT #1:"</head>"
PRINT #1:"<body>"
PRINT #1:"<h1>数値"&STR$(NN)&"次微分公式</h1>"
FOR N=NN+N1 TO MAXLEVEL STEP 2
   LET  P=INT(N/2+1) !'中央差分式
   !' FOR P=1 TO N
   FOR K=1 TO N
      MAT Y=ZER
      LET Y(0)=1
      FOR I=1 TO N
         IF K<>I THEN
            LET X(0)=-I
            LET X(1)=1
            CALL MUL(Y,X)
         END IF
      NEXT I
      LET L(K)=HORNER(Y,K)
      FOR I=1 TO NN
         CALL DERIVATIVE(Y)
      NEXT I
      LET M(K)=HORNER(Y,P)
   NEXT K
   PRINT #1:"<math>"
   PRINT #1:"<mfrac>"
   PRINT #1:"    <mrow>"
   PRINT #1:"        <msup>"
   PRINT #1:"            <mi>d</mi>"
   IF NN>1 THEN PRINT #1:"            <mn>";STR$(NN);"</mn>"
   PRINT #1:"        </msup>"
   PRINT #1:"    </mrow>"
   PRINT #1:"    <mrow>"
   PRINT #1:"        <msup>"
   PRINT #1:"            <mi>dx</mi>"
   IF NN>1 THEN PRINT #1:"            <mn>";STR$(NN);"</mn>"
   PRINT #1:"        </msup>"
   PRINT #1:"    </mrow>"
   PRINT #1:"</mfrac>"
   PRINT #1:"<mi>f</mi>"
   PRINT #1:"<mfenced>"
   PRINT #1:"    <mi>x</mi>"
   PRINT #1:"</mfenced>"
   PRINT #1:"<mo>=</mo>"
   FOR I=1 TO N
      LET GM=GCD(M(I),L(I))
      LET M(I)=M(I)/GM
      LET L(I)=L(I)/GM
   NEXT I
   LET LM=L(1)
   FOR I=2 TO N
      LET LM=LCM(LM,L(I))
   NEXT I
   FOR I=1 TO N
      LET B=LM/L(I)
      LET M(I)=M(I)*B
      LET L(I)=L(I)*B
   NEXT I
   PRINT #1:"<mfrac>"
   PRINT #1:"<mrow>"
   FOR I=1 TO N
      IF ABS(M(I))<>0 THEN
         IF M(I)*L(I)<0 THEN
            PRINT #1:"<mo>-</mo>"
         ELSE
            IF I>1 THEN PRINT #1:"<mo>+</mo>"
         END IF
         IF ABS(M(I))<>1 THEN PRINT #1:"<mn>";STR$(ABS(M(I)));"</mn>"
         PRINT #1:"<mi>f</mi>"
         PRINT #1:"<mfenced>"
         PRINT #1:"<mrow>"
         PRINT #1:"<mi>x</mi>"
         IF ABS(P-I)>0 THEN
            IF P-I<0 THEN PRINT #1:"<mo>+</mo>" ELSE PRINT #1:"<mo>-</mo>"
            IF ABS(P-I)>1 THEN PRINT #1:"<mn>";STR$(ABS(P-I));"</mn>"
            PRINT #1:"<mi>h</mi>"
         END IF
         PRINT #1:"</mrow>"
         PRINT #1:"</mfenced>"
      END IF
   NEXT I
   PRINT #1:"</mrow>"
   PRINT #1:"<mrow>"
   PRINT #1:"<mn>";STR$(ABS(L(1)));"</mn>"
   PRINT #1:"<msup>"
   PRINT #1:"<mi>h</mi>"
   IF NN>1 THEN PRINT #1:"<mn>";STR$(NN);"</mn>"
   PRINT #1:"</msup>"
   PRINT #1:"</mrow>"
   PRINT #1:"</mfrac>"
   !'NEXT P
   PRINT #1:"</math>"
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
NEXT N
PRINT #1:"</body>"
PRINT #1:"</html>"
CLOSE #1
END

EXTERNAL SUB MUL(A(),B())
OPTION ARITHMETIC RATIONAL
OPTION BASE 0
DIM C(MAXLEVEL)
FOR I=0 TO 1
   FOR J=0 TO MAXLEVEL-I
      LET C(I+J)=C(I+J)+A(J)*B(I)
   NEXT J
NEXT I
MAT A=C
END SUB

EXTERNAL SUB DERIVATIVE(A())
OPTION ARITHMETIC RATIONAL
OPTION BASE 0
DIM B(MAXLEVEL)
FOR I=MAXLEVEL TO 1 STEP-1
   LET B(I-1)=I*A(I)
NEXT I
MAT A=B
END SUB

EXTERNAL FUNCTION HORNER(A(),XX)
OPTION ARITHMETIC RATIONAL
LET Y=A(MAXLEVEL)
FOR I=MAXLEVEL-1 TO 0 STEP-1
   LET Y=Y*XX+A(I)
NEXT I
LET HORNER=Y
END FUNCTION

EXTERNAL FUNCTION LCM(A,B)
OPTION ARITHMETIC RATIONAL
LET LCM=A*B/GCD(A,B)
END FUNCTION
 

球の体積・表面積の公式

 投稿者:しばっち  投稿日:2019年10月13日(日)19時24分45秒
返信・引用 編集済
  MathMLを使用してWebブラウザー上で数式を美麗に表示します。

https://6317.teacup.com/basic/bbs/220
球の体積・表面積の公式をWebブラウザー上で表示させます。

OPTION ARITHMETIC RATIONAL
OPEN #1:NAME "球の体積.html"
ERASE #1
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:"<head>"
PRINT #1:"    <title>球の体積</title>"
PRINT #1:"    <script async src=";CHR$(34);"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/MathJax.js?config=TeX-MML-AM_CHTML";CHR$(34);"></script>"
PRINT #1:"</head>"
PRINT #1:"<body>"
PRINT #1:"<h1>球の体積</h1>"
FOR N=2 TO 100
   LET S=1
   FOR I=N TO 2 STEP-2
      LET S=S*I
   NEXT I
   LET L=GCD(S,2^((N+MOD(N,2))/2))
   LET LL=GCD(S,N*2^((N+MOD(N,2))/2))
   PRINT #1:"<math>"
   PRINT #1:"<mtext>";N;"次元の球の体積</mtext>"
   PRINT #1:"</math>"
   PRINT #1:"
"
   PRINT #1:"<math>"
   PRINT #1:"<msub>"
   PRINT #1:"    <mi>V</mi>"
   PRINT #1:"    <mn>";N;"</mn>"
   PRINT #1:"</msub>"
   PRINT #1:"<mo>=</mo>"
   IF S/L=1 THEN
      IF 2^((N+MOD(N,2))/2)/L>1 THEN PRINT #1:"    <mn>";STR$(2^((N+MOD(N,2))/2)/L);"</mn>"
   ELSE
      PRINT #1:"<mfrac>"
      PRINT #1:"    <mn>";STR$(2^((N+MOD(N,2))/2)/L);"</mn>"
      PRINT #1:"    <mn>";STR$(S/L);"</mn>"
      PRINT #1:"</mfrac>"
   END IF
   PRINT #1:"<msup>"
   PRINT #1:"    <mi>π</mi>"
   IF (N-MOD(N,2))/2>1 THEN PRINT #1:"    <mn>";STR$((N-MOD(N,2))/2);"</mn>"
   PRINT #1:"</msup>"
   PRINT #1:"<msup>"
   PRINT #1:"    <mi>r</mi>"
   IF N>1 THEN PRINT #1:"    <mn>";STR$(N);"</mn>"
   PRINT #1:"</msup>"
   PRINT #1:"</math>"
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
   PRINT #1:"<math>"
   PRINT #1:"<mtext>";N;"次元の球の表面積</mtext>"
   PRINT #1:"</math>"
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
   PRINT #1:"<math>"
   PRINT #1:"<msub>"
   PRINT #1:"    <mi>S</mi>"
   PRINT #1:"    <mn>";N;"</mn>"
   PRINT #1:"</msub>"
   PRINT #1:"<mo>=</mo>"
   IF S/LL=1 THEN
      IF N*2^((N+MOD(N,2))/2)/LL>1 THEN   PRINT #1:"<mn>";STR$(N*2^((N+MOD(N,2))/2)/LL);"</mn>"
   ELSE
      PRINT #1:"<mfrac>"
      PRINT #1:"<mn>";STR$(N*2^((N+MOD(N,2))/2)/LL);"</mn>"
      PRINT #1:"<mn>";STR$(S/LL);"</mn>"
      PRINT #1:"</mfrac>"
   END IF
   PRINT #1:"<msup>"
   PRINT #1:"<mi>π</mi>"
   IF (N-MOD(N,2))/2>1 THEN PRINT #1:"<mn>";STR$((N-MOD(N,2))/2);"</mn>"
   PRINT #1:"</msup>"
   PRINT #1:"<msup>"
   PRINT #1:"    <mi>r</mi>"
   IF N-1>1 THEN  PRINT #1:"    <mn>";STR$(N-1);"</mn>"
   PRINT #1:"</msup>"
   PRINT #1:"</math>"
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
NEXT N
PRINT #1:"</body>"
PRINT #1:"</html>"
CLOSE #1
END
 

TAN倍角公式

 投稿者:しばっち  投稿日:2019年10月13日(日)19時24分11秒
返信・引用 編集済
  MathMLを使用してWebブラウザー上で数式を美麗に表示します。

https://decimalbasic.ninja-web.net/log/article/b/basic/104/nkozlh/sdfoci.html#sdfoci
TAN倍角公式をWebブラウザー上で表示させます。

OPTION BASE 0
OPTION ARITHMETIC RATIONAL
PUBLIC NUMERIC MAXLEVEL
LET MAXLEVEL=50
DIM A(MAXLEVEL),B(MAXLEVEL),AA(MAXLEVEL),BB(MAXLEVEL),C(1),D(1)
LET C(0)=1
LET D(1)=1
LET B(1)=1
LET A(0)=1
OPEN #1:NAME "TAN倍角公式.html"
ERASE #1
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:"<head>"
PRINT #1:"    <title>TAN倍角公式</title>"
PRINT #1:"    <script async src=";CHR$(34);"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/MathJax.js?config=TeX-MML-AM_CHTML";CHR$(34);"></script>"
PRINT #1:"</head>"
PRINT #1:"<body>"
PRINT #1:"<h1>TAN倍角公式</h1>"
FOR K=2 TO MAXLEVEL
   FOR J=0 TO 1
      FOR I=0 TO MAXLEVEL-J
         LET AA(I+J)=AA(I+J)+A(I)*C(J)-B(I)*D(J)
         LET BB(I+J)=BB(I+J)+B(I)*C(J)+A(I)*D(J)
      NEXT I
   NEXT J
   MAT A=AA
   MAT B=BB
   MAT AA=ZER
   MAT BB=ZER
   PRINT #1:"<math>"
   PRINT #1:"<mi>tan</mi>"
   PRINT #1:"<mn>";STR$(K);"</mn>"
   PRINT #1:"<mi>θ</mi>"
   PRINT #1:"<mo>=</mo>"
   PRINT #1:"<mfrac>"
   PRINT #1:"<mrow>"
   CALL DISPLAY(B,#1)
   PRINT #1:"</mrow>"
   PRINT #1:"<mrow>"
   CALL DISPLAY(A,#1)
   PRINT #1:"</mrow>"
   PRINT #1:"</mfrac>"
   PRINT #1:"</math>"
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
NEXT K
PRINT #1:"</body>"
PRINT #1:"</html>"
CLOSE #1
END

EXTERNAL SUB DISPLAY(B(),#1)
OPTION ARITHMETIC RATIONAL
FOR JJ=MAXLEVEL TO 0 STEP-1
   IF B(JJ)<>0 THEN EXIT FOR
NEXT JJ
IF ABS(B(JJ))<>1 AND JJ>1 THEN
   PRINT #1:"<mn>";STR$(B(JJ));"</mn>"
   PRINT #1:"<msup>"
   PRINT #1:"    <mi>tan</mi>"
   PRINT #1:"    <mn>";STR$(JJ);"</mn>"
   PRINT #1:"</msup>"
   PRINT #1:"    <mi>θ</mi>"
ELSEIF ABS(B(JJ))=1 AND JJ>1 THEN
   IF B(JJ)<0 THEN PRINT #1:"<mo>-</mo>"
   PRINT #1:"<msup>"
   PRINT #1:"    <mi>tan</mi>"
   PRINT #1:"    <mn>";STR$(JJ);"</mn>"
   PRINT #1:"</msup>"
   PRINT #1:"<mi>θ</mi>"
END IF
FOR J=JJ-1 TO 2 STEP-1
   IF B(J)<>0 THEN
      IF B(J)<0 THEN PRINT #1:"<mo>-</mo>" ELSE PRINT #1:"<mo>+</mo>"
      IF B(J)<>1 THEN
         PRINT #1:"<mn>";STR$(ABS(B(J)));"</mn>"
         PRINT #1:"<msup>"
         PRINT #1:"    <mi>tan</mi>"
         PRINT #1:"    <mn>";STR$(J);"</mn>"
         PRINT #1:"</msup>"
         PRINT #1:"<mi>θ</mi>"
      ELSEIF B(J)=1 THEN
         PRINT #1:"<msup>"
         PRINT #1:"    <mi>tan</mi>"
         PRINT #1:"    <mn>";STR$(J);"</mn>"
         PRINT #1:"</msup>"
         PRINT #1:"<mi>θ</mi>"
      END IF
   END IF
NEXT J
IF B(1)<>0 THEN
   IF JJ>1 THEN
      IF B(1)<0 THEN PRINT #1:"<mo>-</mo>" ELSE PRINT #1:"<mo>+</mo>"
   END IF
   IF B(1)<>1 THEN
      PRINT #1:"<mn>";STR$(ABS(B(1)));"</mn>"
      PRINT #1:"<mi>tan</mi>"
      PRINT #1:"<mi>θ</mi>"
   ELSEIF B(1)=1 THEN
      PRINT #1:"<mi>tan</mi>"
      PRINT #1:"<mi>θ</mi>"
   END IF
END IF
IF B(0)<>0 THEN
   IF B(0)<0 THEN PRINT #1:"<mo>-</mo>" ELSE PRINT #1:"<mo>+</mo>"
   PRINT #1:"<mn>";STR$(ABS(B(0)));"</mn>"
END IF
END SUB
 

COS倍角公式

 投稿者:しばっち  投稿日:2019年10月13日(日)19時23分38秒
返信・引用 編集済
  MathMLを使用してWebブラウザー上で数式を美麗に表示します。

https://decimalbasic.ninja-web.net/log/article/b/basic/104/nkozlh/nkozlh.html
COS倍角公式をWebブラウザー上で表示させます。

OPTION BASE 0
OPTION ARITHMETIC RATIONAL
PUBLIC NUMERIC MAXLEVEL
LET MAXLEVEL=50
DIM NEWCOSINE(MAXLEVEL+1),COSINE(MAXLEVEL),OLDCOSINE(MAXLEVEL)
OPEN #1:NAME "COS倍角公式.html"
ERASE #1
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:"<head>"
PRINT #1:"    <title>COS倍角公式</title>"
PRINT #1:"    <script async src=";CHR$(34);"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/MathJax.js?config=TeX-MML-AM_CHTML";CHR$(34);"></script>"
PRINT #1:"</head>"
PRINT #1:"<body>"
PRINT #1:"<h1>COS倍角公式</h1>"
LET OLDCOSINE(0)=1
LET COSINE(1)=1
FOR K=2 TO MAXLEVEL
   FOR J=0 TO K
      LET NEWCOSINE(J+1)=NEWCOSINE(J+1)+2*COSINE(J)
      LET NEWCOSINE(J)=NEWCOSINE(J)-OLDCOSINE(J)
   NEXT J
   PRINT #1:"<math>"
   PRINT #1:"<mi>cos</mi>"
   PRINT #1:"<mn>";STR$(K);"</mn>"
   PRINT #1:"<mi>θ</mi>"
   PRINT #1:"<mo>=</mo>"
   CALL DISPLAYCOS(K,NEWCOSINE,#1)
   PRINT
   FOR I=0 TO K
      LET OLDCOSINE(I)=COSINE(I)
      LET COSINE(I)=NEWCOSINE(I)
      LET NEWCOSINE(I)=0
   NEXT I
   PRINT #1:"</math>"
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
NEXT K
PRINT #1:"</body>"
PRINT #1:"</html>"
CLOSE #1
END

EXTERNAL SUB DISPLAYCOS(K,COSINE(),#1)
OPTION ARITHMETIC RATIONAL
PRINT #1:"<mn>";STR$(COSINE(K));"</mn>"
PRINT #1:"<msup>"
PRINT #1:"    <mi>cos</mi>"
PRINT #1:"    <mn>";STR$(K);"</mn>"
PRINT #1:"</msup>"
PRINT #1:"<mi>θ</mi>"
FOR I=K-1 TO 1 STEP-1
   IF COSINE(I)<>0 THEN
      IF COSINE(I)<0 THEN PRINT #1:"<mo>-</mo>" ELSE PRINT #1:"<mo>+</mo>"
      IF I>1 THEN
         PRINT #1:"<mn>";STR$(ABS(COSINE(I)));"</mn>"
         PRINT #1:"<msup>"
         PRINT #1:"    <mi>cos</mi>"
         PRINT #1:"    <mn>";STR$(I);"</mn>"
         PRINT #1:"</msup>"
         PRINT #1:"    <mi>θ</mi>"
      ELSE
         PRINT #1:"<mn>";STR$(ABS(COSINE(I)));"</mn>"
         PRINT #1:"<mi>cos</mi>"
         PRINT #1:"<mi>θ</mi>"
      END IF
   END IF
NEXT I
IF COSINE(0)<>0 THEN
   IF COSINE(0)<0 THEN PRINT #1:"<mo>-</mo>" ELSE PRINT #1:"<mo>+</mo>"
   PRINT #1:"<mn>";STR$(ABS(COSINE(0)));"</mn>"
END IF
PRINT
END SUB
 

SIN倍角公式

 投稿者:しばっち  投稿日:2019年10月13日(日)19時22分58秒
返信・引用 編集済
  MathMLを使用してWebブラウザー上で数式を美麗に表示します。

https://decimalbasic.ninja-web.net/log/article/b/basic/104/nkozlh/nkozlh.html
SIN倍角公式をWebブラウザー上で表示させます。

OPTION ARITHMETIC RATIONAL
OPTION BASE 0
LET MAXLEVEL=50
DIM S(MAXLEVEL,MAXLEVEL)
OPEN #1:NAME "SIN倍角公式.html"
ERASE #1
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:"<head>"
PRINT #1:"    <title>SIN倍角公式</title>"
PRINT #1:"    <script async src=";CHR$(34);"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/MathJax.js?config=TeX-MML-AM_CHTML";CHR$(34);"></script>"
PRINT #1:"</head>"
PRINT #1:"<body>"
PRINT #1:"<h1>SIN倍角公式</h1>"
FOR N=2 TO MAXLEVEL
   PRINT #1:"<math>"
   PRINT #1:"<mi>sin</mi>"
   PRINT #1:"<mn>";STR$(N);"</mn>"
   PRINT #1:"<mi>θ</mi>"
   PRINT #1:"<mo>=</mo>"
   FOR K=0 TO N/2
      IF N-2*K-1>=0 THEN LET S(2*K+1,N-2*K-1)=(-1)^K*COMB(N,2*K+1)
   NEXT K
   CALL DISPLAYSIN(S,N,#1)
   PRINT #1:"</math>"
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
   MAT S=ZER
NEXT N
PRINT #1:"</body>"
PRINT #1:"</html>"
CLOSE #1
END

EXTERNAL SUB DISPLAYSIN(SINE(,),K,#1)
OPTION ARITHMETIC RATIONAL
DIM S(0 TO 2)
LET S(0)=1
LET S(2)=-1
FOR L=K TO 2 STEP-1
   FOR I=0 TO K-2
      FOR J=0 TO 2
         LET SINE(I+J,L-2)=SINE(I+J,L-2)+SINE(I,L)*S(J)
      NEXT J
      LET SINE(I,L)=0
   NEXT I
NEXT L
FOR I=K TO 0 STEP-1
   FOR J=K TO 0 STEP-1
      IF SINE(I,J)<>0 THEN
         IF FL=0 THEN
            IF SINE(I,J)<0 THEN PRINT #1:"<mo>-</mo>"
         END IF
         IF FL=1 THEN
            IF SINE(I,J)<0 THEN PRINT #1:"<mo>-</mo>" ELSE PRINT #1:"<mo>+</mo>"
         END IF
         IF I>1 THEN
            PRINT #1:"<mn>";STR$(ABS(SINE(I,J)));"</mn>"
            PRINT #1:"<msup>"
            PRINT #1:"    <mi>sin</mi>"
            PRINT #1:"    <mn>";STR$(I);"</mn>"
            PRINT #1:"</msup>"
            PRINT #1:"    <mi>θ</mi>"
         ELSEIF I=1 THEN
            PRINT #1:"<mn>";STR$(ABS(SINE(I,J)));"</mn>"
            PRINT #1:"<mi>sin</mi>"
            PRINT #1:"    <mi>θ</mi>"
         END IF
         IF J>1 THEN
            PRINT #1:"<msup>"
            PRINT #1:"    <mi>cos</mi>"
            PRINT #1:"    <mn>";STR$(J);"</mn>"
            PRINT #1:"</msup>"
            PRINT #1:"    <mi>θ</mi>"
         ELSEIF J=1 THEN
            PRINT #1:"<mi>cos</mi>"
            PRINT #1:"    <mi>θ</mi>"
         END IF
         LET FL=1
      END IF
   NEXT J
NEXT I
END SUB
 

和の公式

 投稿者:しばっち  投稿日:2019年10月13日(日)19時22分2秒
返信・引用 編集済
  MathMLを使用してWebブラウザー上で数式を美麗に表示します。

https://it-engineer-lab.com/archives/825
https://it-engineer-lab.com/archives/1000


実行するとhtmlファイルを書き出しますので
Webブラウザー上にD&Dしてください。
(又はhtmlファイルをダブルクリック)

現在最新のOpera ver64,Chrome ver77,Fire fox ver69,Vivaldi ver 2.7にて動作確認しています。


和の公式をWebブラウザー上で表示させます。
https://decimalbasic.ninja-web.net/log/article/b/basic/104/shyvwm/shyvwm.html


OPTION BASE 0
OPTION ARITHMETIC RATIONAL
PUBLIC NUMERIC MAXLEVEL
LET MAXLEVEL=50
DIM X(MAXLEVEL+1)
OPEN #1:NAME "和の公式.html"
ERASE #1
PRINT #1:"<!DOCTYPE html>"
PRINT #1:"<html>"
PRINT #1:"<head>"
PRINT #1:"    <title>和の公式</title>"
PRINT #1:"    <script async src=";CHR$(34);"https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2/MathJax.js?config=TeX-MML-AM_CHTML";CHR$(34);"></script>"
PRINT #1:"</head>"
PRINT #1:"<body>"
PRINT #1:"<h1>和の公式</h1>"
LET X(1)=1
FOR K=1 TO MAXLEVEL
   CALL SHORTMUL(X,K)
   CALL INTEGRAL(X)
   LET S=1
   FOR I=MAXLEVEL TO 2 STEP-1
      LET S=S-X(I)
   NEXT I
   LET X(1)=S
   PRINT #1:"<math>"
   PRINT #1:"    <munderover>"
   PRINT #1:"        <mi>∑</mi>"
   PRINT #1:"        <mrow>"
   PRINT #1:"        <mi>k</mi>"
   PRINT #1:"            <mo>=</mo>"
   PRINT #1:"            <mn>1</mn>"
   PRINT #1:"        </mrow>"
   PRINT #1:"        <mi>n</mi>"
   PRINT #1:"    </munderover>"
   PRINT #1:"    <msup>"
   PRINT #1:"        <mi>k</mi>"
   IF K>1 THEN PRINT #1:"        <mn>";STR$(K);"</mn>"
   PRINT #1:"    </msup>"
   PRINT #1:"<mo>=</mo>"
   CALL DISPLAY(X,#1)
   PRINT #1:"</math>"
   PRINT #1:CHR$(60);CHR$(98);CHR$(114);CHR$(62)
NEXT K
PRINT #1:"</body>"
PRINT #1:"</html>"
CLOSE #1
END

EXTERNAL SUB INTEGRAL(A())
OPTION ARITHMETIC RATIONAL
OPTION BASE 0
DIM B(MAXLEVEL)
FOR I=MAXLEVEL-1 TO 0 STEP-1
   LET B(I+1)=A(I)/(I+1)
NEXT I
CALL COPY(A,B)
END SUB

EXTERNAL FUNCTION DIMCHECK(X())
OPTION ARITHMETIC RATIONAL
FOR N=MAXLEVEL TO 0 STEP -1
   IF X(N)<>0 THEN EXIT FOR
NEXT N
LET DIMCHECK=N
END FUNCTION

EXTERNAL SUB DISPLAY(A(),#1)
OPTION ARITHMETIC RATIONAL
LET N=DIMCHECK(A)
IF N>1 THEN
   IF A(N)<0 THEN PRINT #1:"<mo>-</mo>"
   IF ABS(A(N))<>1 THEN
      IF ABS(DENOM(A(N)))=1 THEN
         PRINT #1:"    <mn>";STR$(ABS(A(N)));"</mn>"
      ELSE
         PRINT #1:"<mfrac>"
         PRINT #1:"    <mn>";STR$(ABS(NUMER(A(N))));"</mn>"
         PRINT #1:"    <mn>";STR$(ABS(DENOM(A(N))));"</mn>"
         PRINT #1:"</mfrac>"
      END IF
      PRINT #1:"<msup>"
      PRINT #1:"    <mi>n</mi>"
      PRINT #1:"    <mn>";STR$(N);"</mn>"
      PRINT #1:"</msup>"
   ELSE
      IF ABS(DENOM(A(N)))=1 THEN
         PRINT #1:"    <mn>";STR$(ABS(A(N)));"</mn>"
      ELSE
         PRINT #1:"<mfrac>"
         PRINT #1:"    <mn>";STR$(ABS(NUMER(A(N))));"</mn>"
         PRINT #1:"    <mn>";STR$(ABS(DENOM(A(N))));"</mn>"
         PRINT #1:"</mfrac>"
      END IF
      PRINT #1:"<msup>"
      PRINT #1:"    <mi>n</mi>"
      PRINT #1:"</msup>"
   END IF
END IF
FOR I=N-1 TO 2 STEP-1
   IF A(I)<>0 THEN
      IF A(I)<0 THEN PRINT #1:"<mo>-</mo>" ELSE PRINT #1:"<mo>+</mo>"
      IF ABS(A(I))<>1 THEN
         IF ABS(DENOM(A(I)))=1 THEN
            PRINT #1:"    <mn>";STR$(ABS(A(I)));"</mn>"
         ELSE
            PRINT #1:"<mfrac>"
            PRINT #1:"    <mn>";STR$(ABS(NUMER(A(I))));"</mn>"
            PRINT #1:"    <mn>";STR$(ABS(DENOM(A(I))));"</mn>"
            PRINT #1:"</mfrac>"
         END IF
         PRINT #1:"<msup>"
         PRINT #1:"    <mi>n</mi>"
         PRINT #1:"    <mn>";STR$(I);"</mn>"
         PRINT #1:"</msup>"
      ELSEIF ABS(A(I))=1 THEN
         PRINT #1:"<msup>"
         PRINT #1:"    <mi>n</mi>"
         PRINT #1:"    <mn>";STR$(I);"</mn>"
         PRINT #1:"</msup>"
      END IF
   END IF
NEXT I
IF A(1)<>0 THEN
   IF N>1 THEN
      IF A(1)<0 THEN PRINT #1:"<mo>-</mo>" ELSE PRINT #1:"<mo>+</mo>"
   END IF
   IF ABS(A(1))<>1 THEN
      IF ABS(DENOM(A(1)))=1 THEN
         PRINT #1:"    <mn>";STR$(ABS(A(1)));"</mn>"
      ELSE
         PRINT #1:"<mfrac>"
         PRINT #1:"    <mn>";STR$(ABS(NUMER(A(1))));"</mn>"
         PRINT #1:"    <mn>";STR$(ABS(DENOM(A(1))));"</mn>"
         PRINT #1:"</mfrac>"
      END IF
      PRINT #1:"<mi>n</mi>"
   ELSEIF ABS(A(1))=1 THEN
      PRINT #1:"<mi>n</mi>"
   END IF
END IF
IF A(0)<>0 THEN
   IF A(0)<0 THEN PRINT #1:"<mo>-</mo>" ELSE PRINT #1:"<mo>+</mo>"
   IF ABS(DENOM(A(0)))=1 THEN
      PRINT #1:"    <mn>";STR$(ABS(A(0)));"</mn>"
   ELSE
      PRINT #1:"<mfrac>"
      PRINT #1:"    <mn>";STR$(ABS(NUMER(A(0))));"</mn>"
      PRINT #1:"    <mn>";STR$(ABS(DENOM(A(0))));"</mn>"
      PRINT #1:"</mfrac>"
   END IF
END IF
END SUB

EXTERNAL SUB COPY(X(),Y())
OPTION ARITHMETIC RATIONAL
MAT X=Y
END SUB

EXTERNAL SUB SHORTMUL(X(),S)
OPTION ARITHMETIC RATIONAL
MAT X=(S)*X
END SUB
 

画像処理

 投稿者:しばっち  投稿日:2019年 9月26日(木)20時15分12秒
返信・引用
  open cvライブラリーを使用して、十進BASIC上で画像処理を行います。



なお、実行時にはopencv_world300.dllが必要です(BASIC.EXEと同じフォルダに入れてください)

下記URLからダウンロードしてください。(imagetool.zip)

https://36.gigafile.nu/1125-n8d2d72a2da1c926a4d213cd6f41f8bd3

ダウンロード期限:2019年11月25日(月)
ダウンロードキー:設定していません


※警告
open cvは日本語パスに対応していません。



FILE GETNAME F$,"画像ファイル|*.jpg;*.jpeg;*.png;*.gif;*.bmp"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
CALL GRAY(XSIZE*.2,YSIZE*.2,XSIZE*.8,YSIZE*.8)
END

EXTERNAL  SUB GRAY(XS,YS,XE,YE)
OPTION BASE 0
OPTION CHARACTER BYTE
LET XSIZE=INT(XE)-INT(XS)+1
LET YSIZE=INT(YE)-INT(YS)+1
DIM IN(XSIZE,YSIZE),OUT(XSIZE,YSIZE)
ASK PIXEL ARRAY (XS,YS) IN
LET IN$=REPEAT$(CHR$(0),XSIZE*YSIZE*3)
LET OUT$=REPEAT$(CHR$(0),XSIZE*YSIZE*3)
FOR Y=0 TO YSIZE-1
   FOR X=0 TO XSIZE-1
      LET ADR=(Y*XSIZE+X)*3+1
      CALL RGB(IN(X,Y),R,G,B)
      LET IN$(ADR:ADR)=CHR$(B)
      LET IN$(ADR+1:ADR+1)=CHR$(G)
      LET IN$(ADR+2:ADR+2)=CHR$(R)
   NEXT X
NEXT Y
CALL GRAY_(IN$,OUT$,XSIZE,YSIZE)
FOR Y=0 TO YSIZE-1
   FOR X=0 TO XSIZE-1
      LET ADR=(Y*XSIZE+X)+1
      LET R=ORD(OUT$(ADR:ADR))
      LET G=ORD(OUT$(ADR:ADR))
      LET B=ORD(OUT$(ADR:ADR))
      LET OUT(X,Y)=COLORINDEX(R/255,G/255,B/255)
   NEXT X
NEXT Y
MAT PLOT CELLS,IN XS,YS;XE,YE:OUT !'画像表示
!'
SUB GRAY_(INIMAGE$,OUTIMAGE$,WIDTH,HEIGHT)
   ASSIGN ".\DLL\imageprocessing.dll","gray_"
END SUB
END SUB

以下略
 

画像ファイル読み込み

 投稿者:しばっち  投稿日:2019年 9月26日(木)20時14分9秒
返信・引用
  open cvライブラリーを使用して、十進BASICが対応する画像ファイルの種類が増えました。
但し、gif形式には未対応です。

なお、実行時にはopencv_world300.dllが必要です(BASIC.EXEと同じフォルダに入れてください)

下記URLからダウンロードしてください。(imagetool.zip)

https://36.gigafile.nu/1125-n8d2d72a2da1c926a4d213cd6f41f8bd3

ダウンロード期限:2019年11月25日(月)
ダウンロードキー:設定していません


※警告
open cvは日本語パスに対応していません。


FILE GETNAME IMAGENAME$,"画像ファイル|*.bmp;*.dib;*.jpg;*.jpe;*.jpeg;*.jp2;*.png;*.pbm;*.pgm;*.ppm;*.sr;*.ras;*.tif;*.tiff;*.webp"
CALL IMAGELOAD(IMAGENAME$)
END

EXTERNAL SUB IMAGEINFO(FILENAME$,WIDTH,HEIGHT)
OPTION CHARACTER BYTE
LET WIDTH$=REPEAT$(CHR$(0),8)
LET HEIGHT$=REPEAT$(CHR$(0),8)
LET NUM=IMAGEINFO_(FILENAME$,WIDTH$,HEIGHT$)
IF NUM=-1 THEN
   PRINT "画像ファイルをロードできません"
   STOP
END IF
LET WIDTH=UNPACKDBL(WIDTH$)
LET HEIGHT=UNPACKDBL(HEIGHT$)
PRINT WIDTH;HEIGHT
!'
FUNCTION IMAGEINFO_(FILENAME$,WIDTH$,HEIGHT$)
   ASSIGN ".\DLL\imageload.dll","imageinfo"
END FUNCTION
END SUB

EXTERNAL  SUB IMAGELOAD(FILENAME$)
OPTION BASE 0
OPTION CHARACTER BYTE
IF FILENAME$="" THEN STOP
CALL IMAGEINFO(FILENAME$,WIDTH,HEIGHT)
LET MAP$=REPEAT$(CHR$(0),WIDTH*HEIGHT*3+100)
LET NUM=IMAGELOAD_(FILENAME$,MAP$)
IF NUM=-1 THEN
   PRINT "画像ファイルをロードできません"
   STOP
END IF
DIM M(WIDTH,HEIGHT)
CALL GINIT(WIDTH,HEIGHT)
FOR Y=0 TO HEIGHT-1
   FOR X=0 TO WIDTH-1
      LET ADR=(Y*WIDTH+X)*3+1
      LET R=ORD(MAP$(ADR+2:ADR+2))
      LET G=ORD(MAP$(ADR+1:ADR+1))
      LET B=ORD(MAP$(ADR:ADR))
      LET M(X,Y)=COLORINDEX(R/255,G/255,B/255)
   NEXT X
NEXT Y
MAT PLOT CELLS,IN 0,0;WIDTH-1,HEIGHT-1:M
!'
FUNCTION IMAGELOAD_(FILENAME$,MAP$)
   ASSIGN ".\DLL\imageload.dll","loadimage"
END FUNCTION
END SUB

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MIX(0) 0,0,0
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

-----------------------------------------------------------------------------
                       imageload.cpp


#include <opencv2/core/core.hpp>
#include <opencv2/imgproc/imgproc.hpp>
#include <opencv2/imgcodecs/imgcodecs.hpp>
#include <opencv2/highgui/highgui.hpp>

using namespace std;
using namespace cv;

extern "C"  __declspec(dllexport) int imageinfo(char *filename,double *width,double *height)
{
    Mat image = imread(filename, 1);
    if(!image.data) return -1;
    *height=image.rows; //縦の大きさ
    *width=image.cols; //横の大きさ
    return 0;
}

extern "C"  __declspec(dllexport) int loadimage(char *filename,char *framedata)
{
    Mat image = imread(filename, 1);
    if(!image.data) return -1;
    int height=image.rows; //縦の大きさ
    int width=image.cols; //横の大きさ
    for(int y=0; y<height; y++)
        for(int x=0; x<width; x++)
            for(int c=0; c<3; c++)
                framedata[(y*width+x)*3+c]=image.at<cv::Vec3b>(y,x)[c]; // c=0 blue, c=1 green, c=2 red
    return 0;
}
 

テンプレートマッチング

 投稿者:しばっち  投稿日:2019年 9月26日(木)20時12分48秒
返信・引用
  open cvライブラリーを使用して、十進BASIC上でテンプレートマッチングを行います。

ソース画像ファイルから検索対象とするテンプレート画像ファイルを使って
その位置を検索します。



なお、実行時にはopencv_world300.dllが必要です(BASIC.EXEと同じフォルダに入れてください)

下記URLからダウンロードしてください。(imagetool.zip)

https://36.gigafile.nu/1125-n8d2d72a2da1c926a4d213cd6f41f8bd3

ダウンロード期限:2019年11月25日(月)
ダウンロードキー:設定していません


※警告
open cvは日本語パスに対応していません。



サンプル画像はソース画像、テンプレート画像、検索結果の画像(赤枠)となります。


OPTION BASE 0
FILE GETNAME F$,"ソース画像ファイル|*.jpg;*.png;*.bmp"
IF F$="" THEN STOP
CALL PICTURELOAD(F$,XSIZE,YSIZE)
SET WINDOW 0,XSIZE-1,YSIZE-1,0
DIM SRC(XSIZE,YSIZE)
ASK PIXEL ARRAY (0,0) SRC
FILE GETNAME T$,"テンプレート画像ファイル|*.jpg;*.png;*.bmp" !'検索画像
IF T$="" THEN STOP
CALL PICTURELOAD(T$,XSIZE_T,YSIZE_T)
PAUSE !'一旦停止(テンプレート画像表示)
CALL GINIT(XSIZE,YSIZE)
MAT PLOT CELLS,IN 0,0; XSIZE-1,YSIZE-1:SRC !'画像表示
CALL TEMPLATEMATCHING(F$,T$,3,XS,YS,XE,YE,LMIN,LMAX)
SET LINE WIDTH 3
CALL BOX(XS,YS,XE,YE,255,0,0)
PRINT XS;YS;XE;YE
PRINT LMIN;LMAX
END

EXTERNAL  SUB TEMPLATEMATCHING(FILENAME$,TEMPLATENAME$,SW,XS,YS,XE,YE,LMIN,LMAX)
LET XS$=REPEAT$(CHR$(0),8)
LET YS$=REPEAT$(CHR$(0),8)
LET XE$=REPEAT$(CHR$(0),8)
LET YE$=REPEAT$(CHR$(0),8)
LET LMIN$=REPEAT$(CHR$(0),8)
LET LMAX$=REPEAT$(CHR$(0),8)
LET NUM=TEMPLATEMATCHING_(FILENAME$,TEMPLATENAME$,SW,XS$,YS$,XE$,YE$,LMIN$,LMAX$)
IF NUM=-1 THEN
   PRINT "ソース画像ファイルが読めません"
   STOP
ELSEIF NUM=-2 THEN
   PRINT "テンプレート画像ファイルが読めません"
   STOP
END IF
LET LMIN=UNPACKDBL(LMIN$)
LET LMAX=UNPACKDBL(LMAX$)
LET XS=UNPACKDBL(XS$)
LET YS=UNPACKDBL(YS$)
LET XE=UNPACKDBL(XE$)
LET YE=UNPACKDBL(YE$)
!'
FUNCTION TEMPLATEMATCHING_(FILENAME$,TEMPLATENAME$,SW,XS$,YS$,XE$,YE$,LMIN$,LMAX$)
   ASSIGN ".\DLL\templatematching.dll","templatematching"
END FUNCTION
END SUB

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
!'SET COLOR MIX(0) 0,0,0
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
END SUB

EXTERNAL SUB BOX(XS,YS,XE,YE,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT LINES:XS,YS;XE,YS
PLOT LINES:XE,YS;XE,YE
PLOT LINES:XE,YE;XS,YE
PLOT LINES:XS,YE;XS,YS
END SUB

----------------------------------------------------------------------------------
                            templatematching.cpp


#include <opencv2/core/core.hpp>
#include <opencv2/imgproc/imgproc.hpp>
#include <opencv2/imgcodecs/imgcodecs.hpp>
#include <opencv2/objdetect/objdetect.hpp>
#include <opencv2/highgui/highgui.hpp>

using namespace std;
using namespace cv;

extern "C"  __declspec(dllexport) int templatematching(char *filename,char *templatename,int sw,double *xs,double *ys,double *xe,double *ye,double *min,double *max)
{
    Mat src,temp,result;
    Point minpt,maxpt;
    double maxval,minval;

    src=imread(filename,1);
    if (!src.data) return -1;
    temp=imread(templatename,1);
    if (!temp.data) return -2;
    switch(sw)
    {
    case 0:
        matchTemplate(src,temp,result,TM_SQDIFF); //差の2乗の合計、小さいほど良くマッチしている
        break;
    case 1:
        matchTemplate(src,temp,result,TM_SQDIFF_NORMED); // 同上の正規化
        break;
    case 2:
        matchTemplate(src,temp,result,TM_CCORR); //乗算したものの合計、大きいほど良くマッチしている
        break;
    case 3:
        matchTemplate(src,temp,result,TM_CCORR_NORMED); //同上の正規化
        break;
    case 4:
        matchTemplate(src,temp,result,TM_CCOEFF); //相関係数であり、正に大きいほど良くマッチしている
        break;
    case 5:
        matchTemplate(src,temp,result,TM_CCOEFF_NORMED); //同上の正規化
        break;
    default:
        matchTemplate(src,temp,result,TM_CCORR_NORMED);
    }
    minMaxLoc(result,&minval,&maxval,&minpt,&maxpt);
    *min=minval;
    *max=maxval;
    *xs=maxpt.x;
    *ys=maxpt.y;
    *xe=maxpt.x+temp.cols;
    *ye=maxpt.y+temp.rows;
    return 0;
}
 

カメラ映像表示

 投稿者:しばっち  投稿日:2019年 9月26日(木)20時10分7秒
返信・引用
  open cvライブラリーを使用して、十進BASIC上でUSBカメラ、内臓カメラ映像を
表示します。※デジカメではありません。


解像度の指定はカメラデバイスが対応した解像度を指定してください。
カメラデバイスが複数ある場合は、IDナンバーを変えると別のカメラ映像が表示できます。

(注意)
※このプログラムは動作未テストです。
だって、内臓カメラもUSBカメラも持ってないんだもん(泣)

なお、実行時にはopencv_world300.dllが必要です(BASIC.EXEと同じフォルダに入れてください)

下記URLからダウンロードしてください。(imagetool.zip)

https://36.gigafile.nu/1125-n8d2d72a2da1c926a4d213cd6f41f8bd3

ダウンロード期限:2019年11月25日(月)
ダウンロードキー:設定していません

※警告
open cvは日本語パスに対応していません。


!'USBカメラ映像を表示する
OPTION BASE 0
LET XSIZE=640 !'カメラデバイス対応の解像度を指定すること
LET YSIZE=480
LET ID=0 !'カメラデバイスナンバー
DIM M(XSIZE,YSIZE)
CALL GINIT(XSIZE,YSIZE)
DO
   CALL GETCAMERAFRAME(ID,XSIZE,YSIZE,M)
   MAT PLOT CELLS,IN 0,0;XSIZE-1,YSIZE-1:M
   WAIT DELAY .3
LOOP
END

EXTERNAL SUB GETCAMERAFRAME(ID,WIDTH,HEIGHT,M(,))
OPTION CHARACTER BYTE
LET MAP$=REPEAT$(CHR$(0),WIDTH*HEIGHT*3)
LET NUM=GETCAMERAFRAME_(ID,WIDTH,HEIGHT,MAP$)
IF NUM=-1 THEN
   PRINT "カメラデバイスが見つかりません"
   STOP
ELSEIF NUM=-2 THEN
   PRINT "データが読み出せません"
   STOP
END IF
FOR Y=0 TO HEIGHT-1
   FOR X=0 TO WIDTH-1
      LET ADR=(Y*WIDTH+X)*3+1
      LET R=ORD(MAP$(ADR+2:ADR+2))
      LET G=ORD(MAP$(ADR+1:ADR+1))
      LET B=ORD(MAP$(ADR:ADR))
      LET M(X,Y)=COLORINDEX(R/255,G/255,B/255)
   NEXT X
NEXT Y
!'
FUNCTION GETCAMERAFRAME_(ID,WIDTH,HEIGHT,MAP$)
   ASSIGN ".\DLL\getcameraframe.dll","getcameraframe"
END FUNCTION
END SUB

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MIX(0) 0,0,0
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

--------------------------------------------------------------------------
                             getcameraframe.cpp


#include <opencv2/core/core.hpp>
#include <opencv2/imgproc/imgproc.hpp>
#include <opencv2/objdetect/objdetect.hpp>
#include <opencv2/highgui/highgui.hpp>

using namespace std;
using namespace cv;

extern "C"  __declspec(dllexport) int getcameraframe(int n,int width,int height,char *framedata)
{
    Mat img;
    VideoCapture cap(n);
    if (!cap.isOpened()) return -1;
    cap.set(CV_CAP_PROP_FRAME_WIDTH,width); //縦の大きさ
    cap.set(CV_CAP_PROP_FRAME_HEIGHT,height); //横の大きさ
    if (!cap.read(img)) return -2;
    cap>>img ; //1フレーム分取り出してimgに保持させる
    for(int y=0; y<height; y++)
        for(int x=0; x<width; x++)
            for(int c=0; c<3; c++)
                framedata[(y*width+x)*3+c]=img.at<cv::Vec3b>(y,x)[c]; // c=0 blue, c=1 green, c=2 red
    return 0;
}
            
 

動画フレーム切り出し

 投稿者:しばっち  投稿日:2019年 9月26日(木)20時08分50秒
返信・引用
  open cvライブラリーを使用して、十進BASIC上で画像ファイルだけでなく、
動画ファイルも読めるようになりました。(笑)

下記プログラムでは動画ファイルを読み込み、およそ1秒間隔(調整可 0.3秒~2秒)で
画像表示します(動画本来のフレームレートでは負荷が高いのでわざと落としています)

※音は出ません。

なお、実行時にはopencv_world300.dll 及び opencv_ffmpeg300.dll が必要です(BASIC.EXEと同じフォルダに入れてください)

下記URLからダウンロードしてください。(imagetool.zip)

https://36.gigafile.nu/1125-n8d2d72a2da1c926a4d213cd6f41f8bd3

ダウンロード期限:2019年11月25日(月)
ダウンロードキー:設定していません

※警告
open cvは日本語パスに対応していません。


OPTION BASE 0
FILE GETNAME VIDEONAME$,"動画ファイル|*.mp4;*.avi;*.wmv;*.mkv;*.flv;*.mpg;*.mov"
IF VIDEONAME$="" THEN STOP
CALL VIDEOINFO(VIDEONAME$,WIDTH,HEIGHT,MAXFRAME,FPS)
PRINT WIDTH;HEIGHT;MAXFRAME;FPS
DIM M(WIDTH,HEIGHT) !'バッファー
CALL GINIT(WIDTH,HEIGHT)
LET T=INT(TIME)
DO
LOOP WHILE INT(TIME)=T
LET I=0 !'動画フレームナンバー
LOCATE VALUE NOWAIT(1),RANGE .3 TO 2,AT 1:SECOND
DO
   LOCATE VALUE NOWAIT(1):SECOND  !'表示間隔
   LET SECOND=ROUND(SECOND,2)
   LET T=TIME
   PRINT I;"/";MAXFRAME-1
   CALL GETVIDEOFRAME(VIDEONAME$,WIDTH,HEIGHT,M,I)
   MAT PLOT CELLS,IN 0,0;WIDTH-1,HEIGHT-1:M !'画像表示
   DO
   LOOP WHILE TIME-T<=SECOND !'ウェイト
   LET I=I+INT(FPS*SECOND+.1)
   IF INT(FPS*SECOND+.1)=0 THEN LET I=I+1
LOOP WHILE I<MAXFRAME-1
PRINT MAXFRAME-1;"/";MAXFRAME-1
CALL GETVIDEOFRAME(VIDEONAME$,WIDTH,HEIGHT,M,MAXFRAME-1)
MAT PLOT CELLS,IN 0,0;WIDTH-1,HEIGHT-1:M !'画像表示
END

EXTERNAL SUB VIDEOINFO(VIDEONAME$,WIDTH,HEIGHT,MAXFRAME,FPS)
OPTION CHARACTER BYTE
LET WIDTH$=REPEAT$(CHR$(0),8)
LET HEIGHT$=REPEAT$(CHR$(0),8)
LET MAXFRAME$=REPEAT$(CHR$(0),8)
LET FPS$=REPEAT$(CHR$(0),8)
LET NUM=VIDEOINFO_(VIDEONAME$,WIDTH$,HEIGHT$,MAXFRAME$,FPS$)
IF NUM=-1 THEN
   PRINT "動画ファイルをロードできません"
   STOP
END IF
LET WIDTH=UNPACKDBL(WIDTH$)
LET HEIGHT=UNPACKDBL(HEIGHT$)
LET MAXFRAME=UNPACKDBL(MAXFRAME$)
LET FPS=UNPACKDBL(FPS$)
!'
FUNCTION VIDEOINFO_(VIDEONAME$,WIDTH$,HEIGHT$,MAXFRAME$,FPS$)
   ASSIGN ".\DLL\getvideoframe.dll","videoinfo"
END FUNCTION
END SUB

EXTERNAL SUB GETVIDEOFRAME(VIDEONAME$,XSIZE,YSIZE,M(,),N)
OPTION CHARACTER BYTE
LET MAP$=REPEAT$(CHR$(0),XSIZE*YSIZE*3)
LET NUM=GETVIDEOFRAME_(VIDEONAME$,MAP$,INT(N+.5))
IF NUM=-1 THEN
   PRINT "動画ファイルをロードできません"
   STOP
END IF
FOR Y=0 TO YSIZE-1
   FOR X=0 TO XSIZE-1
      LET ADR=(Y*XSIZE+X)*3+1
      LET R=ORD(MAP$(ADR+2:ADR+2))
      LET G=ORD(MAP$(ADR+1:ADR+1))
      LET B=ORD(MAP$(ADR:ADR))
      LET M(X,Y)=COLORINDEX(R/255,G/255,B/255)
   NEXT X
NEXT Y
!'
FUNCTION GETVIDEOFRAME_(VIDEONAME$,MAP$,NUM)
   ASSIGN ".\DLL\getvideoframe.dll","getvideoframe"
END FUNCTION
END SUB

EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MIX(0) 0,0,0
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

---------------------------------------------------------------------------------
                           getvideoframe.cpp


#include <opencv2/core/core.hpp>
#include <opencv2/imgproc/imgproc.hpp>
#include <opencv2/objdetect/objdetect.hpp>
#include <opencv2/highgui/highgui.hpp>

using namespace std;
using namespace cv;

extern "C"  __declspec(dllexport) int videoinfo(char *filename,double *width,double *height,double *max_frame,double *fps)
{
    Mat img;
    VideoCapture cap(filename);
    if (!cap.isOpened()) return -1;
    *width=cap.get(CV_CAP_PROP_FRAME_WIDTH); //縦の大きさ
    *height=cap.get(CV_CAP_PROP_FRAME_HEIGHT); //横の大きさ
    *max_frame=cap.get(CV_CAP_PROP_FRAME_COUNT); //フレーム数
    *fps=cap.get(CV_CAP_PROP_FPS); //フレームレート
    return 0;
}

extern "C"  __declspec(dllexport) int getvideoframe(char *filename,char *framedata,int num)
{
    Mat img;
    VideoCapture cap(filename);
    if (!cap.isOpened()) return -1;
    cap.set(CV_CAP_PROP_POS_FRAMES,num);

    int width=cap.get(CV_CAP_PROP_FRAME_WIDTH); //縦の大きさ
    int height=cap.get(CV_CAP_PROP_FRAME_HEIGHT); //横の大きさ
    cap>>img ; //1フレーム分取り出してimgに保持させる

    for(int y=0; y<height; y++)
        for(int x=0; x<width; x++)
            for(int c=0; c<3; c++)
                framedata[(y*width+x)*3+c]=img.at<cv::Vec3b>(y,x)[c]; // c=0 blue, c=1 green, c=2 red
    return 0;
}
 

画像認識

 投稿者:しばっち  投稿日:2019年 9月26日(木)20時07分27秒
返信・引用
  今現在注目されている技術でAI(人工知能)技術のひとつ機械学習による画像認識を
十進BASIC上で行います。

画像処理ライブラリーopen cvを使用しました。
https://opencv.org/


今回使用したのはWindows版ビルド済み open cv 3.0.0(2015-06-03) VC++2012 x86版です。
このためVC++2012にてコンパイルしました。

※現在の最新版はopen cv 4.1.1(2019-07-26)です。こちらはwin64(x64)のみです。


ライブラリー同梱のカスケードファイル(学習済みデータ)を使用して人物の正面顔を認識させます。
このカスケードファイルを別のに変更することで認識対象を変更することができます。


              ● 用意するもの

正面顔の人物画像(jpg,png) (自画撮り画像 等)
集合写真でも構いません。
※横向きの顔やアニメのキャラなどは認識できません。


なお、実行時にはopencv_world300.dllが必要です(BASIC.EXEと同じフォルダに入れてください)

集合写真の場合は、誤認識分も含めバッファサイズ(変数 N)を多めにしてください。
カスケードファイルのパスを指定してください。


下記URLからダウンロードしてください。(imagetool.zip)

https://36.gigafile.nu/1125-n8d2d72a2da1c926a4d213cd6f41f8bd3

ダウンロード期限:2019年11月25日(月)
ダウンロードキー:設定していません

※警告
open cvは日本語パスに対応していません。


サンプル画像は十進BASIC上で認識させた実行結果です。
認識した正面顔の座標領域(赤枠)は

219  203  389  373

となりました。

OPTION BASE 0
FILE GETNAME IMAGENAME$,"画像ファイル|*.jpg;*.png"
CALL PICTURELOAD(IMAGENAME$,XSIZE,YSIZE)
LET CASCADEFILENAME$="haarcascade_frontalface_default.xml" !'カスケードファイル(学習済みデータ) ※絶対パスか画像と同じフォルダ
LET N=100 !'バッファサイズ(誤認識分を含む100人分)
DIM XS(N),YS(N),XE(N),YE(N)
CALL IMAGEDETECTION(IMAGENAME$,CASCADEFILENAME$,N,XS,YS,XE,YE)
SET LINE WIDTH 4
FOR I=0 TO N-1
   CALL BOX(XS(I),YS(I),XE(I),YE(I),255,0,0)
   !'CALL ELLIPSE((XS(I)+XE(I))/2,(YS(I)+YE(I))/2,(XE(I)-XS(I))/2,(YE(I)-YS(I))/2,0,255,0)
   PRINT XS(I);YS(I);XE(I);YE(I)
NEXT I
END

EXTERNAL SUB IMAGEDETECTION(FILENAME$,CASCADEFIENAME$,N,XS(),YS(),XE(),YE())
OPTION CHARACTER BYTE
LET X0$=REPEAT$(CHR$(0),8*N)
LET X1$=REPEAT$(CHR$(0),8*N)
LET Y0$=REPEAT$(CHR$(0),8*N)
LET Y1$=REPEAT$(CHR$(0),8*N)
LET NUM=IMAGEDETECTION_(FILENAME$,CASCADEFIENAME$,N,X0$,Y0$,X1$,Y1$)
IF NUM=-1 THEN
   PRINT "画像ファイルをロードできません"
   STOP
ELSEIF NUM=-2 THEN
   PRINT "カスケードファイルをロードできません"
   STOP
END IF
IF N>NUM THEN
   FOR I=0 TO NUM-1
      LET XS(I)=UNPACKDBL(X0$(8*I+1:8*I+8))
      LET XE(I)=UNPACKDBL(X1$(8*I+1:8*I+8))
      LET YS(I)=UNPACKDBL(Y0$(8*I+1:8*I+8))
      LET YE(I)=UNPACKDBL(Y1$(8*I+1:8*I+8))
   NEXT I
ELSE
   PRINT "バッファ不足です"
END IF
LET N=NUM
!'
FUNCTION IMAGEDETECTION_(FILENAME$,CASCADEFIENAME$,NUM,X0$,Y0$,X1$,Y1$)
   ASSIGN ".\DLL\imagedetection.dll","imagedetection"
END FUNCTION
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
CLEAR
SET COLOR MODE "NATIVE"
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB BOX(XS,YS,XE,YE,R,G,B)
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT LINES:XS,YS;XE,YS
PLOT LINES:XE,YS;XE,YE
PLOT LINES:XE,YE;XS,YE
PLOT LINES:XS,YE;XS,YS
END SUB

EXTERNAL  SUB ELLIPSE(X,Y,XR,YR,R,G,B)
OPTION ANGLE DEGREES
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT LINES
FOR T=0 TO 360
   LET XX=X+XR*COS(T)
   LET YY=Y+YR*SIN(T)
   PLOT LINES:XX,YY;
NEXT T
PLOT LINES
END SUB

--------------------------------------------------------------------------------------
                                    imagedetection.cpp



#include <opencv2/core/core.hpp>
#include <opencv2/imgproc/imgproc.hpp>
#include <opencv2/objdetect/objdetect.hpp>
#include <opencv2/highgui/highgui.hpp>

using namespace cv;
using namespace std;

extern "C"  __declspec(dllexport) int imagedetection(char *imgfile, char *cascadefile,int num,double *x0,double *y0,double *x1,double *y1)
{
    /* 画像のロード */
    Mat image = imread(imgfile, 1);
    if(!image.data) return -1;

    /* 正面顔検出器のロード */
    CascadeClassifier cascade;
    if(!cascade.load(cascadefile)) return -2;

    vector<Rect> faces;
    int i;

    /* 顔検出 */
    cascade.detectMultiScale(image,faces);

    /* 顔領域 */
    if(num>faces.size()) {
        for( i = 0; i < faces.size(); i++ )
        {
            x0[i]=faces[i].x;
            y0[i]=faces[i].y;
            x1[i]=faces[i].x+faces[i].width;
            y1[i]=faces[i].y+faces[i].height;
        }

    }
    return  faces.size();
}
 

QRコード

 投稿者:しばっち  投稿日:2019年 9月22日(日)19時31分9秒
返信・引用
  C++ライブラリーを使用して十進BASIC上でQRコード(2次元バーコード)が
作成できるようになりました。

https://github.com/nayuki/QR-Code-generator

今回のビルド及びコンパイルはgccを使用しました。


なお、実行時は別途libgcc_s_dw2-1.dll 及び libstdc++-6.dllが必要です。
BASIC.exeと同じフォルダに入れてください。


下記URLからダウンロードしてください。(QRcode.zip)

https://36.gigafile.nu/1121-d77d1e27a240c031b77434afa7cc3d133

ダウンロード期限:2019年11月21日(木)
ダウンロードパス:設定していません


サンプル画像は下記プログラムで作成したこの掲示板URLのQRコードです


!'INPUT TEXT$
LET TEXT$="https://6317.teacup.com/basic/bbs"
CALL QRCODEGENERATE(TEXT$)
END

EXTERNAL  SUB QRCODEGENERATE(INPUT$)
OPTION CHARACTER BYTE
LET OUTPUT$=REPEAT$(CHR$(0),177*177)
LET N=QRCODEGENERATE_(INPUT$,OUTPUT$,2)
PRINT "SIZE=";N
LET BOADER=4
LET SCALE=10
DIM MAP(-BOADER TO N-1+BOADER,-BOADER TO N-1+BOADER)
FOR Y=-BOADER TO N-1+BOADER
   FOR X=-BOADER TO N-1+BOADER
      LET ADR=Y*N+X+1
      IF X>=0 AND Y>=0 AND X<N AND Y<N AND OUTPUT$(ADR:ADR)="1" THEN
         LET MAP(X,Y)=1
      END IF
   NEXT X
NEXT Y
SET BITMAP SIZE (BOADER+N)*SCALE,(BOADER+N)*SCALE
SET WINDOW 0,1,1,0
MAT PLOT CELLS, IN 0 , 0 ; 1 , 1 :MAP
!'
FUNCTION QRCODEGENERATE_(INPUT$,OUTPUT$,LEV)
   ASSIGN ".\DLL\qrcodegenerate.dll","qrcodegenerate"
END FUNCTION
END SUB

-----------------------------------------------------------------------------

                               qrcodegenerate.cpp


#include <cstdio>
#include <cstring>
#include "QrCode.hpp"

using qrcodegen::QrCode;
using qrcodegen::QrSegment;
using namespace qrcodegen;
using namespace std;

extern "C"  __declspec(dllexport) int qrcodegenerate(char *input,char *output,int lev)
{
    string out;
    QrCode::Ecc  errCorLvl;

    if (lev==0)
        errCorLvl=QrCode::Ecc::LOW;
    else if (lev==1)
        errCorLvl=QrCode::Ecc::MEDIUM;
    else if (lev==2)
        errCorLvl=QrCode::Ecc::HIGH;
    else
        errCorLvl=QrCode::Ecc::HIGH;

    const QrCode qr = QrCode::encodeText(input, errCorLvl);

    for (int y = 0; y < qr.getSize(); y++)
        for (int x = 0; x < qr.getSize(); x++)
            if(qr.getModule(x, y)) out=out+"1";
            else out=out+"0";

    strcpy(output,out.c_str());
    return qr.getSize();
}

 

アプリ判定

 投稿者:しばっち  投稿日:2019年 9月18日(水)19時30分40秒
返信・引用
  実行ファイル(exe,dll)がwin32(x86)かwin64(x64)かを判定します。

http://foma-zakki.cocolog-nifty.com/zakki/2010/08/win-win32-ka-73.html#_ga=1.182028135.1709505233.1471867811



OPTION CHARACTER BYTE
LET A$=REPEAT$(CHR$(0),2048)
FILE GETNAME F$,"実行ファイル|*.EXE;*.DLL"
IF F$="" THEN STOP
OPEN #1:NAME F$
FOR I=1 TO 2048
   CHARACTER INPUT #1,IF MISSING THEN EXIT FOR:A$(I:I)
NEXT I
CLOSE #1
LET X86$=HEXCHR$("504500004C01")
LET X64$=HEXCHR$("504500006486")
FOR I=1 TO 2043
   LET X$=A$(I:I+5)
   IF X$=X86$ THEN
      PRINT "WIN32(x86)"
      STOP
   ELSEIF X$=X64$ THEN
      PRINT "WIN64(x64)"
      STOP
   END IF
NEXT I
PRINT "不明"
END

EXTERNAL FUNCTION HEXCHR$(X$)
OPTION CHARACTER BYTE
IF MOD(LEN(X$),2)=1 THEN LET X$=X$ & "0"
FOR I=1 TO LEN(X$) STEP 2
   LET S$=S$&CHR$(BVAL(MID$(X$,I,2),16))
NEXT I
LET HEXCHR$=S$
END FUNCTION
 

Re: win64版十進BASICのリリースを

 投稿者:SHIRAISHI Kazuo  投稿日:2019年 9月15日(日)08時24分3秒
返信・引用
  > No.4722[元記事へ]

Win64だとstdcallとcdeclが同じものになるので,64ビットであればcdeclで作成したものでも呼び出せるはずです。

Lazarus64ビット版でコンパイル

library Sample;

function add(a,b:Int64): Int64; cdecl;
begin
   add:=a+b
end;

function sub(a,b:Int64): Int64; cdecl;
begin
   sub:=a-b
end;

exports add, sub;

end.

BASICAccを64ビットでコンパイルしたものを使用

100 FUNCTION ADD(a,b)
110    ASSIGN "Sample.dll","add"
120 END FUNCTION
130
140 FUNCTION SUB(a,b)
150    ASSIGN "Sample.dll","sub"
160 END FUNCTION
170
180 PRINT ADD(5,-4),SUB(4,7)
190 END

DLLはBASICAccと同じディレクトリに置くか,フルパス名で指定してください。

実行結果

1                      -3
 

Re: win64版十進BASICのリリースを

 投稿者:しばっち  投稿日:2019年 9月13日(金)19時17分44秒
返信・引用
  > No.4718[元記事へ]

SHIRAISHI Kazuoさんへのお返事です。

> 公開する関数にstdcall(C++では,__stdcall)を指定すること。

-------------------------------------------------------------------
                       airy_.cpp


#include <boost/math/special_functions/airy.hpp>
using namespace boost::math;
using namespace std;

extern "C"  __declspec(dllexport)  double airy_ai_(double *a)
{
    try {
        return airy_ai(*a);
    } catch (...) {
        return -99999999.0;
    }
}

extern "C"  __declspec(dllexport)  double airy_bi_(double *a)
{
    try {
        return airy_bi(*a);
    } catch (...) {
        return -99999999.0;
    }
}


EXTERNAL FUNCTION AIRY_AI(Z)
OPTION CHARACTER BYTE
LET X$=PACKDBL$(Z)
LET AIRY_AI=AIRY_AI_(X$)

FUNCTION AIRY_AI_(X$)
   ASSIGN ".\DLL\airy_.dll","airy_ai_",FPU
END FUNCTION
END FUNCTION

EXTERNAL FUNCTION AIRY_BI(Z)
OPTION CHARACTER BYTE
LET X$=PACKDBL$(Z)
LET AIRY_BI=AIRY_BI_(X$)

FUNCTION AIRY_BI_(X$)
   ASSIGN ".\DLL\airy_.dll","airy_bi_",FPU
END FUNCTION
END FUNCTION


__stdcallをつけずにコンパイルしたDLLは上記の定義でBASIC7854は動きます。(cdecl呼び出し規約)

__stdcallをつけてコンパイルしたDLLは下記のように訂正すればBASIC7854やBASIC 8017Jaでも動きました。(stdcall呼び出し規約)
C++では関数名が変わってしまうのようです。


EXTERNAL FUNCTION AIRY_AI(Z)
OPTION CHARACTER BYTE
LET X$=PACKDBL$(Z)
LET AIRY_AI=AIRY_AI_(X$)

FUNCTION AIRY_AI_(X$)
   ASSIGN ".\DLL\airy_.dll","_airy_ai_@4",FPU
END FUNCTION
END FUNCTION

EXTERNAL FUNCTION AIRY_BI(Z)
OPTION CHARACTER BYTE
LET X$=PACKDBL$(Z)
LET AIRY_BI=AIRY_BI_(X$)

FUNCTION AIRY_BI_(X$)
   ASSIGN ".\DLL\airy_.dll","_airy_bi_@4",FPU
END FUNCTION
END FUNCTION


いちいち関数名を調べるのは煩雑なので  cdecl 呼び出し規約でBASIC7854のようにBASICAcc, BASIC8017Ja を動くようにできませんか?

http://home.a00.itscom.net/hatada/mcc/doc2012/functioncall.html
https://ja.wikipedia.org/wiki/呼出規約

また、作成したDLLファイルが別のDLL(ライブラリーでビルドしたdll等)を要求するような場合は、stdcallではコンパイルが通らないようです。(cdeclなら通る)
これは別のDLLが cdecl 呼び出し規約でビルドされているからなのかもしれません。
 

Re: win64版十進BASICのリリースを

 投稿者:SHIRAISHI Kazuo  投稿日:2019年 9月13日(金)15時38分11秒
返信・引用
  > No.4720[元記事へ]

SHIRAISHI Kazuoさんへのお返事です。

> SHIRAISHI Kazuoさんへのお返事です。
> BASICAcc自体は32ビットで動いているので,ASSIGN文を翻訳するときは32ビット版のDLLをテストしているの対し,実行時は64ビット版を要求するのが原因でした。
> Windowsは,32ビットと64ビットで同名のDLLを持っているので動作していました。

Lazarus 64ビット版の「プロジェクトを開く」でsourceフォルダ内のBASIAccを指定し,
BASICAcc.dprの49行目
{$IFDEF Win32} ExtDll,{$ENDIF}

{$IFDEF Windows} ExtDll,{$ENDIF}
に書き換えてコンパイル。
すると,ExtDLL.pasの102行目
  PUSH EAX
でエラーになるので,

Function RoundToLongint(x:extended):longint;assembler;
asm
    PUSH EDX
    PUSH EAX
    FLD x
    FISTP QWORD PTR [ESP]
    WAIT
    POP EAX
    POP EDX
end;

をすべて削除して再度コンパイルしてください。
 

Re: win64版十進BASICのリリースを

 投稿者:SHIRAISHI Kazuo  投稿日:2019年 9月13日(金)14時07分30秒
返信・引用
  > No.4719[元記事へ]

SHIRAISHI Kazuoさんへのお返事です。
BASICAcc自体は32ビットで動いているので,ASSIGN文を翻訳するときは32ビット版のDLLをテストしているの対し,実行時は64ビット版を要求するのが原因でした。
Windowsは,32ビットと64ビットで同名のDLLを持っているので動作していました。


> SHIRAISHI Kazuoさんへのお返事です。
>
> http://hp.vector.co.jp/authors/VA008683/MakeDLL_Laz.htm
> の例1を64ビットLazarusで試してみたら,
> BASICAccで
>
> [Warning]
> Syntax Error at line 3
> Sample.dll could not be loaded.
>
> となってしまいました。
> Lazarusで64ビットDLLを作るとWindows APIと仕様が異なるのかもしれません。
> でも,Lazarusで作ったDLLがLazarusのLoadLibraryで読み込めないのは不思議。
>
 

レンタル掲示板
/167