Web Frontier

例えば、フォーム上にあるテキストボックス(TEdit)をすべて空欄にする時には、 ひとつひとつ書くのではなく、以下のようにすると便利です。

procedure TMainForm.ClearEdit;
var i : Integer ;
begin
   for i := 0 to ControlCount-1 do
   begin
      if Controls[i] is TEdit then
      begin
         TEdit(Controls[i]).Text := '' ;
      end ;
   end ;
end ;

また、パネル(TPanel)のコンポーネント名(Name)を"Panel1〜panel9"の9つあったとします。 この場合はパネルの色を一括で赤色に変更したい場合には以下のようにします。 適当にボタン(TButton)のOnClickイベントに書くとしましょう。

procedure TMainForm.Button1Click;
var i : Integer ;
begin
   for i := 0 to 9 do
   begin
      TPanel(FindComponent('Panel' + IntToStr(i))).Color := clRed ;
   end ;
end ;

FindComponentを使って一括処理を行います。

さて、Perlでプログラミングしていると 文字列処理が他言語が結構面倒に感じてしまいます。というので以下のような関数を考えてみる事にしました。 これを使うと非常に簡単な置換の関数ができあがります。但し、Delphi4以降には「StringReplace」という便利な ものがすでにありますので、ヘルプで見てみて下さい。

function TMainForm.Rep(BaseStr,OldStr,NewStr : String) : String ;
begin
   Result := '' ;
   if (BaseStr  '') or (OldStr = '') then Result := BaseStr else
   begin
      while AnsiPos(OldStr,BaseStr) <> 0 do
      begin
         Result := Result + 
                   Copy(BaseStr,1,AnsiPos(OldStr,BaseStr)-1) + NewStr ;
         Delete(BaseStr,1,AnsiPos(OldStr,BaseStr)) ;
      end ;
      Result := Result + BaseStr ;
   end ;
end ;

これで、一括置換が可能となります。しかし、デフォルトで「StringReplace」という関数が用意されていました（笑）。 置換処理速度は遅いですが、ちょっとした置換ならばこれでＯＫだと思います。

お金の計算とかで千単位で 区切りがありますが、それを実現してみます。以下のようにすれば簡単です。

function TMainForm.SplitDigit(S : String) : String ;
var I : Integer ;
begin
   Result := '' ;
   for I := 1 to (Length(s)-1) div 3 do
   begin
      Result := Result + ',' + Copy(s,Length(s)-2,3) ;
      Delete(s,Length(s)-2,3) ;
   end ;
  Result := s + Result ;
end ;

以下はポインタ処理編（複数処理の時はアドレス渡しもあってちょこっと高速になるかも）。

function TMainForm.SplitDigit(var S : String) : String ;
var p,ps : PChar ;
    cnt : Integer ;
begin
   Result := '' ;
   cnt := 0 ;
   p := PChar(S) ;
   ps := p ;
   inc(p,Strlen(p)) ;
   while ps <= p do
   begin
      inc(cnt) ;
      if cnt mod 3 = 0 then 
         Result := ',' + p^ + Result else Result := p^ + Result ;
      dec(p) ;
   end ;
end ;

エディタを作る際にはk高度になってくれば改行コードというもの を考えなくてはなりません。例えば、Windowsでは「CR LF」で、Macintoshでは「CR」、UnixやLinuxなどでは「LF」です。 「CR」はアスキーコードで言うと、「0D」、「LF」は「0A」に当たります。

これらは「Delphi」では「#13#10」と表します。これらは「TEditor」では読み込む際に自動的に「CR LF」に変換してくれるので設定する必要がありませんでしたが、 通常は必要で、メモ帳などで行が続いていて非常に読みにくい…なんて経験した事はありませんか？ 例えば、CGIのスクリプトを見てメモ帳で読み込んだ時にそういう現象はたまにあります。 そういうのも考慮しなくてはいけません。ここでは改行コードの取り扱い方法に付いてちょっと考えてみます。 まず、CR LF»LF、CR LF»LFへと変換するスクリプトは一番最初に作成した「Rep」関数を用いれば一発です。

{定数の宣言}
const
   CRLF_OUT = 1 ;
   LF_OUT   = 2 ;
   CR_OUT   = 3 ;

   CRLF_IN = 1 ;
   LF_IN   = 2 ;
   CR_IN   = 3 ;

function TMainForm.ChangeCode(Str: string; CodeOUT: Integer):String ;
var CodeIN : Integer ;
begin
   //まずは、渡されてきた文字列の改行コードをチェックします。
   if AnsiPos(#13#10,Str) <> 0 then CodeIN := CRLF_IN else
   if AnsiPos(#13,Str) <> 0 then CodeIN := CR_IN else
   if AnsiPos(#10,Str) <> 0 then CodeIN := LF_IN ;

   //CRLFで出力する場合
   if (CodeOUT = CRLF_OUT) and (CodeIN = CR_IN) then
      Result := Rep(Str,#13,#13#10) ;
   if (CodeOUT = CRLF_OUT) and (codeIN = LF_IN) then
      Result := Rep(Str,#10,#13#10) ;

   //LFで出力する場合
   if (CodeOUT = LF_OUT) and (CodeIN = CRLF_IN) then
      Result := Rep(Str,#13#10,#10) ;
   if (CodeOUT = LF_OUT) and (CodeIN = CR_IN) then
      Result := Rep(Str,#13,#10) ;

   //CRで出力する場合
   if (CodeOUT = CR_OUT) and (CodeIN = CRLF_IN) then
      Result := Rep(Str,#13#10,#13) ;
   if (CodeOUT = CR_OUT) and (CodeIN = LF_iN) then
      Result := Rep(Str,#10,#13) ;
end ; 

良く、テキスト文書などをアプリケーションへドラッグ＆ドロップすると読み込めますが、 その実現の仕方です。まず、Delphiのメニューから「表示」 » 「ユニットの表示」（Ctrl+F12）を選びます。 ここで、プロジェクトファイルがありますので、これを選択して開きます。

program Mdiapp;  {適当なプロジェクト名が書かれているはずです。}

uses
  Forms,Windows,   //uses節にWindowsを追加して下さい。
  Main in 'MAIN.PAS' {MainForm},
  Childwin in 'CHILDWIN.PAS' {MDIChild},

{$R *.RES}
var
i : Integer;     //ここに適当な変数を宣言します。

begin
  Application.Initialize;
  Application.Title := 'ez-HTML';
  Application.CreateForm(TMainForm, MainForm);

  For i := 1 to ParamCount do //ParamStr関数で取り出します。
    MainForm.FileOpen(ParamStr(i)) ;

  Application.Run;

end. 

今回の場合は、「ez-HTML」を例にとってみましたが、これはMDIアプリケーションなので他とはちょっと違った設計になっているはずです。 ParamStr関数を利用します。これで、現在アプリケーションにアクセスしたファイルを取得できます。 ParamStr(0)は、実行ファイルのパス名なので飛ばさなくてはいけません。

尚、「FileOpen」は自作した手続きですので、 そのまま書いてもエラーが出ます。

画像の縦幅や、 横幅を取るにはどのようにしたらいいか？というので最初は非常に悩んでましたので紹介します。 以下の文を追加すればOKです。例えば、「Button1」をクリックするとラベルに結果を表示するものです。 予め用意するものは、「TOpenPictureDialog」です。

procedure TMainForm.Button1Click(Sender: TObject);
var Picture : TPicture ;
    yoko,tate : Integer ;
begin
   //TPictureを新規に作ります。
   Picture := TPicture.Create ;
 
   if OpenPictureDialog1.Execute then
   begin
      try 
         Picture.LoadFromFile(OpenPictureDialog1.FileName) ; 
         yoko := Picture.Width ;
         tate := Picture.Height ;
      finally
         //失敗しても解放するようにします。
         Picture.Free;
      end ;
     Label1.Caption := 'Size:'+inttostr(yoko)+'*'+inttostr(tate) ;
   end ;
end;

"try...finally"構文で もし取得に失敗してもメモリ上に読み込んだ画像データを解放するようにしています。

TEditで、指定した文字列のみ入力を許したい場合にはどのようにすればいいのでしょうか？ また、TEditに書かれている文字列がアルファベットかどうかを判定するプログラムはどのようにすればいいのでしょうか？ 各関数を作成してみました。まず、「OnKeyPress」イベントに書きます。

procedure TMainForm.Edit1KeyPress(Sender: TObject; var Key : Char);
const
   Arrow_Keys := ['a'..'z','A'..'Z'] ;
begin
   if not Key in Arrow_keys then Exit ;
end; 

とすれば、アルファベットしか入力できなくなります。 つまり、TEdit内でキーボードを入力すると、「OnKeyPress」イベントへ渡されます。 そこで、押したキーがアルファベット以外であれば、手続きを終了させてしまおうという考え方です。これと同時に、

funtion TMainForm.IsAlphabet(Edit:TEdit) : Boolean ; 
var 
  i : Integer ; 
  s : Char ; 
begin
   Result := False ;
   For i := 1 to Length(Edit.Text) do
   begin 
      s := Edit.Text[I] ; 
      //2バイトコードが見つかったならば処理を終了
      if s in LeadBytes then Exit ; 
      //アルファベット以外の文字が見つかっても処理を終了
      if s in ['a'..'z','A'..'Z'] = False then Exit ;
      //最後まで到達したら成功フラグを立てる
      if i = Length(Edit.Text) then Result := True ;
   end ;
end ;

使い方は、次のようにします。

if IsAlphabet(Edit1) then showmessage('Alphabet Only !!') ;

このようにプログラムを組みます。引数はTEdit.Nameを渡します。そうしてアルファベットしかなければ判定を行います。 これは、「Delphi情報局」で質問された時の解答になります。

「Delphi」にはマルチメディア関連を扱う 「TMediaPlayer」がありますが、いちいち配置していたら面倒です。 そこで、Waveファイルを効果音程度に簡単に扱える関数を紹介します。

sndPlaySound(Pchar('effect.wav'),SND_ASYNC) ;

という一行を書くだけでOKです。尚、これを使うのには、 uses節で「MMSystem」というのを追加する必要があります。 Pcharというのは、実はこの「sndPlaySound」というのはWindowsの関数で、 Windowsが扱うものの文字列は最後が「#0（null）」というヌル文字列で扱います。 それに比べて、「Delphi」や「C++Builder」などで扱うString型は、最後がヌルでありません。 このためにこのヌルを付け加えて変換しなくては、Windowsは解釈できません。 逆に、String型に戻すには、PCharの変わりに、Stringを使えば変換できます。

良く簡単なファイラを作る時に使うTFileListBoxですが、 拡張子が以下のような場合にリスト内に多重化されて表示されてしまいます。

*.htm; *.html;

このようなフィルタの場合は気を付ける必要性があります。これは以下のコードによって対処できます。 TDirectoryBoxのOnChangeイベントを使います。

procedure TFiler.DirectoryListBox1Change(Sender: TObject);
var i : Integer;
begin
   with FileListBox1 do
   begin
      Items.BeginUpdate ;
      For i := Items.Count-2 downto 0 do
        if Items[i] = Items[i+1] then Items.Delete(i+1);
      Items.EndUpdate ;
   end ;
end;

基本的に削除してやっている訳ですが、削除という作業のため、downtoで後ろから削除して行く事に注意して行けば良いと思います。

例えば、TEditに「top」などの名前を付けたとしましょう。 コンポーネントの一括処理などで仕方がなくこのような名前を付けなければならない場合が出てくる時があるかも知れません。 そうした場合に、「top」という名前は使えますが、TFormにも「top」というプロパティが存在します。 つまり普通にコードを記述すると、「top.」と打つと「top.Text」のような候補が出てきてしまいます（Delphi側はTEditと解釈している）。 これをTFormの「top」としたい時には以下のように扱います。

TForm(Form1).top

このようにしてあげれば大丈夫です。

TLabelに書かれたURLをクリックさせたらブラウザを立ち上げてそのページへアクセスするようなものを考えている人もいると思います。 これはWindowsAPIを使ってその方法を実現する方法です。

ShellExecute(Handle, 'open', 'http://www.w-frontier.com/', nil, nil, SW_SHOW)

このようにすればアクセスできます。「ShellExecute」というものを使うにはuses節に「ShellAPI」を追加する必要があります。 最初の引数はハンドルですが、取りあえず分からなければ「Handle」と書いておけば大丈夫でしょう。 第２引数は「open」にします。第３引数に指定したURLを記述して下さい。尚、変数を使う場合は注意しなければなりません。 Windows APIはDelphiでのString型とは違います。最後にヌル文字を付加して扱うので（分からなければ読み飛ばして下さい）PChar型に変換する必要があります。

第４・５引数は「nil」でいいでしょう。最後は「SW_SHOW」とすると表示します。一般的にするためにラベルに書かれたURLをクリックしたらジャンプするようにもうちょっと工夫してみましょう。

procedure TForm1.Label1Click(Sender: TObject);
begin
   if Sender is TLabel then
   begin
      ShellExecute(Handle, 'open', 
         PChar(TLabel(Sender).Caption), nil, nil, SW_SHOW) ;
   end ;
end;

このようにLabel1のOnClickイベントに記述すればラベルをクリックしたらブラウザを立ち上げてジャンプするようになります。

数学や物理などで時間領域と周波数領域を相互変換する際に、フーリエ変換・フーリエ逆変換というものを使います。 ただ、Pascalでのサンプルプログラムがなかったので掲載する事にしました。 音声データやWAVEファイルから特定の周波数のみを抽出したい人も利用できるのではないでしょうか？

ここでは高速フーリエ変換（通称「fft」）のメカニズムについては敢えて言いません。 この仕組みに関しては複雑なのでウェブ上のものを参考にしてください。

procedure fft;
var K,L,KD : Integer ;
    wc,ws : Array of Extended ;
        procedure fftint ;
        var s : Integer ;
            wk : Extended ;
        begin
           For s := 0 to KD-1 do
           begin
              wk := 2.0 * Pi * s / K ;
              wc[s] := Cos(wk) ;
              ws[s] := -Sin(wk) ;
           end ;
        end ;
        function bitrev(ip : Integer) : Integer ;
        var i,w : Integer ;
        begin
           w := 0 ;
           For I := 1 to L do
           begin
              w := w * 2 + (ip mod 2) ;
              ip := ip div 2 ;
           end ;
           Result := w ;
        end ;
        procedure cfft(inv : Integer) ;
        var i,j,Li,sn,i0,i1,expon,iw : Integer ;
            wk,yr,yi,sign,wwc,wws : Extended ;
        begin
           if inv = 1 then sign := 1.0 else sign := -1.0 ;
           Li := K ;
           iw := 1 ;
           For I := 1 to L do
           begin
              iw := iw * 2 ;
              Li := Li div 2 ;
              sn := 0 ;
              while sn < K-1 do
              begin
                 For J := 0 to Li-1 do
                 begin
                    expon := (bitrev(sn) mod iw) * Li ;
                    wws := sign * ws[expon] ;
                    wwc := wc[expon] ;
                    i0 := sn ;
                    i1 := i0 + Li ;
                    yr := xr[i1] * wwc - xi[i1] * wws ;
                    yi := xr[i1] * wws + xi[i1] * wwc ;
                    xr[i1] := xr[i0] - yr ;
                    xi[i1] := xi[i0] - yi ;
                    xr[i0] := xr[i0] + yr ;
                    xi[i0] := xi[i0] + yi ;
                    Inc(sn) ;
                 end ;
                 Inc(sn,Li) ;
              end ;
           end ;

           For i := 0 to K-1 do
           begin
              j := bitrev(i) ;
              if inv = 1 then
              begin
                 cr[j] := xr[i] / K ;
                 ci[j] := xi[i] / K ;
              end else
              begin
                 cr[j] := xr[i] ;
                 ci[j] := xi[i] ;
              end ;
           end ;
        end ;
var s : Integer ;
begin
   //分割数を得る
   K := 1024 ; //2^nの形
   L := Trunc(log2(K)) ;
   KD := K div 2 ;
   //データはxr,xiで渡される。
   SetLength(wc,KD) ;
   SetLength(ws,KD) ;
   //手続き呼び出し
   fftint ;
   //以下で逆高速フーリエ変換ならば引数を-1にすれば大丈夫
   cfft(1) ;
end;

高速フーリエ変換はノーマルなフーリエ変換（DFT）とは違い回数がLogarithm的に減少します。 変数Kの値は2のn乗にしておかないと都合上できないという事はありますが、それを考慮しても十分な利用価値はあります。 利用の仕方は、まず変換前のデータとして、xr[i]とxi[i]にそれぞれ実数と虚数のデータを格納します。xr,xiという配列が変換前のデータ、 「fft」手続きを呼び出した後にcrとciという配列が作成されます。

const X = 1024 ; //分割数
var xr,xi,cr,ci : Array of Extended ; //グローバル変数

procedure TForm1.Button1Click(Sender : TObject) ;
var I : Integer;
    ls : TStringList ;
begin
   SetLength(xr,X) ; SetLength(xi,X) ;
   SetLength(cr,X) ; SetLength(ci,X) ;
   For I := 0 to X-1 do
   begin
      xr[I] := 1.0 ; //適当な値（実数） を代入
      xi[I] := 0.0 ; //適当な値（虚数） を代入
   end ;
   {ここで高速フーリエ変換の手続き}
   fft ;
   {結果をcsv形式のファイルで保存}
   ls := TStringList.Create ;
   try
      For I := 0 to X-1 do
      begin
         ls.Add(FloatToStr(cr[I])+','+FloatToStr(ci[I])) ;
      end ;
      ls.SaveToFile('sample.csv') ;
   finally
      ls.Free ;
   end ;
end;

利用の仕方はこのようにして下さい。 後はTChartが付属していれば読み込ませてもいいですし、CSVで掃き出してExcelでグラフ化と言った事もできます。 ただ、複素数の関数がDelphi5.0にはないので（6.0以降ならあります）、複素数関数ライブラリが「Delphian World」にありますので、 必要な方は適宜ダウンロードして下さい。 また、利用する際にはuses節に「math」を追加しておかないと数学の関数などでコンパイルエラーが起きてしまいますので注意して下さい。 尚、Extended型は倍精度浮動小数点が5.0 x 10^-324〜1.7 x 10³⁰⁸なのに対して3.6 x 10^-4951 .. 1.1 x 10⁴⁹³²まで扱え、精度が優れた型ですが、 互換性が低く速度も当然多少遅くなってしまいますので、十分考慮した上で利用して見てください。