2010年08月03日

Delphi:CSVを扱うクラス

DelphiのTStringsはCSVを行単位でしか読み込めないので、表単位で読み込むCSVクラスを自作した。とりあえずCSVファイルの入出力とソートの最小限の機能のみ。ダウンロードはこちら
posted by 忘却の達人 at 08:14| Comment(0) | TrackBack(0) | Delphi | このブログの読者になる | 更新情報をチェックする

2010年04月29日

Delphi:連想配列

Delphi2009のTDictionaryクラスを使って連想配列と同等のことができる。
ただ存在しないキーでは例外が発生するので、以下のようにTDictionaryを継承してItemsプロパティを変えてやれば、存在しないキーは参照時は型の初期値を返し、設定時はリストに追加されるようになる。
uses節にGenerics.Collectionsを追加。

THash<TKey,TValue> = class(TDictionary<TKey,TValue>)
private
  function GetItem(const Key: TKey): TValue;
  procedure SetItem(const Key: TKey; const Value: TValue);
public
  property Items[const Key: TKey]: TValue read GetItem write SetItem; default;
end;

{ THash<TKey, TValue> }

function THash<TKey, TValue>.GetItem(const Key: TKey): TValue;
begin
  TryGetValue(Key, Result);
end;

procedure THash<TKey, TValue>.SetItem(const Key: TKey;
  const Value: TValue);
begin
  AddOrSetValue(Key, Value);
end;

//---------------------------------------------------------

procedure TForm1.Button1Click(Sender: TObject);
var
  dic: THash<string, string>;
begin
  dic := THash<string, string>.Create;
  try
    dic['東京都'] := '新宿区';
    dic['埼玉県'] := 'さいたま市';
    dic['神奈川県'] := '横浜市';
    Memo1.Lines.Add(dic['東京都']);
    Memo1.Lines.Add(dic['埼玉県']);
    Memo1.Lines.Add(dic['神奈川県']);
    Memo1.Lines.Add(dic['来来軒']);
  finally
    dic.Free;
  end;
end;
posted by 忘却の達人 at 07:16| Comment(0) | TrackBack(0) | Delphi | このブログの読者になる | 更新情報をチェックする

2010年03月21日

Delphi: COMオブジェクト作成時の注意点

COMオブジェクトで戻り値のあるメソッドを定義する場合は、戻り値は出力パラメータとして定義し、メソッドの戻り値の属性はHRESULTにする。

あとVBA・VBSと文字列のやりとりをするにはVariant型で定義するのと、dprファイルに"{$R *.tlb}"を追加。
posted by 忘却の達人 at 10:41| Comment(0) | TrackBack(0) | Delphi | このブログの読者になる | 更新情報をチェックする

2010年01月28日

Delphi:xmlをGridに読み込む

DelphiでxmlファイルをGridに読み込む。

type
	TxmlForm = class(TForm)
		xd: TXMLDocument;
    Grid: TStringGrid;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    OpenButton: TButton;
    SaveButton: TButton;
    procedure OpenButtonClick(Sender: TObject);
    procedure SaveButtonClick(Sender: TObject);
	private
		{ Private 宣言 }
		FNodeName: string;
		FRowIndex,
		FColIndex: Integer;
		procedure AddChildren(xmlNode: IXMLNode);
	public
		{ Public 宣言 }
	end;

var
	xmlForm: TxmlForm;

implementation

{$R *.dfm}

procedure TxmlForm.OpenButtonClick(Sender: TObject);
var
	i, j: Integer;
begin
	if not OpenDialog.Execute then Exit;
	for i := 0 to Grid.ColCount - 1 do
		Grid.Cols[i].Clear;
	Grid.RowCount := 2;
	FRowIndex := 1;
	FColIndex := 1;
	for i := 0 to OpenDialog.Files.Count - 1 do
	begin
		xd.FileName := OpenDialog.Files[i];
		xd.Active := True;
		AddChildren(xd.Node);
		for j := 0 to Grid.ColCount - 1 do
			if Grid.Cells[j, FRowIndex] = '' then
				Grid.Cells[j, FRowIndex] := Grid.Cells[j, FRowIndex - 1];
		Grid.Cells[0, FRowIndex] := IntToStr(FRowIndex);
	end;
	Grid.ColCount := FColIndex;
	Grid.RowCount := FRowIndex + 1;
end;

procedure TxmlForm.SaveButtonClick(Sender: TObject);
var
	Row, Col: Integer;
	s: string;
begin
	if not SaveDialog.Execute then Exit;

	s := '';
	for Row := 0 to Grid.RowCount - 1 do
	begin
		for Col := 1 to Grid.ColCount - 1 do
			s := s + AnsiQuotedStr(Grid.Cells[Col, Row], '"') + ',';
		s[Length(s)] := #13;
		s := s + #10;
	end;
	StrToFile(s, SaveDialog.FileName, nil);
end;

procedure TxmlForm.AddChildren(xmlNode: IXMLNode);
var
	i, j, ColIndex: Integer;
	s: string;
begin
	for i := 0 to xmlNode.ChildNodes.Count - 1 do
	begin
		if xmlNode.ChildNodes[i].NodeType = ntText then
		begin
			s := xmlNode.ChildNodes[i].NodeValue;
			ColIndex := Grid.Rows[0].IndexOf(FNodeName);
			if ColIndex < 0 then
			begin
				Grid.Cells[FColIndex, 0] := FNodeName;
				ColIndex := FColIndex;
				Inc(FColIndex);
			end;
			if Grid.Cells[ColIndex, FRowIndex] = '' then
				Grid.Cells[ColIndex, FRowIndex] := s
			else
			begin
				for j := 0 to Grid.ColCount - 1 do
					if Grid.Cells[j, FRowIndex] = '' then
						Grid.Cells[j, FRowIndex] := Grid.Cells[j, FRowIndex - 1];
				Grid.Cells[0, FRowIndex] := IntToStr(FRowIndex);
				Inc(FRowIndex);
				Grid.Cells[ColIndex, FRowIndex] := s
			end;
		end
		else
		begin
			FNodeName := xmlNode.ChildNodes[i].NodeName;
		end;
		AddChildren(xmlNode.ChildNodes[i]);
	end;
end;
posted by 忘却の達人 at 22:10| Comment(0) | TrackBack(0) | Delphi | このブログの読者になる | 更新情報をチェックする

2008年10月26日

Delphi:IEコントロールからドキュメントオブジェクトへの参照

IEコントロールからドキュメントオブジェクトへのアクセスは、型キャストや"item"プロパティを通してのオブジェクトへの参照が面倒臭い。
簡略化できるクラスか関数を作るべし。

ShowMessage((((WebBrowser1.document as IHTMLDocument2)
.Forms.item('formname',0) as IHTMLFormElement)
.item('editname1',0) as IHTMLElement)
.getAttribute('value',0));


と思ったら、レイトバインディングで解決。

var
doc: OleVariant;
begin
doc := WebBrowser1.Document;
ShowMessage(doc.form.element.value);
end;
posted by 忘却の達人 at 12:01| Comment(0) | TrackBack(0) | Delphi | このブログの読者になる | 更新情報をチェックする

2007年04月02日

Delphi:URLのページをファイルにダウンロードする

"UrlMon"ユニットにある"URLDownloadToFile"関数を使用する。URLとダウンロード先のファイル名を渡すだけでOK。

URLDownloadToFile(nil, PChar(URL), PChar(FileName), 0, nil);

尚、URLのページがキャッシュされている場合はそっちを読み込むので、最新ページを読み込みたい場合は、"WinInet"ユニットにある"DeleteUrlCacheEntry"関数でキャッシュを削除する。

DeleteUrlCacheEntry(PChar(URL));
posted by 忘却の達人 at 10:28| Comment(0) | TrackBack(0) | Delphi | このブログの読者になる | 更新情報をチェックする

2006年11月12日

Delphi:Hintテキストの表示時間

Hint(ツールチップ)の表示時間の設定。(単位はミリ秒)
表示するまでの時間:Application.HintPause
表示してから消えるまでの時間:Application.HintHidePause
posted by 忘却の達人 at 10:41| Comment(0) | TrackBack(0) | Delphi | このブログの読者になる | 更新情報をチェックする

広告


この広告は60日以上更新がないブログに表示がされております。

以下のいずれかの方法で非表示にすることが可能です。

・記事の投稿、編集をおこなう
・マイブログの【設定】 > 【広告設定】 より、「60日間更新が無い場合」 の 「広告を表示しない」にチェックを入れて保存する。