トップページへ
Delphi Tips

■2つのStringGridの連動スクロール

■ComboBoxでオーナードローをする

■IEのバージョンを取得する

■2重起動の防止

■ListBoxで文字などを色付けする

■マイドキュメントフォルダなどのパス取得

■ListViewのItemのDataプロパティを活用する

■フォームに背景を付ける

■マウスがコントロールに入るイベントと抜けるイベント

■タイトルバーをダブルクリックしたときにイベント

■Enterキーで次のコントロールに移動する

■ドライブの種類を判別する

■トラックバーの形を変える

■日付から星座を取得する関数

■他のアプリケーションを起動し、終了するまで待つ

■経過時間の計算

■ファイルのダウンロード関数

■グラデーション描画関数

■TSpeedButtonでボタンが下がった時と上がった時のイメージを変更する

■エクスプローラーからファイル名をドラッグ&ドロップで取得

■TComboBoxの縁の描画を取り除く

■TCheckBoxとTRadioButtonのスタイルを変更する

■複数のキーが押された時に処理を実行する

■メモ帳に文字を打ち込む

■マウスカーソルの表示・非表示

■タイトルバーを使用しないでフォームの移動

■マウスカーソルの下のコントロール名を取得する

■マウスの移動範囲を限定する

■BalloonTipを表示する

■バイナリを数値に変換する関数

■16進をバイナリに変換する関数

■StringGridですべての列幅を自動調整する関数

■StringGridで特定のセルを編集不可・可にする

■StringGridで特定の行を削除する

■ログイン名を取得する関数

■コンピュータ名を取得する関数

■BMP画像を暗号化・複合化する関数

■ComboBoxの開閉するコード

■CheckBoxのスタイル変更

■Excelの操作

■Panelに穴を開ける

■RichEditに余白をつける

■ランダムなパスワードを作成する関数

■文字列を反転させる関数

■PageControlのタブシートをドラッグ&ドロップで順番を変更する

■PageControlのタブの部分のクリックイベントを取得

■PageControlのタブシートを実行時に増やす

■StringGridで右寄せ表示

■トラックバーの形を変更する

■簡単に暗号化・複合化する

■ProgressBarの色を変更する

■ListViewに行毎の色を付ける

■Editの入力制限

■ComboBoxのドロップダウンリストの幅の変更

■月日を加算減算する

■実行処理速度を計測する

■ボタンの二重クリック禁止

■ランダムなパスワードを生成する関数

■ファイルをゴミ箱に削除する

■流れる文字を出力する



流れる文字を出力する

1.TTimerとTImageをFormに貼り付けてください。 2.フォームの変数宣言で private { Private 宣言 } panelMoveX:integer; panelStr:string; を宣言してください。 3.TTimerのOnTimerイベントで下記のソースを入力して実行してください

procedure TForm1.Timer1Timer(Sender: TObject); begin PanelStr := 'ABC'; //出力文字列 PanelMoveX := PanelMoveX - 1; //移動量計算 if (Image1.Canvas.TextWidth(PanelStr) + PanelMoveX < 0) then PanelMoveX := Image1.Width; with Image1.Canvas do begin Brush.Color := clBlack; Font.Color := clWhite; Font.Size := 8; Font.Name := 'MS ゴシック'; FillRect(ClientRect); TextOut(ClientRect.Left + PanelMoveX, ClientRect.Top + 5, PanelStr ); end; end;

ファイルをゴミ箱に削除する

uses に ShellApi を追加してください。 処理は[C:\sample.txt]をゴミ箱に削除します。

var FOS : TSHFileOpStruct; saFileName : AnsiString; begin saFileName := 'C:\sample.txt'; FillChar(FOS, SizeOf(FOS), 0); with FOS do begin wFunc := FO_DELETE; pFrom := PChar(saFileName); fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT; end; ShFileOperation(FOS); end;

ランダムなパスワードを生成する関数

function RandomPassword(PassWordLen: Integer): string; var str: string; begin Randomize; //パスワード生成に使用する文字列 str := 'abcdefghijklmnopqrstuvwxyz1234567890'; Result := ''; repeat Result := Result + str[Random(Length(str)) + 1]; until (Length(Result) = PassWordLen) end;

ボタンの二重クリック禁止

Application.ProcessMessagesがミソです

try Button1.Enabled := False; Memo1.Lines.Add('AAA'); sleep(2000); finally Application.ProcessMessages; Button1.Enabled := True; end;

実行処理速度を計測する

procedure TForm1.Button2Click(Sender: TObject); var Start:integer; begin Start := GetTickCount;//スタート時間を取得 {***** 計測したい処理 *****} Caption := (IntToStr(GetTickCount - Start) + '(ms)'); end;

月日を加算減算する

TDate型に1を足すと日が加算され、 月を加算するには IncMonth関数を使用して加算します 1を指定すれば一ヶ月後、-1を指定すれば一ヶ月前を求めることができます

var dateToday :TDate; begin dateToday := Now; dateToday := IncMonth(dateToday, -2); // 2ヶ月前 Caption := DateToStr(dateToday); end;

ComboBoxのドロップダウンリストの幅の変更

procedure TForm1.Button1Click(Sender: TObject); begin //ドロップダウンリストの幅を2倍にします Combobox1.Perform(CB_SETDROPPEDWIDTH,Combobox1.width * 2,0); end;

Editの入力制限

EditのKeyPressイベントに下記を追加します。 AcceptStrには許可する文字列を入れます。 以下の例はバックスペースと数値のみに制限しています。

procedure TForm1.EditFromKeyPress(Sender: TObject; var Key: Char); var AcceptStr:string; begin AcceptStr := '0123456780.'; if (Pos(Key,AcceptStr)=0) and (Ord(Key) <> VK_BACK) then Key := #00 else Key := Key; end;

ListViewに行毎の色を付ける

ListViewのAdvancedCustomDrawItemイベントに 下記のコードを追加してください

procedure TForm1.ListView1AdvancedCustomDrawItem( Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage; var DefaultDraw: Boolean); begin //***奇数行の時色付け***// if Odd(Item.Index) then Sender.Canvas.Brush.Color := clBlue; end;

ProgressBarの色を変更する

1.Uses節にCommCtrlを追加します。 2.Buttonを貼り付けてください 3.下記のコードを追加してください

procedure TForm1.Button1Click(Sender: TObject); begin // ProgressBar背景色 Progressbar1.Brush.Color := clBtnFace; // ProgressBarのバーの色 SendMessage(ProgressBar1.Handle, PBM_SETBARCOLOR, 0, clBlue); end;

簡単に暗号化・複合化する

下記のコードのStrに暗号化又は、複合化したい文字列を入れると 返り値にその結果が返ってきます。

function Encode(Str:string):string; var P:PChar; i:integer; begin Result := ''; P := PChar(Str); for i := 0 to Length(P)-1 do begin Result := Result + Chr(Ord(P[i]) xor 23); end; end;

トラックバーの形を変更するる

var il : Longint; begin with TrackBar1 do begin il := GetWindowLong(Handle, GWL_STYLE) and (not $20); SetWindowLong(Handle, GWL_STYLE, il); end; end;

StringGridで右寄せ表示

StringGridのOnDrawCellイベントで下記のコードを追加してください

procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; State: TGridDrawState); begin StringGrid1.Canvas.FillRect(Rect); Rect.Top := Rect.Top + 2; DrawText(StringGrid1.Canvas.Handle, PChar(StringGrid1.Cells[Col,Row]), Length(StringGrid1.Cells[Col,Row]), Rect, DT_RIGHT) // DT_RIGHT=右寄せ end;

PageControlのタブシートを実行時に増やす

ButtonのClickイベントなどで下記のコードを追加するだけです

procedure TForm1.Button1Click(Sender: TObject); var TabSheet:TTabSheet; begin TabSheet := TTabSheet.Create(PageControl1); TabSheet.PageControl := PageControl1; TabSheet.Caption := '追加したタブシート'; end;

PageControlのタブの部分のクリックイベントを取得

PageControlのMouseDownイベントに下記のコードを追加してください

procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var MousePos:TPoint; HI:TTCHitTestInfo; ret:integer; begin if Button = mbLeft then begin //マウスカーソル位置の取得 GetCursorPos(MousePos); HI.pt := PageControl1.ScreenToClient(MousePos); ret := SendMessage(PageControl1.Handle,TCM_HITTEST,0,LParam(@HI)); if (HI.flags and TCHT_ONITEM) <> 0 then begin if PageControl1.ActivePageIndex=ret then begin ShowMessage(IntToStr(PageControl1.ActivePageIndex)); end; end; end; end;

PageControlのタブシートをドラッグ&ドロップで順番を変更する

PageControlのMouseDown,DragOver,DragDropに下記のコードを 追加してください。

procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin PageControl1.BeginDrag(false); end; procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin if Sender is TPageControl then Accept := true; end; procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); var i: Integer; r: TRect; begin if not (Sender is TPageControl) then Exit; with PageControl1 do begin for i := 0 to PageCount - 1 do begin Perform(TCM_GETITEMRECT, i, LPARAM(@r)); if PtInRect(r, Point(X, Y)) then begin if i <> ActivePage.PageIndex then ActivePage.PageIndex := i; Exit; end; end; end; end;

文字列を反転させる関数

[説明]     文字列の反転 [引数] const S: string; [戻り値] string;

function ReverseStr(const S: string): string; var i : integer; S2: string; begin S2 := ''; for i := 1 to Length(S) do S2 := S[ i ] + S2; Result := S2; end;

ランダムなパスワードを作成する関数

[説明]     ランダムなパスワードを作成する [引数] パスワードの文字列数を指定します PLen: Integer [戻り値] string;

function GetRandomPassword(PLen: Integer): string; var str: string; begin Randomize; str := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'; Result := ''; repeat Result := Result + str[Random(Length(str)) + 1]; until (Length(Result) = PLen) end;

RichEditに余白をつける

下記のコードはボタンを押すとRichEdit1に余白がつきます

procedure TForm1.Button1Click(Sender: TObject); const BORDER_WIDTH = 20; var Rect: TRect; begin SendMessage(RichEdit1.Handle, EM_GETRECT, 0, Longint(@Rect)); Rect.Top := BORDER_WIDTH; Rect.Left := BORDER_WIDTH; Rect.Right := RichEdit1.Width - BORDER_WIDTH; Rect.Bottom := RichEdit1.Height - BORDER_WIDTH; SendMessage(RichEdit1.Handle, EM_SETRECT, 0, Longint(@Rect)); RichEdit1.Refresh; end;

Panelに穴を開ける

PanelとButtonを用意してButtonのClickイベントに下記の コードを入れて実行してください。

procedure TForm1.Button1Click(Sender: TObject); var region1, region2: hrgn; begin region1 := CreateRectRgn(0, 0, Panel1.Width, Panel1.Height); region2 := CreateEllipticRgn(10, 10, 150,150); CombineRgn(region1, region1, region2, RGN_DIFF); SetWindowRgn(Panel1.Handle, region1, True); end;

Excelの操作

private部にこれを宣言してください private { Private 宣言 } Excel : Variant; EApplication : Variant; WorkBook : Variant; WorkSheet : Variant;

//***** Excelの起動 *****// procedure TForm1.Button1Click(Sender: TObject); begin try Excel := CreateOleObject('Excel.Application'); except on EOleSysError do begin //起動失敗 ShowMessage('Excelが起動できません'); Excel := Null; Exit; end; end; Excel.Visible:= True; end; //***** Excelの終了 *****// procedure TForm1.Button3Click(Sender: TObject); begin Excel.DisplayAlerts := False;//メッセージダイアログを表示しない Excel.Quit; Excel := unAssigned; end; //***** 新規作成 *****// procedure TForm1.Button2Click(Sender: TObject); begin WorkBook := Excel.WorkBooks.Add; WorkSheet := WorkBook.WorkSheets[1]; WorkSheet.Activate; end; //***** その他の使用法 *****// //Sheetの選択 WorkSheet := WorkBook.Sheets[1].Select; //セル色変更 WorkSheet.Range['E3'].Interior.ColorIndex := 6; //セル選択 WorkSheet.Range['E3:E5'].Select; //幅自動調整[A-J] WorkSheet.Columns['A:J'].AutoFit; //Version情報取得 Label1.Caption := Excel.Version; Label2.Caption := Excel.OperatingSystem; //縦に分割 Excel.ActiveWindow.SplitColumn := 3; //横に分割 Excel.ActiveWindow.SplitRow := 3; //プリントプレビュー WorkSheet.PrintPreview; //特定のセル同士を足す Edit1.Text := WorkSheet.Range['A3'].Value + WorkSheet.Range['A4'].Value; //ファイルのロード Excel.WorkBooks.Open(ファイル名); ※便利なExcelを操作するクラスを作成しました。

CheckBoxのスタイル変更

FormのCreateイベントに下記のコードを追加してください

procedure TForm1.FormCreate(Sender: TObject); begin SetWindowLong(CheckBox1.Handle, GWL_STYLE, GetWindowLong(CheckBox1.Handle,GWL_STYLE) or BS_PUSHLIKE); end;

ComboBoxの開閉するコード

下記のコードを開閉したいイベントに追加してください

ComboBox1.Perform(CB_SHOWDROPDOWN, 1, 0); //開く場合 ComboBox1.Perform(CB_SHOWDROPDOWN, 0, 0); //閉じる場合

BMP画像を暗号化・複合化する関数

[説明]     BMP画像を暗号化・複合化する [引数] BMP: TBitmap // 画像を指定する Key: integer // 鍵を指定する [戻り値] なし

procedure EncryptBMP(const BMP: TBitmap; Key: integer); var BytesPorScan: Integer; w, h: integer; p: pByteArray; begin BytesPorScan := Abs(Integer(BMP.ScanLine[1]) - Integer(BMP.ScanLine[0])); RandSeed := Key; for h := 0 to BMP.Height - 1 do begin P := BMP.ScanLine[h]; for w := 0 to BytesPorScan - 1 do P^[w] := P^[w] xor Random(256); end; end;

コンピュータ名を取得する関数

[説明]     コンピュータ名を取得する関数 [引数] なし [戻り値] string

function GetComputerNameStr:string; var p : array[0..127] of Char; Buff:DWORD; begin Buff := 128; GetComputerName(p,Buff); Result := p; end;

ログイン名を取得する関数

[説明]     ログイン名を取得する関数 [引数] なし [戻り値] string

function GetLoginNameStr:string; var p : array[0..127] of Char; Buff:DWORD; begin Buff := 128; GetUserName(p,Buff); Result := p; end;

StringGridで特定の行を削除する

ボタンのクリックイベントで下記のソースを入力してください

procedure TForm1.Button1Click(Sender: TObject); var col,row: Integer; begin for col := 1 to StringGrid1.ColCount - 1 do begin for row := StringGrid1.Row to StringGrid1.RowCount - 1 do begin StringGrid1.Cells[col, row] := StringGrid1.Cells[col,row+1]; end; end; if StringGrid1.RowCount > 1 then StringGrid1.RowCount := StringGrid1.RowCount - 1; end;

StringGridで特定のセルを編集不可・可にする

StringGridのOnSelectCellイベントで下記のソースを入力してください

procedure TEnforcementForm.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); begin //3列目を編集不可にして、それ以外は編集可能にします if ACol = 3 then StringGrid1.Options := StringGrid1.Options - [goEditing] else StringGrid1.Options := StringGrid1.Options + [goEditing]; end;

StringGridですべての列幅を自動調整する関数

DefaultColWidthにはデフォルトの幅を指定します

procedure AutoSizeColumnSG(SG: TStringGrid;DefaultColWidth: integer); var ROW, COL, TmpColWidth, MaxColWidth:integer; begin for COL := 0 to SG.ColCount-1 do begin MaxColWidth := DefaultColWidth; for ROW := 0 to SG.RowCount-1 do begin TmpColWidth := SG.Canvas.TextWidth(SG.Cells[COL,ROW]) + 10; if MaxColWidth < TmpColWidth then MaxColWidth := TmpColWidth; end; SG.ColWidths[COL] := MaxColWidth; end; end;

16進をバイナリに変換する関数

【使用例】 Edit1.Text := HextoBin('FF');

function HextoBin(Hex:string):string; const BOX: array [0..15] of string = ('0000','0001','0010','0011', '0100','0101','0110','0111', '1000','1001','1010','1011', '1100','1101','1110','1111'); var i:integer; begin for i:=Length(Hex) downto 1 do Result:=BOX[StrToInt('$'+Hex[i])]+Result; end;

バイナリを数値に変換する関数

【使用例】 Edit1.Text := IntToStr( BinToInt('00001111') );

function BinToInt(Bin: String): Integer; var i,Len: Integer; begin Result := 0; Len := Length(Bin); for i := Len downto 1 do if Bin[i]='1' then Result := Result + (1 shl (Len-i)); end;

BalloonTipを表示す

【使用例】 procedure TForm1.Button1Click(Sender: TObject); begin ShowBalloonTip(Button1.Handle, 'hello world'); end;

procedure ShowBalloonTip(hWnd: THandle; Text: PWideChar); const TOOLTIPS_CLASS = 'tooltips_class32'; TTS_ALWAYSTIP = $01; TTS_NOPREFIX = $02; TTS_BALLOON = $40; TTF_SUBCLASS = $0010; TTF_TRANSPARENT = $0100; TTF_CENTERTIP = $0002; TTM_ADDTOOL = $0400 + 50; ICC_WIN95_CLASSES = $000000FF; type TToolInfo = packed record cbSize: Integer; uFlags: Integer; hwnd: THandle; uId: Integer; rect: TRect; hinst: THandle; lpszText: PWideChar; lParam: Integer; end; var hWndTip: THandle; TI : TToolInfo; begin hWndTip := CreateWindow(TOOLTIPS_CLASS, nil, WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP, 0, 0, 0, 0, hWnd, 0, HInstance, nil); if hWndTip <> 0 then begin SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); TI.cbSize := SizeOf(TI); TI.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS; TI.hwnd := hWnd; TI.lpszText := Text; Windows.GetClientRect(hWnd, ti.rect); SendMessage(hWndTip, TTM_ADDTOOL, 0, Integer(@TI)); end; end;

マウスの移動範囲を限定する

【解説】 GetWindowRect :ウインドウサイズを取得します ClipCursor ;マウスの移動範囲を設定します

procedure TForm1.Button1Click(Sender: TObject); var R :TRECT; begin //ウインドウサイズを取得 GetWindowRect(Form1.Handle,R); //マウスの移動範囲を限定する ClipCursor(@R); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin //解除します ClipCursor(nil); end;

マウスカーソルの下のコントロール名を取得する

TTimerを使用してマウスカーソルの下のコントロール名を取得します

procedure TForm1.Timer1Timer(Sender: TObject); var Comp : TComponent; P : TPoint; begin //マウス位置の取得 GetCursorPos(P); //コンポーネント名取得 Comp := FindDragTarget(P, True); if Comp <> nil then Label2.Caption := Comp.Name else Label2.Caption := ''; end;

タイトルバーを使用しないでフォームの移動

【解説】 ReleaseCapture : マウスキャプチャを解放します SendMessage : 指定ウインドウにメッセージを送ります

//フォームをドラッグアンドドロップで移動出来ます procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer); begin //マウス左ボタンが押されているときだけ処理実行 If ssLeft in Shift then begin ReleaseCapture; SendMessage(Form1.Handle, WM_NCLBUTTONDOWN, HTCAPTION,0); end; end;

マウスカーソルの表示・非表示

マウスカーソルの表示と非表示を行うAPIです
//マウスカーソル表示 ShowCursor(True); //マウスカーソル非表示 ShowCursor(False);

メモ帳に文字を打ち込む

1.フォームにTButtonを貼り付けそこのイベントに下記のソースを入力してください 2.作成したアプリを起動し、メモ帳も起動します。 3.Buttonを押すとメモ帳にStrに入れた文字列が記述されます
procedure TForm1.Button1Click(Sender: TObject); var WND: HWND; i: Integer; Str: string; begin WND := FindWindow('notepad', nil); if WND <> 0 then begin WND := FindWindowEx(WND, 0, 'Edit', nil); Str := 'TEST_MESSAGE'; //文字の送信 for i := 1 to Length(Str) do begin SendMessage(WND, WM_CHAR, Word(Str[i]), 0); end; //改行を行う PostMessage(WND, WM_KEYDOWN, VK_RETURN, 0); end; end;

複数のキーが押された時に処理を実行する

フォームのKeyDownイベントに下記のソースを入力してください
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (( GetKeyState(Ord('1')) and 128 ) = 128) and (( GetKeyState(VK_F7) and 128 ) = 128) and (( GetKeyState(VK_F5) and 128 ) = 128) then begin //ボタンが押された時の処理をここに記述 ShowMessage('3つのボタンが同時に押されました'); end; end;

TCheckBoxとTRadioButtonのスタイルを変更する

TCheckBoxを2個とTRadioButtonを3個貼り付けてフォームの Createイベントで下記のソースを入力してください
procedure TForm1.FormCreate(Sender: TObject); begin SetWindowLong(CheckBox1.Handle,GWL_STYLE, GetWindowLong(CheckBox1.Handle,GWL_STYLE)or BS_PUSHLIKE); SetWindowLong(CheckBox2.Handle,GWL_STYLE, GetWindowLong(CheckBox2.Handle,GWL_STYLE)or BS_FLAT); SetWindowLong(RadioButton1.Handle,GWL_STYLE, GetWindowLong(RadioButton1.Handle,GWL_STYLE)or BS_PUSHLIKE); SetWindowLong(RadioButton2.Handle,GWL_STYLE, GetWindowLong(RadioButton2.Handle,GWL_STYLE)or BS_PUSHLIKE); SetWindowLong(RadioButton3.Handle,GWL_STYLE, GetWindowLong(RadioButton3.Handle,GWL_STYLE)or BS_FLAT); end;

TComboBoxの縁の描画を取り除く

TComboBoxを1個貼り付けてフォームのCreateイベントで 下記のソースを入力してください
procedure TForm1.FormCreate(Sender: TObject); begin SetWindowRgn(ComboBox1.Handle, CreateRectRgn(2,2,ComboBox1.Width-2,ComboBox1.Height-2),True); end;

エクスプローラーからファイル名をドラッグ&ドロップで取得

usesにShellAPIを追加してください
private procedure DropFiles(var Msg:TWMDROPFILES); message WM_DROPFILES; procedure TForm1.FormCreate(Sender: TObject); begin DragAcceptFiles(Form1.Handle, True); end; procedure TForm1.DropFiles(var Msg:TWMDROPFILES); var i, DropedFileCount: integer; FileName: array [0..255] of Char; begin DropedFileCount := DragQueryFile(Msg.Drop, Cardinal(-1), nil, 0); for i := 0 to DropedFileCount-1 do begin DragQueryFile(Msg.Drop, i, FileName, SizeOf(FileName)-1); ListBox1.Items.Add(FileName); end; DragFinish(Msg.Drop); end;

TSpeedButtonでボタンが下がった時と上がった時のイメージを変更する
SpeedButtonのNumGlyphとNumGlyphsを活用する
1.縦16横64ピクセルの画像を作成します。  この時、左上のピクセルは透過色として使用される為、同じ色は透過となります 2.SpeedButtonのGlyphに作成した画像を指定すると内部的に4つに分割される画像になります  この時、NumGlyphsは4になります 3.起動してボタンを押した時などの変化を見てください  【ボタンの状態と内部イメージの関係】  最初のイメージはボタンが上がっている状態のイメージになり、  2番目のイメージはボタンが使用不可状態のイメージになり、  3番目のイメージはボタンが下がっている状態のイメージになり、  4番目のイメージはボタンが下がったまま状態のイメージになります。

グラデーション描画関数
グラデーションを描画する関数です
procedure GradHorizontal(Canvas:TCanvas;Rect:TRect;FromColor,ToColor:TColor); var X:integer; dr,dg,db:Extended; C1,C2:TColor; r1,r2,g1,g2,b1,b2:Byte; R,G,B:Byte; i:integer; begin try C1 := FromColor; R1 := GetRValue(C1); G1 := GetGValue(C1); B1 := GetBValue(C1); C2 := ToColor; R2 := GetRValue(C2); G2 := GetGValue(C2); B2 := GetBValue(C2); dr := (R2-R1) / Rect.Right-Rect.Left; dg := (G2-G1) / Rect.Right-Rect.Left; db := (B2-B1) / Rect.Right-Rect.Left; i := 0; for X := Rect.Left to Rect.Right-1 do begin R := R1+Ceil(dr*i); G := G1+Ceil(dg*i); B := B1+Ceil(db*i); Canvas.Pen.Color := RGB(R,G,B); Canvas.MoveTo(X,Rect.Top); Canvas.LineTo(X,Rect.Bottom); inc(i); end; except end; end; procedure GradVertical(Canvas:TCanvas;Rect:TRect;FromColor,ToColor:TColor); var Y:integer; dr,dg,db:Extended; C1,C2:TColor; r1,r2,g1,g2,b1,b2:Byte; R,G,B:Byte; i:integer; begin try C1 := FromColor; R1 := GetRValue(C1); G1 := GetGValue(C1); B1 := GetBValue(C1); C2 := ToColor; R2 := GetRValue(C2); G2 := GetGValue(C2); B2 := GetBValue(C2); dr := (R2-R1) / Rect.Bottom-Rect.Top; dg := (G2-G1) / Rect.Bottom-Rect.Top; db := (B2-B1) / Rect.Bottom-Rect.Top; i := 0; for Y := Rect.Top to Rect.Bottom-1 do begin R := R1+Ceil(dr*i); G := G1+Ceil(dg*i); B := B1+Ceil(db*i); Canvas.Pen.Color := RGB(R,G,B); Canvas.MoveTo(Rect.Left,Y); Canvas.LineTo(Rect.Right,Y); inc(i); end; except end; end;

ファイルのダウンロード関数
usesにUrlMonを追加してください
function DownloadFile(SourceFile, DestFile: string): Boolean; begin try Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0; except Result := False; end; end;

経過時間の取得
指定時間からある時間(分)が経過した後の時間の取得
function GetAfterTime(DistTime:TDateTime;AfterMin:WORD):TDateTime; var HH,MM:WORD; begin HH := AfterMin div 60; MM := AfterMin mod 60; Result := DistTime + StrToTime(IntToStr(HH)+':'+IntToStr(MM)+':00'); end;

他のアプリケーションを起動し、終了するまで待つ
ボタンイベントなどに下記のコードを入れて実行して下さい
var bo : Boolean; SI : TStartupInfo; PI : TprocessInformation; begin //自アプリのスタートアップ情報取得 GetStartupInfo(SI); //他アプリの起動 bo := CreateProcess(PChar('C:\WINNT\system32\notepad.exe'), nil, nil, nil, False, CREATE_DEFAULT_ERROR_MODE, nil, nil, SI, PI); if bo then begin while WaitForSingleObject(PI.hProcess, 0) = WAIT_TIMEOUT do begin Application.HandleMessage; end; end else ShowMessage('起動に失敗しました'); end;

日付から星座を取得する関数
日付から星座の文字列を取得する関数です
function GetSeizaStr(DistDate:TDateTime):string; var i:integer; MMDD:string; begin MMDD := FormatDateTime('MMDD',DistDate); i := StrToInt(MMDD); case i of 101..110 : Result := '山羊座'; 120..218 : Result := '水瓶座'; 219..320 : Result := '魚座es'; 321..419 : Result := '牡羊座'; 420..520 : Result := '牡牛座'; 521..621 : Result := '双子座'; 622..722 : Result := '蟹座'; 723..821 : Result := '獅子座'; 822..922 : Result := '乙女座'; 923..1023: Result := '天秤座'; 1024..1122: Result := '蠍座'; 1123..1221: Result := '射手座'; 1222..1231: Result := '山羊座' end; end;

トラックバーの形を変える
以下のソースコードをどこでもいいのでイベントに入れてください
var i:longint; begin with TrackBar1 do begin i := GetWindowLong(Handle,GWL_STYLE) and (not $20); SetWindowLong(Handle,GWL_STYLE,i); end; end;

ドライブの種類を判別する
Win32APIのGetDriveType関数を使用します。
case GetDriveType('C:\') of 0: ShowMessage('ドライブの種類が判断できません'); 1: ShowMessage('ルートディレクトリが存在しません'); 2: ShowMessage('フロッピーディスク、MOドライブです'); 3: ShowMessage('ハードディスクです'); 4: ShowMessage('ネットワークドライブです'); 5: ShowMessage('CD-ROMドライブです'); 6: ShowMessage('RAMディスクです'); end;

Enterキーで次のコントロールに移動する
EditのKeyPressイベントで下記のコードを記述
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then begin SendMessage(MyForm.Handle, WM_NEXTDLGCTL, 0, 0); Key := #0; end; if Key #0 then inherited KeyPress(Key); end;

タイトルバーをダブルクリックしたときにイベント
1.private部にコードを追加します。  private { Private 宣言 } procedure WMNCLBUTTONDBLCLK(var Msg: TWMNCLBUTTONDBLCLK);                  message WM_NCLBUTTONDBLCLK;  2.下記コードを追加し、実行します。
procedure TForm1.WMNCLBUTTONDBLCLK(var msg: TWMNCLBUTTONDBLCLK); begin if Msg.HitTest=HTCAPTION then ShowMessage('タイトルバーのダブルクリック'); inherited; end;

マウスがコントロールに入るイベントと抜けるイベント
 1.フォームにパネルを一つ追加します。 2.private部にコードを追加します。  private { Private 宣言 } procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER; procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;  3.下記コードを追加し、実行します。
procedure TForm1.CMMouseEnter(var Msg: TMessage); begin if TComponent(Msg.LParam) = Panel1 then Panel1.Caption := 'マウスが入った'; end; procedure TForm1.CMMouseLeave(var Msg: TMessage); begin if TComponent(Msg.LParam) = Panel1 then Panel1.Caption := 'マウスがぬけた'; end;

フォームに背景を付ける
 1.フォームのOnCreate/OnDestroyに下記のコードを記述します 2.bmpのLoadFromFileにBMPファイルを指定します。 3.フォームのOnPaintに下記のコードを記述して、実行します。
procedure TForm1.FormCreate(Sender: TObject); begin bmp := TBitmap.Create; bmp.LoadFromFile('なにかbmpファイルを指定する'); end; procedure TForm1.FormDestroy(Sender: TObject); begin bmp.Free; end; procedure TForm1.FormPaint(Sender: TObject); var iw,ih,w,h:integer; begin w := ClientWidth div bmp.Width +1; h := ClientHeight div bmp.Height +1; for ih := 0 to h-1 do for iw := 0 to w-1 do Canvas.Draw(bmp.Width*iw,bmp.Height*ih,bmp); end;

ListViewのItemのDataプロパティを活用する
 ListViewにはItemにそれぞれDataプロパティを持っています。  このDataプロパティは内部的に保持されている情報でいつでも引き出せます。
private SL:TStringList; procedure TForm1.FormCreate(Sender: TObject); var i, Index:integer; NewItem:TListitem; begin SL := TStringList.Create; for i := 0 to 20 do begin NewItem := ListView1.Items.Add; NewItem.Caption := IntToStr(i); Index := SL.Add(IntToStr(i)); NewItem.Data := Pointer(SL[Index]); end; end; procedure TForm1.FormDestroy(Sender: TObject); begin SL.Free; end; procedure TForm1.ListView1Click(Sender: TObject); begin if ListView1.Selected = nil then Exit; ShowMessage(ListView1.Selected.Caption+'<-->'+String(ListView1.Selected.Data)); end;

マイドキュメントフォルダなどのパス取得
 usesにShlObjを追加して下さい
function GetMyDocFolderPath: string; var PIDL: PItemIDList; PATH: array[0..MAX_PATH-1] of Char; begin SHGetSpecialFolderLocation(Application.Handle, CSIDL_PERSONAL, PIDL); SHGetPathFromIDList(PIDL, PATH); Result:=PATH; end; ※SHGetSpecialFolderLocationの第2引数を変えることで他のパスも取得出来ます。 ごみ箱 CSIDL_BITBUCKET デスクトップ CSIDL_DESKTOPDIRECTORY お気に入り CSIDL_FAVORITES マイドキュメント CSIDL_PERSONAL スタートメニューのプログラムフォルダ CSIDL_PROGRAMS 最近使ったファイル CSIDL_RECENT 送る CSIDL_SENDTO スタートメニュー CSIDL_STARTMENU スタートアップ CCSIDL_STARTUP

ListBoxで文字などを色付けする
 ListBoxのStyleプロパティをlbOwnerDrawFixedにします。  ListBoxのDrawItemイベントに下記コードを入れて実行する
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); begin try with TListBox(Control) do begin Canvas.Brush.Color := clInfoBk; Canvas.Font.Color := clRed; Canvas.Font.Style := []; Canvas.FillRect(Rect); Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]); end; except end; end;

2重起動の防止
 xxx.dprのファイルを以下のように変更する
program Project1; uses Forms, Windows, Main in 'Main.pas' {MainForm}; {$R *.res} var HWND,HAPP:THandle; begin Application.Initialize; HWND := FindWindow(nil,'アプリのタイトル'); if (HWND <> 0) then begin //アプリケーションのハンドルを取得 HAPP := GetWindow(HWND,GW_OWNER); if (IsIconic(HAPP)) then //アイコン化 -> 元サイズ OpenIcon(HAPP); //前面に移動 SetForegroundWindow(HAPP); end else begin Application.Title := 'アプリのタイトル'; Application.CreateForm(TMainForm, MainForm); Application.Run; end; end.

IEのバージョンを取得する
 uses節にRegistryを追加して下記の関数で取得出来ます。
function GetIEVersion: string; var R: TRegistry; begin R := TRegistry.Create; try R.RootKey := HKEY_LOCAL_MACHINE; R.OpenKey('Software\Microsoft\Internet Explorer', False); try Result := R.ReadString('version'); except Result := ''; end; R.CloseKey; finally R.Free; end; end;

ComboBoxでオーナードローをする
1.ComboBoxのStyleプロパティをcsOwnerDrawFixedかcsOwnerDrawVariableにします。 2.OnDrawItemイベントに下記コードを追加します
procedure TForm1.ComboBox1DrawItem(Control:TWinControl; Index: Integer; Rect:TRect; State: TOwnerDrawState); begin TComboBox(Control).Canvas.FillRect(Rect); if odFocused in State then TComboBox(Control).Canvas.Font.Color := clWhite else TComboBox(Control).Canvas.Font.Color := clWindowText; TComboBox(Control).Canvas.TextOut(Rect.Left+2,Rect.Top, TComboBox(Control).Items[Index]); end;

2つのStringGridの連動スクロール
TStringGridのTopLeftChangedイベントを下記のようにします。
// StringGrid1 procedure TForm1.StringGrid1TopLeftChanged(Sender: TObject); var SG1, SG2: Integer; begin SG1 := StringGrid1.LeftCol; SG2 := StringGrid2.LeftCol; StringGrid2.LeftCol := SG1; end; // StringGrid2 procedure TForm1.StringGrid2TopLeftChanged(Sender: TObject); var SG1, SG2: Integer; begin SG1 := StringGrid1.LeftCol; SG2 := StringGrid2.LeftCol; StringGrid1.LeftCol := SG2; end;