delphi

投稿を登録

Delphi の使い勝手が忘れられない

2010/10/09 6:38 に いつかはちょうになる が投稿

もうすでに Delphi という開発環境を知らない世代も出ているのでは。。。と思ってみたりもしながら、何をするにもDelphi の使い勝手が良くて忘れられない。phpやVB6でもTStringListと同じものを用意してくれればそうも思わないのかもしれないが、、、と駄文。

TXMLDocumentの整形

2010/02/06 8:34 に いつかはちょうになる が投稿

OptionsにdoNodeAutoIndentを指定してから書き込み処理を行うと自動的に整形される。

var
  xml: TXMLDocument;
begin
  xml:=TXMLDocument.Create(Application);
  try
    xml.Active:=true;
    xml.Encoding:='UTF-8';
    xml.Version:='1.0';
    xml.Options:=[doNodeAutoIndent];
    (* 情報の書き込み処理 *)
  finally
    xml.Free;
  end;


TXMLDocumentにXPath指定で書き込む

2010/02/06 8:31 に いつかはちょうになる が投稿

TXMLDocumentにXPath指定で値を書き込む。
AXML: 対象TXMLDocumentオブジェクト
ANode: nil
AXPath: 書き込み先XPath
AValue: 書き込む値
AList: 終端がリストの場合Trueを指定、Falseの場合は既にノードが存在する場合上書きされる

procedure writeXPath(AXML: TXMLDocument; ANode: IXMLNode; AXPath, AValue: String; AList: Boolean);
var
  i,j: Integer;
  s,s2: String;
  n: IXMLNode;
begin
  j:=AnsiPos('/', AXPath);
  if (j=0) then
    begin
      j:=Length(AXPath)+1;
    end;
  s:=Copy(AXPath, 1,j-1);
  s2:=AXPath;
  Delete(s2, 1, j);
  if (AXML<>nil) then
    begin
      n:=AXML.ChildNodes.FindNode(s);

      if (n=nil) then
        begin
          n:=AXML.AddChild(s);
        end;

    end
  else
    begin
      n:=ANode.ChildNodes.FindNode(s);

      if (n=nil) or ((s2='') and (AList)) then
        begin
          n:=ANode.AddChild(s);
        end;

    end;

  if (s2='') then
    begin
      n.NodeValue:=AValue;//AnsiToUtf8(AValue);
    end
  else
    begin
      writeXPath(nil, n, s2, AValue, AList);
    end;
end;


TDateTime型をSitemap形式に変換

2010/02/06 8:27 に いつかはちょうになる が投稿

TDateTime 型を Sitemap で利用するW3形式に変換する関数


function DateTimeToW3DateStr(ASrc: TDateTime): String;
begin
  Result:=FormatDateTime('yyyy-mm-dd', ASrc)+'T'+FormatDateTime('hh:nn:ss', ASrc)+'+09:00'
end;


IXMLNodeのNodeValue をString に変換する

2010/01/30 13:39 に いつかはちょうになる が投稿

値が存在しない場合Nullエラーになるので条件を追加している。

function getXMLNodeValue(ANode: IXMLNode): String;
begin
  if (ANode.NodeValue=null) then
    begin
      Result:='';
    end
  else
    begin
      Result:=ANode.NodeValue;
    end;
end;



sitemapの日付をTDatetimeに変換

2010/01/30 13:38 に いつかはちょうになる が投稿   [ 2010/01/30 13:41 に更新しました ]

フォーマットに制限があるので要注意。

function W3DateStrToDateTime(ASrc: String): TDateTime;
var
  s: String;
begin
  // 2010-01-16T10:18:24+09:00
  s:=ASrc;
  s:=StringReplace(s,'-','/',[rfReplaceAll]);
  s:=StringReplace(s,'T',' ',[rfReplaceAll]);
  s:=StringReplace(s,'+09:00','',[rfReplaceAll]);
  Result:=StrToDateTime(s);
end;


TXMLDocumentからXPathでIXMLNodeを取得する

2010/01/30 13:08 に いつかはちょうになる が投稿   [ 2010/01/30 13:42 に更新しました ]

面倒なのでクラスを拡張版と関数を用意しました。

関数版

function readXPath(AXML: TXMLDocument; ANode: IXMLNode; AXPath: String): IXMLNode;
var
  i,j: Integer;
  s,s2: String;
  n: IXMLNode;
begin
  j:=AnsiPos('/', AXPath);
  if (j=0) then
    begin
      j:=Length(AXPath)+1;
    end;
  s:=Copy(AXPath, 1,j-1);
  s2:=AXPath;
  Delete(s2, 1, j);
  if (AXML<>nil) then
    begin
      Result:=AXML.ChildNodes.FindNode(s);
    end
  else
    begin
      Result:=ANode.ChildNodes.FindNode(s);
    end;
  if (Result<>nil) and (s2<>'') then
    begin
      Result:=readXPath(nil, Result, s2);
    end;
end;

var
  xml: TXXMLDocument;
begin
  xml:=TXXMLDocument.Create(Application);
  xml.LoadFromFile('ファイルパス');
  node:=readXPath(xml, nil, 'project/name');
  xml.free;
end;

クラス拡張版

type
  TXXMLDocument=class(TXMLDocument)
  private
  public
    function readXPath(ANode: IXMLNode; AXPath: String): IXMLNode;
  end;

implementation

function TXXMLDocument.readXPath(ANode: IXMLNode; AXPath: String): IXMLNode;
var
  i,j: Integer;
  s,s2: String;
  n: IXMLNode;
begin
  j:=AnsiPos('/', AXPath);
  if (j=0) then
    begin
      j:=Length(AXPath)+1;
    end;
  s:=Copy(AXPath, 1,j-1);
  s2:=AXPath;
  Delete(s2, 1, j);
  if (ANode=nil) then
    begin
      Result:=Self.ChildNodes.FindNode(s);
    end
  else
    begin
      Result:=ANode.ChildNodes.FindNode(s);
    end;
  if (Result<>nil) and (s2<>'') then
    begin
      Result:=readXPath(Result, s2);
    end;
end;

var
  xml: TXXMLDocument;
begin
  xml:=TXXMLDocument.Create(Application);
  xml.LoadFromFile('ファイルパス');
  node:=xml.readXPath(nil, 'project/name');
  xml.free;
end;

で楽にはなりますが、遅いかも。

Shift-jisからUTF-8へ変換

2010/01/28 12:34 に いつかはちょうになる が投稿   [ 2010/01/28 12:38 に更新しました ]

Shift-JISであることが確定している情報をTStringListに格納していて、その内容をUTF-8に変換する場合、何も苦労することなく変換できる。以下サンプル関数を掲載する。EUCに変換したい場合はAnsiToUtf8ではなくAnsiToEUCを利用すればよい。


procedure ConvUtoA(ASrc: TStringList);
var
  i: Integer;
begin
  for i:=0 to ASrc.Count-1 do
    begin
      ASrc[i]:=Utf8ToAnsi(ASrc[i]);
    end;
end;

procedure ConvAtoU(ASrc: TStringList);
var
  i: Integer;
begin
  for i:=0 to ASrc.Count-1 do
    begin
      ASrc[i]:=AnsiToUtf8(ASrc[i]);
    end;
end;

csvを容易に扱う

2010/01/28 12:27 に いつかはちょうになる が投稿

delphiの大きな特徴VCLには多くの便利なライブラリが含まれている。
中でもTStringListクラスは使い勝手が良すぎて困るくらい。

以下のサンプルはstrlItemsの中に1レコード分の分割された値が格納される。

var
  i:Integer;
  strlLines: TStringList;
  strlItems: TStringList;
begin
  strlLines:=TStringList.Create;
  strlItems:=TStringList.Create;
  try
    strlLines.LoadFromFile('ファイルパス');
    for i:=0 to strlLines.Count-1 do
      begin
        strlItems.CommaText:=strlLines[i];

      end;
  finally
    strlLines.Clear;
    strlLines.Free;
    strlItems.Clear;
    strlItems.Free;
  end;
end;

Bitmap の RGB をそれぞれ入替操作

2010/01/21 3:45 に いつかはちょうになる が投稿

delphi で記述されているが、他の言語でも概念は同じはず。

元の色を赤とする。
赤→青
procedure TForm1.Button2Click(Sender: TObject);
var
  i: Integer;
  c: TColor;
  r,g,b: byte;
  x,y: integer;
  bmp: TBitmap;
begin
  bmp:=TBitmap.Create;
  try
    for i:=1 to 6 do
      begin
        bmp.LoadFromFile('G:\Inetpub\wwwroot\img\3594\tp_0'+IntToStr(i)+'.bmp');
        bmp.PixelFormat:=pf24bit;
        for y:=0 to bmp.Height-1 do
          begin
            for x:=0 to bmp.Width-1 do
              begin
               c:=bmp.Canvas.Pixels[x,y];
               r:=c and $FF;
               g:=(c and $FF00) div 256;
               b:=(c and $FF0000) div(256*256);
               c:=b+(g*256)+(r*256*256);
               bmp.Canvas.Pixels[x,y]:=c;
              end;
          end;
        bmp.SaveToFile('G:\Inetpub\wwwroot\img\3594\tp_02-0'+IntToStr(i)+'.bmp');
      end;
  finally
    bmp.Free;
  end;
end;
赤→緑
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  c: TColor;
  r,g,b: byte;
  x,y: integer;
  bmp: TBitmap;
begin
  bmp:=TBitmap.Create;
  try
    for i:=1 to 6 do
      begin
        bmp.LoadFromFile('G:\Inetpub\wwwroot\img\3594\tp_0'+IntToStr(i)+'.bmp');
        bmp.PixelFormat:=pf24bit;
        for y:=0 to bmp.Height-1 do
          begin
            for x:=0 to bmp.Width-1 do
              begin
               c:=bmp.Canvas.Pixels[x,y];
               r:=c and $FF;
               g:=(c and $FF00)div 256;
               b:=(c and $FF0000)div(256*256);
               c:=g+(r*256)+(b*256*256);
               bmp.Canvas.Pixels[x,y]:=c;
              end;
          end;
        bmp.SaveToFile('G:\Inetpub\wwwroot\img\3594\tp_01-0'+IntToStr(i)+'.bmp');
      end;
  finally
    bmp.Free;
  end;
end;
赤→紫
procedure TForm1.Button3Click(Sender: TObject);
var
  i: Integer;
  c: TColor;
  r,g,b: byte;
  x,y: integer;
  bmp: TBitmap;
begin
  bmp:=TBitmap.Create;
  try
    for i:=1 to 6 do
      begin
        bmp.LoadFromFile('G:\Inetpub\wwwroot\img\3594\tp_0'+IntToStr(i)+'.bmp');
        bmp.PixelFormat:=pf24bit;
        for y:=0 to bmp.Height-1 do
          begin
            for x:=0 to bmp.Width-1 do
              begin
               c:=bmp.Canvas.Pixels[x,y];
               r:=c and $FF;
               g:=(c and $FF00) div 256;
               b:=(c and $FF0000) div(256*256);
               c:=r+(g*256)+(r*256*256);
               bmp.Canvas.Pixels[x,y]:=c;
              end;
          end;
        bmp.SaveToFile('G:\Inetpub\wwwroot\img\3594\tp_03-0'+IntToStr(i)+'.bmp');
      end;
  finally
    bmp.Free;
  end;
end;
赤→灰
procedure TForm1.Button4Click(Sender: TObject);
var
  i: Integer;
  c: TColor;
  r,g,b: byte;
  x,y: integer;
  bmp: TBitmap;
begin
  bmp:=TBitmap.Create;
  try
    for i:=1 to 6 do
      begin
        bmp.LoadFromFile('G:\Inetpub\wwwroot\img\3594\tp_0'+IntToStr(i)+'.bmp');
        bmp.PixelFormat:=pf24bit;
        for y:=0 to bmp.Height-1 do
          begin
            for x:=0 to bmp.Width-1 do
              begin
               c:=bmp.Canvas.Pixels[x,y];
               r:=c and $FF;
               g:=(c and $FF00) div 256;
               b:=(c and $FF0000) div(256*256);
               c:=r+(r*256)+(r*256*256);
               bmp.Canvas.Pixels[x,y]:=c;
              end;
          end;
        bmp.SaveToFile('G:\Inetpub\wwwroot\img\3594\tp_04-0'+IntToStr(i)+'.bmp');
      end;
  finally
    bmp.Free;
  end;
end;

1-10 of 10