« ■TMS Advanced ToolBars & Menusアップデート | トップページ | ■ツールバーのアイコン »

☆コードを簡易HTMLにする。

このブログ、プログラム関係のくせにココログの標準設定のままというあまりに低レベルな表現しかしていなかったので、コード部分ぐらい読みやすくしようと、CSSを少し修正してみました。
ついでに、「Delphi予約語を強調文字にしたHTML」を作成するコードを書いてみました。 かなり力技&簡易なものなのですが、今後はこれを使って更新していきたいと思います。
// 文字列S中でIndex番目のSubstrの位置を返します。
function AnsiPosEx(const Substr: String; const S: String;
  Index: Integer): Integer;
var
  I,K: Integer;
  Str: String;
begin
  Str := S;
  Result := 0;
  K := 0;
  repeat
    Inc(K);
    I := AnsiPos(Substr, Str);
    if I =  0 then
    begin
      Result := 0;
      Break;
    end;
    if K = 1 then
      Result := I
    else
      Result := Result + I +Length(Substr) -1;
    Str := Copy(Str, I + Length(Substr) , Length(Str)-I+Length(Substr) +1);
  until K = Index;
end;


function TForm1.MakeHTML(const Str: String): String;
const
  S1 = '-----------------------------------';
  S2 = '-----------------------------------';
var
  I, J, K, L,M: Integer;
  DefineSL, SrcSL: TStringList;
  S, FileName : String;
begin
  FileName := ExtractFilePath(Application.ExeName) + 'define.txt';
  if not FileExists(FileName) then Exit;

  DefineSL := TStringList.Create;
  SrcSL := TStringList.Create;
  try
    DefineSL.LoadFromFile(FileName);
    SrcSL.Text := Str;

    SrcSL.Text := StringReplace(Str,'<', '<',[rfReplaceAll]);
    SrcSL.Text := StringReplace(SrcSL.Text,'>', '>',[rfReplaceAll]);

    for I := 0 to SrcSL.Count - 1 do
    begin
      for J := 0 to DefineSL.Count - 1 do
      begin
        S := '';
        M := 0;
        L := 1;
        while True do
        begin
          {M番目の文字列位置を取得します。}
          Inc(M);
          K := AnsiPosEx(DefineSL[J],SrcSL[I],M);
          if K = 0 then
            begin
              S := S + Copy(SrcSL[I], L , 1000);
              Break;
            end
          else
            begin
              S := S + Copy(SrcSL[I], L , K-L) +
                   '<strong>' + DefineSL[J] + '</strong>';
              L := K + Length(DefineSL[J]);
            end;
        end;
        SrcSL[I] := S;
      end;
    end;

    S := '<pre class=code>'+ #13#10 + SrcSL.Text + #13#10 + '</pre>';
    Result := '<HTML><BODY>'+#13#10+ S1 + #13#10+ S
       +#13#10+S2+#13#10+'</BODY><HTML>';
  finally
    SrcSL.Free;
    DefineSL.Free;
  end;
end;

define.txtの中身は・・・
function 
implementation
if 
 then
else
try
finally
begin
end;
end.
var
string
 do
 and 
repeat
until 
while 
class
const
string
interface
stdcall
external
nil
for 
to 
downto 
case 
 of
というような感じのテキストファイルです。

|

« ■TMS Advanced ToolBars & Menusアップデート | トップページ | ■ツールバーのアイコン »