透過日陽 http://www.knet.ne.jp/~touka
|
これは私がプログラム開発時に参考になったソースや、 思いついた関数など書き溜めた物です。 Delphi使いの方に参考になればと思い載せました。 全選択でテキストにコピペして保存すると、 アウトラインプロセッサで使用できる階層化テキストになります。 （もはや私はコレ無しでは開発できません・・・） |
.◆Delphi全般
..基礎
＞ユニット解説
Delphiの「ファイル」から「ユニットを使う」を選べば、
unit1の「implementation」にunit2が追加される。
ユニットは大きく2つの部分に分かれます。
Unit ClassUnit; //クラス名
interface //宣言部 他のユニットからでも参照できる。
uses
Dialogs; //参照するユニットを指定
type
TClass = class
MyRecode,
MyRecode2 : Integer;
procedure
MyProcedure;
private
{ Private 宣言 }
//このクラス内でのみ参照できる関数
public
{ Public 宣言 }
//このクラス以外でも参照できる関数
end;
implementation //実装部 このユニットの中だけで参照が出来る。
procedure
TClass.MyProcedure;
begin
ShowMessage('TClass procedure
!');
end;
end.
他のUnitで関数を参照するにはInterface部のUses宣言後に参照する関数の名前だけ記述する。
その後、参照するunitのUses又は、implementation部に参照元のUnitを宣言する。
循環参照してしまった場合にはどちらか一方の参照をimplementation部に参照を変える。
unit1の生成時にunit2のobjectを参照する場合は、Form2を先に生成する。（プロジェクト-オプション-フォーム）
変数の中身をチェック（デバッグ・監視式）
変数の前後へカーソルを移動し、Ctrl+F5
を押すと、監視式が表示されます。
（メニューからデバッグ→監視式
でも表示できます。）
そこでアプリの実行をすると変数の中身が分かります。
確認がしたい実行ポイントでブレークを指定するとよいでしょう。
ユニット出力〜がコンパイルの一時ファイル用パス
出力〜がEXEパス
検索パスがソースパス
ctrl＋J でコードテンプレートを使う。
矩形選択後、ctrl＋Shift＋I
で選択範囲をインデントできます。
アプリケーション名の変更はプロジェクトオプションのアプリケーションタブからタイトルを記入すると変更できる。
ソースの可読性を上げるため、使うコンポーネントは必ず名前を付ける。
＞その他の特徴
大文字小文字の区別はしない。
()で計算式の優先順位を高めることができる。
GUIの&は一文字分のアクセラレータキーの割り当てを意味する。
コメント文 {
} //
代入 ：＝
インクリメントは Inc();
デインクリメントは
dec();
改行コード： #13#10
showmessage('エラーが発生しました。'+#13#10+'リストアイテムを消去します。');
..制御文
IF文
If 条件式
Then
else
--------------*
If (条件式)
or (条件式)
Then
else
-------------------------
条件式に見合った場合、Then以降の文が実行されます。
or演算子、and演算子は条件式を括弧で閉じます。
else文は見合わなかった場合に実行されます。
又、ブロック化することで複数行にわたって記述することができます。
and 両方のビットが 成立 のときのみ成立。
or いずれかのビットが 成立
なら成立。
=======================================================
Case文
case
選択式 of
ケースリスト１: 文 ;
ケースリスト２: 文
;
end;
---------------------------------
case文は条件式による分岐ではなく、選択式と同じ条件文に処理を振り分けます。
case i of
1:
Writeln('食べます。');
2:
begin
Writeln('起きてます。');
ShowMessage('複数行のプログラムを書く場合はbegin〜end;を使います。');
end;
end;
セレクタの複数指定と範囲指定。
case Value of
0,
10 : Z := 0; { Valueが 0 か 10
のどちらか }
1..5 : Z :=
1; { Valueが 1 〜 5 の間 }
end;
文字列型は無効です。順序型ならOKです。
case MyColor of
Red: X
:= 1;
Green: X := 2;
Blue: X :=
3;
=======================================================
goto文
label
//繰り返し専用の変数宣言みたいなモノ。
loop： //繰り返し地点
goto
loop;
..繰り返し処理
For文
//ループ回数(カウント)が終値に達するまでループする。
for
i(カウンタ) 初期値 to 終値 do //変数iをインクリメント
for i(カウンタ) 初期値 downto 終値
do //変数iをデインクリメント
//終値に達した後、もう一度ループして終了します。
for i
:= 0 to 10 do
begin
Memo1.Lines.Add( IntToStr(i) );
end;
====================================================
while文
//条件式がtuleであると繰り返す。
while
条件式 do;
繰り返す処理
複数のFormを使う
ファイルから新規作成、フォームを選択。
Form1のUses節にUnit2を追加する。
Form2のプロパティのVisibleをTrueにする。
..record型
構造体(record型)とは表形式にまとめた情報の集まり。名前だけで関連するいくつもの変数を同時に扱うことができる。
使用するには構造体の宣言と、構造体で使う変数の宣言が必要になります。
type //型宣言の開始を意味する。
Tseiseki
=
record //record型"Tseiseki"を宣言。Tを付けるのは型であると分かり易くするため。セミコロンはつけない。
kokugo,eigo,sugaku
=
Integer; //Tseiseki型で保持する、変数(フィールド)を宣言。
end; //型宣言を終える。続いて宣言する場合はtypeは不要でそのまま宣言が可能。
構造体の変数（表項目）をフィールドと呼びます。
この構造体に関数(メンバ関数)を加えたものが、クラスと呼ばれるものです。
..起動時のイベント発生順序
Formの生成イベント発生順序。 →onCreate･･････onShow･･････onActivate･･････onPaint
の順に発生する。
生成時にグローバル変数を参照する際は、onShow
で参照する。
Formの破棄イベント発生順序。 →OnClose･･････OnHide･･････OnDestroy
破棄時にグローバル変数を参照する際は、onClose
で参照する。
..コンパイルエラー時のチェック項目
//レコード，オブジェクトまたはクラスのいずれかが必要です。
変数、返り値の指定が間違ってませんか？ それ以下の「.」は存在しない筈。
例
S:= Lines.Strings[0].Text; //stringsで行指定した時点でその行のstringが返る。
//変数パラメータに定数オブジェクトを渡すことはできません
変数を参照するメソッドで参照する変数にプロパティを参照させていませんか？ 変数を参照させてください。
例
Delete( RichEdit.Lines.Strings[0], 1, 2);
//Deleteがプロパティを参照しています。変数に置き換えてください。
プロジェクトから追加・削除等を実施したら、再構築をしてみる。
..コンポーネントインストール
パッケージインストール
まず、ツール-環境オプション-ライブラリタブのライブラリパスで、
src＼FreeLib直下のすべてのディレクトリとsrc＼FreeLib＼dms＼sourceのパスを通す。
参考:
ttp://homepage2.nifty.com/Mr_XRAY/Delphi/plSamples/CompPath.htm
次に、src＼FreeLib＼FreeLib.dpkを開いてコンパイル、インストールすると、
パレットにコンポーネントが追加される。
src＼JmLibでも同様の操作をすれば、エラーが起きずにJmEdit2.dprが読み込めるはず。
コンポーネントをコンパイルした結果できるのが .dcu ファイル。
コンポーネントをアンインストールするには
プロジェクト-オプションのパッケージのタブを開き、
インストールしたパッケージをダブルクリック。
パッケージダイアログからアンインストールしたいコンポーネントを選択し、
削除、コンパイルをする。
..演算子
関係演算子
= 等しい
<> 等しくない
< より小さい
> より大きい
<= 以下
>=
以上
算術演算子
+ 加算
- 減算
* 乗算
/ 除算
div 整数除算
mod 剰余
※べき乗は無い。mathにある、power関数を使う。2の3乗は、power(2,3)。
論理演算子 //評価には左辺と右辺を括弧でくくる。
not 論理否定
and 論理積
or
論理和
xor 排他的論理和
/*
条件式１ And 条件式２ 条件１も条件２も成り立つ
条件式１ Or
条件式２ どちらかの条件式が１つでも成り立つ
条件式１ Xor 条件式２ どちらか一方の条件式のみ成り立つ
*/
文字列演算子
+
結合
ポインタ演算子
+ ポインタ加算
- ポインタ減算
^ ポインタ逆参照
= 等しい
<>
等しくない
..仮想キーコード
仮想キーコード 対応するキー
VK_LBUTTON マウスの左ボタン
VK_RBUTTON マウスの右ボタン
VK_CANCEL 〔Control〕+〔Break〕
VK_MBUTTON マウスの中央ボタン
VK_BACK 〔Backspace〕キー
VK_TAB 〔Tab〕キー
VK_CLEAR 〔Clear〕キー
VK_RETURN 〔Enter〕キー
VK_SHIFT 〔Shift〕キー
VK_CONTROL 〔Ctrl〕キー
VK_MENU 〔Alt〕キー
VK_PAUSE 〔Pause〕キー
VK_CAPITAL 〔Caps
Lock〕キー
VK_KANA IME で使用
VK_HANGUL IME で使用
VK_JUNJA IME
で使用
VK_FINAL IME で使用
VK_HANJA IME で使用
VK_KANJI IME
で使用
VK_CONVERT IME で使用
VK_NONCONVERT IME
で使用
VK_ACCEPT IME で使用
VK_MODECHANGE IME
で使用
VK_ESCAPE 〔Esc〕キー
VK_SPACE 〔Space
bar〕
VK_PRIOR 〔Page Up〕キー
VK_NEXT 〔Page
Down〕キー
VK_END 〔End〕キー
VK_HOME 〔Home〕キー
VK_LEFT 〔←〕キー
VK_UP 〔↑〕キー
VK_RIGHT 〔→〕キー
VK_DOWN 〔↓〕キー
VK_SELECT 〔Select〕キー
VK_PRINT 〔Print〕キー（キーボード固有）
VK_EXECUTE 〔Execute〕キー
VK_SNAPSHOT 〔Print
Screen〕キー
VK_INSERT 〔Insert〕キー
VK_DELETE 〔Delete〕キー
VK_HELP 〔Help〕キー
VK_LWIN 〔Left
Windows〕キー（Microsoft キーボード）
VK_RWIN 〔Right Windows〕キー（Microsoft
キーボード）
VK_APPS 〔Applications〕キー（Microsoft
キーボード）
VK_NUMPAD0 〔0〕キー（テンキー）
VK_NUMPAD1 〔1〕キー（テンキー）
VK_NUMPAD2 〔2〕キー（テンキー）
VK_NUMPAD3 〔3〕キー（テンキー）
VK_NUMPAD4 〔4〕キー（テンキー）
VK_NUMPAD5 〔5〕キー（テンキー）
VK_NUMPAD6 〔6〕キー（テンキー）
VK_NUMPAD7 〔7〕キー（テンキー）
VK_NUMPAD8 〔8〕キー（テンキー）
VK_NUMPAD9 〔9〕キー（テンキー）
VK_MULTIPLY 〔*〕キー（テンキー）
VK_ADD 〔+〕キー（テンキー）
VK_SEPARATOR 〔Separator〕キー（テンキー）
VK_SUBTRACT 〔-〕キー（テンキー）
VK_DECIMAL 〔.〕キー（テンキー）
VK_DIVIDE 〔/〕キー（テンキー）
VK_F1 〔F1〕キー
VK_F2 〔F2〕キー
VK_F3 〔F3〕キー
VK_F4 〔F4〕キー
VK_F5 〔F5〕キー
VK_F6 〔F6〕キー
VK_F7 〔F7〕キー
VK_F8 〔F8〕キー
VK_F9 〔F9〕キー
VK_F10 〔F10〕キー
VK_F11 〔F11〕キー
VK_F12 〔F12〕キー
VK_F13 〔F13〕キー
VK_F14 〔F14〕キー
VK_F15 〔F15〕キー
VK_F16 〔F16〕キー
VK_F17 〔F17〕キー
VK_F18 〔F18〕キー
VK_F19 〔F19〕キー
VK_F20 〔F20〕キー
VK_F21 〔F21〕キー
VK_F22 〔F22〕キー
VK_F23 〔F23〕キー
VK_F24 〔F24〕キー
VK_NUMLOCK 〔Num
Lock〕キー
VK_SCROLL 〔Scroll Lock〕キー
VK_LSHIFT 〔Left
Shift〕キー（GetAsyncKeyState および GetKeyState のみと使用）
VK_RSHIFT 〔Right
Shift〕キー（GetAsyncKeyState および GetKeyState
のみと使用）
VK_LCONTROL 〔Left Ctrl〕キー（GetAsyncKeyState および
GetKeyState のみと使用）
VK_RCONTROL 〔Right Ctrl〕キー（GetAsyncKeyState および
GetKeyState のみと使用）
VK_LMENU 〔Left Alt〕キー（GetAsyncKeyState および
GetKeyState のみと使用）
VK_RMENU 〔Right Alt〕キー（GetAsyncKeyState および
GetKeyState
のみと使用）
VK_PROCESSKEY 〔Process〕キー
VK_ATTN 〔Attn〕キー
VK_CRSEL 〔CrSel〕キー
VK_EXSEL 〔ExSel〕キー
VK_EREOF 〔Erase
EOF〕キー
VK_PLAY 〔Play〕キー
VK_ZOOM 〔Zoom〕キー
VK_NONAME 将来使うために予約済み
VK_PA1 〔PA1〕キー
VK_OEM_CLEAR 〔Clear〕キー
型キャストとは、ある型の値を近い種類の型に変換することです。
例えば、0をfalse、0以外をtrueなどで、Integerをbooleanに型キャストすることができます。
..関数の使い方
//引数と戻り値の間は、: で分ける。
function
tashi(s:String; X,Y: Integer): String;
var I: Integer;
begin
I:=
Form1.Height;
Result:= s + inttostr((X+Y)* I);
end;
..基本プロパティ
Checked
:有効なら、ＧＵＩにチェックを表示します。
FormStyle
:Formの表示状態を決めます。最大、最小、最前面、Normalが選べます。
・AutoSize
:Trueにすると、読み込んだデバイスにあわせて、オブジェクトもリサイズされる。
・BorderIcons
:最大化最小化などタイトルバーに付いてるアイコンを使用するか決める。
・BorderStyle
:タイトルバーのスタイルを定義する。サイズの変更不可など。
・Caption :オブジェクトのGUI表示名。半角で(&)
＆の後に
任意のアルファベットを入れることでアクセラレータキーを設定することもできる。
・Filter
:ファイル選択時に他の拡張子の表示を制限できる。*.bmp
など。
実際に読み込める拡張子とは限らない。
・Height : 縦幅を変更します。
・Hint
:「ShowHint」が「True」ならば、ここに書かれているものをヒントとして表示します。
・Name
:オブジェクト名。
・Position :
表示位置とサイズの取り決め。
poDefaultPosOnlyはsizがデフォルトで、位置をWindowsに決めさせる。
・ReadOnly :
実行時に、読み取り専用にする（True）か、しない（False）か？
・ShowHint :
実行時にマウスのカーソルが写った時にポップアップヒントを出すかどうか？
・Top・Left :
（コンポーネントの位置）などもあります。
・Visible :
実行時に、オブジェクトを表示する（True）か、表示しない（False）か？
・Width : 横幅を変更します。
..型キャストの注意点。
型キャストは「変更したい型（対象の変数）」のように
括弧でくくると型キャストされますが、事前に型キャストしておいて、
それを後で代入する、というのはなぜか出来ません。
実際に使う直前に型キャストをしてください。
otofile:PChar;
edit1.text:=
Dlg.Fileneme;
otofile:=
PChar(edit1.text);
sndplaySound(otofile,SND_ASYNC);
//これだとなぜかotofileが空っぽになってしまう。
otofile:string;
edit1.text:=
Dlg.Fileneme;
otofile:=
edit1.text;
sndplaySound(PChar(otofile),SND_ASYNC); //使う直前に型キャストするとうまくいく。
..動的配列
配列の数が固定でなく、動的に増える場合、メモリを最小限に留めて使う配列。
配列名: Array of
配列の型; //添え字を指定しない、つまりメモリ量を指定しないで宣言。宣言場所によっては内容が消えてしまうので注意。
//--------main部分--------
SetLength(配列名,Length(配列名)+1); //配列を増やす。Lengthで現在の配列の要素数を取得し、SetLengthで取得した配列に１を足して設定する。
with
seiseki[High(配列名)] do
//配列インデックスの指定に、High関数の戻り値を渡している。High関数は配列の最大数を取得する。
begin
kokugo :=
Strtoint(Edit1.text); //Edit.textの中をフィールドに代入。
eigo :=
Strtoint(Edit2.text);
sugaku := Strtoint(Edit2.text);
end;
with
..配列 （静的配列）
複数の同じ型の変数にインデックスを付けてグループ化したもの。
var 配列名: Array[添え字(開始)..添え字(末尾)] of
配列の型;
配列の個々の要素には、配列名[添え字] として、添え字を用いてアクセスします。
..変数について
文字列型 ：String
整数型 ：Integer
実数型 ：Real
, Double
配列型 ：Array
of
論理型 ：Boolean
------------------------------
いずれも汎用型です。他にも色々あります。
よく使われる変数と型
x,y
: SmallInt; //座標
pxlRGB :
LongInt; //ピクセル値（ＲＧＢ型）
R,G,B :
Byte;
//Ｒ値、Ｇ値、Ｂ値
複数を一度に定義するには ，で区切る。
繋げる場合には＋を使う。文字列は’を忘れずに。
====================================================
■
列挙型の例 列挙型は候補からひとつ選ぶ。
procedure TForm1.Button1Click(Sender: TObject);
type
TIro = (iroRed, iroGreen, iroBlue); //列挙型の定義
var
Iro: TIro; //列挙型変数の宣言
begin
iro:=
iroRed; //代入する時
if iro = iroRed then //比較する時
begin
ShowMessage('赤い');
end;
end;
====================================================
■ 集合型の例
集合型は候補から複数選ぶことができます。
var
Iro: set of (irRed, irBlue, irYellow,
irGreen, irWhite); //集合型の宣言
//同じ組み合わせの集合型を使う場合にはTypeでユーザ定義の集合型を宣言します。
type
TDispBtn = set of (dspOK, dspCancel);
var
DispBtn: TDispBtn;
//ユーザ定義集合型変数の宣言
begin
DispBtn:= [dspOK]; //代入する時
DispBtn:= DispBtn + [dspCancel]; //現在の集合に追加する時
DispBtn:= DispBtn - [dspOK]; //現在の集合から削除する時
if dspCancel
in DispBtn then //比較する時
begin
ShowMessage('キャンセル有り');
end;
end;
====================================================
文字列
var s: string;//
添字をつけると文字列の文字にアクセスできる。(半角文字で０からはじまる)
s:= 'Delphi';
Label.Caption:= s[1];
//「D」と表示される。
Label.Caption:= s[2]; //「e」と表示される。
文字列から数字（実数）への変換はStrToFloatを使う
..イベントの共用
procedure
TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
Shift:
TShiftState; X, Y: Integer);
begin
if ssLeft in Shift then
//Shift引数の中がssLeftならば…
TEdit(Sender).SelectAll
end;
procedure TForm1.Edit2MouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y:
Integer);
begin
Edit1.OnMouseDown(Sender,Button,Shift,X,Y);//自分に送られた引数をそのままEdit1のOnmouseイベントの引数に渡してる。
end;
TEditオブジェクトから発生したイベントである場合、内容を全選択する。
..イベントを追加する。
誰かが作ったコンポーネントを使って、イベントを追加する際に目的のイベントがない場合、
ソース（.pas）が公開されていれば追加が可能かもしれません。
published
property
OnMouseMove;
property OnMouseUp;
property OnMouseDown;
property
Align;
property Anchors;
end;
..専門用語
●インスタンス＝クラスから派生されたもの。クラスとは別に独自のデータを持つ。
●begin 〜 end をブロックという。
●有効範囲のことをスコープと言う。
●構造文＝プログラムの流れを変える文を構造文と言う。
●大域変数とは他のユニットからでも参照できる変数のこと。グローバル変数とも呼ばれる。
プログラムを難解にすることから、使用は避けられる。
局所変数はその逆で、一定のルーチンからでしか参照できない変数。
ローカル変数とも呼ばれる。コードがわかりやすくなる。
変数は、1ブロックでしか使わないのか、複数のルーチンで使うのかを考えて宣言をする。
●ハンドル
ハンドルとは、システムが管理するプロセスの様々な情報を格納してある内部構造体へのポインタの事です。
ハンドルは参照カウンタというものがあり、それがゼロにならない限り、ハンドルは開放されません。
CloseHandle
APIを使って、参照カウンタを減らし、ゼロになるとハンドルはシステムによって開放されます。
CreateProcess()によって作成されたプロセスのプロセスハンドルは、参照カウンタが２になっています。
自身のプロセスの参照と、作り出した側のプロセスの参照のためです。
作り出した側の参照カウントを減らすと作り出されたプロセスは関係を切られた（デタッチされた）プロセスになります。
●プロセス･スレッド
ソフトの処理全体をプロセス。プロセスの個々の作業をスレッドと呼ぶ。
Windowsから見てソフトは処理の一つなので、ソフト=プロセス ソフトの作業=スレッド
と考えられる。
プログラム中、Windowを取得する場合、Windowタイトルではユニークではないため、
プロセスIDで取得するケースが一般的です。
..例外処理
注意！
設計時にはエラーになるが、exe実行時にはきちんと動作する。
try
except文･･･//単純に使う場合はexcept〜endの間にエラー時の処理を書けばOK。
try
{
保護コード（例外が発生する可能性のあるコード）}
except
on 例外クラス（例外の種類で分けたクラス） do
例外ハンドラ（例外に対して処理を行うハンドラ）;
end;
例外クラス
EAbstractError -
抽象メソッドの呼び出し
EAccessViolation - メモリ領域への無効なアクセス
EConvertError -
文字列オブジェクトを正しく変換できなかった
EInOutError - ファイルの入出力エラー
EInvalidCast -
型キャストエラー
EIntError - 整数値演算エラー
EMathError -
その他のすべての数値演算例外
EOutOfMemory - メモリ割り当てが不可能
ESatckOverflow -
スタックオーバーフロー
EZeroDivide - ゼロ除算例外
EOverflow -
オーバーフロー例外
ExternalException - 上記以外の不明な例外
EMathError を先頭に記述すると，
ほかの 2
つのハンドラはEMathErrorの下位クラスの為、呼び出されなくなってしまいます。
以下、呼び出しではエラー表記をしなくなります。
except on EAbort
do
デバッグテスト項目にもいえる。
・異なるファイルの選択
・数値に文字、その逆を入力
..＜クラス作成＞
「ファイル/新規作成/ユニット」を実行。下記コードが作成されます。
Unit //クラス名
interface //宣言部
implementation //実装部
end.
クラス名をつけて保存すると Unit
の横にクラスの名前が付きます。
Unit名とファイル名は必ず同じでなければなりません。
宣言部の下にクラスの宣言をします。
レコードの宣言、プロパティ、メソッドの宣言の順に宣言しなければいけません。
Unit ClassUnit; //クラス名
interface //宣言部
type
TClass = class
MyRecode,
MyRecode2 : Integer;
procedure
MyProcedure;
end;
implementation //実装部
end.
==========================================================
＜手続き・関数の定義＞
実装部に手続き･関数の処理を記述します。
「クラス名.procedure名」の形で記述しないと、
「forward
または external 宣言された 'xxx'
が見つかりません」とエラーになる。
また、「ShowMessage」はDialogsユニットを使いますので、uses節にDialogsを加える必要があります。
これがないと、「未定義の識別子
: 'ShowMessage'」とエラーになる。
Unit ClassUnit; //クラス名
interface //宣言部
uses Dialogs;
type
TClass = class
MyRecode,
MyRecode2 : Integer;
procedure
MyProcedure;
end;
implementation //実装部
procedure
TClass.MyProcedure;
begin
ShowMessage('TClass procedure
!');
end;
end.
==========================================================
＜変数の定義＞
次にグローバル変数を定義します。
propertyを使う方法と、ユニット変数を使う方法があります。
propertyにはreadとwrite
があり、propertyを操作すると
それぞれの指定した関数やプロシジャが呼び出されます。
Unit ClassUnit;
interface //宣言部
uses Dialogs;
type
TClass = class
MyRecode,
MyRecode2 : Integer;
S : String;
//文字列型Property
procedure MyProcedure;
procedure SetMyproperty(const
Value:String);
property Myproperty read S write
SetMyproperty;//文字列型Property
end;
var
Unitvar : String; //文字列型変数
implementation //実装部
procedure
TClass.SetMyproperty;
begin
ShowMessage('Mypropertyには'+Value+'が代入されました');
S:=Value;
end;
procedure
TClass.MyProcedure;
begin
ShowMessage('TClass procedure
!');
end;
end.
==========================================================
＜イベントの定義＞
クラスから継承しているイベントハンドラであれば、下記のように簡単に追加できる。
Unit ClassUnit;
interface //宣言部
uses Dialogs;
type
TClass = class
MyRecode,
MyRecode2 : Integer;
SMyproperty : String;
property Myproperty read SMyproperty write
SMyproperty;
procedure MyProcedure;
published
property OnMouseMove;
//←これだけでOnMousemoveイベントが可能。
end;
==========================================================
＜コンポーネントパレットの定義＞
コンポーネントパレットに追加します。下記はtestのタブに TClass_Tasctray
を追加してます。
下記コードはコンポーネントを作るうえでの最低限のソースになります。
private クラスの中だけで使える
protected
クラスの中と継承により派生したクラスから使える
public クラスの外からも使える
継承するのに適当なコンポーネントがない場合は下記のように TComponent 型を使います。
unit Class_Tasctray;
interface//------- 宣言部
uses Classes,Controls;
type
TClass_Tasctray =
Class(TComponent)
public
〜
constructor Create(AOwner:
TComponent); override;
destructor Destroy;
override;
end;
procedure Register;
implementation//--実行部
procedure Register;
begin
RegisterComponents('test', [TClass_Tasctray]);
end;
constructor TClass_Tasctray.Create(AOwner:
TComponent);
begin
inherited Create(AOwner);
end;
destructor TClass_Tasctray.Destroy;
begin
inherited
Destroy;
end;
==========================================================
コンポーネントをインストール際、独自のビットマップを表示したい
リソースファイルを作成します。
その際，リソースファイル名はユニット名に，リソースファイル内のビットマップの名前はコンポーネント名にそれぞれ合わせます。
以下は，MyTool.Pas ユニットで TMyLabel
コンポーネントを作成した場合の例です。
１．イメージエディタから［ファイル｜新規作成］で Delphi
コンポーネントリソース
ファイル（.dcr）を作成します。
２．リソースに 24 X 24
ピクセルの「ビットマップ」を追加し，名前を TMyLabel とし
ます。
３．編集が終わったら，リソースファイルを MyTool.DCR という名前でユニットファイル
がある場所と同じディレクトリに保存します。
４．コンポーネントをインストールすると，コンポーネントパレットにリソースファイル
で指定したビットマップが表示されます。
”コンポーネントの新規作成”ダイアログ
［ユニットファイル名］ →独自のフォルダを指定。
.◆Window操作
..取得■Window外枠のサイズ
普通はGetSystemMetricsでSM_CYEDGE等を見る。
けど、この手の質問だと、実はAdjustWindowRectで解決する
問題であることも多いな。
int
GetSystemMetrics(int
nIndex)
と定義されています。
nIndexに入れる引数は、あらかじめ決められています。
かなりの数がありますので、よく使われるものを紹介します。
デファイン値
説 明
SM_ARRANGE アイコン時の開始位置と方向(ビット組み合わせ)
SM_CLEANBOOT ブートの方法
0:Normalブート 1:Fail-safeブート 2:Fail-safeブート(ネットワーク)
SM_CXBORDER
X方向ボーダー(PIXEL数)
SM_CYBORDER Y方向ボーダー(PIXEL数)
SM_CXCURSOR
カーソル幅(PIXEL数)
SM_CYCURSOR カーソル高さ(PIXEL数)
SM_CXDLGFRAME
SM_CXFIXEDFRAMEと同じ
SM_CYDLGFRAME SM_CYFIXEDFRAMEと同じ
SM_CXDOUBLECLK ダブルクリック認識範囲(X方向PIXEL数)
SM_CYDOUBLECLK
ダブルクリック認識範囲(Y方向PIXEL数)
SM_CXDRAG ドラック開始範囲(X方向PIXEL数)
SM_CYDRAG ドラック開始範囲(Y方向PIXEL数)
SM_CXEDGE 3D境界線(X方向PIXEL数)
SM_CYEDGE 3D境界線(Y方向PIXEL数)
SM_CXFIXEDFRAME SM_CXEDGE +
SM_CXBORDERの値
SM_CYFIXEDFRAME SM_CYEDGE + SM_CYBORDERの値
SM_CXFULLSCREEN フルスクリーン幅(PIXEL数)
SM_CYFULLSCREEN
フルスクリーン高さ(PIXEL数)
SM_CXHSCROLL スクロールバー幅(PIXEL数)
SM_CYHSCROLL
スクロールバー高さ(PIXEL数)
SM_CXHTHUMB スクロールバー中のスライダ幅(PIXEL数)
SM_CXICON アイコンの幅(デフォルトPIXEL数)
SM_CYICON アイコンの高さ(デフォルトPIXEL数)
SM_CXMAXIMIZED 画面の最大幅(PIXEL数)
SM_CYMAXIMIZED 画面の最大高さ(PIXEL数)
SM_CXMAXTRACK ウインドウが表示可能な最大幅(PIXEL数)
SM_CYMAXTRACK
ウインドウが表示可能な最大高さ(PIXEL数)
SM_CXMENUCHECK
デフォルトメニューチェックマークのピクセルの中の幅(PIXEL数)
SM_CYMENUCHECK
デフォルトメニューチェックマークのピクセルの中の高さ(PIXEL数)
SM_CXMENUSIZE メニューの幅(PIXEL数)
SM_CYMENUSIZE メニューの高さ(PIXEL数)
SM_CXMIN ウインドウの最小幅(PIXEL数)
SM_CYMIN ウインドウの最小高さ(PIXEL数)
SM_CXMINIMIZED
標準のウインドウ最小幅(PIXEL数)
SM_CYMINIMIZED 標準のウインドウ最小高さ(PIXEL数)
SM_CXMINTRACK ウインドウが表示可能な最小幅(PIXEL数)
SM_CYMINTRACK
ウインドウが表示可能な最小高さ(PIXEL数)
SM_CXSCREEN スクリーンの最大幅(PIXEL数)
SM_CYSCREEN スクリーンの最大高さ(PIXEL数)
SM_CXSIZE
タイトルバーまたはウインドウキャプション中のボタンの幅(PIXEL数)
SM_CYSIZE
タイトルバーまたはウインドウキャプション中のボタンの高さ(PIXEL数)
SM_CXSIZEFRAME
ウインドウフレームの幅(PIXEL数)
SM_CYSIZEFRAME ウインドウフレームの高さ(PIXEL数)
SM_CXSMICON 小さいアイコンの幅(PIXEL数)
SM_CYSMICON 小さいアイコンの高さ(PIXEL数)
SM_CXSMSIZE キャプションボタンの幅(PIXEL数)
SM_CYSMSIZE
キャプションボタンの高さ(PIXEL数)
SM_CXVSCROLL 垂直スクロールバー上の矢印の幅(PIXEL数)
SM_CYVSCROLL 垂直スクロールバー上の矢印の高さ(PIXEL数)
SM_CYCAPTION
キャプションの高さ(PIXEL数)
SM_CYKANJIWINDOW スクリーン底面の漢字ウインドウの調整用高さ(PIXEL数)
SM_CYMENU シングルラインのメニューの高さ(PIXEL数)
SM_CYSMCAPTION
スモールキャプションの高さ(PIXEL数)
SM_CYVTHUMB スクロールバー中の指標の高さ(PIXEL数)
SM_MENUDROPALIGNMENT メニュー項目の右/左寄り 0(ゼロ)なら左詰め、0(ゼロ)以外なら右詰め
SM_MOUSEPRESENT 0(ゼロ)以外ならばマウスをサポート
SM_NETWORK
ネットワークが使用可能ならば0以外になります。
SM_PENWINDOWS
TRUEもしくは0(ゼロ)以外ならばペンモードをサポートしたウインドウズ
SM_SLOWMACHINE
TRUEなら遅いコンピュータと認識しています
..取得■デスクトップウィンドウのハンドル
GetDesktopWindow:hWnd;
..取得■アクティブウィンドウ
var
Winfo :hWnd;
hyou
:Integer;
poi :pinteger;
begin
winfo := GetActiveWindow();
hyou :=
GetWindowinfo(winfo,getwindowinfo);
Form1.Edit1.Text :=
Inttostr(hyou);
end;
GetActivewindow と
GetForegroundwindow
呼び出しスレッドの持つウィンドウの中だけからアクティブウィンドウを取得するものGetActiveWindow,
システム全体であればGetForegroundWindow。
WindowFromPoint()を使えばマウスカーソルの真下に
あるウィンドウを見つけることが出来る。
..取得■指定Windowと関係のあるWindowハンドル
GetWindow(hWnd,uCmd):hWnd;
第一引数には第二引数の関係状態にあるWindowを検索します。
第二引数には指定したウィンドウとハンドルを取得するウィンドウとの関係を指定します。
uCmdは以下のとおり。
GW_CHILD
指定ウィンドウの子ウィンドウだけを調べます。それより下位は調べません。
GW_ENABLEDPOPUP
指定ウィンドウをオーナーとするポップアップウィンドウを調べます。
GW_HWNDFIRST 指定ウィンドウと同じ種類で最も高い Z
オーダーを持つウィンドウのハンドルを取得します。
GW_HWNDLAST 指定ウィンドウと同じ種類で最も低い Z
オーダーを持つウィンドウのハンドルを取得します。
GW_HWNDNEXT 指定ウィンドウより Z オーダーが 1
つ下のウィンドウのハンドルを取得します。
GW_HWNDPREV 指定ウィンドウより Z オーダーが 1
つ上のウィンドウのハンドルを取得します。
GW_OWNER 指定ウィンドウのオーナーウィンドウのハンドルを取得します。
..取得■アクティブコントロール
ActiveControlプロパティに格納される。
..取得■目的のWindow
Windowタイトルではユニークではないため、注意が必要です。
//====================================================]
//
タイトルから目的のwindowを探す場合（部分一致検索）
//====================================================]
//====================================================]
//
コールバック
//====================================================]
function
EnumWindowProc(hWindow: hWnd; lPalam:
Integer):Boolean;Stdcall;
Var
buf
:array[0..512] of char;
begin
Result:=
True;
//非可視ウィンドウは除く
if not
IsWindowVisible(hWindow) then
exit;
GetWindowText(hWindow,buf,512);
if
AnsiContainsStr(buf,app_name) then
//第二引数に部分一致するタイトルが見つかったら・・
begin
//したい処理
end;
end;
//====================================================]
procedure
TForm1.lsvDblClick(Sender:
TObject);
begin
EnumWindows(Addr(EnumWindowProc),
0);
end;
//====================================================
]
ユニークであるプロセスIDから目的のwindowを取得する場合は
EnumWindowsで全Windowを対象にコールバック関数で絞込み、GetWindowThreadProcessIdで
一致するプロセスIDを検索する流れになります。
GetWindowThreadProcessId(hWnd,lpdwProcessId):ThreadID;
指定されたウィンドウを作成したスレッドID(戻り値)や、プロセスID(第二引数)を取得できます。
第二引数にプロセス
ID を受け取る変数へのポインタを指定します。
EnumWindows(@EnumWindowProc,LParam):Bool
ウィンドウハンドルを順次コールバック関数に渡します。
第一引数にはコールバック関数を、第二引数にはコールバック関数に渡すパラメータです。
列挙を続けるときは
コールバック関数のresultにtrueを、中断するときはfalseを設定する。
使用の際にはセットでコールバック関数を定義する必要がある。
↓フォームに貼り付けたTMemoのオブジェクト(Memo1)にウィンドウのキャプションを列挙する。
type
PMemo=^TMemo; ////PmemoがTmemoオブジェクトへのポインタであることを定義
function EnumWinProc(hwnd,lParam: LPARAM): BOOL;
stdcall;
var
buf: array[0..512] of char;
begin
If
(GetWindow(hWnd,GW_OWNER)= 0) and IsWindowVisible(hWnd) then
//オーナが無くて、表示されているウィンドウを対象。
begin
GetWindowText(hWnd, buf,
512);
PMemo(lParam)^.Lines.Add(buf);
end;
Result
:= True;
end;
procedure TForm1.Button1Click(Sender:
TObject);
begin
EnumWindows(@EnumWinProc,
LParam(@Memo1));
//LParamの格納できるデータは数値のみです。ポインタも数値なので、渡すことができます。
end;
//=============== タイトルで検索
================
FindWindow では、トップレベルウィンドウしか検索できないが、
FindWindowEx
は、ウィンドウハンドルを指定することによって、その子ウィンドウを検索できる。
FindWindowEx(
hWnd,//対象のWindowハンドル。NillはデスクトップWindowを対象。
hWnd,//第一引数の子Windowハンドル。Nillは全てを対象。
lpszClass,//ウィンドウクラスの名前或いはポインタを指定
lpszWindow//ウィンドウタイトルへのポインタを指定。
):hWnd;//検索結果の子ウィンドウが戻る。
//=============================================
OLEオブジェクトであればGetActiveOleObject
関数でインスタンスを取得できます。
※OLEとは、別のアプリケーションにデータ･機能を提供することができる技術。
implementation
部に ComObj を追加する必要があります。
procedure TForm1.Button1Click(Sender:
TObject);
var
objWord: OleVariant;
bAppOpen:
Boolean;
begin
try
objWord :=
GetActiveOleObject('Word.Application');
bAppOpen :=
true;
except
on E: EOleSysError
do
begin
bAppOpen :=
false;
end;
end;
//
Wordのインスタンスが作成されていなかったら作成する
if not bAppOpen then
begin
objWord :=
CreateOleObject('Word.Application');
end;
//
新規文書を挿入する
objWord.Visible := true;
objWord.Documents.Add;
objWord :=
Unassigned;
end;
..取得■子ウィンドウのハンドル
特定ウィンドウを構成する、全ウィンドウ（子、孫）のハンドルを取得する。
下記例はボタンをクリックすると、Form1を構成する全ウィンドウのスクロールバーを消す。
function EnumChildProc(hWnd :integer) :
Boolean;Stdcall;
begin
showscrollbar(hwnd,SB_BOTH,false);
Result
:=True;
end;
procedure TForm1.Button1Click(Sender:
TObject);
begin
EnumChildWindows(Form1.Handle,@EnumChildProc,
0)
end;
..WM_CLOSEとWM_QUIT
WM_QUITは一般的に強制終了。
WM_CLOSEだと普通のアプリケーションは修正済みのドキュメントがあれば保存しますかというダイアログを出します。
..プロセスが起動し終わったかどうか
WaitForInputIdle
というAPIで確認できるが、これにはプロセスのハンドルを指定しなければならない。
下記はCreateProcess
で起動したプロセスを確認している。
procedure TForm2.Button1Click(Sender:
TObject);
Var
Fpath:String;
Success:boolean;
ProcINFO
: TProcessInformation;{新しく作成されたプロセスとその第1スレッドに関する情報}
StINFO
: TStartupInfo;{ウィンドウの登録内容}
p: array[0..256] of Char;
s:
Cardinal;
begin
s := 256;
With StINFO Do
Begin
cb := SizeOf(StINFO);
{構造体のサイス゛をセット}
lpReserved :=
nil;
{以外は初期化}
lpDesktop := nil;
lpTitle := nil;
dwFlags :=
0;
cbReserved2 := 0;
lpReserved2 :=
nil;
dwysize := 0;
End;
Fpath:=cmb_mapp.Text+'
"'+cmb_edit.Text+'"';//起動アプリにブランクで渡すファイルを指定。
Success:=CreateProcess(Nil,PChar(Fpath),Nil,Nil,False,0,Nil,Nil,StINFO,ProcINFO);
If Success=false then showmessage(Fpath+'を起動できませんでした。');//失敗通知
If WaitForInputIdle(ProcInfo.hProcess,10000)=0 then
begin
Winfo:=GetForegroundWindow;
GetWindowText(winfo,p,s);
showmessage(p+'は起動完了しました。')
end;
..タスクバー関連
タスクバーの位置や大きさを取得するには、SHAppBarMessage関数で簡単に取得できます。
タスクバーの大きさがAPPBARDATA構造体のrcメンバにRECT型で入っています。
var
AD
: TAPPBARDATA ;
begin
AD.cbSize :=0;
//初期化
SHAppBarMessage(ABM_GETTASKBARPOS,AD);
height:=screen.Height-AD.rc.Bottom;
width:=screen.Width;
top:=AD.rc.Bottom;
end;
APPBARDATA構造体のuEdgeメンバにはタスクバーの位置が入っています。
uEdgeの定数
ABE_BOTTOM =
3
下辺にある
ABE_LEFT =
0
左辺にある
ABE_RIGHT =
2
右辺にある
ABE_TOP =
1
上辺にある
ABM_GETSTATE 「自動的に隠す」、「常に手前に表示」のどちらに設定されているか調べる。
ユーザーが設定を変更したときWindowsはABN_STATECHANGE(=0)を発行する。戻り値は以下の定数の組み合わせ
0
デフォルト(指定されていない)
ABS_AUTOHIDE
&H1 自動的に隠す
ABS_ALWAYSONTOP &H2
常に手前に表示
...タスクトレイに登録するには？
uses に ShellAPI と Messages
を追加します。
NotifyIcon 構造体を使います。
cbSize
//構造体のサイズを指定します。
Wnd
//メッセージを受取るウィンドウを指定します。
uID
//通知領域のアイコンを識別するアプリケーション定義の値です。
szTip
//チップヘルプに用いる文字列
uCallbackMessage //この識別子をhWndに通知メッセージとして送ります。トレイ上での
マウスイベントなどが送られます。
uFlags {指定したフラグを有効にします。
NIF_MESSAGE(メッセージを受ける為のフラグ)
NIF_ICON(アイコンを表示する為のフラグ)
NIF_TIP(チップヘルプを表示する為のフラグ)}
private
{ Private 宣言
}
NotifyIcon :
TNotifyIconData; //タスクトレイアイコン用データ
procedure MakeTrayIcon(Sender:TObject);//タスクトレイにアイコン作成
procedure DelTrayIcon(Sender:TObject);//タスクトレイのアイコンを削除
procedure TaskTrayEvent(var Msg : TMsg);message WM_USER +
100;//タスクトレイからのメッセージ受信
end;
procedure
TForm1.MakeTrayIcon;//タスクトレイにアイコン作成のイベントハンドラ
begin
ShowWindow(Application.Handle,
SW_HIDE); //タスクバーからアプリケーションを消す。
NotifyIcon.cbSize :=
SizeOf(TNotifyIconData);
NotifyIcon.Wnd := Handle;
NotifyIcon.uID :=
0;
NotifyIcon.uFlags := NIF_ICON or NIF_MESSAGE or
NIF_TIP;
NotifyIcon.uCallbackMessage := WM_USER + 100;
NotifyIcon.hIcon :=
Application.Icon.Handle;
NotifyIcon.szTip :=
'help';
Shell_NotifyIcon(NIM_ADD, @NotifyIcon);
end;
procedure TForm1.DelTrayIcon;
begin
Shell_NotifyIcon(NIM_DELETE,@NotifyIcon);//アイコン削除
end;
procedure TForm1.TaskTrayEvent(var Msg :
TMsg);//タスクトレイのイベントを処理する関数
begin
case Msg.wParam of
WM_LBUTTONDOWN: //左クリック処理時
begin
If
isiconic(Application.Handle) then
begin
ShowWindow(Application.Handle,
SW_SHOW);//タスクバーにアプリケーションを表示する。
SendMessage(Application.Handle,WM_SYSCOMMAND,SC_RESTORE,0);//元のサイズに戻す。
end;
end;
WM_RBUTTONDOWN: //右クリック時処理
begin
end;
WM_LBUTTONDBLCLK: //左ダブルクリック時処理
begin
end;
WM_RBUTTONDBLCLK: //右ダブルクリック時処理
begin
end;
end;
end;
procedure TForm1.FormCreate(Sender:
TObject);
begin
Application.OnMinimize:=
MakeTrayIcon;//フォーム最小化イベントでアイコン作成関数を呼ぶ。
Application.OnRestore:=
DelTrayIcon;//フォームを戻すイベントでアイコン削除関数を呼ぶ。
end;
....クラスを使う
uses ShellAPIを消し、Class_Tasktrayを追加する。
TClass_TascTray型の「Class_Tasktray」を宣言・生成・破棄を用意する。
interface
procedure mesproc(var Msg :
TMsg);Message WM_USER + 100; //メッセージ識別子「WM_USER」をクラスへ転送する。
implemantation
procedure TForm1.mesproc(var Msg :
TMsg);
begin
Class_Tasktray.TaskTrayEvent(Msg);
end;
Application.OnMinimize:=
Class_Tasktray.MakeTrayIcon;
Application.OnRestore :=
Class_Tasktray.DelTaskIcon;//アイコン削除
...タスクバーのアプリケーション名を変える
プロジェクトファイルを開き、TApplication.Title：String を書き換える。
タスクバーに表示されるのは、メインフォームのキャプションではない。
設計時に設定するにはプロジェクトオプションからどうぞ。
...タスクボタンを表示しない。
//タスクトレイアイコンなどを変わりに用意しないと終了などの操作ができなくなる。
initialization
begin
SetWindowLong(
Application.Handle,
GWL_EXSTYLE,
GetWindowLong(Application.Handle,
GWL_EXSTYLE) or WS_EX_TOOLWINDOW
);
end;
ウィンドウをツールウィンドウとして登録します。
その際、通常のウィンドウと異なる点をいくつかあげます。
・タイトルバーの右端の最大化ボタンと最小化ボタンが削除される。
・タスクバーに表示されない。
・[Alt]
+ [tab] が押された場合に現れるウィンドウに、ウィンドウが表示されない。
...タスクバーからアプリケーションを消す。
プロジェクトファイルを開き、
Application.ShowMainForm
プロパティを False
にすればよい。
program WMCloser;
uses
Forms,
Unit1 in 'Unit1.pas'
{WMcloser1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TWMcloser1, WMcloser1);
Application.ShowMainForm := False;
Application.Run;
end.
..ウィンドウを最大･最小･通常表示にする。
function ShowWindow(hWnd: HWND; nCmdShow:Integer):
BOOL; stdcall;
nCmdShow に設定できる値を以下に示す。
const
{
ShowWindow() Commands }
SW_HIDE =
0;
//ウィンドウを隠し、他のウィンドウをアクティブにする
SW_SHOWNORMAL = 1;
//ウィンドウを表示し、アクティブにする
SW_NORMAL =
1;
SW_SHOWMINIMIZED = 2;
//ウィンドウをアクティブにし、最小化する
SW_SHOWMAXIMIZED = 3;
//ウィンドウをアクティブにし、最大化する
SW_MAXIMIZE = 3;
SW_SHOWNOACTIVATE = 4;//ウィンドウを通常表示する
SW_SHOW =
5;
//ウィンドウを通常表示し、アクティブにする
SW_MINIMIZE = 6;
//ウィンドウを最小化し、次のＺオーダーのウィンドウをアクティブにする
SW_SHOWMINNOACTIVE =
7;//ウィンドウを最小化表示する
SW_SHOWNA =
8; //ウィンドウを通常表示する
SW_RESTORE = 9;
//ウィンドウを最小化・最大化から通常表示にし、アクティブにする
SW_SHOWDEFAULT = 10;
//アプリケーション起動時の設定で表示する
SW_MAX =
10;
SendMessage(hCalc,WM_SYSCOMMAND,SC_MINIMIZE,0);
SC_MAXIMIZEを投げることで最大化させる。
SC_RESTORE を投げることで通常状態にします。
..windowをアクティブにする。
SetForegroundWindow(form1.Handle);
..最背面に置く
・SetWindowPosを使い、ウィンドウのZindexを固定させます。
SetWindowPos(handle,HWND_BOTTOM,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE);
HWND_BOTTOM 最背面に置く
HWND_NOTOPMOST
ウィンドウを最前面ウィンドウ以外のすべてのウィンドウの前
HWND_TOP ウィンドウを Z オーダーの先頭に置きます。
HWND_TOPMOST
アクティブでないときにも最前面に表示されます。
..Windowが表示されているか判断する。
IsWindowVisibl(hWnd):Bool;
..角の丸いウィンドウを作る
その形のリージョンを作るCreateRoundRectRgnというWindowsAPIが用意されてます。
HRGN CreateRoundRectRgn(
int
LeftRect,
int TopRect,
int RightRect,
int
BottomRect,
int WidthEllipse,
int
HeightEllipse); //計６つの引き数を使います。
宣言部
var
Rgn:
HRgn;
実行部
procedure TForm1.FormCreate(Sender:
TObject);
begin
Rgn :=
CreateRoundRectRgn(0,0,Width,Height,25,25);
SetWindowRgn(Handle,Rgn,True);
end;
procedure TForm1.FormResize(Sender:
TObject);
begin
Rgn :=
CreateRoundRectRgn(0,0,Width,Height,25,25);
SetWindowRgn(Handle,Rgn,True);
end;
procedure TForm1.FormDestroy(Sender:
TObject);
begin
DeleteObject(Rgn);//リージョンの解放
end;
他にも下記APIがあります。
{楕円}
CreateEllipticRgn(0,0,Width,Height);
{長方形}
CreateRectRgn(0,0,Width,Height);
..WindowStyle
を変更する。
今のWindowStyleを元にStyleの追加・削除を行います。追加は or，削除は xor
を使います。
SetWindowLongの第三引数を使って、様々なデザインを設定できます。
var NowStyle:integer; //WindowStyle格納用変数
NowStyle:= GetWindowLong(Edit1.Handle, GWL_STYLE);
//現在のWindowStyleを代入
SetWindowLong(Edit1.Handle,GWL_STYLE,NowStyle or
ES_CENTER or ES_NUMBER);
...第三引数に使う Style
ES_CENTER &H1
中央揃え
ES_LEFT &H0 左揃え
S_MULTILINE
&H4 複数行のテキストボックス
ES_NUMBER &H2000
数字のみ入力可
ES_RIGHT &H2 右揃え
WS_CAPTION 0x00C00000
タイトルバーを持つウィンドウを作成します。
WS_VSCROLL 0x00200000
垂直スクロールバーを持つウィンドウを作成します。
WS_HSCROLL 0x00100000
水平スクロールバーを持つウィンドウを作成します。
..タイトルの無いwindowを移動＆サイズを変更する。
通常、タイトルバーの無いwindowを作る時、FormのBorderStyleをbsnoneにすると思います。
その場合、FormのWindowStyleはWS_POPUPになります。（bsnone
=
WS_POPUP)
しかし、このWS_POPUP、通常のウィンドウとして使うには様々な不都合があります。
（内部でWS_POPを呼ぶとフリーズする とか。）
なのでWindowStyle には DS_CONTROL を使うことをオススメします。
※FormのBorderStyleはbsnoneにする。（こうしないとタイトルバーが残ってしまう。）
Form表示時にDS_CONTROL
を指定する。
WS_THICKFRAME であればサイズ可変の枠のみ残る。
procedure TForm1.FormShow(Sender:
TObject);
begin
SetWindowLong(Form1.Handle,GWL_STYLE,DS_CONTROL);
end;
するとbsnoneと変わらないように使うことができます。
しかし、当然のことながらタイトルバーや、ウィンドウ枠が無いため、
このままでは移動、サイズ変更ができません。
そのため、WinAPIを使ってFormの端っこはウィンドウ枠だよ、タイトルバーだよと
WINDOWS
にわからせてやります。（というより騙す）
また、bsClient指定のオブジェクトがある場合、ウィンドウにメッセージが飛ばない事があります。
その場合は四隅にbevelを配置すればOKです。
宣言部
procedure WMNCHitTest(var Msg: TWMNCHitTest);
message WM_NCHITTEST;
実装部
procedure TForm1.WMNCHitTest(var Msg:
TWMNCHitTest);
var
pos : TPoint;
begin
inherited;
if Msg.Result = HTCLIENT
then
begin
pos.x :=
Msg.XPos - Left;
pos.y := Msg.YPos -
Top;
if (pos.x <= 3) then
begin
if (pos.y <= 12)
then
Msg.Result := HTTOPLEFT
else if
(pos.y >= Height - 12) then Msg.Result :=
HTBOTTOMLEFT
else
Msg.Result := HTLEFT;
end
else if (pos.x >= Width - 3) then
begin
if (pos.y <= 12)
then
Msg.Result := HTTOPRIGHT
else if
(pos.y >= Height - 12) then Msg.Result :=
HTBOTTOMRIGHT
else
Msg.Result := HTRIGHT;
end
else if (pos.y <= 3) then
begin
if (pos.x <= 12)
then
Msg.Result := HTTOPLEFT
else if
(pos.x >= Width - 12) then Msg.Result :=
HTTOPRIGHT
else
Msg.Result := HTTOP;
end
else if (pos.y >= Height - 3) then
begin
if (pos.x <= 12)
then
Msg.Result := HTBOTTOMLEFT
else if
(pos.x >= Width - 12) then Msg.Result :=
HTBOTTOMRIGHT
else
Msg.Result := HTBOTTOM;
end
else if (pos.x >= Width - 10) and
(pos.y >= Height - 10) then
begin
Msg.Result :=
HTBOTTOMRIGHT;
end
else
begin
Msg.Result :=
HTCAPTION;
end;
end;
end;
なお、自分でタイトルバーを作る場合は、OnMouseMoveに下記コードを入力する。
ReleaseCapture;
cursor:=crDefault;
If Shift=[ssLeft] then
Sendmessage(Handle,WM_SYSCOMMAND,SC_MOVE or 2,0);
end;
end;
//====================================================
//
WMNCHitTestを使わない場合
//====================================================
procedure TForm2.FormMouseMove(Sender: TObject; Shift:
TShiftState; X,
Y: Integer);
var
i:byte;
begin
i:=10;
ReleaseCapture;
If (Height-i<Y) and (Width-i>X) and (i<X) then //下
begin
cursor:=crSizeNS;
If Shift=[ssLeft] then
perform(WM_SYSCOMMAND, SC_SIZE or 6, 0);
end else If (i>Y) and
(Width-i>X) and (i<X) then //上
begin
cursor:=crSizeNS;
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 3, 0);
end else If (Width-i<X) and (Height-i>Y) and
(i<Y) then //右
begin
cursor:=crSizeWE;
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 2, 0);
end else If (i>X) and (Height-i>Y) and
(i<Y) then //左
begin
cursor:=crSizeWE;
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 1, 0);
end else If (i>X) and (i>Y) then
//左上
begin
cursor:=crSizeNWSE;
If
Shift=[ssLeft] then perform(WM_SYSCOMMAND, SC_SIZE or 4, 0);
end else
If (Width-i<X) and (Height-i<Y) then //右下
begin
cursor:=crSizeNWSE;
If Shift=[ssLeft] then
perform(WM_SYSCOMMAND, SC_SIZE or 8, 0);
end else If (i>X) and
(Height-i<Y) then //左下
begin
cursor:=crSizeNESW;
If Shift=[ssLeft] then
perform(WM_SYSCOMMAND, SC_SIZE or 7, 0);
end else If (Width-i<X)
and (i>Y) then //右上
begin
cursor:=crSizeNESW;
If Shift=[ssLeft] then
perform(WM_SYSCOMMAND, SC_SIZE or 5, 0);
end else If (i<X) and
(i<Y) and (Height-i>Y) and (Width-i>X) then //真ん中
begin
cursor:=crDefault;
If Shift=[ssLeft] then
perform(WM_SYSCOMMAND,SC_MOVE or 2,0);
end;
end;
..コントロールのサイズを変更する。
枠無しウィンドウなどのサイズ変更を可能にしています。
変数 i
の値がサイズ開始の範囲値です。また、
変数direction
の値を調べる事でマウスジェスチャーも可能になります。
下記の例はコントロールの境目にAutoSizeをオフにしたLabelを置き、
これをキーにサイズ変更のイベントをしています。
procedure TForm2.imgMouseMove(Sender: TObject;
Shift: TShiftState; X,
Y:
Integer);
var
i:byte;
begin
i:=10;
ReleaseCapture;
If (Height-i<Y) and (Width-i>X) and (i<X) then //下
begin
cursor:=crSizeNS;
direction:='↓';
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 6, 0);
end else If (i>Y) and (Width-i>X) and (i<X)
then //上
begin
cursor:=crSizeNS;
direction:='↑';
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 3, 0);
end else If (Width-i<X) and (Height-i>Y) and
(i<Y) then //右
begin
cursor:=crSizeWE;
direction:='→';
If
Shift=[ssLeft] then perform(WM_SYSCOMMAND, SC_SIZE or 2, 0);
end else
If (i>X) and (Height-i>Y) and (i<Y) then //左
begin
cursor:=crSizeWE;
direction:='←';
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 1, 0);
end else If (i>X) and (i>Y) then
//左上
begin
cursor:=crSizeNWSE;
direction:='左上';
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 4, 0);
end else If (Width-i<X) and (Height-i<Y) then
//右下
begin
cursor:=crSizeNWSE;
direction:='右下';
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 8, 0);
end else If (i>X) and (Height-i<Y) then
//左下
begin
cursor:=crSizeNESW;
direction:='左下';
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 7, 0);
end else If (Width-i<X) and (i>Y) then
//右上
begin
cursor:=crSizeNESW;
direction:='右上';
If Shift=[ssLeft] then perform(WM_SYSCOMMAND,
SC_SIZE or 5, 0);
end else If (i<X) and (i<Y) and
(Height-i>Y) and (Width-i>X) then //真ん中
begin
cursor:=crDefault;
If Shift=[ssLeft] then
perform(WM_SYSCOMMAND,SC_MOVE or 2,0);
end;
end;
..プログラムの終了
SendMessage(Application.Handle,WM_CLOSE,0,0);
Close;でも閉じれる。が、元々はFileを閉じる用途に用いる模様。
CloseHandle(Application.Handle);は、どちらかというと動的に生成したプロセスの終了に
用いられるようです。ミューテックスが登録されている場合、終了できません。
..二重起動禁止
[表示(V)|プロジェクト
ソース(J)] で表示されるプロジェクトソースに記述してください。
program corchi;
uses
Forms,windows,
Unit1 in
'Unit1.pas' {Form1},
{$R *.res}
const
MutexName = 'corchi';//登録名。プログラム名と一緒が望ましい。
var hMutex: THANDLE; //二重起動禁止。
begin
hMutex := OpenMutex(MUTEX_ALL_ACCESS, False,
MutexName);//アプリ名が登録されているか？0以外なら起動中
If hMutex<>0
then
begin
CloseHandle(hMutex);
exit;
end;
hMutex := CreateMutex(nil, False, MutexName);//登録無ければ登録する。
Application.Initialize;
Application.CreateForm(TForm1,
Form1);
Application.Run;
ReleaseMutex(hMutex); //登録を開放。
end.
..常に手前に表示する。
＞一アプリの複数フォーム内に限り有効。
FormStyle を fsStayOnTop
にセットする。
＞他のAppを含むウィンドウで有効。
※隠したいFormがメインフォームである必要があります。
procedure
TForm1.zen;
begin
If pop_zen.Checked
then
SetWindowPos(Form2.Handle,HWND_TOPMOST,1,1,1,1,SWP_NOMOVE+SWP_NOSIZE)
else
SetWindowPos(Form2.Handle,HWND_NOTOPMOST,1,1,1,1,SWP_NOMOVE+SWP_NOSIZE);
end;
procedure TForm1.pop_zenClick(Sender:
TObject);
begin
pop_zen.Checked:= not
pop_zen.Checked;
zen;
end;
..複数のウィンドウを同時に動かす
ウィンドウは「WM_MOVE」というメッセージを受け取ると動きます。
したがって、このメッセージが投げられた時に
別のウィンドウも合わせて動くようにすればOKです。
詳細はMessageイベントハンドラを参照してください。
..別のEXEにフォーカスを移す。
procedure
SetForeWnd(hWnd:HWND);
var
dwID,dwForeID: DWORD;
begin
dwID :=
GetWindowThreadProcessId(hWnd, nil);
dwForeID :=
GetWindowThreadProcessId(GetForegroundWindow, nil);
if dwID = dwForeID
then
begin
BringWindowToTop(hWnd);
end
else
begin
AttachThreadInput(dwID,
dwForeID, True);
SetActiveWindow(hWnd);
AttachThreadInput(dwID, dwForeID,
False);
BringWindowToTop(hWnd);
end;
end;
アクティブにしたいウィンドウのハンドルと現在アクティブなウィンドウのハンドルを比べ
異なるようであればアタッチして、ウィンドウをアクティブにし、再び切り離してる
-------------------------------------文字列操作-----------------------------------
.◆ディレクトリ/File系
..取得■File名
ExtractFileName(
'c:\windows\Win.ini' ) は 'Win.ini'
を返します。
..取得■特殊フォルダのパス
usesにShlObjを追加して下さい
function GetMyDocFolderPath:
string;
var
PATH: String;
begin
ShGetFolderPath(0,PChar(PATH), CSIDL_DRIVES,false);
Result:=PATH;
end;
※ShGetFolderPathの第3引数を変えることで他のパスも取得出来ます。
デスクトップ
CSIDL_DESKTOPDIRECTORY
お気に入り CSIDL_FAVORITES
マイドキュメント
CSIDL_PERSONAL
スタートメニューのプログラムフォルダ CSIDL_PROGRAMS
最近使ったファイル
CSIDL_RECENT
送る CSIDL_SENDTO
スタートメニュー CSIDL_STARTMENU
スタートアップ
CCSIDL_STARTUP
Ｆｏｎｔｓ CSIDL_FONTS
ヒストリー CSIDL_HISTORY
仮想フォルダのパスについては下記で指定することができます。（Windows ME
以降のみ）
マイコンピュータ: CSIDL_DRIVES
::{20D04FE0-3AEA-1069-A2D8-08002B30309D}
ネットワークコンピュータ: CLSIDL_NETWORK,
CSIDL_NETHOOD
::{208D2C60-3AEA-1069-A2D7-08002B30309D}
ごみ箱:
CSIDL_BITBUCKET
::{645FF040-5081-101B-9F08-00AA002F954E}
コントロールパネル:
CSIDL_CONTROLS
::{21EC2020-3AEA-1069-A2DD-08002B30309D}
プリンタ: CSIDL_PRINTERS, CSIDL_PRINTHOOD
::{2227A280-3AEA-1069-A2DE-08002B30309D}
..取得■ディレクトリ名
ExtractFileDir('c:\windows\Win.ini')は'c:\windows'を返す。
..取得■拡張子を変更する/ファイル名を取得する
ChangeFileExt(File,'.拡張子')
//指定した「File」に第二引数の拡張子を当てます。第二引数を空白にすることで、
//拡張子を消したFile名のみを取得することができます。
..取得■引数・exeフルパス
ParamStr(1); //String
-----------------------
ParamStr関数を使います。
1つ目の引数を文字列で取得しています。
ParamStr(0)は
Exeパスとファイル名（C:\TEST\MYPROG.EXE）を返します。
..取得■ディレクトリ内のファイル
自前で指定ディレクトリからファイル数を取るのは大変なので、
TFileListBoxを使います。
var
FileList:TFileListBox;
i:integer;
If DirectoryExists(ExtractFiledir(ParamStr(0))+'\skin\')
then
//↑読み取るフォルダが存在するか確認。
begin
FileList:=
TFileListBox.Create(Self);
FileList.Parent:=Form1;
with FileList
do
begin
Directory:=ExtractFiledir(ParamStr(0))+'\skin\';
mask:='*.qrm';
//qrmファイルのみを追加するようにマスキング
for i:=0 to Count-1
do
Form2.cbx_skin.Items.Add(FileList.Items.Strings[i]);
Free;
end;
end;
..取得■関連付けられたアイコン
SHGetFileInfoでアイコンを取得し、ImageListへ格納している。
特殊フォルダの取得にはAPIを使わず直指定のため、windowsME以降のOSでないと動作しない。
uses に
ShellAPI
を追加する。
procedure TForm1.FormShow(Sender:
TObject);
var
icon: TIcon;
n, i, r,ic:
Integer;
fn: string;
SFI: TSHFileInfo;
begin
ListView1.Items.BeginUpdate;
{
それまでの内容を消去する }
ImageList1.Clear;
ListView1.Items.Clear;
{ ICONを列挙して追加する }
n:=
Filelist.Items.Count;
try
icon := TIcon.Create;
for i := 1 to n-1 do
begin
If
Filelist.Folders[i].IsFolder then //trueならフォルダ
begin
fn:=
Filelist.Folders[i].PathName;
//特殊フォルダ用
If fn='マイ コンピュータ' then
fn:='::{20D04FE0-3AEA-1069-A2D8-08002B30309D}';
If fn='マイ ネットワーク' then
fn:='::{208D2C60-3AEA-1069-A2D7-08002B30309D}';
If fn='ごみ箱' then
fn:='::{645FF040-5081-101B-9F08-00AA002F954E}';
//フォルダ
SHGetFileInfo( PChar(fn), FILE_ATTRIBUTE_DIRECTORY, SFI, SizeOf( SFI
),SHGFI_ICON or SHGFI_USEFILEATTRIBUTES);
Icon.Handle :=
sfi.hIcon;
r := ImageList1.Addicon(icon); //失敗したら-1を返す。
end
else
begin
//ファイル
fn:=
Filelist.Folders[i].PathName;
SHGetFileInfo( PChar(fn), 0, SFI,
SizeOf( SFI ),SHGFI_ICON or SHGFI_LARGEICON);
Icon.Handle :=
sfi.hIcon;
r:= ImageList1.Addicon(icon); //失敗したら-1を返す。
end;
if r > -1 then
begin
ListView1.Items.Add;
ic:=ListView1.Items.Count-1;
//特殊フォルダ用
If
fn='::{20D04FE0-3AEA-1069-A2D8-08002B30309D}' then fn:='マイ
コンピュータ';
If fn='::{208D2C60-3AEA-1069-A2D7-08002B30309D}' then
fn:='マイ ネットワーク';
If
fn='::{645FF040-5081-101B-9F08-00AA002F954E}' then fn:='ごみ箱';
ListView1.Items[ic].Caption := ExtractFilename(fn);
ListView1.Items[ic].ImageIndex:=ic;
end;
end;
finally
icon.Free;
end;
sendmessage(ListView1.Handle,LVM_SETTEXTBKCOLOR,0,-1);
sendmessage(ListView1.Handle,LVM_SETBKCOLOR,0,-1);
ListView1.Items.EndUpdate;
end;
..取得■Fileの拡張子
function
ExtractFileExt(const FileName: string):
string;
を使うと，指定されたファイル名から拡張子を返します。
結果には，<file@C:\Documents and Settings\ｍ\Application
Data\Microsoft\Internet Explorer\Quick
Launch\めも.txt.lnk>
ピリオドも含まれます。拡張子がない場合は空を返します。」
..フォルダ内のファイルに変更があるかどうか監視する
スレッドを立てて、 FindFirstChangenotification
で監視する方法が一般的のようですが、
如何せん複雑なのでタイマースレッドで監視をする方法を紹介します。
★流れ
最初に監視ディレクトリのファイルを取得し、それをカンマテキストとして文字列変数に記憶。
Timerで監視ディレクトリを再取得し、記憶していた文字列変数と新しいファイル一覧の
カンマテキストを比べて、異なればファイル更新されたことになる。
TFileListBox
のVisibleをfalseにすることで描画処理がなくなり軽くなる。
Enableもfalseにすれば入力デバイス処理がなくなると思うのでもっと軽くなると思います･･･。
★宣言部分
flb: TFileListBox;//重要→ visible:=false;
Enable:=false;
var
flname:string;//デスクトップファイル一覧
★実行部分
function
TForm1.deskfile:string;
var
i:integer;
sl:TStrings;
begin
sl:=TStringlist.Create;
for
i:=0 to flb.Count-1
do
sl.Add(flb.Items.Strings[i]);
result:=sl.CommaText;
sl.Free;
end;
procedure TForm1.FormCreate(Sender:
TObject);
begin
flb.Directory:=path;//pathは監視ディレクトリ
flname:=deskfile;
end;
procedure TForm1.Timer1Timer(Sender:
TObject);//私は2秒に設定します。
var
s:string;
begin
flb.Update;
s:=deskfile;
If
flname <> s then
begin
showmessage('ファイルが更新されました。');
flname:=s;
end;
end;
..Fileを関連付けで実行する。
ShellExecuteを使うと関連付けされているブラウザが立ち上がる。
use節にShellapiが必要。
//ウェブページ
ShellExecute(0, 'OPEN', 'http://', '', '',
SW_SHOW);
Application.ProcessMessages;
//メーラー
ShellExecute(0, 'OPEN', 'mailto:？？？＠？？？', '',
'', SW_SHOW);
Application.ProcessMessages;
ShellExecute(0,'OPEN',PChar(？？？),'','',SW_SHOW);
戻り値
関数が成功すると、32 より大きい値が返ります。失敗すると、以下の値が返ります。
値 意味
0 メモリまたはリソースが不足しています。
SE_ERR_ACCESSDENIED 5
アクセスが拒否されました。
SE_ERR_ASSOCINCOMPLETE 27 ファイルの関連付け情報が不完全です。
SE_ERR_DDEBUSY 30 DDEがビジーです。
SE_ERR_DDEFAIL 29 DDEが失敗しました。
SE_ERR_DDETIMEOUT 28 DDEがTime Outです。
SE_ERR_DLLNOTFOUND 32 DDLが見つかりません。
SE_ERR_FNF 2 ファイルが見つかりません。
SE_ERR_NOASSOC 31 ファイルの関連付けが利用できません。
SE_ERR_OOM 8 メモリが不足しています。
SE_ERR_PNF 3 パスが見つかりません。
SE_ERR_SHARE 26
開いたファイルは共有できません。
..INI読み書き
procedure IniWrite; //Iniファイルの書き込み手続き
begin
IniFile :=TIniFile.Create(ChangeFileExt(ParamStr(0),'.ini'));
try
with Form1, INIFile do
begin
WriteInteger('Window','Left',Left);
WriteInteger('Window','Top',Top);
WriteInteger('Window','Height',Height);
WriteInteger('Window','Width',Width);
end;
If INIFile.SectionExists('ListView') then EraseSection('ListView');//リスト項目全消去。
for i:=0 to Form1.ListView1.Items.Count-1
do //リスト項目書込み
begin
with
Form1.ListView1.Items.Item[i] do
begin
WriteString('ListView','Item'+IntToStr(i),Caption);
WriteString('ListView','SubItem1-'+IntToStr(i),SubItems.Strings[0]);
end;
end;
end;
finally
IniFile.Free;
end;
end;
procedure
IniRead;//Iniファイルの読み込み手続き
var
IniFile:
TIniFile;
WRect: TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @WRect, 0); //モニタ解像度を取得
IniFile :=TIniFile.Create(ChangeFileExt(ParamStr(0),'.ini'));
try
with Form1, IniFile do
begin
Top :=
ReadInteger('Window','Top', WRect.Top);
Left := ReadInteger('Window','Left',
WRect.Left);
Width :=
ReadInteger('Window','Width', Width);
Height
:= ReadInteger('Window','Height', Height);
if Left > WRect.Right - 10
then
Left :=
WRect.Left;
if Left < WRect.Left
then
Left :=
WRect.Left;
if Top < WRect.Top then Top :=
WRect.Top;
if Top > WRect.Bottom - 10
then
Top:=WRect.Top;
end;
finally
IniFile.free;
end;
//リストのアイテム情報を読み込む
If
INIFile.SectionExists('ListView') then
while
IniFile.ValueExists('ListView','Item'+IntToStr(i)) do
begin
with listitem, IniFile do
begin
listitem:=
Form1.ListView1.Items.Add;
caption:= 'あ';
subitems.Add(ExtractFileName(fpas));
inc(i);
end;
If INIFile.SectionExists('ListView') then
EraseSection('ListView');//Section削除
If
INIFile.ValueExists('ListView','Item2') then
DeleteKey('ListView','Item2');//key削除
end;
---------------------------------------------------------------------
使用上の注意：
メソッドはwriteString(文字列型)writeInteger(整数型)writeBool(yes,no型)があります。
又、Unitのuses節に、IniFilesと宣言してください。
グローバル変数としてIniFile
:
TIniFileと宣言してください。
IniFileに書き込む情報も目的によって書き換える必要があります。
WriteInteger/WriteString
の第三引数には保存する値（オブジェクトのプロパティ）
を書きます。
メソッドはReadString(文字列型)ReadInteger(整数型)ReadBool(yes,no型)
があります。
＜IniFile の呼び名＞
[Window] ←
Section
Left=440 ←↓
key
Top=343
..File/Folderがあるか確認する。
FileExists(File)
//指定された「File」が存在する場合
True を返し、
//存在しない場合， False
を返します。
DirectoryExists(Folder)
//指定された「Folder」が存在する場合
True を返し、
//存在しない場合， False
を返します。
下記関数をIniから読み込んだファイルの検査などに使うとよい。
function
TForm1.passkakunin(fileORdir:byte;file_pass:string):string;
//ファイルが存在するか確認し、なければ空を返す。
//第一引数にファイルかディレクトリかを指定する。0ならディレクトリ。1ならファイル。
//secondパスではexeディレクトリを確認している。
var
secondpass:string;
begin
case fileORdir of
0:begin
If
DirectoryExists(file_pass)=true then
begin
result:=file_pass;
showmessage('dir '+file_pass);
end
else result:=ExtractFileDir(ParamStr(0));
end;
1:begin
If FileExists(file_pass)=true
then
begin
result:=file_pass;
showmessage(file_pass);
end
else If
FileExists(file_pass)=false then
begin
If
ExtractFileName(file_pass)='' then //渡されてる値が元々空なら
begin
result:='';
exit;
end;
secondpass:=ExtractFileDir(ParamStr(0))+'\'+ExtractFileName(file_pass);
showmessage('sec '+secondpass);
If FileExists(secondpass) then
result:=secondpass
else result:='';
end;
end;
end;
end;
..更新されたかどうかを確認する。
text系なら
Modified
それ以外は変更トリガーでフラグを立てて、
フラグが立ってれば、更新中。
保存時にフラグを下げる方法しか思いつかない。
..TextFile書込み
新規書込み
procedure TForm1.Button2Click(Sender:
TObject);
var
i:integer;
F:TextFile;
begin
for
i:=0 to ListView.Items.Count-1 do
begin
AssignFile(F,
ExtractFiledir(ParamStr(0))+'\todo.csv');
Rewrite(F);
Write(F, ListView.Items.Item[i].Caption+',');
Write(F,
ListView.Items.Item[i].SubItems.Strings[0]+',');
CloseFile(F);
end;
end;
最後に追記
var ErrorFile: TextFile;
if
FileExists('C:\ErrorFile.log') then//ログファイルがあればTrueを返す。
begin
AssignFile(ErrorFile, 'C:\Error.log');
Append(ErrorFile);
Writeln(ErrorFile, FormatDateTime('yyyy//mm/dd hh:nn', Now));
Writeln(ErrorFile, Sender.ClassName);
Writeln(ErrorFile,
E.ClassName);
Writeln(ErrorFile, E.Message);
CloseFile(ErrorFile);
読み込み
var
F:TextFile;
StrItem:String;
Listitem:TListitem;
SL:TStringList;
begin
AssignFile(F,
ExtractFiledir(ParamStr(0))+'\todo.csv');
Reset(F);
//既存のファイルを開く
SL :=
TStringList.Create;//TStringList型は宣言しないと使えないため
try
while not
Eof(F) do
begin
Listitem:= Listview.Items.Add;
with
ListItem,Listview do
begin
Readln(F,strItem);
SL.CommaText:= strItem;
Caption:= SL[0];
subItems.Add(SL[1]);
subItems.Add(SL[2]);
end;
end;
finally
SL.Free;
CloseFile(F);
..ドラッグアンドドロップ
全てのコントロールに
DragMode プロパティがあり、 dmAutomatic
を設定すると，コントロールをドラッグすることが可能になります。
ドロップを受け取るには，コントロールの OnDragOver イベントに Accept
というパラメータを True
にします。
DragOver
イベントは，各パラメータを参照して，ドロップを受け入れるかどうかを判断します。
ドロップが可能なコントロールは， OnDragDrop
イベントにドロップした項目の処理を定義します。
uses節にshellapiを追加。
//shellapiは各種ドラッグアンドドロップ関数をサポートします。
type節に下記を追加。
procedure WMDropFiles(var Msg:
TWMDropFiles); message
WM_DROPFILES;
//WM_DOROPFILESはドラッグされたウィンドウに送信されるメッセージで、ドラッグされている項目についての情報を保有します。
実装部(implementation)に下記を追加(受付宣言)。
TForm1.Create(AOwner: TComponent);
begin
inherited;
DragAcceptFiles(Handle,
True);
end;
//OSにドロップを受け取ることを通知する。
procedure TForm1.WMDropFiles(var Msg:
TWMDropFiles);
var
FileName:
PChar;
//ファイル名のバッファを変数「FileName」に確保。
begin
FileName :=
StrAlloc(MAX_PATH);
DragQueryFile(Msg.Drop, 0, FileName,
SizeOf(FileName));
//DragQueryFile関数はドロップされたファイル名を取得する関数。
//第１引数：ドロップされたファイルのパスを含む、構造体のハンドル。
//上では変数「msg」経由でWM_DOLOPFILESから情報を読み出している。
//第２引数：0から始まるファイル名のインデックス。-1とするとDropされたファイル数を返す。
//第３引数：ファイル名を受け取るバッファの場所
//第４引数：バッファのサイズ
try
//ここにやりたい事を書く
finally
DragFinish(Msg.Drop);//Dropの終了をOSに通知。
end;
end
procedure WMDropFiles(var
Msg:TWMDropFiles);
message WM_dropfiles;
implementation
{$R *.dfm}
var
FName :
array[0..255]of
char;
procedure
TForm1.WMDropFiles;//D&DでFNameにパスを格納
begin
dragQueryFile(msg.Drop,0,FName,256);
dragFinish(msg.Drop);
kaku
:=
ExtractFileExt(Strpas(FName));
kakucheck;
end;
DragAcceptFiles(handle,true);
//ドロップを受け取る
条件が合う場合にのみドラッグを開始する
コントロールのドラッグを（自動的にでなく）明示的に開始するには，そのコントロールの
BeginDrag メソッドを呼び出します。BeginDrag は Immediate という論理パラメータを使用します。加えて，オプションとして
Threshold という整数パラメータをとることもできます。Immediate をTrue で渡すと，すぐにドラッグが始まります。False
を渡すと，Threshold
で指定したピクセル数だけユーザーがマウスを動かすまで，ドラッグは開始しません。下のコードを呼び出せば，
BeginDrag(False);
コントロールをクリックしただけではドラッグ操作は開始されません。
..エクスプローラの「送る」、ドロップでファイルを受け取る。
コマンドラインの引数が paramstr
に代入されます。
（paramstr(0)は自身のファイルパスが代入されます）
引数がいくつあるかは paramcount に代入されます。
procedure TForm1.FormCreate(Sender:
TObject);
begin
If FileExists(paramstr(1))
then
begin
Fname:=paramstr(1);
Gyomi;
end;
end;
..画像ファイルを開く
ifOpenDialog.Execute
then
Image1.Picture.LoadFromFile(OpenDialog.FileName);
---------------------------------------------------------------------
使用上の注意：
OpenPictureDialogコンポーネントを使用してください。
..画像ファイルを保存する
if
SavePic.Execute Then
Image1.Picture.SavetoFile(Save.FileName);
--------------------------------------------
使用上の注意：
SavePictureDialogコンポーネントを使用してください。
..ファイルを削除･コピー･移動する。
WindowsAPIのSHFileOperationを使います。
引数は構造体のため、TSHFileOpStruct型を作って渡します。
wFunc （第二引数）
FO_COPY コピー
FO_MOVE 移動
FO_DELETE 削除
fFlags （第五引数）
FOF_FILESONLY ファイルのみ処理
FOF_ALLOWUNDO 削除の時にごみ箱に入ります。
FOF_NOCONFIRMATION 確認ダイアログを出さず処理します。（「はい」「全て」などが選択される）
var
foStruct :
TSHFileOpStruct;
begin
with foStruct do
begin
wnd := handle;
wFunc :=
FO_COPY;
pFrom :=
PChar(String(FileName)+#0);
pTo :=
PChar(home+#0);
fFlags := FOF_ALLOWUNDO;
end;
SHFileOperation(foStruct);
end;
注意点
From と To のファイルパスは終わりを示す #0 をつけること。
ファイル削除時は
pto:=nil;
にすること。
ファイルの移動だけならRenameFile関数でもっと簡単にできます。
RenameFile(FromFile,
toFolder+'\'+ExtractFilename(FromFile));
.◆マウス/キーボード
..取得■マウスカーソルの位置
procedure
TForm1.FormClick(Sender: TObject);
var
P :
TPoint;
begin
GetCursorPos(P);
Edit1.Text := 'Ｘ座標：' +
IntToStr(P.x);
Edit2.Text := 'Ｙ座標：' + IntToStr(P.y);
end;
クライアント領域でのマウス座標を取得するには、
ScreenToClient()を使います。
..取得■マウスカーソルの位置にある項目のIndex
//---関数(ﾏｳｽのY座標にある項目のIndexを返す)---
function
MouseInt: Integer;
var I: Integer; P:
TPoint;
begin
GetCursorPos(P);
I:= Form1.ListView.Font.Height-2;
//項目の高さはFont.Height+2
if I>-18 then //項目の高さは最小17。それ以下にはならない。
I:=
-17;
Result := (-P.Y) div
I-1;
//ﾏｳｽのY座標から項目の高さを割る。-1はIndexが0からカウントするため。
..取得■キャレットの位置
procedure TForm1.FormClick(Sender:
TObject);
var
P : TPoint;
begin
GetCaretPos(P);
Edit1.Text := 'Ｘ座標：' + IntToStr(P.x);
Edit2.Text := 'Ｙ座標：' + IntToStr(P.y);
end;
..取得■マウスイベント
コントロール上にマウスカーソルが
CM_MOUSEENTER：入ってきたとき
CM_MOUSELEAVE：出て行ったとき
イベントで拾えるメッセージハンドラ。
..取得■どのボタンが押されているか
GetKeyStateというAPIを使います。
押されていれば負数が返ります。
GetKeyState(vk_LBUTTON) マウスの左ボタン
GetKeyState(vkUPKEY)
キーボードの上
・・・押されている時の動作
..キーを送る
対象のウィンドウをアクティブにしてから仮想キーコードを送る。
SetForegroundWindow(winfo);
keybd_event(VK_CONTROL,0,0,0);
keybd_event(90,0,0,0);
keybd_event(90,0,KEYEVENTF_KEYUP,0);
keybd_event(VK_CONTROL,0,KEYEVENTF_KEYUP,0);
Sendmessage(web_main.Handle,WM_KEYDOWN,VK_RETURN,0);
Sendmessage(web_main.Handle,WM_KEYUP,VK_RETURN,0);
仮想キーコード一覧
数値 定数名 キー
0 (00H)
1 (01H) VK_LBUTTON マウス左ボタン
2 (02H) VK_RBUTTON マウス右ボタン
3 (03H) VK_CANCEL
4 (04H) VK_MBUTTON
マウス中央ボタン
5 (05H) VK_XBUTTON1
6 (06H) VK_XBUTTON2
8 (08H) VK_BACK
BS(BackSpace)
9 (09H) VK_TAB TAB
12 (0CH) VK_CLEAR
13 (0DH)
VK_RETURN リターン(Enter)
16 (10H) VK_SHIFT Shift
17 (11H) VK_CONTROL Ctrl
18 (12H) VK_MENU Alt(GRPH)
19 (13H) VK_PAUSE Pause
20 (14H)
VK_CAPITAL CapsLock
21 (15H) VK_KANA
VK_HANGUL カナ
23 (17H) VK_JUNJA
24 (18H) VK_FINAL
25 (19H) VK_HANJA
VK_KANJI 漢字
27 (1BH)
VK_ESCAPE ESC
28 (1CH) VK_CONVERT 変換
29 (1DH) VK_NONCONVERT 無変換
30
(1EH) VK_ACCEPT
31 (1FH) VK_MODECHANGE
32 (20H) VK_SPACE スペースバー
33 (21H) VK_PRIOR PageUp(RollDown)
34 (22H) VK_NEXT PageDown(RollUp)
35 (23H) VK_END End(Help)
36 (24H) VK_HOME Home
37 (25H) VK_LEFT ←
38 (26H) VK_UP ↑
39 (27H) VK_RIGHT →
40 (28H) VK_DOWN ↓
41 (29H)
VK_SELECT
42 (2AH) VK_PRINT
43 (2BH) VK_EXECUTE
44 (2CH)
VK_SNAPSHOT PrintScreen(COPY)
45 (2DH) VK_INSERT Insert
46 (2EH)
VK_DELETE Delete
47 (2FH) VK_HELP
48 (30H) '0' 0
49 (31H) '1' 1
50 (32H) '2' 2
51 (33H) '3' 3
52 (34H) '4' 4
53 (35H) '5' 5
54 (36H) '6' 6
55 (37H) '7' 7
56 (38H) '8' 8
57 (39H) '9' 9
65 (41H) 'A' A
66 (42H) 'B' B
67 (43H) 'C' C
68 (44H) 'D' D
69 (45H) 'E' E
70 (46H) 'F' F
71 (47H) 'G' G
72 (48H) 'H' H
73 (49H) 'I' I
74 (4AH) 'J' J
75 (4BH) 'K' K
76 (4CH) 'L' L
77 (4DH) 'M' M
78 (4EH) 'N' N
79 (4FH) 'O' O
80 (50H) 'P' P
81 (51H) 'Q' Q
82 (52H) 'R' R
83 (53H) 'S' S
84 (54H) 'T' T
85 (55H) 'U' U
86 (56H) 'V' V
87 (57H) 'W' W
88 (58H) 'X' X
89 (59H) 'Y' Y
90 (5AH) 'Z' Z
91 (5BH) VK_LWIN 左Windowsキー
92
(5CH) VK_RWIN 右Windowsキー
93 (5DH) VK_APPS アプリケーションキー
95 (5FH) VK_SLEEP
96 (60H) VK_NUMPAD0 Num 0
97 (61H) VK_NUMPAD1 Num 1
98 (62H)
VK_NUMPAD2 Num 2
99 (63H) VK_NUMPAD3 Num 3
100 (64H) VK_NUMPAD4 Num 4
101 (65H) VK_NUMPAD5 Num 5
102 (66H) VK_NUMPAD6 Num 6
103 (67H)
VK_NUMPAD7 Num 7
104 (68H) VK_NUMPAD8 Num 8
105 (69H) VK_NUMPAD9 Num 9
106 (6AH) VK_MULTIPLY Num *
107 (6BH) VK_ADD Num +
108 (6CH)
VK_SEPARATOR Num ,
109 (6DH) VK_SUBTRACT Num -
110 (6EH) VK_DECIMAL Num
.
111 (6FH) VK_DIVIDE Num /
112 (70H) VK_F1 F1
113 (71H) VK_F2 F2
114 (72H) VK_F3 F3
115 (73H) VK_F4 F4
116 (74H) VK_F5 F5
117
(75H) VK_F6 F6
118 (76H) VK_F7 F7
119 (77H) VK_F8 F8
120 (78H) VK_F9
F9
121 (79H) VK_F10 F10
122 (7AH) VK_F11 F11
123 (7BH) VK_F12 F12
124 (7CH) VK_F13 F13
125 (7DH) VK_F14 F14
126 (7EH) VK_F15 F15
127 (7FH) VK_F16 F16
128 (80H) VK_F17 F17
129 (81H) VK_F18 F18
130 (82H) VK_F19 F19
131 (83H) VK_F20 F20
132 (84H) VK_F21 F21
133 (85H) VK_F22 F22
134 (86H) VK_F23 F23
135 (87H) VK_F24 F24
144 (90H) VK_NUMLOCK NumLock
145 (91H) VK_SCROLL ScrollLock
146
(92H) Num =
160 (A0H) VK_LSHIFT 左Shift
161 (A1H) VK_RSHIFT 右Shift
162 (A2H) VK_LCONTROL 左Ctrl
163 (A3H) VK_RCONTROL 右Ctrl
164 (A4H)
VK_LMENU 左Alt
165 (A5H) VK_RMENU 右Alt
166 (A6H) VK_BROWSER_BACK
167 (A7H) VK_BROWSER_FORWARD
168 (A8H) VK_BROWSER_REFRESH
169
(A9H) VK_BROWSER_STOP
170 (AAH) VK_BROWSER_SEARCH
171 (ABH)
VK_BROWSER_FAVORITES
172 (ACH) VK_BROWSER_HOME
173 (ADH)
VK_VOLUME_MUTE
174 (AEH) VK_VOLUME_DOWN
175 (AFH) VK_VOLUME_UP
176 (B0H) VK_MEDIA_NEXT_TRACK
177 (B1H) VK_MEDIA_PREV_TRACK
178
(B2H) VK_MEDIA_STOP
179 (B3H) VK_MEDIA_PLAY_PAUSE
180 (B4H)
VK_LAUNCH_MAIL
181 (B5H) VK_LAUNCH_MEDIA_SELECT
182 (B6H)
VK_LAUNCH_APP1
183 (B7H) VK_LAUNCH_APP2
186 (BAH) VK_OEM_1 :
187
(BBH) VK_OEM_PLUS ;
188 (BCH) VK_OEM_COMMA ,
189 (BDH) VK_OEM_MINUS -
190 (BEH) VK_OEM_PERIOD .
191 (BFH) VK_OEM_2 /
192 (C0H) VK_OEM_3 @
219 (DBH) VK_OEM_4 [
220 (DCH) VK_OEM_5 \
221 (DDH) VK_OEM_6 ]
222 (DEH) VK_OEM_7 ^
223 (DFH) VK_OEM_8 _
225 (E1H) VK_OEM_AX
226 (E2H) VK_OEM_102 _
227 (E3H) VK_ICO_HELP
228 (E4H) VK_ICO_00
229 (E5H) VK_PROCESSKEY
230 (E6H) VK_ICO_CLEAR
231 (E7H)
VK_PACKET
233 (E9H) VK_OEM_RESET
234 (EAH) VK_OEM_JUMP
235
(EBH) VK_OEM_PA1
236 (ECH) VK_OEM_PA2
237 (EDH) VK_OEM_PA3
238
(EEH) VK_OEM_WSCTRL
239 (EFH) VK_OEM_CUSEL
240 (F0H) VK_OEM_ATTN
241 (F1H) VK_OEM_FINISH
242 (F2H) VK_OEM_COPY
243 (F3H)
VK_OEM_AUTO
244 (F4H) VK_OEM_ENLW
245 (F5H) VK_OEM_BACKTAB
246
(F6H) VK_ATTN
247 (F7H) VK_CRSEL
248 (F8H) VK_EXSEL
249 (F9H)
VK_EREOF
250 (FAH) VK_PLAY
251 (FBH) VK_ZOOM
252 (FCH)
VK_NONAME
253 (FDH) VK_PA1
254 (FEH) VK_OEM_CLEAR
..マウスジェスチャー
旧マウスカーソル位置を覚えておき、現在のマウスカーソル位置と比べて
多いか少ないかで方向がわかる。旧マウスカーソル位置の更新数で移動量も分かる。
※Twebbrowserはナビゲート後、ハンドルが変わるらしく、AppMessageでハンドルのフィルタを掛けてると機能しなくなる。
宣言部
procedure AppMessage(var
Msg:TMsg;var Handled:boolean);
procedure
MouseDown;
procedure MouseUp;
var
oldmX:integer; //旧マウスカーソル位置
oldmY:integer;
実行部
//====================================================]
//
マウスジェスチャー
//====================================================
]
procedure TForm1.AppMessage(var Msg:TMsg;var
Handled:boolean);
begin
// if Msg.hwnd=web_main.Handle then
//検出targetを指定
// begin
case Msg.message of
WM_RBUTTONUP:MouseUp;
WM_RBUTTONDOWN:MouseDown;
end;
// end;
end;
procedure
TForm1.MouseDown;
var
p:TPoint;
begin
GetCursorPos(p);
oldmX:=p.x;
oldmY:=p.y;
end;
procedure
TForm1.MouseUp;
begin
var
p:TPoint;
begin
GetCursorPos(p);
If
oldmx<p.X then //→
begin
web_main.GoForward;
oldmx:=p.X;
end else If oldx>X
then //←
begin
web_main.GoBack;
oldmx:=p.X;
end;
If oldmY>p.Y then
//↑
begin
oldmY:=p.Y;
end else If oldmY>p.Y
then //↓
begin
oldmY:=p.Y;
end;
end;
//====================================================]
..タブキーの移動順序を決める。
各コンポーネントのTabOrderプロパティを移動したい順番どおりに記入する。
.◆文字列操作
..取得■全行数
Coment.Caption :=
inttostr(SendMessage(RichEdit1.Handle,EM_GETLINECOUNT,0,0));
..取得■文字列の長さ
s: string; Length(s); // s
の長さを取得します。
..取得■特定の文字
Copy(S; 2, 4):
String
----------------------------------
Copy関数を使います。
文字列Ｓの２番目の文字から、4番目の文字列までを文字列として取得します。
Pos(':',
ParamStr(1));
//Integer。ParamStr引数からセミコロンの位置を数値で返す。
------------------------------
Pos関数を使います。
引数からコロンの位置を表す整数値返します。
見つからなかった場合には，0
を返します。
..取得■キャレット位置
L:=
SendMessage(Memo1.Handle,EM_LINEFROMCHAR,-1,0); //行
P:=
memo1.SelStart - SendMessage(memo1.Handle, EM_LINEINDEX, -1, 0); //桁
Edit1.text := inttostr(L)+'行
'+inttostr(P)+'桁';
SendMessageに対象のコントロールハンドルを渡す。
このメッセージ（EM_LINEFROMCHAR）は指定した文字位置のある行を返します。先頭は0からカウントされます。
文字位置はWParamに渡しますが、-1を渡すと現在のカーソル位置の行番号を返します。
Label1.Caption :=
InttoStr(RichEdit1.Perform(EM_LINEFROMCHAR,RichEdit1.SelStart,0));
SendMessageを使わない場合、Perform
メソッドは，メッセージをコントロールのウィンドウプロシージャへ送ることができます。
SelStart（キャレット位置）は、テキスト文字列先頭からの 文字数である
..テキストを行単位でリストに起こす。
ListBox1.Items.AddStrings(RichEdit1.Lines);
AddStrings
メソッドは，TStrings オブジェクトから文字列リストにまとめて追加します。
..キャレットを指定行に移動する。
行の指定にEdit1を使います。
var
ToLine:integer;
begin
with Memo1 do
begin
ToLine:=IntToStr(Edit1.Text);
Perform(WM_VSCROLL,SB_THUMBTRACK,ToLine-1); {指定行にスクロール}
SelStart:=Perform(EM_LINEINDEX,ToLine,0); {カーソルを指定行に移動}
SetFocus;
end;
end;
..一行選択
※ガタークリック時に一行選択をする。（TsynEdit使用時）
選択の始まりを表すSelstartと選択の終わりを表すSelendを使う。
Selstartはキャレット位置までの総文字数である。
つまりSelendにSelstartを代入し、（ここまでで文字0個分を選択したことになる）
更にキャレット位置のある行全ての文字数を足す。
procedure TForm1.SynMemo0GutterClick(Sender: TObject;
Button: TMouseButton;
X, Y, Line: Integer; Mark:
TSynEditMark);
begin
with Memo[pages.ActivePageIndex]
do
Selend:= selstart+length(lines.Strings[caretY-1]);
end;
..エディット メッセージ一覧
EM_CANPASTE
指定されたクリップボード形式のデータを貼り付けることができるかどうかを判断します。
EM_CANUNDO
最後の操作をEM_UNDOメッセージで元に戻すことができるかどうかを取得します。
EM_EXGETSEL 現在選択されている範囲を取得します。
EM_EXLIMITTEXT
書きこんだり貼り付けたりすることのできるテキストのサイズの上限を設定します。
EM_EXLINEFROMCHAR
指定された位置の文字がどの行に含まれているのかをを取得します。
EM_EXSETSEL 指定された範囲の文字列や COM
オブジェクトを選択された状態にします。
EM_FINDTEXT 指定された文字列を検索します。
EM_FINDTEXTEX
指定された文字列を検索します。
EM_GETCHARFORMAT 現在の文字書式を取得します。
EM_GETEVENTMASK
イベントマスクを取得します。
EM_GETFIRSTVISIBLELINE 可視領域で最も上に表示されている行の 0
から始まるインデックスを取得します。
EM_GETMODIFY
EM_GETOPTIONS
EM_GETPARAFORMAT
EM_GETSEL
EM_GETSELTEXT
EM_HIDESELECTION
EM_SETBKGNDCOLOR
背景色を設定します。
EM_SETCHARFORMAT
EM_SETEVENTMASK
EM_SETMODIFY
EM_SETOPTIONS オプションを設定します。
EM_SETPARAFORMAT
EM_STREAMIN
EM_STREAMOUT
EM_UNDO
最後の操作をアンドゥします（元に戻します）。
..文字の表示
Canvas.TextOut(x,y,'String');
------------------------------
x,yは座標を表します。Refresh;で初期化することができます。
Labelコンポーネントを使う。Captionで文字が表示できる。スタイル等はFontプロパティ。
FontDialogで実行中の文字スタイルが変更できる。
ShowMessage()でダイアログ文字表示ができる。
..文字列の置き換え
ソース:=
StringReplace(ソース,'置き換え前文字列','置き換え後文字列',[]);
..文字列を小文字に変換
LowerCase( S
);
//string
--------------------------------
LowerCase関数を使います。文字列Ｓを小文字に変換します。
GroupBox ：オブジェクトをＧＵＩグループ分けする。
..文字列を全角半角変換
LCMapStringを使う。
純粋に変換しか行わないAPIの為、変数のメモリ確保を自分でする。
LCMapStringの引数は以下のとおり。
LCID
Locale, // ロケール識別子
DWORD dwMapFlags, //
変換の種類
LPCTSTR lpSrcStr, // 元文字列のアドレス
int
cchSrc, // 元文字列の文字数 ※-1でも良いらしい。
LPTSTR
lpDestStr, // 戻り値バッファのアドレス
int cchDest //
戻り値バッファのサイズ
dwMapFlagsの指定
LCMAP_FULLWIDTH(全角文字にします)
LCMAP_HALFWIDTH(半角文字にします)
LCMAP_HIRAGANA(ひらがなにします)
LCMAP_KATAKANA(カタカナにします)
半角→全角
procedure TForm1.N8Click(Sender:
TObject);
var S,R:string; Buf:integer; //第四引数用戻り値サイズ
begin
S:=
Memo[pages.ActivePageIndex].SelText;
Buf:= Length(S)*2;
//全角用のメモリサイズ確保。半角の2倍。
SetLength(R,Buf); //全角用のメモリサイズを持った変数にする。
LCMapString(GetThreadLocale,LCMAP_FULLWIDTH,PChar(S),-1,PChar(R),Buf);
Memo[pages.ActivePageIndex].SelText:=R;
※全角を半角にする場合は、第二引数をLCMAP_HALFWIDTHに変えて、Buf:=
Length(S)にする。
..文字列を大文字･小文字にする
大文字
Memo1.SelText:=
AnsiUpperCase(Memo1.SelText);
小文字
Memo1.SelText:=
AnsiLowerCase(Memo1.SelText);
..文字列を分解
procedure bunkai(source: string);
//sourceのIPアドレスを元に分解してoctに代入。
var
SL:TStringList;//変数TStestの宣言
begin
SL :=
TStringList.Create;//TStringList型は宣言しないと使えないため
SL.Delimiter:='.';//区切り記号を指定する。
try
SL.DelimitedText:= source;
oct1:= SL[0];
oct2:=
SL[1];
oct3:= SL[2];
oct4:= SL[3];
finally
//範囲内でエラーがでてもこの文より下は実行される。
SL.Free;//TStringList型の解放、解放しないとメモリ関係のトラブルの原因に。
end;
end;
引数のsourceを元に区切り記号で区切って、
SLに区切った結果の文字列が行単位で挿入される。
後は、indexを指定して取り出す。
..文字列内の挿入・削除
Insert( 挿入したい文字列, 挿入対象文字列, インデックス
)
Delete( 削除対象文字列, インデックス, 文字数
)
..数値限定・右揃えEdit
var
NowStyle:integer; //WindowStyle格納用変数
NowStyle:= GetWindowLong(Edit1.Handle, GWL_STYLE);
//現在のWindowStyleを代入
SetWindowLong(Edit1.Handle, GWL_STYLE, NowStyle or
ES_RIGHT or ES_NUMBER);//中央揃えと数値限定
他にも以下のスタイルがある。
エディットスタイル
ES_AUTOHSCROLL
行末に文字を入力したとき、10文字分右にスクロール
ES_AUTOVSCROLL
最終行でEnterキーを押したとき、1ページ分上にスクロール
ES_LEFT 左揃え
ES_RIGHT
右揃え
ES_NOHIDESEL フォーカスを受け取ったときに強調表示にしない。
ES_READONLY
入力・編集不可
ES_UPPERCASE 入力された文字をすべて大文字に変換
ES_LOWERCASE
入力された文字をすべて小文字に変換
ES_PASSWORD 入力されたすべての文字をアスタリスク（*）で表示
ES_OEMCONVERT 入力されたテキストをANSI文字セットからOEM文字セットに変換し、その後ANSI文字セットに戻します。
ES_WANTRETURN 複数行のテキストボックスに入力しているとき、Enterキーにより改行を挿入（1行入力では無効）
ES_MULTILINE 複数行のテキストボックス
ボタンコントロールスタイル
(コード) 意味
BS_PUSHBUTTON
プッシュボタンを作成します。ボタンが押されると、オーナーウィンドウに WM_COMMAND メッセージがポストされます。
BS_DEFPUSHBUTTON
太い境界を持つデフォルトのプッシュボタンを作成します。このボタンがダイアログボックスにある場合は、ボタンが入力フォーカスを持っていなくても、［Enter］キーを押せばボタンを選択できます。
BS_CHECKBOX
チェックボックスを作成します。デフォルトでは、テキストはチェックボックスの右側に表示されます。テキストをボックスの左側に表示するには、このフラグと
BS_LEFTTEXT スタイル (BS_RIGHTBUTTON スタイル) を組み合わせて指定します。
BS_AUTOCHECKBOX
チェックボックスを作成します。ユーザーがチェックボックスを選択するとチェックボックスの状態が自動的に変わります。
BS_RADIOBUTTON
ラジオボタンを作成します。デフォルトでは、テキストはボタンの右側に表示されます。テキストをボタンの左側に表示するには、このフラグと BS_LEFTTEXT
スタイル (BS_RIGHTBUTTON スタイル) を組み合わせて指定します。
BS_3STATE
選択された状態、選択されていない状態、灰色表示の状態という 3 つの状態を持つチェックボックスを作成します。
BS_AUTO3STATE
スタイルのボタンを作成します。ユーザーがチェックボックスを選択するとボックスの状態が自動的に変わります。
BS_GROUPBOX
グループボックスを作成します。
BS_AUTORADIOBUTTON
ラジオボタンを作成します。ただし、ボタンが選択がされると、自動的にボタンを選択状態にし、同じグループのほかのボタンを非選択状態にします。
BS_OWNERDRAW オーナードローボタンを作成します。
BS_LEFTTEXT, BS_RIGHTBUTTON
ラジオボタンスタイルやチェックボックススタイルと組み合わせると、ラジオボタンやチェックボックスの左側にテキストが置かれます。
BS_ICON
アイコンを表示するボタンを作成します。
BS_BITMAP ビットマップを表示するボタンを作成します。
BS_LEFT
ボタンの中にテキストを左寄せします。
BS_RIGHT ボタンの中にテキストを右寄せします。
BS_CENTER
ボタンの（水平方向の）中央にテキスト置きます。
BS_TOP ボタンの最上部にテキストを置きます。
BS_BOTTOM
ボタンの下部にテキストを置きます。
BS_VCENTER ボタンの（垂直方向の）中央にテキストを置きます。
BS_PUSHLIKE
プッシュボタンのような概観と機能を持つ、チェックボックスまたはラジオボタンを作ります。
BS_MULTILINE
テキストが長すぎてボタンの中に一行で収まらないときは、テキストを複数行に折り返します。
BS_NOTIFY 親ウィンドウに、ボタンが
BN_DBLCLK, BN_KILLFOCUS, BN_SETFOCUS の各通知メッセージを送るようにします。このスタイルを持つかどうかに関わらず、ボタンは
BN_CLICKED 通知メッセージを送ります。
BS_FLAT フラットボタンを作成します。デフォルトの陰影を使用した3Dイメージを使用しません。
コンボボックススタイル
(コード) 意味
CBS_SIMPLE
(0x0001)
常時リストボックスが表示されるコンボボックスを作成します。
CBS_DROPDOWN
(0x0002) ドロップダウンコンボボックスを作成します。
CBS_DROPDOWNLIST
(0x0003) ドロップダウンリストボックスを作成します。テキストの編集はできません。
CBS_OWNERDRAWFIXED
(0x0010) 各項目の高さがすべて同じ、オーナードローコンボボックスを作成します。
CBS_OWNERDRAWVARIABLE
(0x0020) 各項目の高さが可変の、オーナードローコンボボックスを作成します。
CBS_AUTOHSCROLL
(0x0040)
ユーザーが行末に文字を入力すると、エディットコントロール内のテキストが自動的に右スクロールします。
CBS_OEMCONVERT
(0x0080)
コンボボックスのエディットコントロールに入力されたテキストを Windows 文字セットから OEM 文字セットに変換します。CBS_SIMPLE スタイルか
CBS_DROPDOWN スタイルで作成されたコンボボックスにのみ有効です。
CBS_SORT
(0x0100)
リストボックスに追加されたテキストを自動的にソートします。
CBS_HASSTRINGS
(0x0200)
オーナードローコンボボックスのアイテムがテキストであることを指定します。
CBS_NOINTEGRALHEIGHT
(0x0400)
コンボボックスのサイズを指定します。デフォルトでは、項目が途中で切れないように、Windows システムがコンボボックスのサイズを調整します。
CBS_DISABLENOSCROLL
(0x0800)
スクロールするほどの項目数がない場合、リストボックスの垂直方向のスクロールバーが無効状態で表示されます。デフォルトでは表示されません。
CBS_UPPERCASE
(0x2000) コンボボックスのエディットコントロールに入力された小文字を、大文字に変換します。
CBS_LOWERCASE
(0x4000) コンボボックスのエディットコントロールに入力された大文字を、小文字に変換します。
リストボックス
スタイル
(コード) 意味
LBS_NOTIFY
(0x0001)
ユーザーがリストボックス内の文字列をクリック (またはダブルクリック) するたびに、親ウィンドウに入力メッセージを通知します。
LBS_SORT
(0x0002) リストボックス内の文字列を自動的にソートします。
LBS_NOREDRAW
(0x0004)
アイテムが変更されてもリストボックスの外観を更新しないように指定します。このスタイルは WM_SETREDRAW メッセージを送ることで変更できます。
LBS_MULTIPLESEL
(0x0008) 項目をクリックまたはダブルクリックして、複数の項目を選択できるようにします。
LBS_OWNERDRAWFIXED
(0x0010) 各アイテムの高さがすべて同じ、オーナードローリストボックスを作成します。
LBS_OWNERDRAWVARIABLE
(0x0020) 各アイテムの高さがすべて可変の、オーナードローリストボックスを作成します。
LBS_HASSTRINGS
(0x0040) オーナードローリストボックスのアイテムが文字列であることを指定します。
LBS_USETABSTOPS
(0x0080) リストボックスが文字列を描画するときにタブ文字を認識し表示できるようにします。
LBS_NOINTEGRALHEIGHT
(0x0100)
リストボックスのサイズを指定します。デフォルトでは、アイテムが途中で切れないようにリストボックスのサイズが調整されます。
LBS_MULTICOLUMN
(0x0200) 水平にスクロールする複数列のリストボックスを指定します。LB_SETCOLUMNWIDTH
メッセージで列の幅を設定します。
LBS_WANTKEYBOARDINPUT
(0x0400)
リストボックスが入力フォーカスを持っているときにユーザーがキーを押すと、リストボックスのオーナーが WM_VKEYTOITEM または
WM_CHARTOITEM メッセージを受け取ります。
LBS_EXTENDEDSEL
(0x0800)
［Shift］キーとマウス、または特殊なキーの組み合わせで、複数のアイテムを選択できるようにします。
LBS_DISABLENOSCROLL
(0x1000)
スクロールするほどの項目数がない場合、リストボックスの垂直方向のスクロールバーが無効状態で表示されます。デフォルトではスクロールバーは表示されません。
LBS_NODATA
(0x2000) データを持たないリストボックスを指定します。リストボックス内の項目数が 1000
を超えるときに、このスタイルを指定します。LBS_OWNERDRAWFIXED スタイルが必要です。 LBS_SORT スタイルや LBS_HASSTRINGS
スタイルを同時に指定することはできません。
LBS_NOSEL
(0x4000L)
表示するだけで選択できないアイテムを持つリストボックスを指定します。
LBS_STANDARD
(0x00A00003) LBS_NOTIFY,
LBS_SORT, WS_VSCROLL, WS_BORDER スタイルの組み合わせです。
スクロールバー
スタイル
(コード) 意味
SBS_HORZ
(0x0000)
水平スクロールバーを作成します。
SBS_VERT
(0x0001) 垂直スクロールバーを作成します。
SBS_TOPALIGN,
SBS_LEFTALIGN, SBS_SIZEBOXTOPLEFTALIGN
(0x0002) SBS_HORZ
スタイルの場合水平スクロールバーが指定された矩形の上端に、SBS_VERT スタイルの場合水平スクロールバーが指定された矩形の左端に、SBS_SIZEBOX
スタイルではサイズボックスが指定された矩形の左上端にそれぞれ表示されます。スクロールバーの幅やサイズボックスのサイズはデフォルトのものが適用されます。
SBS_BOTTOMALIGN, SBS_RIGHTALIGN, SBS_SIZEBOXBOTTOMRIGHTALIGN
(0x0004)
SBS_HORZ スタイルの場合水平スクロールバーが指定された矩形の下端に、SBS_VERT
スタイルの場合水平スクロールバーが指定された矩形の右端に、SBS_SIZEBOX
スタイルではサイズボックスが指定された矩形の右下端にそれぞれ表示されます。スクロールバーの幅やサイズボックスのサイズはデフォルトのものが適用されます。
SBS_SIZEBOX
(0x0008) サイズボックスを作成します。
SBS_SIZEGRIP
(0x0010)
縁が盛り上がったサイズボックスを作成します。
スタティックコントロール
スタイル
(コード) 意味
SS_LEFT
(0x00000000) 文字列を左揃えで表示します。テキストが行末を超える場合は自動的に折り返されます。
SS_CENTER
(0x00000001) テキストを中央揃えで表示します。テキストが行末を超える場合は自動的に折り返されます。
SS_RIGHT
(0x00000002) テキストを右揃えで表示します。テキストが行末を超える場合は自動的に折り返されます。
SS_ICON
(0x00000003)
アイコンを表示するスタティックコントロールを作成します。コントロールサイズはアイコンサイズに合わせて調整されます。
SS_BLACKRECT
(0x00000004) ウィンドウの枠と同じ色（デフォルトでは黒）で塗りつぶされた長方形を作成します。
SS_GRAYRECT
(0x00000005) 画面の背景 (デスクトップ) と同じ色（デフォルトでは灰色）で塗りつぶされた長方形を作成します。
SS_WHITERECT
(0x00000006) ウィンドウの背景と同じ色（デフォルトでは白）で塗りつぶされた長方形を作成します。
SS_BLACKFRAME
(0x00000007) ウィンドウの枠と同じ色（デフォルトでは黒）の枠を持つボックスを作成します。
SS_GRAYFRAME
(0x00000008) 画面の背景 (デスクトップ) と同じ色（デフォルトでは灰色）の枠を持つボックスを作成します。
SS_WHITEFRAME
(0x00000009) ウィンドウの背景と同じ色（デフォルトでは白）の枠を持つボックスを作成します。
SS_USERITEM
(0x0000000A) ユーザー定義のアイテムを指定します。
SS_SIMPLE
(0x0000000B)
単一行のテキストを左揃えで表示します。テキスト行は、短くしたり、置き換えたりすることはできません。このコントロールの親ウィンドウまたはダイアログ
ボックスは、WM_CTLCOLOR メッセージを処理してはいけません。
SS_LEFTNOWORDWRAP
(0x0000000C)
テキストを左揃えで表示します。タブは展開されますが、テキストは折り返されません。行末を越えるテキストはクリップされます。
SS_OWNERDRAW
(0x0000000D) オーナードローコントロールを作成します。
SS_BITMAP
(0x0000000E)
ビットマップを表示するスタティックコントロールを作成します。コントロールサイズはビットマップサイズに合わせて調整されます。
SS_ENHMETAFILE
(0x0000000F) ??
SS_ETCHEDHORZ
(0x00000010)
コントロールの上下端の縁を EDGE_ETCHED エッジスタイルを使用して描画します。
SS_ETCHEDVERT
(0x00000011)
コントロールの左右端の縁を EDGE_ETCHED エッジスタイルを使用して描画します。
SS_ETCHEDFRAME
(0x00000012)
コントロールの縁を EDGE_ETCHED エッジスタイルを使用して描画します。
SS_NOPREFIX
(0x00000080)
テキスト中のアンパサント（&）を、アクセラレータのプレフィックス文字として解釈しないように指定します。デフォルトではアンパサント（&）がプレフィックス文字として解釈され、アンパサンド（&）は取り除かれてその次の文字に下線が付けられます。
SS_NOTIFY
(0x00000100) ユーザーがコントロールをクリック（またはダブルクリック）するたびに、親ウィンドウに
STN_CLICKED 通知メッセージ（または STN_DBLCLK 通知メッセージ）を送ります。
SS_CENTERIMAGE
(0x00000200) コントロールのサイズが変更されても、SS_BITMAP スタイルや SS_ICON
スタイルを持つコントロールの中心点は変えないようにします。
SS_RIGHTJUST
(0x00000400) SS_BITMAP スタイルや
SS_ICON スタイルを持つコントロールのサイズが変更されたときに、イメージを右下隅に固定するようにします。
SS_REALSIZEIMAGE
(0x00000800) SS_BITMAP スタイルや SS_ICON
スタイルを持つコントロールのイメージがロードされたり描画されたりするときに、コントロールサイズが変更されないようにします。
SS_SUNKEN
(0x00001000) コントロールの周囲にくぼんだ縁を描画します。
SS_ENDELLIPSIS
(0x00004000) コントロールに表示しきれない場合に、文字列の最後の部分を省略記号（...）で置き換えます。
SS_PATHELLIPSIS
(0x00008000)
コントロールに表示しきれない場合に、文字列の一部を省略記号（...）で置き換えます。文字列がバックスラッシュ（\）を含むなら、バックスラッシュの後の文字列をできるだけ残すようにします。
SS_WORDELLIPSIS
(0x0000C000) コントロールに表示しきれない場合に、文字列を切り縮めて、省略記号（...）をつけます。
リッチエディットコントロール
スタイル
(コード) 意味
ES_LEFT
(0x0000) テキストを左揃えで表示します。
ES_CENTER
(0x0001)
複数行エディットコントロールにおいて、テキストを中央揃えで表示します。
ES_RIGHT
(0x0002)
複数行エディットコントロールにおいて、テキストを右揃えで表示します。
ES_MULTILINE
(0x0004)
複数行エディットコントロールを作成します。デフォルトは一行のエディットコントロールです。
ES_AUTOVSCROLL
(0x0040)
ユーザーが最下行で［Enter］キーを押すと、テキストを自動的に上にスクロールします。
ES_AUTOHSCROLL
(0x0080)
ユーザーが行末に文字を入力すると、エディットコントロール内のテキストが自動的に右スクロールします。
ES_NOHIDESEL
(0x0100)
選択されているテキストは、コントロールがフォーカス持っていない場合も反転表示されます。デフォルトでは、コントロールが入力フォーカスを失うと選択項目が表示されなくなり、入力フォーカスを受け取ると反転表示されます。
ES_READONLY
(0x0800) ユーザーによるテキストの入力や編集をできないようにします。
ES_WANTRETURN
(0x1000)
ダイアログボックス内の複数行エディットコントロールにテキストを入力しているときに［Enter］キーが押されると、改行が挿入されるようにします。このスタイルを指定していないと、ダイアログボックスのデフォルトのプッシュボタンが押されます。
ES_DISABLENOSCROLL
(0x00002000) スクロールバーが必要ない場合にも、無効状態で表示する。
ES_SUNKEN
(0x00004000) くぼんで見える境界を描きます。Windows95/98ではこのスタイルではなく
WS_EX_CLIENTEDGE 拡張スタイルを用いるべきです。
ES_SAVESEL
(0x00008000)
コントロールが入力フォーカスを失うときに、現在選択されている範囲が保存され、次にフォーカスを得たときに同じ領域が選択されている状態になります。
ES_SELFIME
(0x00040000) すべてのIME操作をアプリケーションが行なうようにします。
ES_NOIME
(0x00080000) IMEを無効にします。
ES_VERTICAL
(0x00400000)
縦書きのリッチエディットコントロールを作成します。
..CharとString
stringをcharに入れるにはどうすればいいですか？
c := s[1];
PCharなら
p :=
PChar(s); // or
@s[1];
長い場合は、
StrCopy(c,
str[1]);
Move(str[1], c, Length(str));
..IMEを操作する。
プロパティのIMEmodeを変更する。
imSAlpha 半角ローマ字入力を受け付ける
imAlpha 全角ローマ字入力を受け付ける
imHira 全角ひらがな入力を受け付ける
imSKata 半角カタカナ入力を受け付ける
imKata 全角カタカナ入力を受け付ける
.◆画像処理
..画像を拡大縮小
bairitu :
Double;
GWidth,GHeight :
integer;
Procedure
ChangeSize;
//サイズに倍率変数を掛けて画像を拡大縮小してます。
begin
vewr.Image1.Width
:= Trunc(GWidth * bairitu);
vewr.Image1.Height := Trunc(GHeight *
bairitu);
end;
procedure
kansibairitu;
//倍率の限界以上は強引に限界倍率に変換してます。
begin
if
bairitu < 0.3 then
bairitu := 0.3;
if bairitu
> 5 then
bairitu := 5;
picture.height
は拡大縮小のしていない元画像の高さです。
高品位な拡大縮小はhttp://www.asahi-net.or.jp/~HA3T-NKMR/DGS/index.htm にある
DHGLを使って面積平均法を使うことで実現できます。
uses BitmapUtils;
procedure
TForm2.Changesize(bai:real);//倍率によって変更されたサイズをImageに代入
var
Bitmap:
TGraphic;
begin
Ghei := Trunc(bmp.Height *
bai);//元画像の変換倍率の大きさを格納
Gwid := Trunc(bmp.width *
bai);
image.Height:=Ghei;
image.Width:=
Gwid;
Image.Picture.Bitmap:=bmp;
Bitmap :=
Shrink(Image.Picture.Graphic as TBitmap, Gwid,
Ghei);
Image.Picture.Graphic :=
Bitmap;
Bitmap.Free;
end;
※
ImageコンポーネントのStrechはニアレストネイバーより綺麗みたいです。
処理速度はニアレストネイバーと同じくらい。
面積平均法は処理が遅いので、縮小時のみの適応が好ましいです。
function KIBResizeNearest(Src: TBitmap; const
NewWidth, NewHeight: Integer): TBitmap;
const
ZERO_RECT: TRect =
(Left: 0; Top: 0; Right: 0; Bottom: 0);
var
Dst: TBitmap;
PixelFormat: TPixelFormat;
SrcWidth, SrcHeight, OnePixelSize:
Integer;
SrcScanLineBuffer, DstScanLineBuffer: array of
Pointer;
x, y: Integer;
pDst, pSrc: PByte;
SrcX,
SrcY: Integer;
begin
// 少しでも速くするため、元画像の大きさとピクセルフォーマットを取得
PixelFormat := Src.PixelFormat;
SrcWidth := Src.Width;
SrcHeight := Src.Height;
// ピクセルフォーマットのチェック
if not (PixelFormat
in [pf8bit, pf24bit, pf32bit]) then
raise
Exception.Create('未対応のピクセルフォーマットです');
// ピクセルフォーマットから１ピクセルの大きさを取得
//
コンパイラの警告を避ける為にとりあえず1を設定しておく
OnePixelSize := 1;
case
PixelFormat of
pf8bit: OnePixelSize :=
1;
pf24bit: OnePixelSize := 3;
pf32bit: OnePixelSize := 4;
end;
Dst := TBitmap.Create;
try
// pf8bitの場合、パレットをコピーする必要がある
if
PixelFormat = pf8bit then Dst.Assign(Src);
//
新しい画像の大きさとピクセルフォーマットを設定する
Dst.PixelFormat :=
PixelFormat;
Dst.Width := NewWidth;
Dst.Height := NewHeight;
//
スキャンラインの結果をバッファに（この方が速いらしい）
SetLength(SrcScanLineBuffer,
Src.Height);
for x := 0 to Src.Height - 1 do
SrcScanLineBuffer[x] := Src.ScanLine[x];
SetLength(DstScanLineBuffer, Dst.Height);
for x := 0 to
Dst.Height - 1 do DstScanLineBuffer[x] := Dst.ScanLine[x];
// ピクセル毎に処理
for
y := 0 to NewHeight - 1 do
begin
//
コピー先のスキャンラインをバッファから取得
pDst :=
DstScanLineBuffer[y];
for x := 0 to NewWidth -
1 do
begin
//
コピー元の座標を取得する
SrcX := Round(x /
NewWidth * SrcWidth);
SrcY :=
Round(y / NewHeight * SrcHeight);
//
座標がオーバーしている場合への対応
if SrcX < 0
then SrcX := 0;
if SrcY < 0
then SrcY := 0;
if SrcX >=
SrcWidth then SrcX := SrcWidth -
1;
if SrcY >= SrcHeight then
SrcY := SrcHeight -
1;
//
コピー元を取得
pSrc :=
SrcScanLineBuffer[SrcY];
Inc(pSrc,
SrcX * OnePixelSize);
//
コピー
CopyMemory(pDst, pSrc,
OnePixelSize);
//
次のピクセルへ
Inc(pDst,
OnePixelSize);
end;
//
ここまで来れば処理は成功
Result := Dst;
except
Dst.Free;
raise; //
例外を再生成
end;
..画像を敷き詰める
procedure TBackDraw.Backdrawing(Sender: TForm; Graphic:
TGraphic); //背景画像読み込み
var
R: TRect;
x, y:
Integer;
begin
//
更新領域（再描画する部分）の取得
if not GetUpdateRect(Sender.Handle, R,
FALSE) then
R :=
sender.ClientRect;
//
壁紙の必要枚数（行・列）を計算する
R.Left := R.Left div
Graphic.Width;
R.Right := (R.Right - 1) div
Graphic.Width;
R.Top := R.Top div
Graphic.Height;
R.Bottom := (R.Bottom - 1) div
Graphic.Height;
// 壁紙を描画する
for y :=
R.Top to R.Bottom do
for x := R.Left to
R.Right do
sender.Canvas.Draw(x *
Graphic.Width, y * Graphic.Height,
Graphic);
end;
..取得■色を取り出す
WinAPI
「RGB」関数
//各RGBを色情報に結合する。
function RGB(r:BYTE,g:BYTE,b:BYTE):LongInt;
「GetRValue」「GetGValue」「GetBValue」関数
//色情報を各RGBに分ける。
function
GetRValue(rgbs:LongInt):Byte;
function
GetGValue(rgbs:LongInt):Byte;
function GetBValue(rgbs:LongInt):Byte;
..色補正
function
TForm1.RoundByte(data:Double):Byte;
begin
//バイトの範囲（０〜２５５）に値を丸め込んでいます。
if Data > 255 then Data := 255;
if Data < 0 then Data :=
0;
RoundByte := Round(Data);
end;
procedure
TForm1.ColorRevision(master:TBitmap);
var
x,y : SmallInt;
//ビットマップのＸ軸、Ｙ軸
R,G,B :
Byte; //Ｒ値、Ｇ値、Ｂ値
Rrv,Grv,Brv : SmallInt;
//色補正値
begin
//色補正値設定
Rrv := -60;
Grv :=
-60;
Brv := -60;
//色補正処理
for x := 0 to
master.Width do
begin
for y := 0 to
master.Height do
begin
//現画像から３原色に分解
R :=
GetRValue(imgbmp.Canvas.Pixels[x,y]);
G :=
GetGValue(imgbmp.Canvas.Pixels[x,y]);
B :=
GetBValue(imgbmp.Canvas.Pixels[x,y]);
//色補正補正
R := RoundByte(R +
Rrv);
G := RoundByte(G +
Grv);
B := RoundByte(B +
Brv);
//色補正ビットマップに描画
master.Canvas.Pixels[x,y] :=
RGB(R,G,B);
end;
end;
end;
..色を変える
プロパティのColorを変更する。又は、ColorDialogコンポーネントを使う。
カラー名称 TColor（TColor型は、ＢＧＲの順に格納されています。）
clAqua
空色
clBlack 黒色
clBlue 青色
clCream 淡黄色
clDkGray
灰色（暗）
clFuchsia 赤紫色
clGray 灰色
clGreen 緑色
clLime
濃緑色
clLtGray 灰色（明）
clMaroon 栗色
clMedGray 50% 灰色
clMoneyGreen
ミントグリーン
clNavy 濃紺色
clOlive 黄緑色
clPurple
紫色
clRed 赤色
clSilver 銀色
clSkyBlue スカイブルー
clTeal
暗青緑色
clWhite 白色
clYellow
黄色
..BitmapObject
の生成
宣言したビットマップオブジェクトを使うにはオブジェクトを生成する必要があります。
オブジェクトの生成は、Create
メソッドで出来ます。
ビットマップを生成する時期ですが、
今回は、Form
が生成されるのと同時に生成するのが適切です。
＜Form1＞の＜OnCreate＞イベント
procedure TForm1.FormCreate(Sender:
TObject);
begin
BitMap := TBitMap.Create;
//ビットマップの生成
end;
生成したポインタは、最後に解放するのがルールです。
オブジェクトの解放は、Free
メソッドで出来ます。
ビットマップを解放する時期 ですが、これはForm
が放棄されるときが適切です。
＜Form1＞の＜Destroy＞イベント
procedure
TForm1.FormDestroy(Sender: TObject);
begin
BitMap.Free;
//ビットマップの解放
end;
今度はビットマップにファイルをロードする。
//カラのBitmapにファイルを渡す。
BitMap.LoadFromFile(OpenDialog1.FileName);
//イメージにビットマップを渡す。
Image1.Picture.Bitmap :=
BitMap;
..オーナードロー
プログラムの描画処理をwindowsがするのではなく、プログラム自身(オーナー)が行うもの。
画一的なデザインから自由にデザインすることが可能になる。
＞コンポーネントの「OwnerDraw」イベントをTrueにします。
これにより、「MeasureItem」と「DrawItem」というイベントが発生するようになります。
MeasureItemではメニュー項目を表示させるのに必要なサイズを計算し、DrawItemで実際に描画します。
procedure TForm1.ListView1DrawItem(Sender:
TCustomListView;
Item: TListItem; Rect: TRect; State:
TOwnerDrawState);
Canvas.Brush.Color := clBrue;
//現在の色を青にする。
Canvas.FillRect(Rect);
//矩形を塗る。
Canvas.TextOut(Rect.Left+2,Rect.Top,Items.Item[i].Caption);
//指定場所に文字を書く。
.テキストファイルの読み書き
memo1.Lines.LoadFromFile(ChangeFileExt(ParamStr(0),'.txt'));//ファイル読み込み。
memo1.Lines.SaveToFile(ChangeFileExt(ParamStr(0),'.txt'));//ファイル書き込み
..ビットマップを半透明で描画する
// ビットマップを半透明で描画する
procedure
DrawTranslucent(Canvas: TCanvas; x, y: Integer;
Graphic:
TGraphic);
var
bmpBkg, bmpMix: TBitmap;
pdwMix, pdwSrc:
PDWORD;
w, h, iX, iY, iLineSize: Integer;
begin
w :=
Graphic.Width;
h := Graphic.Height;
bmpBkg :=
TBitmap.Create;
bmpMix := TBitmap.Create;
//
背景をビットマップに取得する
bmpBkg.Width := w;
bmpBkg.Height :=
h;
bmpBkg.PixelFormat := pf24bit;
bmpBkg.Canvas.CopyRect(Rect(0, 0, w, h),
Canvas,
Rect(x, y, x + w, y + h));
//
「背景＋ビットマップ」をビットマップにする
bmpMix.Assign(bmpBkg);
bmpMix.Canvas.Draw(0, 0, Graphic);
//「背景」と「背景＋ビットマップ」を半々に混ぜる
iLineSize := (w * 3 + 3) div
sizeof(DWORD);
for iY := 0 to h - 1 do
begin
pdwMix := bmpMix.ScanLine[iY];
pdwSrc := bmpBkg.ScanLine[iY];
for iX := 0 to iLineSize -
1 do
begin
Dec(pdwMix^,
(pdwMix^ shr 1)and
$7f7f7f7f
- (pdwSrc^ shr 1)and $7f7f7f7f);
Inc(pdwMix);
Inc(pdwSrc);
end;
end;
//
混ぜたビットマップを描く
Canvas.Draw(x, y, bmpMix);
bmpMix.Free;
bmpBkg.Free;
end;
procedure TForm1.Button1Click(Sender:
TObject);
begin
DrawTranslucent(Canvas, 0, 0,
Image1.Picture.Bitmap);
end;
..アクティブウィンドウをキャプチャー
procedure TForm2.cap;
var
Bitmap1:
TBitmap;
Bitmap: TGraphic;
ScreenDC: HDC;
Rect1:
TRect;
ActHwnd: HWND;
TopBuffer, LeftBuffer, WidthBuffer,
HeightBuffer: Integer;
begin
Bitmap1 :=
TBitmap.Create;
try
//↓最前面のWindowHandle取得
ActHwnd
:= GetForegroundWindow;
while (ActHwnd <> HWND(nil))
do
begin
if IsWindowVisible(ActHwnd) and (not
IsIconic(ActHwnd)) then
Break;
ActHwnd :=
GetWindow( ActHwnd, GW_HWNDNEXT);
end;
if ActHwnd = HWND(nil) then
raise
Exception.Create('Windowの取得に失敗しました');
GetWindowRect( ActHwnd, Rect1);
{↓ﾃﾞｽｸﾄｯﾌﾟからはみ出す範囲を削除}
if
Rect1.Left < 0 then
LeftBuffer := -(Rect1.Left)
else
LeftBuffer := 0;
if Rect1.Top < 0
then
TopBuffer := -(Rect1.Top)
else
TopBuffer := 0;
if Rect1.Right > Screen.Width then
WidthBuffer := Screen.Width - Rect1.Left - LeftBuffer
else
WidthBuffer := Rect1.Right - Rect1.Left -
LeftBuffer;
if Rect1.Bottom > Screen.Height then
HeightBuffer := Screen.Height - Rect1.Top - TopBuffer
else
HeightBuffer := Rect1.Bottom - Rect1.Top - TopBuffer;
ScreenDC := GetWindowDC(ActHwnd);
Bitmap1.Width := WidthBuffer;
Bitmap1.Height := HeightBuffer;
try
GDIFlush;
BitBlt(Bitmap1.Canvas.Handle,0,0,WidthBuffer,HeightBuffer,
ScreenDC,LeftBuffer,TopBuffer,SRCCOPY);
finally
ReleaseDC(ActHwnd,ScreenDC);
end;
Image1.Picture.Bitmap:=Bitmap1;
Bitmap :=
Shrink(Image1.Picture.Graphic as TBitmap, width,
Height);
Image1.Picture.Graphic :=
Bitmap;
Bitmap.Free;
finally
Bitmap1.Free;
end;
end;
.◆プロセス系
..TSTARTUPINFO
プロセスの表示状態を格納するための構造体。
CreateProcess関数、CreateProcessAsUser関数、CreateProcessWithLogonW関数のパラメータとして利用される。
メンバ
DWORD
cb;
// 構造体サイズ
LPTSTR lpReserved;
// 予約(0)
LPTSTR
lpDesktop; // デスクトップ
LPTSTR lpTitle; //
ウィンドウタイトル
DWORD
dwX; //
x位置
DWORD
dwY; //
y位置
DWORD
dwXSize; //
xサイズ
DWORD
dwYSize; //
yサイズ
DWORD dwXCountChars; //
文字幅
DWORD dwYCountChars; //
文字高
DWORD dwFillAttribute; //
文字色・背景色
DWORD
dwFlags; //
フラグ
WORD wShowWindow;
// ウィンドウ表示形式
WORD
cbReserved2; // 予約(0)
LPBYTE
lpReserved2; // 予約(0)
HANDLE
hStdInput; // 標準入力
HANDLE hStdOutput; // 標準出力
HANDLE hStdError; //
標準エラー出力
GetStartupInfo() 関数で呼び出し元プロセスが作成された時に使用された構造体を取得します。
..プログラムを起動する。
CreateProcessを使います。
第一引数をnilにしておくと，第2引数にMS-DOSでアプリを起動するように
コマンドラインを指定できます．
例えば，メモ帳を起動して，C:\Delphi\FAQ.TXTを開くには，
'NOTEPAD.EXE'+'
'+'"'+C:\Delphi\FAQ.TXT+'"'という文字列を使用する。
終了時には下記処理も実施する。（システムにプロセスが残る）
生成したプロセスを操作しないのであれば生成直後に処理しても良い。
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
Var
SI :TStartupInfo;
PI
:TProcessInformation;
Begin
GetStartupInfo(SI);
If Not
CreateProcess('C:\Windows\Notepad.Exe', nil, nil,
nil,
False, CREATE_DEFAULT_ERROR_MODE,nil, nil, SI, PI)
Then
Raise Exception.Create('Exec Error ' +
IntToStr(GetLastError));
While WaitForSingleObject(PI.hProcess, 0) =
WAIT_TIMEOUT Do
Application.ProcessMessages;
{このループが抜けたら、起動したプログラムが終了している}
End;
..Tprocessinformation
プロセスに関する構造体。
メンバ
hThread //プロセスのハンドル
hProcess
//プロセスのハンドル
..WaitForInputIdle()
プロセスがアイドリングするまで待つ。
引数
hProcess
ハンドルを指定します。
dwMilliseconds タイムアウトをミリ秒で指定します。INFINITE
を指定すると、アイドル状態になるまで制御を返しません。
戻り値
次の表は、発生する可能性のある戻り値を示します。
値 意味
0
待機条件が成立しました。
WAIT_TIMEOUT タイムアウト時間が経過したために、待機状態を終了しました。
-1
.◆Windowsメッセージ
..Messageフックとサブクラス化
ウィンドウがメッセージを受け取ったら発生
宣言部
procedure WMMove(var
Msg:TMessage);message WM_MOVE;
実行部
procedure TForm1.WMMove(var Msg:
TMessage);
begin
Form2.Left:= Left;
Form2.Top:=
top;
end;
//Form1を動かすと、Form1にぴったり合わせてForm2も動きます。
通常、子コントロールで発生したメッセージは親コントロール送られるWM_COMMANDを調べることでわかる。
（TMessage
型で受信すると、WParam と LParam をデコードしなくてはならないので TWMCommand
型で受信する。
また、WM_COMMANDをフックする場合はinherited;を忘れないようにする。inherited;は元々の標準の動作をするものである。）
＜TWMCOMMAND型＞
TWMCommand = packed
record
Msg: Cardinal; // メッセージ本体。いまの場合は
WM_COMMAND
ItemID: Word; //
コントロールのID
NotifyCode: Word; // 通知コード
Ctl: HWND; //
コントロールのハンドル
Result: Longint; // 戻り値
end;
しかし、目的のコントロールの親がフォームでない場合や、
子コントロールのスクロールバーといった場合、メッセージを受け取ることができない。
（例えば、目的のコントロールがパネル上にある場合、パネルにメッセージが送られる。）
その場合、目的のコントロールをサブクラス化することでメッセージを受け取ることができる。
public { Public 宣言
}
OriginalProc:TWndMethod;
procedure
WMCommand(var Msg:TWMCommand);message WM_COMMAND;
procedure SubclassProc(var Msg:TMessage);
end;
-略-
procedure TForm1.FormCreate(Sender:
TObject);
begin
Memo1.ScrollBars := ssVertical;
OriginalProc := Panel1.WindowProc; //WindowProc プロパティーに TWndMethod
型のハンドラを代入して、サブクラス化する。
Panel1.WindowProc := SubclassProc;
end;
procedure TForm1.SubclassProc(var Msg:
TMessage);
begin
OriginalProc(Msg);
case Msg.Msg
of
WM_COMMAND:WMCommand(TWMCommand(Msg)); //WM_COMMAND
を捕まえて、WMCommand() に転送している。
end;
end;
procedure TForm1.WMCommand(var Msg:
TWMCommand);
var
WC:TWinControl;
begin
inherited;
WC := FindControl(Msg.Ctl);
if WC is TButton then
begin
Memo1.Lines.Add(WC.Name);
end;
end;
PostMessage と Sendmessage
PostMessage
は処理中の関係なしに制御が戻る。戻り値は成功すれば０．失敗すれば０以外。boolean同意
Sendmessage
は処理が終わるまで制御が戻らない。
..タブコントロールのメッセージ一覧
TCM_ADJUSTRECT
TCM_DELETEALLITEMS
TCM_DELETEITEM
指定されたタブを削除します。
TCM_GETCURSEL 現在選択されているタブのインデックスを取得します。
TCM_GETITEM
タブに関する情報を取得します。
TCM_GETITEMCOUNT 含まれるタブの数を取得します。
TCM_INSERTITEM
TCM_SETCURSEL 指定されたタブを選択します。
TCM_SETIMAGELIST
TCM_SETITEM
..リストビューのメッセージ一覧
CommCtrl
を追加する。
windowsメッセージは LVM_ から始まるAPIが使用できる。
LVM_DELETEALLITEMS
LVM_DELETECOLUMN
LVM_DELETEITEM
LVM_FINDITEM
LVM_GETBKCOLOR
LVM_GETEXTENDEDLISTVIEWSTYLE
LVM_GETHEADER
LVM_GETITEM
LVM_GETITEMCOUNT
LVM_GETNEXTITEM
LVM_GETTEXTCOLOR
LVM_GETTEXTBKCOLOR
LVM_INSERTCOLUMN
LVM_INSERTITEM
LVM_SETBKCOLOR
LVM_SETEXTENDEDLISTVIEWSTYLE
LVM_SETIMAGELIST
LVM_SETITEM
LVM_SETTEXTBKCOLOR
LVM_SETTEXTCOLOR
..ツールバーのメッセージ一覧
TB_ADDBITMAP
TB_ADDBUTTONS
TB_ADDSTRING
TB_AUTOSIZE ボタンのサイズに合わせてツールバーをリサイズします。
TB_BUTTONSTRUCTSIZE
TB_CHECKBUTTON ツールバーのボタンを押された状態または押されていない状態に設定します。
TB_COMMANDTOINDEX
TB_DELETEBUTTON ツールバーからボタンを削除します。
TB_ENABLEBUTTON
TB_GETSTATE
TB_HIDEBUTTON
TB_INSERTBUTTON
TB_LOADIMAGES
TB_SETBITMAPSIZE
TB_SETDISABLEDIMAGELIST
TB_SETHOTIMAGELIST
TB_SETIMAGELIST
TB_SETINDENT
TB_SETSTATE
..スクロールバーのメッセージ一覧
水平トラックバーは親ウィンドウに
WM_HSCROLL、垂直トラックバーは WM_VSCROLL メッセージを送る｡
動作を表す定数 値
内容
------------------------------------------------------
SB_LINEUP
0
上矢印を押した
SB_LINEDOWN
1
下矢印を押した
SB_PAGEUP
2
上ページアップを押した
SB_PAGEDOWN
3 下ページアップを押した
SB_THUMBPOSITION
4
lParamの下位ワードにサムの位置を示す
SB_THUMBTRACK
5
サム移動中
SB_TOP
6
[HOME]キーが押された
SB_BOTTMOM
7
[END]キーが押された
SB_ENDSCROLL
8 スクロールが終了
..ウィンドウ メッセージ一覧
メッセージ 意味
WM_ACTIVATE
ウィンドウのアクティブ化・非アクティブ化
WM_CHAR キーボードからの文字の入力
WM_CLEAR エディットコントロールのテキストの削除
WM_COMMAND
メニューアイテムの選択・コントロールからの通知
WM_CONTEXTMENU
コンテキストメニューを表示するために受け取る通知
WM_COPY
エディットコントロールのテキストのコピー
WM_CTLCOLOREDIT エディットの背景色を通知
WM_CTLCOLORSTATIC コントロールの背景色を通知
WM_CUT
エディットコントロールのテキストの切り取り
WM_DROPFILES3
ファイルがドロップされた
WM_ERASEBKGND ウィンドウ背景を消去する通知
WM_GETFONT
コントロールのフォントを取得
WM_GETICON ウィンドウのアイコンを取得
WM_GETTEXT ウィンドウタイトルやコントロールのテキストを取得
WM_GETTEXTLENGTH ウィンドウタイトルやコントロールのテキストのサイズを取得
WM_ICONERASEBKGND デスクトップ背景を描画する
WM_KEYDOWN
非システムキーが押された
WM_KEYUP 押されていた非システムキーが離された
WM_LBUTTONDBLCLK マウス左ボタンをダブルクリック
WM_LBUTTONDOWN
マウス左ボタンを押し下げ
WM_LBUTTONUP マウス左ボタンを離した
WM_MBUTTONDBLCLK マウス中央ボタンをダブルクリック
WM_MBUTTONDOWN
マウス中央ボタンを押し下げ
WM_MBUTTONUP マウス中央ボタンを離した
WM_MENUSELECT メニューアイテムが選択された
WM_MOVE
ウィンドウの移動
WM_NCCALCSIZE 非クライアント領域の大きさを取得
WM_NOTIFY
コモンコントロールからの通知
WM_NULL 効果をもたないメッセージ
WM_PAINT ウィンドウ再描画の通知
WM_PASTE
エディットコントロールのテキストの貼り付け
WM_RBUTTONDBLCLK
マウス右ボタンをダブルクリック
WM_RBUTTONDOWN マウス右ボタンを押し下げ
WM_RBUTTONUP マウス右ボタンを離した
WM_SETFONT
コントロールのフォントを設定
WM_SETTEXT
ウィンドウタイトルやコントロールのテキストを設定
WM_SIZE
ウィンドウサイズ変更
WM_SYSCOMMAND システムメニューアイテム選択
WM_UNDO エディットコントロールの直前の操作を元に戻す
WM_USER
アプリケーション定義メッセージの先頭
..ツリビューのメッセージ一覧
TVM_DELETEITEM
TVM_EXPAND
指定されたアイテムが子アイテムを持つ場合に、子アイテムのリストを開いたり閉じたりします。
TVM_GETBKCOLOR
TVM_GETCOUNT
TVM_GETITEM
TVM_GETNEXTITEM
指定されたアイテムに対して指定された関係を持つアイテムを取得します。
TVM_GETTEXTCOLOR
TVM_GETVISIBLECOUNT
TVM_INSERTITEM
TVM_SETBKCOLOR 背景色を設定します。
TVM_SETIMAGELIST
TVM_SETITEM
TVM_SETTEXTCOLOR
文字色を設定します。
TVM_SORTCHILDREN
指定された親アイテムが持つ子アイテムをソートします。
.◆特定コンポーネント
..Webブラウザーコンポーネント
DelphiのコンポーネントからActiveXの取り込みを選択。
Microsoft
Internet Controls を選択して「インストール」を選択。
...Enterキーなどを機能させる。
Uses に ActiveX を加える。
procedure TForm1.AppMessage(var Msg:TMsg;var
Handled:boolean);
begin
case Msg.message of
WM_RBUTTONUP :MouseUp;
WM_RBUTTONDOWN:MouseDown;
WM_MOUSEMOVE
:MouseMove;
WM_MBUTTONUP :centerUp;
WM_MBUTTONDOWN:centerDown;
WM_MOUSEWHEEL
:MouseWheel(msg.wParam);
WM_KEYDOWN
:Keydown(msg);
WM_KEYUP :Keyup(msg);
end;
end;
procedure TForm1.Keydown(Msg:TMsg);
var
FOleInPlaceActiveObject:
IOleInPlaceActiveObject;
begin
FOleInPlaceActiveObject
:=web_main.ControlInterface as
IOleInPlaceActiveObject;
FOleInPlaceActiveObject.TranslateAccelerator(Msg);
//メッセージをアクティブオブジェクトに転送
end;
...グローバル変数
var
back_f:boolean;//戻る･進むを許可するか？
forw_f:boolean;//戻る･進むを許可するか？
procedure TForm1.web_mainCommandStateChange(Sender:
TObject;
Command: Integer; Enable: WordBool);
begin
case
Command of
CSC_NAVIGATEBACK : back_f:=Enable;
CSC_NAVIGATEFORWARD: forw_f:=Enable;
end;
end;
procedure TForm1.Button1Click(Sender:
TObject);
begin
If back_f then web_main.GoBack;
end
procedure TForm1.Button2Click(Sender:
TObject);
begin
If forw_f then web_main.GoForward;
end
...var
MH:boolean;//マウスホイール
procedure TForm1.AppMessage(var Msg:TMsg;var
Handled:boolean);
begin
case Msg.message of
WM_MOUSEWHEEL :MouseWheel(msg.wParam);
WM_MBUTTONUP
:centerUp;
WM_MBUTTONDOWN:centerDown;
end;
end;
function WebScroll( Web: TWebBrowser; X, Y: Integer ):
Boolean;
var
X0, Y0: Integer;
XMax, YMax:
Integer;
WebDoc: IHTMLDocument2;
Body: OleVariant;
X1, Y1: Integer;
begin
WebDoc := Web.Document as
IHTMLDocument2;
Body := OleVariant( WebDoc
).body;
Result := True;
X0 := body.ScrollLeft;
Y0 :=
body.ScrollTop;
XMax := body.ScrollHeight-body.ClientWidth;
YMax := body.ScrollHeight-body.ClientHeight;
X1 := X0 + X;
Y1 := Y0 +
Y;
if( Y < 0 )and( body.ScrollTop <= 0 )then
begin
Y1 := 0;
Result :=
False;
end else
if( Y > 0 )and( body.ScrollTop >= YMax
)then begin
Y1 := YMax;
Result :=
False;
end;
if( X < 0 )and( body.ScrollLeft <= 0 )then
begin
X1 := 0;
Result :=
False;
end else
if( X > 0 )and( body.ScrollLeft >=
XMax )then begin
X1 := XMax;
Result
:= False;
end;
WebDoc.parentWindow.scroll( X1, Y1 );
end;
procedure TForm1.MouseMove;
var
X,Y:Integer;
MousePos
:TPoint;
begin
popupmenu1.AutoPopup:=true;
GetCursorPos(MousePos
);
X:=MousePos.x;
Y:=MousePos.y;
If MH=true then
WebScroll(web_main,MousePos.x-EX,MousePos.Y-EY);
end;
procedure
TForm1.MouseWheel(wparam:integer);
begin
if (WParam > 0) then
begin
//奥にホイール
WebScroll(web_main,0,-10);
end
else
begin //手前にホイール
WebScroll(web_main,0,10);
end
end;
procedure
TForm1.CenterDown;
var
p:TPoint;
begin
GetCursorPos(p);
EX:=p.x;
EY:=p.y;
MH:=true;
end;
procedure
TForm1.CenterUp;
begin
MH:=false;
end;
...画面上で文字列の検索をする
(1) [コンポーネント][ActiveXコントロールの取込み]
(2) [Microsoft HTML
Object Library (Version4.0)]を選択
(3) [インストール]
(4) かなり時間がかかる
(5)
IDE上で[パッケージ]のダイアログが表示されたら保存して終了
(6) [ActiveX]のタブに[Internae
Explorer]が追加されている
(7) 本体は，C:\..... \Delphi6\Import\MSHTML_TLB.pas(11MB以上)
このMSHTML_TLBがpro版以上のmshtml.pasに相当します．
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants,
Classes, Graphics, Controls, Forms,
Dialogs,mshtml_TLB, StdCtrls,
OleCtrls, SHDocVw_TLB;
type
TForm1 =
class(TForm)
WebBrowser1:
TWebBrowser;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender:
TObject);
procedure Button2Click(Sender:
TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1:
TForm1;
implementation
{$R *.dfm}
procedure WBLocateHighlight(WB: TWebBrowser; Text:
string) ;
const
prefix = '<span style="color:white;
background-color: blue;">';
suffix =
'</span>';
var
tr:
IHTMLTxtRange;
begin
if Assigned(WB.Document)
then
begin
tr := ((wb.Document AS
IHTMLDocument2).body AS
IHTMLBodyElement).createTextRange;
while
tr.findText(Text, 1, 0) do
begin
tr.pasteHTML(prefix + tr.htmlText
+ suffix) ;
tr.scrollIntoView(True)
;
end;
end;
end;
procedure TForm1.Button1Click(Sender:
TObject);
begin
WebBrowser1.Navigate('http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+200511/05110050.txt');
end;
procedure TForm1.Button2Click(Sender:
TObject);
begin
WBLocateHighlight(WebBrowser1,'武田');
end;
end.
...ブラウザで読み込んだ内容を変換して出力する方法です。
-- TWebBrowser で表示している画面のHTMLソースを取得して変換表示する方法 --
TWebBrowser で表示している画面のHTMLソースを取得する方法と
TWebBrowser
に任意のHTMLソース文字列を渡して表示させる方法
両方を使って、既存の見ているページのタグの内容を書き換えて
表示することができます。
次のソースを参考にしてください。
────────────────────
uses
ActiveX, AxCtrls,
//uses AxCtrls
function IStreamToString(pStream:
IStream): string;
var
st
: TStringStream;
os :
TOLEStream;
begin
result := '';
os :=
TOLEStream.Create(pstream);
st :=
TSTringStream.Create('');
try
st.CopyFrom(os,
0);
st.Seek(0, 0);
setstring(result,
pchar(st.datastring), st.size);
finally
st.free;
os.free;
end;
end;
//uses ActiveX
function GetDocumentSource(WebBrowser:
TWebBrowser): Widestring;
var
pPStm : IPersistStreamInit;
pStream : IStream;
hMem : HGLOBAL ;
begin
pPStm :=
WebBrowser.document as IPersistStreamInit;
hMem :=
GlobalAlloc(GHND , 0 );
CreateStreamOnHGlobal(Hmem, TRUE,
pStream);
pPStm.Save(pstream , true);
result :=
IStreamToString( pstream);
end;
//これでブラウザで表示されているソースが表示される
procedure
TMainForm.Button1Click(Sender: TObject);
begin
ShowMessage(GetDocumentSource(WebBrowser1));
end;
procedure TMainForm.Button2Click(Sender:
TObject);
var
sl: TStringList;
ms:
TMemoryStream;
begin
WebBrowser.Navigate('about:blank');
if Assigned(WebBrowser1.Document) then begin
sl :=
TStringList.Create;
ms :=
TMemoryStream.Create;
try
// HTML を TStringList に作る(直接 Stream
でも可能)
sl.Text := '<html><body
bgcolor="#ff0000">てすと</html>';
sl.SaveToStream(ms);
ms.Seek(0,
0);
(WebBrowser1.Document as
IPersistStreamInit).Load(TStreamAdapter.Create(ms));
finally
ms.Free;
sl.Free;
end;
end;
end;
...ファイルのダウンロード
Unit URLMON; の
URLDownloadToFile で実現できます。
下のソースはブラウザのリンクをたどって画像を保存→表示するものです。
procedure TForm1.webbrowser1StatusTextChange(Sender:
TObject;
const Text:
WideString);
var
kaku:string;
S:String;
del:PChar;
begin
pnl.Visible:=false;
S :=AnsiString(text);
stsb.Panels[0].Text:= S;
kaku:=Copy(S,Length(S)-3,4);
kaku:=LowerCase(kaku);
If
(kaku<>'.jpg')and(kaku<>'.bmp')and(kaku<>'.png') then
exit;
If (kaku='.jpg') then
del:=PChar(changeFileExt(paramStr(0),'.jpg'));
If(kaku='.bmp')
then del:=PChar(changeFileExt(paramStr(0),'.bmp'));
If(kaku='.png') then
del:=PChar(changeFileExt(paramStr(0),'.png'));
If
URLDownloadToFile(nil,PChar(S),del,0,nil)=0 then
begin
img.Picture.LoadFromFile(del);
pnl.Height:=img.Height;
pnl.Width:=img.Width;
pnl.Show;
end;
end;
...ブラウザのハンドル
WebBrowser1.Handle
は本体のウィンドウハンドルですね。
実際にコンテンツが表示されている部分は、その子の子の部分の'Internet Explorer_Server'
ウィンドウです。
（Winspector 使用）
procedure TForm1.Button1Click(Sender:
TObject);
var
hIE:HWND;
begin
hIE :=
FindWindowEx(WebBrowser1.Handle,0,'Shell DocObject View',nil);
hIE :=
FindWindowEx(hIE,0,'Internet Explorer_Server',nil);
if hIE = 0 then
exit;
end;
...リンク先の URL
を取得
StatusTextChange の Text
に代入されます。
※URL以外の全てのステータスが代入されますので、ふるいにかける必要があります。
..ボタン系
ImageListの格納Imageを使って、ボタンの画像を作る。
BMPオブジェクトの生成と破棄を記述し、GetBitmapでImageListから取り出す。
ボタンで表示するビットマップは左下のピクセルが透過色として予約されてます。
BitBtnは通常、押された、使用不可など状況に応じて画像を変えられます。
Speedbutton.AllowAllUp
は押されたままの状態を維持できます。（GroupIndexを1以上にする。）
SpeedButton はマウスにだけ反応し、キー入力を受けるための
Windows のリソースを使用しないので、
非常に軽い（起動が速い）ボタンです。
凹み状態で処理中、凸状態で、処理解除というような機能を持たせる場合、
onClickと
onMouseDownを使います。
onClickはマウスボタンを押して上げた状態で発生するイベントなので、
SpeedbuttonのDownプロパティではクリック前の状態が見れません。
onClickに処理実行のコードを書き、
onMouseDownに処理解除のコードを書きます。
bmp.Create;
ImageList1.GetBitmap(1,BBmp);
..TSynEdit
フリーの高機能テキストエディタコンポーネント。
eoScrollPastEol フリーカーソルになる。
eoTabsToSpaces タブ余白がスペースに置き換わる。
WantTabs タブキーでのIndentを有効にする。
Gutter.ShowLineNumbers 左のスペースに行数を表示する。
caretY 行 ※１からカウント。
caretX 桁 ※１からカウント。
RightEdge:=
0; テキスト右側にある指定行数の縦線。
..Listview関係
ListViewで表示されるアイテムは全てListItemオブジェクト。
ListViewへの書き込みはListItemを経由する。
var Listitem:TListitem;
//ListItemを宣言する。スコープに気を付けないとメモリが消える。
...Item操作
◆項目の読み込み
with ListView1.Selected
do
begin
e_jikan.Text:= Caption;
e_kyoten.Text:=
SubItems.Strings[0];
e_memo.Text:=
SubItems.Strings[1];
end;
//選択状態にあるリストアイテムをサブアイテムの順番も指定して読み込んでます。
◆項目の追加
listitem:=
ListView1.Items.Add;
with listitem do
begin
caption:=
inttostr(Listview1.Items.Count);
subitems.Add(e_jikan.Text);
subitems.Add(e_kyoten.Text);
subitems.Add(e_taiousha.Text);
◆選択項目のコピー
ListView.CopySelection(ListView2);
◆複数項目の削除
プロパティ MultiSelect:=
true;
begin
while ListView1.Selected<>nil
do //選択アイテムがなくなるまでループ
begin
ListView.Items.Item[ListView.Selected.Index].Delete;
end;
end;
...ListViewに色を付ける
vsReport形式チェック付きの場合は、ListViewのAdvancedCustomDrawItemイベントに
以下のコードを追加
procedure
TForm1.ListView1AdvancedCustomDrawItem(
Sender: TCustomListView; Item:
TListItem; State: TCustomDrawState;
Stage: TCustomDrawStage; var DefaultDraw:
Boolean);
begin
//Checkのあるところに色がつく
if Item.Checked
then
Sender.Canvas.Brush.Color :=
clBlue;
end;
また、
onAdvancedCustomDrawSubItemに記述すれば、SubItemのみに色がつく。
...ListViewのD&Dの項目入れ替え
＊アルゴリズム。
マウスカーソル位置から項目のIndexを記憶。//関数化
ドラッグした項目をドロップしたIndexに挿入して、
記憶していたドラッグ前の項目を消す
ListViewのプロパティ：DragMode = dmAutomatic
に設定する。
以下のイベントを作成する。
宣言部
old :integer;
ListView.DragOver 部
//ドラッグを開始したときに発生
begin
Accept:= Source is
TListView;//ドラッグ中のオブジェクトならドロップを受け入れます。
end;
ListView.StartDrag 部
begin
old:=
ListView.Items.IndexOf(ListView.Selected);//ドラッグする項目のIndexを記憶。
end;
ListView.DragDrop 部
procedure
TForm1.ListViewDragDrop(Sender, Source: TObject; X, Y:
Integer);
var
new
:integer;
begin
ListView.Items.BeginUpdate;
new:=
ListView.Items.IndexOf(Listview.GetItemAt(X,Y));
if new<old
then//上にドロップした場合
begin
ListView.Items.Insert(new);
ListView.Items[new]:=
ListView.Items[old+1];
ListView.Items.Delete(old+1);
end;
if new>old
then//下にドロップした場合
begin
ListView.Items.Insert(new+1);
ListView.Items[new+1]:=
ListView.Items[old];
ListView.Items.Delete(old);
end;
ListView.Items.EndUpdate;
end;
end;
...カラムのサイズを設定する。
//ColumnTextWideは定数「-1」で項目のテキストに合わせて列のサイズが決まる。
//ColumnHeaderWidthは定数「-2」で見出しに合わせて列のサイズが決まる。
ListView1.Columns[0].Width:=
-2;
...カラムの動的設定
Call ListView1.ColumnHeaders.Add(, ,
"最初の列", 1000)
Call ListView1.ColumnHeaders.Add(, , "２番目の列", 800,
lvwColumnRight)
Call ListView1.ColumnHeaders.Add(, , "３番目の列", 800)
Call
ListView1.ColumnHeaders.Add(, , "４番目の列",
800)
...チェックボックスとグリッド線の利用。
ListView1.Checkboxes =
True
ListView1.GridLines =
True
ListView1.Selected.Index; //選択されている項目のIndexを返します。
ListView.Items.Delete(); //渡されたIndexの項目を削除します。
ListView1.Items.Insert();
//新しい項目を指定したIndexの位置に挿入できます。
ListView.Selected.Assign(ListView.Items[]);
//指定したIndexの項目を丸ごとコピーします。
...ポインターを参照し、Itemに格納する。
data := pointer(SL[0]);
//StringList[0]のメモリアドレスを指定している。
実際のデータを代入するわけではなく、あくまでもアドレスを代入しているという意識を忘れずに。
procedure TForm1.Button1Click(Sender:
TObject);
var
pFav: PFavData; //ポインタ型を宣言
ListItem:
TListItem;
begin
New(pFav); //メモリ領域を確保
pFav^.URL :=
'http://www.borland.co.jp/';//レコードに値を代入
pFav^.FileName :=
'C:＼Windows＼Favorites＼Borland Japan.url';
ListItem :=
ListView1.Items.Add;//ListItem作成
ListItem.Caption :=
ChangeFileExt(ExtractFileName(pFav^.FileName), '');
ListItem.Data :=
Pointer(pFav);//Dataプロパティにレコード（のアドレス）を代入
end;
「^」を前に付けるか後ろに付けるかで参照の方向が変わる。（参照／逆参照）pFavレコードに値を代入するときは後ろにを付ける。
pFavはアドレスしか入っていないので、値を代入するときは実際のデータを持ってくる必要がある。
このように、ポインタから実データを引っ張り出してくる記述は山形の記号1つだけで済む。「記号なしは単なるアドレス」「記号ありは実データ」という意識しよう。
一番最後のListItem.Dataへの代入は、このプロパティがPointer型なのでPointerで型キャストして代入する。
Pointer型は最も汎用的なポインタ型であり、どのような型に限らず（アドレスを）代入できる。
//Dataプロパティから取り出す
値を取り出す場合は、Dataを逆参照して実データを持ってきて、それを型キャストする。
procedure
TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
Selected:
Boolean);
begin
Label1.Caption :=
TFavData(Item.Data^).FileName;
end;
「Item.Data^」で逆参照して実データを取り出す。しかし、ポインタは入っているデータの型までは教えてくれない。そこでTFavDataで型キャストしてからFileNameを取り出す。
手動でメモリを確保した（New(pFav);）、手動で確保したメモリは手動で解放しなければならない。
Newで確保したメモリを解放するには、Disposeを呼び出すだけだ。「New」したら「Dispose」するのを忘れずに。
ちなみに、手動で確保したメモリ領域を自動で開放する仕組みを「ガーベージ
コレクション」という。Javaや.NET Frameworkでサポートされているが、Delphiにはない。
ListViewの項目を削除したらデータもいらなくなるので、ここでメモリを解放する。
procedure
TForm1.ListView1Deletion(Sender: TObject; Item:
TListItem);
begin
Dispose(Item.Data);
end;
...処理の高速化／チラツキ防止
BeginUpdate
メソッドを使うことで、画面の再描画を抑制します。最後にEndUpdate メソッドが呼び出し、再描画をします。
...保存･読み込み
//-------------------------------------------------
// Ini編 保存・読み込み処理
//-------------------------------------------------
//
IniFile を使って、保存と読み込みをします。
var i:integer;
try
for i:=0 to
Form1.ListView1.Items.Count-1 do
begin
WriteString('ListView','Item'+IntToStr(i),Form1.ListView1.Items.Item[i].Caption);
WriteString('ListView','SubItem1-'+IntToStr(i),Form1.ListView1.Items.Item[i].SubItems.Strings[0]);
WriteString('ListView','SubItem2-'+IntToStr(i),Form1.ListView1.Items.Item[i].SubItems.Strings[1]);
Application.ProcessMessages; //アプリケーションのキューを受け付けます。
end;
end;
finally
IniFile.Free;
end;
var i:integer;
try
while
IniFile.ValueExists('ListView','Item'+IntToStr(i)) do
begin
listitem:=
Form1.ListView1.Items.Add;
caption:=
IniFile.ReadString('ListView','Item'+IntToStr(i),'');
subitems.Add(IniFile.ReadString('ListView','SubItem1-'+IntToStr(i),''));
subitems.Add(IniFile.ReadString('ListView','SubItem2-'+IntToStr(i),''));
i:= i+1;
Application.ProcessMessages;
//アプリケーションのキューを受け付けます。
end;
finally
IniFile.Free;
end;
//-------------------------------------------------
//-------------------------------------------------
// csv編 保存・読み込み処理
//-------------------------------------------------
procedure
TForm1.SaveList(Sender: TListView;
Path:String);
//保存対象のListViewと、保存場所を引数で指定。
var
i:integer;
F:TextFile;
begin
If
not FileExists(Path) then exit;
AssignFile(F,
Path);
Rewrite(F); //新規でファイルを作って閉じる。
try
for i:=0 to
Sender.Items.Count-1 do
begin
with Sender.Items.Item[i]
do
begin
If Caption<>'' then Write(F,
Caption);
If SubItems.Count>0 then Write(F,
','+SubItems.Strings[0]);
If SubItems.Count>1 then Write(F,
','+SubItems.Strings[1]);
Writeln(F, '');
end;
end;
finally
CloseFile(F);
end;
end;
procedure TForm1.LoadList(Sender: TListView;
Path:String);
var
F:TextFile;
StrItem:String;
ListItem
:TListitem;
SL:TStringList;
begin
If FileExists(Path)
then
begin
AssignFile(F, Path);
Reset(F);
//既存のファイルを開く
SL :=
TStringList.Create;//TStringList型は宣言しないと使えないため
try
while not
Eof(F) do
begin
Readln(F,strItem);
ListItem:=
Listview.Items.Add;
SL.CommaText:= strItem;
If SL.Count>0
then ListItem.Caption:= SL[0];
If SL.Count>1 then
ListItem.subItems.Add(SL[1]);
If SL.Count>2 then
ListItem.subItems.Add(SL[2]);
end;
finally
CloseFile(F);
SL.Free;
end;
end;
end;
//-------------------------------------------------
...アイコンテキストの背景を透明にする。
Uses CommCtrl
Sendmessage(ListView1.Handle,LVM_SETTEXTBKCOLOR,0,-1);
解説＞
第四引数の -1 がアイコンテキストの背景色を透明にしている。
ここを
ColorToRGB(clRed)
などとすることで好きな色を背景色することもできる。
なお、テキスト自体の色を変えるには、LVM_SETTEXTCOLOR の lParam
を変える。
...アイコンの背景を透明にする。
Uses CommCtrl
Sendmessage(ListView1.Handle,LVM_SETBKCOLOR,0,-1);
解説＞
第四引数の -1 がアイコンの背景色を透明にしている。
ここを
ColorToRGB(clRed) などとすることで好きな色を背景色することもできる。
...ShellListView
uses節にShellCtrlsを追加する。（自動的。他フォームからの参照時には手入力）
AutoNavigateプロパティ
Trueならダブルクリックでディレクトリを更新する。Falseならしない。
ObjectTypesプロパティ-otFolders Trueならフォルダー表示する。Falseならしない。代入時は[]をつける。
ObjectTypesプロパティ-otNonFolders Trueならファイルを表示する。Falseならしない。代入時は[]をつける。
〜.PathName フルパス
〜.Display
フォルダ名／ファイル名のみ。
ShellListView1.SelectedFolder.PathName 選択中のファイルのパスが渡される。
ShellListView1.Folders[0].IsFolder TrueならディレクトリFalseならファイル
ShellListView1.Items.Count 選択アイテム数。
ShellListView1.RootFolder.PathName; 表示中のフォルダを文字列で返す。
注意：バグ
ShellTreeViewにはカレントフォルダを指定できないバグがあります。
本来なら、pathプロパティにフォルダ名を代入するだけで出来るはずなのですが、
指定をしても変化がありません。そのため、ソースを変更する必要があります。
C:\Program
Files\Borland\Delphi6\Demos\ShellControlsの
ShellCtrls.pasをテキストで開き、procedure
TCustomShellTreeView.SetPathを検索します。
FUpdating := True;とFUpdating :=
False;の行をコメントにします。
vclshlctrls.dpkを実行し、コンパイルします。
するとShellCtrls.dcuが出来ますので、これをC:\Program
Files\Borland\Delphi6\Libへ上書きします。
これでPathプロパティでカレントフォルダが指定できるようになります。
..ツールバーを利用する。
右クリックでボタンや、セパレータを作れる。
画像にはImagelistの右クリックで括られた画像インデックスを指定する。
ボタンの画像を一枚のビットマップから抜き出すには
img_tlbbtn:TImage;
imgl
:TImageList;
tlb :TToolbar;
procedure TForm1.tlb_aico;
var
i:integer;
begin
img_tlbbtn.Picture.LoadFromFile(ExtractFileDir(ParamStr(0))+'\skin.bmp');
for i:=0 to tlb.ButtonCount-1
do
begin
imgl.Add(img_tlbbtn.Picture.Bitmap,nil);
end;
end;
..ListBox，RichEdit
ListBox Lineごとの独立性が高いText。LineをItemとして扱い、直接編集はできない。
RichEdit HTML風の装飾やテーブル作成があるRichEdit。
FormコンポーネントのCaptionはタイトル文字となる。
メニューコンポーネントで、-（ハイフン）は仕切りを意味する。
..TPagecontrol
Styleをボタンにすると枠が消える。
.コンポーネントの動的生成
動的配列で、格納するコンポーネント型の変数を用意し、
その変数に生成したコンポーネントを格納する。
RichEdit: Array of TRichEdit;
//RichEdit型の変数を宣言。（動的配列）
SetLength(RichEdit,pages.PageCount);
//RichEdit型の配列をPageCount数まで増やす。
RichEdit[High(RichEdit)]:= TRichEdit.Create(self);
//SetLengthで確保した変数にインスタンスを代入する。
RichEdit[High(RichEdit)].Name:='RichEdit'+IntToStr(pages.PageCount);//特定Editを指定できるよう名前を付ける。
with RichEdit[High(RichEdit)] do
//コンテナのスタイルを変更
begin
Parent:=self;
//生成物の格納先を指定する。必須。
end;
{Parentプロパティが読み込み専用等で代入できない場合。
RemoveControl(子オブジェクト);
親オブジェクト.InsertControl(子オブジェクト);
で格納できる。
また、List系ならAddメソッドで親から子を指定することも出来る。}
RichEdit[High(RichEdit)].OnKeyUp:=RichEdit0keyup;
//イベントなど・・・
↓
procedure TForm1.RichEdit0keyup(Sender: TObject; var
Key: Word;
Shift:
TShiftState);
begin
TRichEdit(Sender).Font.Size:= ........
end;
→破棄処理
procedure TForm1.FormDestroy(Sender:
TObject);
var i:integer;
begin
for i:=High(RichEdit) downto
Low(RichEdit) do
//RichEdit最大値が最小値になるまでループ
begin
RichEdit[i].free;
end;
..タブ付きページの動的生成
上の流れでタブエディタを作ります。
private
procedure
NewPageCreate;//TForm1内のみ有効の手続きを宣言。
function CurrentEdit:
TRichEdit;//TForm1内のみ有効の関数を宣言。
implementation
var
SheetCount:
integer;//シート数を数えるための変数。
〜〜〜〜〜〜〜〜〜〜〜〜〜〜
{新規ページ作成}
procedure
TForm1.NewPageCreate;//privateの手続きを指定。
var
TabSheet:
TTabSheet;//TabSheet型の変数を宣言。
RichEdit:
TRichEdit;//RichEdit型の変数を宣言。
begin
//シート作成
Inc(SheetCount);//SheetCountに
+1
TabSheet:=TTabSheet.Create(Self);//自分自身(Form)をオーナとしてTabSheetを生成します。
TabSheet.Name:='TabSheet'+IntToStr(SheetCount);//特定Pageを指定できるよう名前を付ける。
TabSheet.Caption:='新規シート'+IntToStr(SheetCount);
TabSheet.PageControl:=PageControl1;//TabSheetの格納先にPageControl1を指定します。
//RichEdit作成
RichEdit:=TRichEdit.Create(Self);//自分自身(Form)をオーナとしてRichEditを生成します。
RichEdit.Name:='RichEdit'+IntToStr(SheetCount);//特定Editを指定できるよう名前を付ける。
RichEdit.Align:=alClient;
RichEdit.Parent:=TabSheet;
RichEdit.Lines.Clear;
PageControl1.ActivePage:=TabSheet
end
コメント：オブジェクトインスペクタで"＋"を持ってるオブジェクトが親。
その"＋"を展開して出てくるオブジェクトが子になる。
ちなみに"Application"は全てのオブジェクトの親にあたる。
他のフォームから参照する場合はPraivateを消して、
オーナをApplicationにすれば動く･･･と思う。
function TForm1.CurrentEdit:
TRichEdit;//現在のRichEditを検索。(RichEdit1〜nを返す)
var
Found:
TComponent;
begin
Found:=FindComponent('RichEdit'+IntToStr(PageControl1.ActivePage.PageIndex+1));
//RichEditコンポーネントがあればそのクラス型を返す。
if
Found is TRichEdit then
Result:=Found as TRichEdit
//上位クラス型のオブジェクト変数(object)を下位クラス型(TRichEdit)として使用。(型キャスト)
else
Result:=nil;
end;
{ページ切り替え}
procedure TForm1.PageControl1Change(Sender:
TObject);
begin
Caption:=Form1.Caption+' '+CurrentEdit.Hint;
//Formタイトルにテキストタイトルを反映。保存時にはHintに名前を代入するので。
end;
{開くメニュー}
procedure TForm1.Open1Click(Sender:
TObject);
begin
if OpenDialog1.Execute then
begin
NewPageCreate;
CurrentEdit.Lines.LoadFromFile(OpenDialog1.FileName);
CurrentEdit.Hint:=OpenDialog1.FileName;
PageControl1.ActivePage.Caption:=ExtractFileName(OpenDialog1.FileName);
Caption:=CurrentEdit.Hint;
end;
end;
{上書き保存メニュー}
procedure TForm1.Save1Click(Sender:
TObject);
begin
if FileExists(CurrentEdit.Hint) then
CurrentEdit.Lines.SaveToFile(CurrentEdit.Hint)
else
SaveAs1Click(Sender);
end;
{名前を付けて保存メニュー}
procedure TForm1.SaveAs1Click(Sender:
TObject);
begin
if SaveDialog1.Execute then
begin
CurrentEdit.Lines.SaveToFile(SaveDialog1.FileName);
CurrentEdit.Hint:=SaveDialog1.FileName;
PageControl1.ActivePage.Caption:=ExtractFileName(SaveDialog1.FileName);
Caption:=CurrentEdit.Hint;
end;
end;
{終了メニュー}
procedure TForm1.Exit1Click(Sender:
TObject);
begin
Close;
end;
end.
.取得■自分の名前
Application.ExeName
.取得■Sender
の値
showmessage(sender.ClassName);
でSenderが何かを調べることができます。
.取得■デスクトップ領域
SystemParametersInfo(SPI_GETWORKAREA, 0, @result, 0);
第一引数に
SPI_SETDESKWALLPAPER ：壁紙をセットします。第三引数にnullで終わるビットマップのフルパスへのポインタを指定します。空を渡すと壁紙が表示されなくなる。
取得■画面解像度
Caption := Format('%d
x %d', [Screen.Width,
Screen.Height]);
----------------------------------------------------
TScreenのプロパティであるWidth,Heightに格納されています。
あらかじめインスタンスされたグローバル変数です。
.取得■現在時刻
Date関数/*日付を返す*/、Time関数/*時刻を返す*/、Now関数/*日付と時刻を返す*/
DatetoStr(Date); //日付を文字列に変換
DateTimeToStr(Now);
//Now関数から日付を文字列に型変換
----------------------
TimeToStr(Now);
//Now関数から時刻をを文字列に型変換
---------------------------------------
caption:=
FormatDateTime('yyyy/mm/dd (aaa)
hh:nn:ss',Now);
//Now関数からユーザー定義（Format）形式で表す。
----------------------------------------------
DayOfTheWeek(Now);
//Now関数から曜日を1〜7の数字で取得します。1が月曜日です
NOW関数を使う。表示にはそれぞれ別の関数が必要になる。
なお、Dattostrなどで型キャストするときはShortdateformatで形式を決めて置く！
ShortdateFormat
:= 'yy/mm/dd';
e_jikan.Text:= FormatDateTime('hh:nn',time);
.スクロールバーの表示・非表示
SB_BOTH ウィンドウの水平と垂直のスクロール バーを指定します。
SB_HORZ
ウィンドウの水平スクロール バーを指定します。
SB_VERT ウィンドウの垂直スクロール バーを指定します。
通常は onPaint
イベントに書く。
procedure TForm1.ListView1AdvancedCustomDraw(Sender:
TCustomListView;
const ARect: TRect; Stage: TCustomDrawStage; var
DefaultDraw:
Boolean);
begin
ShowScrollbar(ListView1.Handle,SB_HORZ,False);
end;
procedure TForm1.ListView1Resize(Sender:
TObject);
begin
ShowScrollbar(ListView1.Handle,SB_HORZ,False);
end;
SetWindowLong(Form1.lsv_past.Handle,GWL_STYLE,GetWindowLong(lsv_past.Handle,
GWL_STYLE) and (not WS_HSCROLL));
ウィンドウスタイルに WS_HSCROLL や WS_VSCROLL
を加えるとウィンドウ作成時に同時作成される｡
消す場合は逆に上記をウィンドウスタイルからはずす。
.popupを抑止する。
autopopupをfalseにする。
.Record型の読み書き
Windows のアプリケーションなら Loop するとき
Application.ProcessMessages を忘れずに。
{読み込む時}
begin
dataList: =
TList.Create; //TList オブジェクトはポインタの配列を格納します
assignfile(f,
ChangeFileExt(ParamStr(0),'.txt'));
reset(f);
while Eof(f)
do
begin
New(r);
read(f,r^);
dataList.Add(r);
Application.ProcessMessages;
end;
Closefile(f);
end;
{書き込む時}
begin
assignfile(f,
ChangeFileExt(ParamStr(0),'.txt'));
rewrite(f);
for i := 0
to dataList.Count -1 do
begin
r :=
dataList.Items[i];
write(f, r^);
dispose(r);//レコードの領域開放
Application.ProcessMessages;
end;
Closefile(f);
dataList.Free;
end;
var
FileStream :
TFileStream;
Record : TRecord;
AFileName:
TFileName;
{読み込む時}
Filestream:=
TFileStream.Create(AFileName,fmCreate);
try
if Assigned(Record) then
begin
FileStream.WriteComponent(Record);
finally
Filestream.Free;
{書き込む時}
FileStream :=
TFileStream.Create(AFileName,fmOpenRead);
try
FileStream.ReadComponent(Record);
finally
FileStream.Free;
Memo1.Lines.Add(Record.property);//読出したデータを表示
FreeAndNil(Record);//recordの破棄
end;
.クリップボード操作。
uses節に 「Clipbrd」を追加します。
Clipboard.AsText (プロパティ)を使います。
テキストをクリップボードに書き込むには
Clipboard.AsText := Edit1.Text;
クリップボードのテキストを読み込むには
Edit1.Text := Clipboard.AsText;
Clipboard.Assign （メソッド）を使います。
Bitmapデータをクリップボードにコピーするには
Clipboard.Assign(Image1.Picture);
クリップボードのBitmapデータを読み込むには
Image1.Picture.Assign(Clipboard);
uses節に 「Clipbrd, ActiveX,
Exploror_ClipbrdDrops」を追加します。
下記ソースをExploror_ClipbrdDrops.pasで保存。
//
****************************************************
//
Exploror_ClipbrdDrops
//
// エクスプローラーの貼り付け、切り取り は
//
クリップボードとやりとりしているので、
// そこからデータをもらってくる関数です。
//
ファイルの名前と動作を取得します。
// 移動などの操作は、別に記述する必要があります。
//
****************************************************
unit Exploror_ClipbrdDrops;
interface
uses Windows , Classes ,SysUtils
,ShlObj,Clipbrd ,ShellAPI;
function ClipboardFromFiles(var AFlag:Word) :
string;
function FilesToClipboard( Handle:HWND; AFiles : string; Flag:Word) :
boolean;
implementation
function ClipboardFromFiles(var
AFlag:Word) : string;
var
MyHandle :
THandle;
hDrop : Pointer;
nFiles , i
: Integer;
Buf : array[0..MAX_PATH+500] of
Char;
FileListsText : String;
dwEffect : Word;
CF_DROPEFFECT : UINT;
begin
Result := '';
AFlag := 0;
if Not
(Clipboard.HasFormat(CF_HDROP)) then
Exit;
MyHandle :=
Clipboard.GetAsHandle(CF_HDROP);
if MyHandle <> 0
then hDrop := Windows.GlobalLock(MyHandle);
if
hDrop <> nil then
try
nFiles :=
DragQueryFile(Integer(hDrop) , $FFFFFFFF, nil,
0);
for i := 0 to nFiles-1
do
begin
DragQueryFile(Integer(hDrop) , i, Buf,
SizeOf(Buf)-1);
if
(i=0)
then
FileListsText :=
Buf
else
FileListsText := FileListsText + #13#10+
Buf;
end;
Result :=
FileListsText;
finally
if MyHandle <>0 then
GlobalUnlock(MyHandle);
end;
CF_DROPEFFECT :=
RegisterClipboardFormat(CFSTR_PREFERREDDROPEFFECT);
if
Clipboard.HasFormat(CF_DROPEFFECT) then
begin
MyHandle := Clipboard.GetAsHandle(CF_DROPEFFECT);
if
MyHandle <>0 then
begin
hDrop :=
Windows.GlobalLock(MyHandle);
try
dwEffect :=
PWord(hDrop)^;
finally
if MyHandle
<>0 then GlobalUnlock(MyHandle);
end;
end;
end;
AFlag :=
dwEffect;
end;
function FilesToClipboard( Handle:HWND; AFiles : string;
Flag:Word) : boolean;
var
StrList : TStringList;
i , TotalBufSize
: integer;
Word_Pointer :
PWord;
dfs :
DROPFILES;
hDrop :
HGLOBAL;
pDrop :
PChar;
hDropEffect :
HGLOBAL;
CF_DROPEFFECT :
UINT;
MemError : Boolean;
begin
Result := False; MemError := False;
//CF_HDROPを作成
FillChar(dfs,sizeof(DROPFILES),#0);
StrList :=
TStringList.Create;
if (Length(AFiles)>0) then
try //
ここから下は １ 個以上でないと中に入れない♪
StrList.Text :=
AFiles;
dfs.pFiles := sizeof(dfs);
// PChar (* Char) なので、最後のnullも足す
// 総テキスト
バッファのサイズ計算。
for i:= 0 to StrList.Count-1
do
if i=0
then
TotalBufSize :=
Length(StrList.Strings[i])+1
else
Inc(TotalBufSize,
Length(StrList.Strings[i])+1);
Inc(TotalBufSize); //
文字列ポインタの最後のnull用 ** Char
//
メモリを確保
hDrop := GlobalAlloc(GHND,
sizeof(DROPFILES)
+
TotalBufSize);
// GHND = GMEM_MOVEABLE
or MEM_ZEROINIT
//
nullで初期化指定なので、ポンポン放り込むだけ♪
pDrop :=
GlobalLock(hDrop);
if (hDrop<>0)
then
try
try
//
メモリを丸ごとコピー
System.Move(dfs , pDrop^ ,
sizeof(DROPFILES));
//
文字列配列ポインタの最初へ移動
pDrop := Ptr(Integer(pDrop) +
sizeof(DROPFILES));
for i := 0 to
StrList.Count-1 do
begin
StrCopy(pDrop ,
PChar(StrList.Strings[i]));
// ポインタを次の文字列の先頭に移す
pDrop :=
Ptr(Integer(pDrop)+(Length(StrList.Strings[i])+1));
end;
except
MemError :=
True;
end;
finally
GlobalUnlock(hDrop);
end;
//Preferred
DropEffectを作成
try
hDropEffect := GlobalAlloc(GHND,
sizeof(DWORD));
Word_Pointer :=
GlobalLock(hDropEffect);
Word_Pointer^ :=
Flag;
GlobalUnlock(hDropEffect);
except
MemError :=
True;
end;
//クリップボードにデーターをセット
if Not(MemError)
then
CF_DROPEFFECT :=
RegisterClipboardFormat(CFSTR_PREFERREDDROPEFFECT);
if
Not(MemError) then
if
Not(OpenClipboard(Handle)) then
begin
//
ロックされていてクリップボードが使えないので
// 操作の取り消し
MemError :=
True;
end
else
try
EmptyClipboard();
MemError
:= False; //
必要ないけど念のため
SetClipboardData(CF_HDROP,
hDrop);
SetClipboardData(CF_DROPEFFECT,
hDropEffect);
Result :=
True;
finally
CloseClipboard();
end;
if MemError
then
begin //
メモリ操作で違反を起こしたので解放して終了
if hDrop>0 then
GlobalFree(hDrop);
if hDropEffect>0
then GlobalFree(hDropEffect);
end
finally
StrList.Free;
end;
end;
end.
すると下記関数が使えるようになります。
function
ClipboardFromFiles(var AFlag:Word) : string;
// 使用例:
// S := ClipboardFromFiles(AFlag);
// if (AFlag and
DROPEFFECT_COPY)>0 then ...
function FilesToClipboard( Handle:HWND; AFiles
: string; Flag:Word) : boolean;
// 使用例:
//
FilesToClipboard(Handle,'C:\WINDOWS\シャボン.bmp', DROPEFFECT_LINK);
// FilesToClipboard(Handle, Memo1.Text , DROPEFFECT_COPY);
// FilesToClipboard(Handle, Memo1.Text , DROPEFFECT_COPY or
DROPEFFECT_LINK);
{ AFlag 複数の場合は
or でつなげる。
DROPEFFECT_COPY
DROPEFFECT_MOVE
DROPEFFECT_LINK
}
..クリップボード履歴
private
{ Private 宣言
}
FChainNextWindow: HWND;
procedure ClipboardChanged(var msg: TWMDrawClipboard); message
WM_DRAWCLIPBOARD;
procedure
ClipboardChainChanged(var msg: TWMChangeCBChain); message WM_CHANGECBCHAIN;
procedure TForm1.ClipboardChainChanged(var msg:
TWMChangeCBChain);
begin
{
自分の次が削除された時、削除された次を自分の次に更新します。
}
if
(FChainNextWindow = msg.Remove) then
FChainNextWindow := msg.Next;
inherited;
end;
procedure TForm1.ClipboardChanged(var msg:
TWMDrawClipboard);
begin
inherited;
try
If Clipboard.AsText<>'' then
begin
If form1.lsb.Items.IndexOf(Clipboard.AsText)=-1
then
Form1.lsb.Items.Add(Clipboard.AsText);
If
lsb.Items.Count>20 then
lsb.Items.Delete(0);
end;
except
exit;
end;
Perform(WM_VSCROLL,SB_THUMBTRACK,lsb.Count-1);
SendMessage(FChainNextWindow, msg.Msg, 0, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FChainNextWindow :=
SetClipboardViewer(Handle);
end;
procedure TForm1.FormDestroy(Sender:
TObject);
begin
ChangeClipboardChain(Handle,
FChainNextWindow);
end;
.オブジェクトの表示非表示
｛オブジェクト名｝.Show;
//オブジェクトを表示する
｛オブジェクト名｝.Hide;
//オブジェクトを非表示にする
.ヒントボックスのカラーを変える。
TApplication.HintColor：TColor
注意：TApplicationはpublishedなプロパティを持たないため、
設計時にヒントボックスのカラーを設定することは出来ない。
.音を鳴らす
警告音は Beep;
サウンド再生にはAPI関数を使います。Usesにmmsystemを追加しておく。
◇wav再生
PlaySound(PChar(ChangeFileExt(ParamStr(0),'.wav')),0,SND_ASYNC);
-----------------------------
第１引数に再生対象のファイルフルパスを指定します。
(上記ではexeディレクトリにあるexe名と同じwavを鳴らします。）
第３引数には下記フラグを使います。
SND_SYNC
演奏が終了するまで、制御は戻りません。
SND_ASYNC 演奏を開始すると、制御が戻ります。
SND_NODEFAULT
指定したファイルが無い場合、何もせず戻ります。
SND_LOOP 繰り返し演奏します。
SND_NOSTOP
既に他の演奏がされている場合、何もせず戻ります。
サウンドを停止したい時は、第１引数に nil を指定して PlaySound 関数を実行します。
◇mid再生
mciSendString('play
test.mid',nil,0,0);
mciSendString("close
test.mid",nil,0,0);
---------------------------------------
mciSendStringはMCI（Multimedia
Control
Interface）にコマンドを投げるAPIです。
第一引数は送信するコマンド。
第二引数はMCIの状態を格納する文字列変数を指定
第三引数は第二引数の文字列の長さを指定
第四引数はMCIのメッセージを受け取るウィンドウハンドル。
openコマンドに'alias'オプションをつけることでファイル変数の関連付けが出来る。
スペースを含むファイルパスも正常に受け取れるよう、必ずダブルコーテーションで括りましょう。
mciSendString('open "test.mid" alias music',nil,0,0);
//以後、musicで扱うことが出来る。
mciSendString('play music',nil,0,0);
基本的には第一引数にPlay、半角、ファイルパスを渡すだけで再生できる。
しかし、スペースを含むファイルパスは再生できないので、その場合はopenオプションのaliasを使いましょう。
拡張子が関連付けされていない可能性があるファイルはopenオプションのtypeが必要になります。
どの拡張子がどのデバイスタイプで再生可能かは、Windows\win.iniに記述があります。
mciSendString('open test.mp3 type Mpegvideo alias
mp3',nil,0,0);
mciSendString('open "test.mid" type Sequencer alias
music',nil,0,0);
◇代表的なコマンド（NAMEはファイル名又はデバイス名。）
stop NAME
演奏を中止する
play NAME repeat 音楽をループ演奏する
pause NAME 音楽を一時停止する
seek NAME to POS
演奏位置をPOSに変更する
status NAME length 演奏の長さを求める
status NAME position 曲の演奏位置を求める
set NAME time format
milliseconds nnnnnn ミリ秒単位の数字指定
set NAME time format
ms nnnnnn ミリ秒単位の数字指定
set NAME time format
msf mm:ss:ff 分:秒:コンマ秒の形式
set NAME time format
tmsf tt:mm:ss:ff トラック番号:分:秒:コンマ秒の形式
'set cd time format tmsf'
'seek cd to
3:00:00:00' //これでトラック３の先頭にシークします。
.ダイアログ
ShowMessageで簡単な文字ダイアログを表示する。
拡張ポップアップダイアログはMessageDlgを使う。
if
MessageDlg('文字'+#13#10 改行+''コーティション表示'',アイコンタイプ,[ボタン種類(列 挙型),mbYes],help) =
mrYes
then
//第一引数は文字。+#13#10+で改行。''でシングルコーティションを表示できます。
//第二引数はダイアログタイプ。確認や警告、エラーなどのタイプがある。
//第三引数はダイアログに載せるボタン。列挙型で、,で複数指定できる。
//第四引数はヘルプ。使わないときは0を入れる。
//MessageDlgは、mr＋押したボタンを返す。if判定でmr値によって処理を分ける。
ダイアログにアクセス
Dialog
if
OpenDialog.Execute then
Image1.Picture.LoadFromFile(OpenDialog.FileName);
LoadFromFile
;ファイルをメモリ上に読み込む。
CheckBox
//ガンマ補正タイプを設定（「False」プラス／「True」マイナス）
GammaType := CheckBox1.Checked;
if GammaType <><>
True
then
Popupmenu
オブジェクトのpupupmenuプロパティを有効にしてください。
Checkedプロパティを使うとＧＵＩにチェックが付きます。
.プログラムの情報の表示
AboutBoxを作ります。新規作成、Formから、バージョン情報を選択してください。
.べき乗を使う。
usesにmathを追加し、power関数を使う。
power(2,3); ←2の3乗
.一定時間ごとに動作する
タイマーコントロールコンポーネントを使う。
Intervalプロパティで動作する時間の間隔を決める。
.一部を半透明化
力技で一部のみを半透明化にします。（オススメしない・・・）
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle,
GWL_EXSTYLE) or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle, 0,
Byte(196),
2);
上記コードを使うと、半透明化できますが、Form全体が半透明になり、一部のみを半透明化することが出来ません。
しかし、LWA_COLORKEYを利用する事で、Formを２つ重ねて一部のみが半透明になったかのように見せることが出来ます。
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or
WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle, clRed, Byte(196),
1);
半透明にしたいコンポーネントの背景色をLWA_COLORKEYにして、完全な透明にします。（上のコード）
もう一つフォームを作り、LWA_ALPHAで半透明にします。そして、そのフォームを半透明にしたいコンポーネントの背景と全く同じ
大きさにすることで部分的に半透明にすることが可能。
.実数を整数に切捨て
Trunc();
タブ付きページを作る
新規作成でフォームから、タブ付きページを選ぶ。
.判定を反転させる
：= Not
判定対象；
Jpegファイルを扱う
Uses節にJpegを加える。
.描画のちらつきを抑える。
普通ウィンドウはWM_ERASEBKGNDメッセージを受け取ると、画面を一度消します。
こうする事で以前の残像が重なった崩れた画面になるのを防いでいます。
しかし、同じ描写をする場合、画面がちらつくだけです。
ちらつきを止めるにはこのメッセージを受け取っても無視するようにします。
WM_ERASEBKGNDは成功すると0をWindowsに返します。
つまり、画面が消される前に0を返すことでWindowsをだます事が出来ます。
宣言部
procedure WMERASEBKGND(var
Msg:TMessage);message WM_ERASEBKGND;
実行部
procedure TForm1.WMERASEBKGND(var
Msg:TMessage);
begin
msg.Result:=0;
end;
描画停止：SendMessage(memo1.Handle,WM_SETREDRAW, 0,
0);
描画開始：Sendmessage(memo1.Handle,WM_SETREDRAW, 1,
0);
memo1.Refresh;