Delphi memo
2008年4月30日
Suns & Moon Laboratory
文字列処理
Ansi付き関数は、日本語使える
Ansi無しは日本語つかうと駄目な時有る
比較
function SameStr(S1: string; S2: string): Boolean;//大文字小文字区別する
function SameText(S1: string; S2: string): Boolean;//大文字小文字区別しない
CompareStr,CompareTextも同様だが、戻り値がIntegerになる。
検索
function Pos(const Substr: string; const S: string): Integer;
SubstrがSに有る場合は、その位置を1〜nで返す。
無い場合は、0を返す。
動的配列
SetLength関数で要素数を設定
High関数で要素数-1を取得
Length関数で要素数を取得
colors:array of TColor;
SetLength(colors,5);
for i=0 to High(colors) do
colors[i]
動的メモリ
GetMemとの差は?
var
ptr:pointer;
begin
try
ptr:=GetMemory(600*1024*1024); //600MBytes!!
finally
FreeMemory(ptr);
end;
初期化 initialization
var
uid:integer;
implementation
:
:
initialization
uid:=0;
end.
ラベルとgoto
procedure test;
label
exit_success;
begin
goto exit_success;
:
:
exit_success:
:
end;
プロパティで配列
function Getvalues(index: integer): string;
procedure Setvalues(index: integer; const Value: string);
property values[index:integer]:string read Getvalues write Setvalues;
例外
uses SysUtils;
raise Exception.Create('Error!!');
浮動小数点(double,float)を文字列に変換
uses SysUtils;
FloatToStrF(Tick/1000,ffFixed,15,3);
DateTimeToString 日付時刻を文字列に変換
ソース
uses SysUtils;
var
str:string;
begin
DateTimeToString(str,'yymmdd_hhnnss',Now);
Memo1.Lines.Add(str);
end;
結果
070127_112913
070127_112914
ポインタ
メモリフィル
FillChar(m_Buffer^,total_size,$FF);
列挙型
CでいうところのEnum
type
TGohan = (ghAsaGohan,ghHiruGohan,ghBanGohan);
構造体,Record
type
PNS_HEAD = ^NOTE_TO_SH;
NOTE_TO_SH = record
lMitei2Size:Longint;
lVerUpStartAddress:Longword;
cYobi:array[0..31] of char;
end;
TFileStream,ファイルサイズ,共有モード
read
var
fs:TFileStream;
acc_size:integer;
m_Buffer:PChar;
ptr:pchar;
begin
GetMem(m_Buffer,LARGE_BUF_SIZE);
ptr = m_Buffer;
fs:=TFileStream.Create(fname,fmOpenRead);
try
fs.Read(ptr^,acc_size);
finally
fs.Free
end;
end;
write
var
fs:TFileStream;
begin
acc_size:=READ_MEMORY_SIZE;
remain:=readsize;
fs:=TFileStream.Create(fname,fmCreate);
try
while remain>0 do
begin
fs.Write(PChar(m_Buffer + SizeOf(SH4USBIF_HEADER)+SizeOf(SH_TO_NOTE))^,acc_size);
end;
finally
fs.Free
end;
end;
注意点
procedure TForm1.btnRefClick(Sender: TObject);
var
fs:TFileStream;
fname:string;
begin
if OpenDialog1.Execute then
begin
fname:=OpenDialog1.FileName;
edFname.Text:=fname;
fs:=TFileStream.Create(fname,fmOpenRead or fmShareDenyNone);
try
edSize.Text:=IntToStr(fs.Size);
finally
fs.Free;
end;
end;
end;
TImage上でマウスドラッグ
procedure TfrmMain.ImageViewMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
memo('mouse down');
MouseCapture:=True;
end;
procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
memo('main mouse move');
end;
procedure TfrmMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
memo('main mouse up');
MouseCapture:=False;
end;
TChart(TeeChart)
TChartのヘルプ
なんか、どう探してもインストールされていない様な気がします(RAD Studio 2007)。
しかたないので、CODE GEARからTeeChartをダウンロード、インストールして、その中に有るヘルプを見ています。
TChartの情報
ニュートンQ&A(TeeChart Pro 7J VCL)
PointerのStyle

↓こんな雰囲気
TLineSeries.Pointer.Style:=TSeriesPointerStyle(cmbPointerStyle.ItemIndex);
TLineSeries.Pointer.Visible:=chkPointerVisible.Checked;
終了コード
System.ExitCodeで戻り値を返す事が可能。
戻り値はバッチファイルならば、ERRORLEVELで判定可能。
別のexe実行
ShellExecute
ShellExecute(Application.Handle,'open',PChar(cmd),PChar(option),nil,SW_NORMAL);
ShellExecuteEX
バッチファイルから終了コードを返したい場合は、「exit 1」とかで指定可能です。
function TForm1.shell_exec(cmd:string;option:string):DWORD;
var
sei:SHELLEXECUTEINFO;
begin
ZeroMemory(@sei, sizeof(SHELLEXECUTEINFO));
//構造体のサイズ
sei.cbSize := sizeof(SHELLEXECUTEINFO);
//起動側のウインドウハンドル
sei.Wnd := Handle;
//起動後の表示状態
sei.nShow := SW_SHOWNORMAL;
//このパラメータが重要で、セットしないとSHELLEXECUTEINFO構造体のhProcessメンバがセットされない。
sei.fMask := SEE_MASK_NOCLOSEPROCESS;
//起動プログラム
sei.lpFile := PChar(cmd);
sei.lpParameters := PChar(option);
//プロセス起動
if not ShellExecuteEx(@sei) then//shell32.lib必須
exit;
//エラー?
if sei.hInstApp <= 32 then
exit;
//終了を待つ
WaitForSingleObject( sei.hProcess, INFINITE ) ;
//戻り値を取得
GetExitCodeProcess(sei.hProcess, Result);
end;
CreateProcess
パイプ使った入出力のサンプルは↓から
http://www.autch.net/page/tips/delphi_anonymous_pipe.html
エクスプローラからドラッグドロップ
type
TForm1 = class(TForm)
private
{ Private 宣言 }
procedure WMDropFiles(var Msg: TWMDropFiles); Message WM_DropFiles;
end;
implementation
uses ShellApi;
{$R *.dfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle,True);
end;
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
num_files:integer;
i:integer;
FileName: Array[0..MAX_PATH] of Char;
begin
num_files := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0);
for i := 0 to num_files - 1 do
begin
DragQueryFile(Msg.Drop, i, FileName, SizeOf(FileName));
Memo1.Lines.Add(String(FileName));
end;
DragFinish(Msg.Drop);
end;
参考
http://kwi.cocolog-nifty.com/blog/2005/12/delphi_drag__dr_e30d.html
http://www.geocities.co.jp/Milano/8000/delphi/dragdrop.html
コンポーネントを動的に生成
一般的な例ではないのですが、こんな感じで。
procedure TForm1.btnComm1CreateClick(Sender: TObject);
begin
comm1:=TComm.Create(self);
comm1.BaudRate:=9600;
comm1.ByteSize:=cbs8;
comm1.ParityBits:=cpbNone;
comm1.StopBits:=csb1;
comm1.FlowControls:=[];
comm1.Port:=1;
comm1.OnCommReceive:=Comm1CommReceive;
comm1.Open;
end;
procedure TForm1.Comm1CommReceive(Sender: TObject; Size: Word);
begin
end;
タスクバーに表示しない
メインフォームをタスクバーで非表示にする方法。
ヘルプを見ると、Runメソッドの呼び出し前にとなっています。
とりあえずFormCreateとかで良いかと。
Application.ShowMainForm:=False;
環境変数
GetEnvironmentVariable('OS')
ファイルとフォルダの有無確認
ファイルの有無確認はFileExists
ディレクトリの有無確認はDirectoryExists
if not DirectoryExists('xyz') then
MkDir('xyz');
タイトルバーの無いフォームの移動(WM_NCHITTEST)
引用元失念。
procedure WMNCHITTEST(var Msg: TWMNCHITTEST); message WM_NCHITTEST;
procedure WMNCLButtonDBLCLK(var msg :TWMNCHitMessage); message WM_NCLBUTTONDBLCLK;
procedure TFormHusen.WMNCHITTEST(var Msg: TWMNCHITTEST);
var
Pt:TPoint;
begin
//マウス座標を取得
GetCursorPos(Pt);
//フォーム上の座標に変換
Pt := ScreenToClient(Pt);
if GetAsyncKeyState(VK_LBUTTON) < 0 then
//ウィンドウズにタイトル バーで発生することを示すHTCAPTIONを返す
Msg.Result := HTCAPTION
else
Msg.Result := HTCLIENT;
end;
//WMNCHITTESTで小細工しているので、ダブルクリックをFormのイベントで検出出来ない
procedure TFormHusen.WMNCLButtonDBLCLK(var msg: TWMNCHitMessage);
begin
end;
TListView
選択されたアイテムを取得する方法。
TCustomListView.GetNextItem メソッド
TListを継承して独自のリストを作成。ついでにソートもしてみる。
TListはメモリの確保をしないので、メモリの確保と解放をするように実装。
TObjectListを参考に実装してみました。
とりあえず作ってみた物の、悩み中。
実装
unit IkCustomList;
interface
uses Classes;
type
TIkDoubleList = class(TList)
Protected
procedure Notify(Ptr: Pointer; Action: TListNotification); override;
function GetItem(Index: Integer): Double;
procedure SetItem(Index: Integer; const Value: Double);
public
procedure Clear; override;
function Add(Value: Double): Integer;
property Items[Index: Integer]: Double read GetItem write SetItem; default;
end;
function CompareDouble(item1,item2:Pointer):Integer;
implementation
//Sort用比較関数
function CompareDouble(item1, item2: Pointer): Integer;
begin
if PDouble(item1)^ < PDouble(item2)^ then
Result:=-1
else if PDouble(item1)^ > PDouble(item2)^ then
Result:=1
else
Result:=0
end;
{ TIkDoubleList }
function TIkDoubleList.Add(Value: Double): Integer;
var
p:PDouble;
begin
New(p);
p^:=Value;
Result:=Inherited Add(p)
end;
//この方法だと、Extractの戻り値が使えなくなる。が、実害はなさそう。
procedure TIkDoubleList.Notify(Ptr: Pointer; Action: TListNotification);
begin
if Action = lnDeleted then
begin
Dispose(Ptr);
end;
inherited Notify(Ptr, Action);
end;
procedure TIkDoubleList.Clear;
var
i:integer;
begin
for i := 0 to Count - 1 do
Delete(0);//ClearはTListでは要素の解放をしない。ちなみにDestroyではClear呼出しが存在する。
inherited Clear;
end;
function TIkDoubleList.GetItem(Index: Integer): Double;
begin
Result:= PDouble(inherited Items[index])^;
//Items[index]をアクセスすると、TList.Getが呼ばれる
//TList.Getはポインタを返す。
//ポインタを逆参照して値を返す。
end;
procedure TIkDoubleList.SetItem(Index: Integer; const Value: Double);
begin
PDouble(inherited Items[index])^:=Value;
//Items[index]をアクセスすると、TList.Getが呼ばれる
//TList.Getはポインタを返す。
//ポインタを逆参照して値を入れる。
end;
end.
使い方
TMemoとTButtonをはりつけて、下記ソースみたくする。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,IkCustomList;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
dlist:TIkDoubleList;
i:integer;
begin
dlist:=TIkDoubleList.Create;
try
for i := 0 to 100 do
dlist.Add(Random()*100);
dlist.Sort(@CompareDouble);
for i := 0 to 100 do
Memo1.Lines.Add( FloatToStr(dlist.Items[i]));
finally
dlist.Free;
end;
end;
end.
コンポーネントのインストール方法
参考:コンポーネントのインストール方法等
リンク
CodeGear 旧Delphi FAQ
Delphi Library [Mr.XRAY] 高度なサンプル有ります
CとDelphiの対比表
2008-10-23 19:49:28 32400