// よせあつめ関数集 for Delphi // // 作成開始：1998/05〜 // 最終改定：2008/06/27 // // programing：baruth // e-mail:baruth@csc.jp // unit MyJunk; interface uses Graphics, SysUtils, Windows; (* 定数 *) const mjVER = '080627'; //最終改定年月日 mjCR = #$0d; //改行文字 mjLF = #$0a; //復帰文字 mjCRLF = mjCR + mjLF; //改行復帰 mjESC = #$1b; //ESC文字 //sin(deg)のテーブル：-360度〜+450度(cos用に+90度多く用意) //value:-127..127 mjSINVAL: array[-360..449] of ShortInt = ( 0, 2, 4, 7, 9, 11, 13, 15, 18, 20, 22, 24, 26, 29, 31, 33, 35, 37, 39, 41, 43, 46, 48, 50, 52, 54, 56, 58, 60, 62, 64, 65, 67, 69, 71, 73, 75, 76, 78, 80, 82, 83, 85, 87, 88, 90, 91, 93, 94, 96, 97, 99, 100, 101, 103, 104, 105, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 119, 120, 121, 121, 122, 123, 123, 124, 124, 125, 125, 125, 126, 126, 126, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 126, 126, 126, 125, 125, 125, 124, 124, 123, 123, 122, 121, 121, 120, 119, 119, 118, 117, 116, 115, 114, 113, 112, 111, 110, 109, 108, 107, 105, 104, 103, 101, 100, 99, 97, 96, 94, 93, 91, 90, 88, 87, 85, 83, 82, 80, 78, 76, 75, 73, 71, 69, 67, 65, 63, 62, 60, 58, 56, 54, 52, 50, 48, 46, 43, 41, 39, 37, 35, 33, 31, 29, 26, 24, 22, 20, 18, 15, 13, 11, 9, 7, 4, 2, 0, -2, -4, -7, -9, -11, -13, -15, -18, -20, -22, -24, -26, -29, -31, -33, -35, -37, -39, -41, -43, -46, -48, -50, -52, -54, -56, -58, -60, -62, -64, -65, -67, -69, -71, -73, -75, -76, -78, -80, -82, -83, -85, -87, -88, -90, -91, -93, -94, -96, -97, -99, -100, -101, -103, -104, -105, -107, -108, -109, -110, -111, -112, -113, -114, -115, -116, -117, -118, -119, -119, -120, -121, -121, -122, -123, -123, -124, -124, -125, -125, -125, -126, -126, -126, -127, -127, -127, -127, -127, -127, -127, -127, -127, -127, -127, -126, -126, -126, -125, -125, -125, -124, -124, -123, -123, -122, -121, -121, -120, -119, -119, -118, -117, -116, -115, -114, -113, -112, -111, -110, -109, -108, -107, -105, -104, -103, -101, -100, -99, -97, -96, -94, -93, -91, -90, -88, -87, -85, -83, -82, -80, -78, -76, -75, -73, -71, -69, -67, -65, -63, -62, -60, -58, -56, -54, -52, -50, -48, -46, -43, -41, -39, -37, -35, -33, -31, -29, -26, -24, -22, -20, -18, -15, -13, -11, -9, -7, -4, -2, 0, 2, 4, 7, 9, 11, 13, 15, 18, 20, 22, 24, 26, 29, 31, 33, 35, 37, 39, 41, 43, 46, 48, 50, 52, 54, 56, 58, 60, 62, 63, 65, 67, 69, 71, 73, 75, 76, 78, 80, 82, 83, 85, 87, 88, 90, 91, 93, 94, 96, 97, 99, 100, 101, 103, 104, 105, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 119, 120, 121, 121, 122, 123, 123, 124, 124, 125, 125, 125, 126, 126, 126, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 126, 126, 126, 125, 125, 125, 124, 124, 123, 123, 122, 121, 121, 120, 119, 119, 118, 117, 116, 115, 114, 113, 112, 111, 110, 109, 108, 107, 105, 104, 103, 101, 100, 99, 97, 96, 94, 93, 91, 90, 88, 87, 85, 83, 82, 80, 78, 76, 75, 73, 71, 69, 67, 65, 64, 62, 60, 58, 56, 54, 52, 50, 48, 46, 43, 41, 39, 37, 35, 33, 31, 29, 26, 24, 22, 20, 18, 15, 13, 11, 9, 7, 4, 2, 0, -2, -4, -7, -9, -11, -13, -15, -18, -20, -22, -24, -26, -29, -31, -33, -35, -37, -39, -41, -43, -46, -48, -50, -52, -54, -56, -58, -60, -62, -63, -65, -67, -69, -71, -73, -75, -76, -78, -80, -82, -83, -85, -87, -88, -90, -91, -93, -94, -96, -97, -99, -100, -101, -103, -104, -105, -107, -108, -109, -110, -111, -112, -113, -114, -115, -116, -117, -118, -119, -119, -120, -121, -121, -122, -123, -123, -124, -124, -125, -125, -125, -126, -126, -126, -127, -127, -127, -127, -127, -127, -127, -127, -127, -127, -127, -126, -126, -126, -125, -125, -125, -124, -124, -123, -123, -122, -121, -121, -120, -119, -119, -118, -117, -116, -115, -114, -113, -112, -111, -110, -109, -108, -107, -105, -104, -103, -101, -100, -99, -97, -96, -94, -93, -91, -90, -88, -87, -85, -83, -82, -80, -78, -76, -75, -73, -71, -69, -67, -65, -64, -62, -60, -58, -56, -54, -52, -50, -48, -46, -43, -41, -39, -37, -35, -33, -31, -29, -26, -24, -22, -20, -18, -15, -13, -11, -9, -7, -4, -2, 0, 2, 4, 7, 9, 11, 13, 15, 18, 20, 22, 24, 26, 29, 31, 33, 35, 37, 39, 41, 43, 46, 48, 50, 52, 54, 56, 58, 60, 62, 63, 65, 67, 69, 71, 73, 75, 76, 78, 80, 82, 83, 85, 87, 88, 90, 91, 93, 94, 96, 97, 99, 100, 101, 103, 104, 105, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 119, 120, 121, 121, 122, 123, 123, 124, 124, 125, 125, 125, 126, 126, 126, 127, 127, 127, 127, 127 ); (* 変数 *) var __mjTickTime: DWORD; //LAP計測に使用する変数 (* 1.汎用関数 *) procedure mjSwap(var a, b: Integer); function mjBigger(a, b: Integer): Integer; function mjSmaller(a, b: Integer): Integer; function mjMaxOf3(a, b, c: Integer): Integer; function mjMinOf3(a, b, c: Integer): Integer; function mjAveOf3(a, b, c: Integer): Integer; function mjMaxOf(const aa: array of Integer): Integer; function mjMinOf(const aa: array of Integer): Integer; function mjAveOf(const aa: array of Integer): Integer; function mjSumOf(const aa: array of Integer): Integer; function mjTrimedAve(const aa: array of Integer): Integer; procedure mjSelectSort(var aa: array of Integer); procedure mjDCountSort(const aa: array of Integer; var bb: array of Integer); function mjSelect(aa: array of Integer; kk: Integer): Integer; function mjStdevInt(const x: array of Integer): Extended; (* 2.数値変換関数 *) function mjInt2Bin(ii, nn: Integer): String; function mjBin2Int(const bn: String): Integer; function mjHex2Int(const hx: String): Integer; (* 3.色変換関数 *) procedure mjPix2RGB(C: TColor; var R, G, B: Integer); procedure mjRGB2HSV(R, G, B: Integer; var H, S, V: Integer); procedure mjRGB2HSVeX(R, G, B: Integer; var H, S, V: Single); procedure mjHSV2RGB(H, S, V: Integer; var R, G, B: Integer); procedure mjHSV2RGBeX(H, S, V: Single; var R, G, B: Integer); function mjRGB2Y(R, G, B: Integer): Integer; function mjColorMix(iro1, iro2: TColor; ratio: Integer): TColor; (* 4.文字列関数：String型対象 *) function mjIsKanji(c: Char): Boolean; function mjIsKanji2(c: Char): Boolean; function mjLenM(const s: String): Integer; function mjM2Index(s: String; mm: Integer): Integer; function mjMidB(const s: String; sp, bb: Integer): String; function mjMidM(const s: String; sp, mm: Integer): String; function mjLeftB(const s: String; bb: Integer): String; function mjLeftM(const s: String; mm: Integer): String; function mjRightB(const s: String; bb: Integer): String; function mjRightM(const s: String; mm: Integer): String; function mjStrSplit(const s, d: String; nn: Integer): String; function mjStrSplitByChar(s: String; c: Char; nn: Integer): String; function mjStrCount(const s, d: String): Integer; function mjInsert(ss, TargetS: String; pt: Integer): String; function mjCharDelete(s: String; c: Char): String; function mjStrReplace(const s, d1, d2: String): String; (* 5.その他 *) function mjTailYen(const src: String): String; function mjWinDir: String; function mjSysDir: String; function mjTmpDir: String; procedure mjElapseStart; function mjElapse: DWORD; function mjSin(const aa, deg: Integer): Integer; function mjCos(const aa, deg: Integer): Integer; procedure mjKyoku2XY(const x0, y0, Ang, Len: Integer; var xp, yp: Integer); function mjGetCPUClock: Int64; implementation (* 1.汎用関数 *) ///////////////////////////////////////////////////////////////////// //整数値a,bを入れ替える procedure mjSwap(var a, b: Integer); var z: Integer; begin z:= a; a:= b; b:= z; (******** xor方式では、mjSwap(a,a)とした時、０になってしまう a:= a xor b; //bit合成 a:=(a+b) b:= a xor b; //b':=(a+b)-b a:= a xor b; //a':=(a+b)-a ********) end; ///////////////////////////////////////////////////////////////////// //整数値a,bを比較し、大きい方を返す function mjBigger(a, b: Integer): Integer; begin if (a > b) then Result:= a else Result:= b; end; ///////////////////////////////////////////////////////////////////// //整数値a,bを比較し、小さい方を返す function mjSmaller(a, b: Integer): Integer; begin if (a < b) then Result:= a else Result:= b; end; ///////////////////////////////////////////////////////////////////// //整数値a,b,cの中で最大の値を返す function mjMaxOf3(a, b, c: Integer): Integer; begin Result:= mjBigger(a, mjBigger(b, c)); end; ///////////////////////////////////////////////////////////////////// //整数値a,b,cの中で最小の値を返す function mjMinOf3(a, b, c: Integer): Integer; begin Result:= mjSmaller(a, mjSmaller(b, c)); end; ///////////////////////////////////////////////////////////////////// //整数値a,b,cの平均値（小数点以下四捨五入）を返す //加算値がMaxIntを超えた場合を考慮していないので注意!! function mjAveOf3(a, b, c: Integer): Integer; begin Result:= Round((a + b + c) / 3); end; ///////////////////////////////////////////////////////////////////// //Integer型配列aa内の最大値を返す function mjMaxOf(const aa: array of Integer): Integer; var ii, jj, kk: Integer; begin ii:= High(aa); //Indexの最大値 jj:= aa[0]; //仮の最大値 for kk:= 1 to ii do if (aa[kk] > jj) then jj:= aa[kk]; Result:= jj; end; ///////////////////////////////////////////////////////////////////// //Integer型配列aa内の最小値を返す function mjMinOf(const aa: array of Integer): Integer; var ii, jj, kk: Integer; begin ii:= High(aa); //Indexの最大値 jj:= aa[0]; //仮の最小値 for kk:= 1 to ii do if (aa[kk] < jj) then jj:= aa[kk]; Result:= jj; end; ///////////////////////////////////////////////////////////////////// //Integer型配列aa内の平均値（小数点以下四捨五入）を返す function mjAveOf(const aa: array of Integer): Integer; var ii, jj, sum: Integer; begin ii := High(aa); //Indexの最大値 sum:= 0; for jj:= 0 to ii do Inc(sum, aa[jj]); Result:= Round(sum / (ii + 1)); end; ///////////////////////////////////////////////////////////////////// //Integer型配列aa内の合計値を返す function mjSumOf(const aa: array of Integer): Integer; var ii, jj, sum: Integer; begin ii := High(aa); //Indexの最大値 sum:= 0; for jj:= 0 to ii do Inc(sum, aa[jj]); Result:= sum; end; ///////////////////////////////////////////////////////////////////// //Integer型配列aa内の最大と最小を除いた平均値（小数点以下四捨五入）を返す function mjTrimedAve(const aa: array of Integer): Integer; var ii, jj, sum, maxDat, minDat: Integer; begin ii := High(aa); //Indexの最大値 sum:= 0; maxDat:= aa[0]; //仮の最大値 minDat:= aa[0]; //仮の最小値 for jj:= 0 to ii do begin Inc(sum, aa[jj]); if (aa[jj] > maxDat) then maxDat:= aa[jj]; if (aa[jj] < minDat) then minDat:= aa[jj]; end; Result:= Round((sum - maxDat - minDat) / (ii + 1 - 2)); end; ///////////////////////////////////////////////////////////////////// //選択ソート //Integer型配列aa内の値を昇順に並べ替え、結果をaaに格納する //低速であるが、配列が1000個程度または回数が少ないならば我慢できる procedure mjSelectSort(var aa: array of Integer); var ii, jj, LastIndex: Integer; begin //配列aaのIndexの最大値 LastIndex:= High(aa); //比較・交換 for ii:= 0 to (LastIndex - 1) do for jj:= (ii + 1) to LastIndex do if (aa[ii] > aa[jj]) then mjSwap(aa[ii], aa[jj]); end; ///////////////////////////////////////////////////////////////////// //分布数えソート(distribution counting sort) //[Ｃ言語によるアルゴリズム辞典]より //Integer型配列aa内の値を昇順に並べ替え、結果を受け側配列bbに格納する //受け側の配列bbは配列aaと同サイズの配列を呼出側で用意すること //配列内の値は必ず、MINVAL以上〜MAXVAL以下であること //配列が大きい場合、mjSelectSortに比べ高速 // //Sort結果格納領域を関数内で確保し(GetMem)、結果を配列aaに書き戻す方法も //試験したが、頻繁にこの関数が呼出した場合、かえって、領域の確保・開放， //配列aaへの書き戻しに時間を取られるようで、速度が低下した procedure mjDCountSort(const aa: array of Integer; var bb: array of Integer); const MAXVAL = 255; //必要に応じてここの範囲を変える MINVAL = 0; var ii, LastIndex: Integer; freq: array[MINVAL..MAXVAL] of Integer; //頻度計数用変数 begin //配列aaのIndexの最大値 LastIndex:= High(aa); //頻度計数用変数の初期化 for ii:= MINVAL to MAXVAL do freq[ii]:= 0; //頻度計数 for ii:= 0 to LastIndex do Inc(freq[aa[ii]]); //頻度累積 for ii:= (MINVAL + 1) to MAXVAL do Inc(freq[ii], freq[ii - 1]); //受け側変数に格納 for ii:= LastIndex downto 0 do begin Dec(freq[aa[ii]]); bb[freq[aa[ii]]]:= aa[ii]; end; end; ///////////////////////////////////////////////////////////////////// //Integer型配列aaにおいて、小さい方から数えてkk番目(0..)の値を返す //[Ｃ言語によるアルゴリズム辞典]より function mjSelect(aa: array of Integer; kk: Integer): Integer; var ii, jj, ptLeft, ptRight, xx: Integer; tmp: Integer; begin ptLeft := 0; ptRight:= High(aa); //もしkk番目が配列範囲を超えていたら-1を返して終了 if (kk > ptRight) or (kk < 0) then begin Result:= -1; exit; end; //本処理 while (ptLeft < ptRight) do begin xx:= aa[kk]; ii:= ptLeft; jj:= ptRight; while (True) do begin while (aa[ii] < xx) do Inc(ii); while (xx < aa[jj]) do Dec(jj); if (ii > jj) then Break; //無限Loop脱出 //関数呼出のオーバーヘッド解消のためtmp経由交換に変更('03/11/03) //mjSwap(aa[ii], aa[jj]); tmp := aa[ii]; aa[ii]:= aa[jj]; aa[jj]:= tmp; Inc(ii); Dec(jj); end; if (jj < kk) then ptLeft := ii; if (kk < ii) then ptRight:= jj; end; Result:= aa[kk]; end; ///////////////////////////////////////////////////////////////////// //引数を母集団のサンプルとして、標準偏差を求める。 //画像処理用途を想定しているため、引数はIntegerを想定。 function mjStdevInt(const x: array of Integer): Extended; var ii, jj, nn: Integer; //Loop用変数ii,jj,要素(配列)の個数nn sx2, sx: Extended; //Σ(x^2),Σx：桁あふれを考慮してExtended型 begin jj := High(x); //（配列要素数-1） nn := jj + 1; //配列の要素数 sx2:= 0.0; //Σ(x^2) sx := 0.0; //Σx for ii:= 0 to jj do begin sx2:= sx2 + (x[ii] * x[ii]); sx := sx + x[ii]; end; Result:= Sqrt( (nn * sx2 - sx * sx) / (nn * (nn - 1)) ); end; (* 2.数値変換関数 *) ///////////////////////////////////////////////////////////////////// //整数値iiを nn桁の2進数文字列に変換する function mjInt2Bin(ii, nn: Integer): String; var aa: Integer; bn: String; begin bn:= ''; for aa:= 1 to nn do begin //最下位bit検査 if Boolean(ii and $01) then bn:= '1' + bn else bn:= '0' + bn; //下位に1bitシフトして次のbitへ ii:= ii shr 1; end; Result:= bn; end; ///////////////////////////////////////////////////////////////////// //2進数文字列bnを整数値に変換する //2進数文字列bn中の'0',1'以外のキャラは無視される function mjBin2Int(const bn: String): Integer; var ii, aa, bb: Integer; begin aa:= Length(bn); ii:= 0; for bb:= 1 to aa do begin if (bn[bb] = '0') or (bn[bb] = '1') then begin //上位に1bitシフトして次のbitへ ii:= ii shl 1; //文字列が'1'ならばbitを立てる if (bn[bb] = '1') then ii:= ii or $01; end; end; Result:= ii; end; ///////////////////////////////////////////////////////////////////// //16進数文字列hx（大文字小文字混在可）を整数値に変換する //16進数文字列hx中の0〜F以外のキャラクタは無視される('08/06/27修正) function mjHex2Int(const hx: String): Integer; const HEXCHAR = '0123456789ABCDEF'; var hxs: String; ii, jj, kk, ans: Integer; begin hxs:= UpperCase(Trim(hx)); ii := Length(hxs); ans:= 0; for jj:= 1 to ii do begin kk:= Pos(String(hxs[jj]), HEXCHAR); //↑Stringキャストしなくてもなぜか正常に動作するが、念のため if (kk > 0) then begin ans:= ans * 16; ans:= ans + (kk - 1); end; end; Result:= ans; end; (* 3.色変換関数 *) ///////////////////////////////////////////////////////////////////// //TColor型のpixelの色を、Integer型のR,G,Bに変換する //入力：C；TColor型色値 //出力：R,G,B；0..255 procedure mjPix2RGB(C: TColor; var R, G, B: Integer); begin R:= C and $ff; G:=(C shr 8) and $ff; B:=(C shr 16) and $ff; end; ///////////////////////////////////////////////////////////////////// //RGB値をHSV値に変換する:C magazine '93/7 より //入力：R,G,B；0..255 //出力：色相H；0..359 彩度S；0..255 強度V：0..255 procedure mjRGB2HSV(R, G, B: Integer; var H, S, V: Integer); var maxdat, mindat, di: Integer; begin maxdat:= mjMaxOf3(R, G, B); mindat:= mjMinOf3(R, G, B); V:= maxdat; //強度:= max(R,G,B) if (maxdat = mindat) then //無彩色なら begin H:= 0; //色相:= 不定 S:= 0; //彩度:= 0 end else begin di:= maxdat - mindat; S := (di * 255) div maxdat; //彩度 if (maxdat = R) then begin H:= (60 * (G - B)) div di; if (H < 0) then H:= H + 360; end else begin if (maxdat = G) then H:= (60 * (B - R)) div di + 120 else H:= (60 * (R - G)) div di + 240; end; end; end; ///////////////////////////////////////////////////////////////////// //RGB値をHSV値に変換する:実数版(RGB→HSV→RGBの精度向上'03/10/26追加) //※処理時間は整数版の2倍程度かかるので、使い分けること！ //入力：R,G,B；0..255 //出力：色相H；0.0〜360.0 彩度S；0.0〜1.0 強度V：0.0〜1.0 procedure mjRGB2HSVeX(R, G, B: Integer; var H, S, V: Single); var rr, gg, bb, maxdat, mindat, di: Single; begin rr:= R / 255.0; gg:= G / 255.0; bb:= B / 255.0; //最大値 if (rr > gg) then begin if (rr > bb) then maxdat:= rr else maxdat:= bb; end else begin if (gg > bb) then maxdat:= gg else maxdat:= bb; end; //最小値 if (rr < gg) then begin if (rr < bb) then mindat:= rr else mindat:= bb; end else begin if (gg < bb) then mindat:= gg else mindat:= bb; end; V:= maxdat; //強度:= max(rr,gg,bb) if (maxdat = mindat) then //無彩色なら begin H:= 0.0; //色相:= 不定 S:= 0.0; //彩度:= 0.0 end else begin di:= maxdat - mindat; S := di / maxdat; //彩度 if (maxdat = rr) then begin H:= 60.0 * (gg - bb) / di; if (H < 0.0) then H:= H + 360.0; end else begin if (maxdat = gg) then H:= 60.0 * (bb - rr) / di + 120.0 else H:= 60.0 * (rr - gg) / di + 240.0; end; end; end; ///////////////////////////////////////////////////////////////////// //HSV値をRGB値に変換する：Zumiさんからのご教授 //入力：色相H；0..359 彩度S；0..255 強度V：0..255 //出力：R,G,B；0..255 procedure mjHSV2RGB(H, S, V: Integer; var R, G, B: Integer); var takasa, haba, area: Integer; maxdat, middat, mindat: Integer; begin takasa:= V; haba := (S * takasa) div 255; maxdat:= takasa; mindat:= takasa - haba; middat:= (H mod 60 * haba) div 60; area := H div 60; case (area) of 0:begin R:= maxdat; B:= mindat; G:= mindat + middat; end; 1:begin G:= maxdat; B:= mindat; R:= maxdat - middat; end; 2:begin R:= mindat; G:= maxdat; B:= mindat + middat; end; 3:begin R:= mindat; B:= maxdat; G:= maxdat - middat; end; 4:begin G:= mindat; B:= maxdat; R:= mindat + middat; end; 5:begin R:= maxdat; G:= mindat; B:= maxdat - middat; end; end; end; ///////////////////////////////////////////////////////////////////// //HSV値をRGB値に変換する：実数版('03/10/26追加) //入力：色相H；0.0〜360.0 彩度S；0.0〜1.0 強度V：0.0〜1.0 //出力：R,G,B；0..255 procedure mjHSV2RGBeX(H, S, V: Single; var R, G, B: Integer); var takasa, haba, maxdat, middat, mindat: Single; area: Integer; begin takasa:= V; haba := S * takasa; maxdat:= takasa; mindat:= takasa - haba; middat:= (H - 60.0 * Int(H / 60.0)) * haba / 60; area := Trunc(H / 60); case (area) of 0:begin R:= Round(maxdat * 255); B:= Round(mindat * 255); G:= Round((mindat + middat) * 255); end; 1:begin G:= Round(maxdat * 255); B:= Round(mindat * 255); R:= Round((maxdat - middat) * 255); end; 2:begin R:= Round(mindat * 255); G:= Round(maxdat * 255); B:= Round((mindat + middat) * 255); end; 3:begin R:= Round(mindat * 255); B:= Round(maxdat * 255); G:= Round((maxdat - middat) * 255); end; 4:begin G:= Round(mindat * 255); B:= Round(maxdat * 255); R:= Round((mindat + middat) * 255); end; 5:begin R:= Round(maxdat * 255); G:= Round(mindat * 255); B:= Round((maxdat - middat) * 255); end; end; end; ///////////////////////////////////////////////////////////////////// //カラー放送を白黒TVで見るように、RGB値→YIQ値のY(輝度)に変換 //入力：R,G,B；0..255 //戻値：輝度値；0..255 function mjRGB2Y(R, G, B: Integer): Integer; begin //Result:= Round(0.299 * R + 0.587 * G + 0.114 * B); //下の式の方が約1.2倍高速('03/11/15) Result:= (306 * R + 601 * G + 117 * B) shr 10; end; ///////////////////////////////////////////////////////////////////// //TColor型の色iro1,iro2を、割合ratioで混ぜた色を返す //入力：iro1,iro2；TColor，ratio：0..100 //戻値：iro1とiro2の間の色TColor型 //戻値は、raio=0 でiro1，ratio=100 でiro2となる function mjColorMix(iro1, iro2: TColor; ratio: Integer): TColor; var rr, gg, bb, r1, g1, b1, r2, g2, b2: Integer; begin mjPix2RGB(iro1, r1, g1, b1); mjPix2RGB(iro2, r2, g2, b2); rr:= r1 + Round((r2 - r1) * ratio / 100); gg:= g1 + Round((g2 - g1) * ratio / 100); bb:= b1 + Round((b2 - b1) * ratio / 100); Result:= RGB(rr, gg, bb); end; (* 4.文字列関数：String型対象 *) ///////////////////////////////////////////////////////////////////// //1byte c が漢字(2byte文字)の1byte目なら True を返す function mjIsKanji(c: Char): Boolean; begin Result:= ( ($81 <= Ord(c)) and (Ord(c) <= $9f) ) or ( ($e0 <= Ord(c)) and (Ord(c) <= $fc) ); end; ///////////////////////////////////////////////////////////////////// //1byte c が漢字(2byte文字)の2byte目になり得るなら True を返す //あまり使い道が無い... function mjIsKanji2(c: Char): Boolean; begin Result:= ( ($40 <= Ord(c)) and (Ord(c) <= $7e) ) or ( ($80 <= Ord(c)) and (Ord(c) <= $fc) ); end; ///////////////////////////////////////////////////////////////////// //文字列ｓ中の文字数を返す function mjLenM(const s: String): Integer; begin Result:= Length(WideString(s)); (******** WideStringを知らなかったころの方法 var mCnt, pt: Integer; begin s := s + #0#0; //最終ByteがisKanjiだった時の対策に２つ pt := 1; //Indexポインタ mCnt:= 0; //文字数カウンタ while (True) do //無限Loop begin if (s[pt] = #0) then Break; //列末に達した Inc(mCnt); //文字数カウンタ++ if (mjIsKanji(s[pt])) then Inc(pt, 2) else Inc(pt); end; Result:= mCnt; end; ********) end; ///////////////////////////////////////////////////////////////////// //文字列ｓにおいて、mm文字目のIndex値（1〜）を返す // mjLenM(s)< mm の場合、Length(s)+1 を返す // s = '' や mm< 1 の場合、1 を返す function mjM2Index(s: String; mm: Integer): Integer; var mCnt, pt: Integer; begin s := s + #0#0; //最終ByteがisKanjiだった時の対策に２つ pt := 1; //Indexポインタ mCnt:= 0; //文字数カウンタ while (True) do //無限Loop begin if (s[pt] = #0) then Break; //列末に達した Inc(mCnt); //文字数カウンタ++ if (mCnt >= mm) then Break; //mm文字目に達した... if (mjIsKanji(s[pt])) then Inc(pt, 2) else Inc(pt); end; Result:= pt; end; ///////////////////////////////////////////////////////////////////// //文字列ｓの指定Index位置sp から、指定byte数bb の文字列を切り出す //Basicの関数に似せた名前の方が覚えやすいため... function mjMidB(const s: String; sp, bb: Integer): String; begin Result:= Copy(s, sp, bb); end; ///////////////////////////////////////////////////////////////////// //文字列ｓの指定文字位置sp から、指定文字数mm の文字列を切り出す //sp<1の時は文字列先頭から。mm>mjLenM(s)の時は文字列最後まで function mjMidM(const s: String; sp, mm: Integer): String; var pt1, pt2: Integer; begin if (sp < 1) then sp:= 1; //mjMidBと挙動を一致させるための補正 pt1 := mjM2Index(s, sp); //切出開始位置(Index位置) pt2 := mjM2Index(s, sp + mm); //切出終了位置の次の文字Index位置 Result:= Copy(s, pt1, pt2 - pt1); end; ///////////////////////////////////////////////////////////////////// //文字列ｓの先頭から、bb Byte切出す function mjLeftB(const s: String; bb: Integer): String; begin Result:= Copy(s, 1, bb); end; ///////////////////////////////////////////////////////////////////// //文字列ｓの先頭から、mm文字切出す function mjLeftM(const s: String; mm: Integer): String; var pt: Integer; begin pt:= mjM2Index(s, mm + 1) - 1; //切出し終了Index位置 Result:= Copy(s, 1, pt); end; ///////////////////////////////////////////////////////////////////// //文字列ｓの右側(列末)から、bb Byte 切出す function mjRightB(const s: String; bb: Integer): String; var pt: Integer; begin pt:= Length(s) - bb + 1; //切出し開始Index位置 Result:= Copy(s, pt, bb); end; ///////////////////////////////////////////////////////////////////// //文字列ｓの右側(列末)から、mm文字切出す function mjRightM(const s: String; mm: Integer): String; var pt: Integer; begin pt:= mjLenM(s) - mm + 1; //切出し開始文字位置 Result:= mjMidM(s, pt, mm); end; ///////////////////////////////////////////////////////////////////// //文字列 s から、区切文字列 d で区切られたnn番目(1..)の文字列を返す //例: mjStrSplit('aa##bb##cc', '##', 2) → 'bb' function mjStrSplit(const s, d: String; nn: Integer): String; var s1, s2: String; aa, mp: Integer; begin //sにデリミタdが1個も含まれないならば''を返す if (Pos(WideString(d), WideString(s)) = 0) then begin Result:= ''; Exit; end; //デリミタがあった場合 s1:= ''; s2:= s + d; //最後の文字を取出すためにデリミタ付加 for aa:= 1 to nn do begin //左から最初のデリミタを探して、デリミタの左右に分割 mp:= Pos(WideString(d), WideString(s2)); s1:= mjLeftM(s2, (mp - 1)); s2:= mjRightM(s2, mjLenM(s2) - mjLenM(d) - (mp - 1)); end; Result:= s1; end; ///////////////////////////////////////////////////////////////////// //文字列 s から、1byteキャラクタ c で区切られたnn番目の文字列を返す // デリミタが1byteキャラならば、文字列代入が無い分、mjStrSplitより // こっちのほうが高速。 // ｓにｃが含まれず、かつ１番目を指定した場合、ｓを返す // 例：mjStrSplitByChar('aa\bb\cc', '#', 1) → aa\bb\cc function mjStrSplitByChar(s: String; c: Char; nn: Integer): String; var cnt, pt, d1, d2: Integer; begin s := String(c) + s + #0#0; //先頭にデリミタ付加 cnt:= 0; //デリミタカウンタ pt := 1; //文字列走査ポインタ d1 := Length(s) - 1; //nn 番目のデリミタIndex値 d2 := d1; //nn+1 番目のデリミタIndex値 while (True) do //無限Loop begin if (s[pt] = #0) then Break; //列末に達した if (s[pt] = c ) then begin Inc(cnt); //デリミタカウンタ++ if (cnt = nn ) then d1:= pt; if (cnt = (nn + 1)) then begin d2:= pt; Break; end; end; if (mjIsKanji(s[pt])) then Inc(pt, 2) else Inc(pt); end; Result:= mjMidB(s, d1 + 1, d2 - d1 - 1); end; ///////////////////////////////////////////////////////////////////// //文字列中 s 中に、文字列 d がいくつあるか数える // '1212121'の中に'121'は2つ function mjStrCount(const s, d: String): Integer; var ss: String; cnt, mp: Integer; begin cnt:= 0; //カウンタ ss := s; while (True) do begin mp:= Pos(WideString(d), WideString(ss)); if (mp = 0) then Break; //d が見当たらないなら抜け出る Inc(cnt); //文字列先頭〜見つかったdまで除去 ss:= mjRightM(ss, mjLenM(ss) - mjLenM(d) - (mp - 1)); end; Result:= cnt; end; ///////////////////////////////////////////////////////////////////// //文字列 TargetS のIndex値pt（1..）位置に ss を挿入した文字列を返す //Insert手続きは、TargetS に文字列定数が使えないので関数化しただけ function mjInsert(ss, TargetS: String; pt: Integer): String; begin Insert(ss, TargetS, pt); Result:= TargetS; end; ///////////////////////////////////////////////////////////////////// //文字列 s から、1byteキャラ c を取り除いた文字列を返す //例：mjCharDelete('123.456', '.') → '123456' function mjCharDelete(s: String; c: Char): String; var pt: Integer; dest: String; begin s := s + #0#0; //２つ加えるのは、最終ByteがisKanjiだった時の対策 pt := 1; //Indexポインタ dest:= ''; //結果文字列 while (True) do //無限Loop begin if (s[pt] = #0) then Break; //列末に達した if (s[pt] <> c) then begin dest:= dest + s[pt]; //キャラクタ c でないなら加える if (mjIsKanji(s[pt])) then //全角1byte目ならばその次も加える dest:= dest + s[pt + 1]; end; if (mjIsKanji(s[pt])) then Inc(pt, 2) else Inc(pt); end; Result:= dest; end; ///////////////////////////////////////////////////////////////////// //文字列中 s 中に含まれる文字列 d1 を d2 に置換する //d1 と d2 は同じbyte数でなくても良い //mjStrReplace('あかあおあかあお', 'あお', '青')→'あか青あか青' //(-_-;)StringReplace関数があるのを知らなかった... function mjStrReplace(const s, d1, d2: String): String; var sWork, sAns: String; mp: Integer; begin sWork:= s; //サーチ対象文字列のCopy(いじるから) sAns := ''; while (True) do begin //d1を探す mp:= Pos(WideString(d1), WideString(sWork)); if (mp = 0) then Break; //d1 が見当たらないなら抜け出る //sWork先頭〜d1直前 + d2 をsAnsに確保しておく //sWorkに直接d2を埋めこんで先頭からPosすると、d1=d2で無限Loopに陥るから sAns:= sAns + mjLeftM(sWork, (mp - 1)) + d2; //d1直後〜最後までを新しいsWorkとする sWork:= mjRightM(sWork, mjLenM(sWork) - mjLenM(d1) - (mp - 1)); end; //最後のsWork(d1が含まれなかった残り)を加えて置換完了 Result:= sAns + sWork; end; (* 5.その他 *) ///////////////////////////////////////////////////////////////////// //文字列 src の最後が'\'で終わっていない場合、'\'を加える //GetWindowsDirectory APIの戻値は、ルート以外の時には'\'で終わらないから function mjTailYen(const src: String): String; begin if (mjRightM(src, 1) <> '\') then Result:= src + '\' else Result:= src; end; ///////////////////////////////////////////////////////////////////// //Windowsディレクトリを返す。文字列は必ず'\'で終了する。 function mjWinDir: String; var buf: String; begin buf:= StringOfChar(#0, MAX_PATH); //Nullで埋める Result:= mjTailYen( mjLeftB(buf, GetWindowsDirectory(@buf[1], MAX_PATH)) ); end; ///////////////////////////////////////////////////////////////////// //Systemディレクトリを返す。文字列は必ず'\'で終了する。 function mjSysDir: String; var buf: String; begin buf:= StringOfChar(#0, MAX_PATH); //Nullで埋める Result:= mjTailYen( mjLeftB(buf, GetSystemDirectory(@buf[1], MAX_PATH)) ); end; ///////////////////////////////////////////////////////////////////// //Tempディレクトリを返す。文字列は必ず'\'で終了する。 //GetTempPathの戻値には最初から\がついてくる function mjTmpDir: String; var buf: String; begin buf:= StringOfChar(#0, MAX_PATH); //Nullで埋める Result:= mjTailYen( mjLeftB(buf, GetTempPath(MAX_PATH, @buf[1])) ); end; ///////////////////////////////////////////////////////////////////// //時間計測開始（時間を要する処理等の直前で1度呼び出す） //ただ単にSystem起動後経過時間を記憶しておくだけ。 procedure mjElapseStart; begin __mjTickTime:= GetTickCount; end; ///////////////////////////////////////////////////////////////////// //時間計測値：mjElapseStartからの時間(ms)を返す。 function mjElapse: DWORD; begin Result:= GetTickCount - (__mjTickTime); end; ///////////////////////////////////////////////////////////////////// //簡易sin：整数aaにsin(deg)をかけた値を返す。 //精度は厳密ではないが、テーブル参照なので標準関数より数倍高速。 //deg:-360..+449度 function mjSin(const aa, deg: Integer): Integer; begin //ビットシフト(shr 7)では、負号bitまでシフトされ、不具合あり。 //整数除算でもビットシフトと速度は同等だった。関数呼出しの //オーバーヘッドがあるため、直接mjSINVAL参照のほうがさらに高速 Result:= (aa * mjSINVAL[deg]) div 127; end; ///////////////////////////////////////////////////////////////////// //簡易cos：整数aaにcos(deg)をかけた値を返す。 //精度は厳密ではないが、テーブル参照なので標準関数より数倍高速。 //deg:-450..+359度 function mjCos(const aa, deg: Integer): Integer; begin Result:= (aa * mjSINVAL[deg + 90]) div 127; end; ///////////////////////////////////////////////////////////////////// //極座標→直角座標変換 //原点x0,y0から、角度Ang・長さLenの座標xp,ypを返す。 //角度Angは、反時計周りが正方向。 procedure mjKyoku2XY(const x0, y0, Ang, Len: Integer; var xp, yp: Integer); var fixedAng: Integer; begin fixedAng:= Ang mod 360; //-359..+359の範囲に収める xp:= x0 + mjCos(Len, fixedAng); yp:= y0 - mjSin(Len, fixedAng); end; ///////////////////////////////////////////////////////////////////// //CPUが起動してからの総クロック数を返す('03/03/19追加) //CPUクロック数(Hz)を知るには、この関数を呼び出し、１秒後に再度 //呼び出してその差を取る。 //ただし、$FFFFFFFF(4GHz)以上は桁あふれするため正常に測れない。 function mjGetCPUClock: Int64; var ClkHi, ClkLo: DWORD; begin asm PUSH edx PUSH eax DW $310F //RTDSC命令 MOV ClkLo, eax; MOV ClkHi, edx; POP eax POP edx end; Result:= (Int64(ClkHi) shl 32) or ClkLo; end; (* End of MyJunk.pas *) end.