Delphi6 Personal

Windows10にDelphi6 Personalをインストールした。
Delphi10を入れたけど画面がフラットデザインで使いにくいし、ノートパソコンで使う気にならなかった。
やっぱりDelphi6はいい。

Lazarusも何やかやと触れてないけれど、これを機会にDelphiを思い出したい。

今は亡き C Magazine の付録CDと、ずっと持ってたアップデータがここにきて役に立つとは。
最初の起動で、使用許諾コードを求められてぞっとしたけれど、Embarcaderoのサイトで新規の発行ができたので問題なし。

Embarcaderoのアカウントも求められたけど、ちょうどDelphi10をインストールするのに必要で取得したところだったので結果オーライ。

あとは、新しいWindowsと古いDelphiが喧嘩しなければうれしい。
とにかくコンパイルが爆速で幸せ。
スポンサーサイト

賞味期限

開けた日をメモできる欄があります
というよりも
開けた日からリトマス試験紙みたいなのがじわじわ変色していって全部色が変わったら、今日までな、みたいなの
いいこと思いついたと思い込んで記念に書いておく

鋼材性能

鋼材手帳要らず 「形鋼・鋼管 断面性能検索サービス」をPHP+MySQLで作ってみました
http://blog.56doc.net/Entry/138/

エクセルでいろんな材料で比較計算とかやってみるときに、便利そう。
手書きで表を作ったりpdfで、というのはいくらでもあるけれど、画面からコピーすると並べ方がぐちゃぐちゃなのかうまく順番通りに取り出せません。
その点、プログラムで吐き出しているからか、見た目の通りにエクセルに貼り付けできます。

作者の人も、断面性能値はJISとか信頼できるページ、資料から入手したと思うんですが、それ自体は入力していくしかなかったと思うので、その手間のことを想像すると余計にしびれます。

素晴らしいです。

エクセルでセルをクリックしてカウンターもどきにする(3)

前回作ったマクロを、実際に使ってみて反省点に対応しました。それなりに完成した気がします。
その1、その2で2種類作りましたが、結果的にシェイプを大量に貼り付けるバージョンを採用してます。

※※注意※※
シート状に存在しているオートシェイプ(四角形)を確認せずに削除するマクロを使っています。
マクロで作ったかどうかの判定はしてません。
マクロで作ったオートシェイプにはタグか何かに特殊な文字列でも書き込んでおいて削除時に判定すればいいのかも。

excelcounter20140524.zip

(1) ピンとこないサンプル画面ですみません。
まずは、いい感じに表を作ります。行にも列にも制限はないですけど、多すぎると遅くなると思います。すごく。
それに、スクロールしないと入力できないサイズだと使い勝手最悪です。


(2) 画面では比較のために、半分だけセルを選択して、ボタンを押そうとしているところです。


(3) 押した後。なかなかセンスのないボタンです。
真っ白でも動作するんですが、カウンターが「生きてるのか」どうかが判断しにくいので何かしら区別したほうがよさそう。
あと、塗りつぶしをありにして透明度を設定した方が見た目はすっきりですが、遅い感じ。


(4) ボタン的なものがあるセルを触るとこうなります。カーソルの「+」はIrfanViewのキャプチャ機能のショートカットにCTRLを使ってるので出ちゃってるだけで、実際には手のマーク。


(5) 何回か押してみた後。


(6) 全部数え終わったら印刷とかすると思います。その時に変に触って数字が変わるのが鬱陶しいはず。
なので、作成したボタンを消せるようにしてます。


マクロでやってるのは「ボタンをつくる」「ボタンを消す」だけ。
ボタンがやってるのは「1だけカウントアップ」だけ。
数字をクリアしたりどうこうするのは、エクセルでやりゃいい。やり直しもできるし。

#標準モジュール
'*******************************************
Const gShapeType = msoShapeRectangle
'*******************************************
'シェイプ削除
'*******************************************
Sub ClearShape()
Dim i As Long
i = 1
Do Until i > ActiveSheet.Shapes.Count
With ActiveSheet
If .Shapes(i).AutoShapeType = gShapeType Then
.Shapes(i).Delete
Else
i = i + 1
End If
End With
Loop
End Sub

'*******************************************
'シェイプ削除
'*******************************************
Sub CallClearShape()
Call ClearShape
End Sub

'*******************************************
'シェイプ作成
'*******************************************
Sub CreateShape(WithCellClear As Boolean)
Dim LoopArea As Range
Dim lShape As Shape

Set LoopArea = Selection
For i = 1 To LoopArea.Count
With LoopArea.Cells(i)
If WithCellClear Then .Value = ""
Set lShape = ActiveSheet.Shapes.AddShape(Type:=gShapeType, _
Left:=.Left + 1, Top:=.Top + 1, Width:=.Width - 2, Height:=.Height - 3)
lShape.Name = .Address(RowAbsolute:=False, ColumnAbsolute:=False)
lShape.Select
Selection.ShapeRange.Fill.Visible = msoFalse
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(150, 150, 150)
.Style = msoLineDash
End With
lShape.OnAction = "CounterMacro"
Set lShape = Nothing
End With
Next

ActiveSheet.Range("A1").Select
End Sub

'*******************************************
'シェイプ作成
'*******************************************
Sub CallCreateShape()
Dim lRet As Integer
lRet = MsgBox("選択したセルをカウンターっぽくします。範囲はいい感じですか?", vbOKCancel, "確認")
If lRet = vbCancel Then
Exit Sub
End If
Call ClearShape
Call CreateShape(False)
End Sub

'----------------------------------------
'シェイプの置いてあるセルをカウントアップ
'----------------------------------------
Sub CounterMacro()
Dim lShape As Shape
On Error Resume Next
Set lShape = ActiveSheet.Shapes(Application.Caller)
With ActiveSheet.Range(lShape.Name)
.Value = .Value + 1
.Select
End With
End Sub

エクセルでセルをクリックしてカウンターもどきにする(2)

ハイパーリンクをクリックして作成したマクロを起動するには
http://www.excel-wing.com/study/jitumu/941

Workbook.SheetFollowHyperlink イベント (Excel)
http://msdn.microsoft.com/ja-jp/library/office/ff838573(v=office.15).aspx

エクセルVBAでアクティブセルの位置を獲得するコードを教えてください
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1218931622

Excel2010でBook1のセルA1にハイパーリンクをVBAで付けたいと思います。
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1185661976

Hyperlinks.Add メソッド (Excel)
http://msdn.microsoft.com/ja-jp/library/office/ff822490(v=office.15).aspx

下線の設定
http://www.officepro.jp/excelvba/cell_font/index4.html

できたのがこれ。

#ThisWorkbook
'*************************************************************************
'http://www.excel-wing.com/study/jitumu/941
'http://msdn.microsoft.com/ja-jp/library/office/ff838573(v=office.15).aspx
'http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1218931622
'指定範囲のセルにハイパーリンクを設定(設定先は自分自身)
'内容を"0"にしてカウンター初期化
'*************************************************************************
Sub Test1()
Dim lRet As Integer
lRet = MsgBox("全部消します。やり直しできません。印刷しました?", vbOKCancel, "確認")
If lRet = vbCancel Then
Exit Sub
End If

Dim i As Long
Dim lRange As Range
Set lRange = Range("B2:AF6")
For i = 1 To lRange.Count
With lRange.Cells(i)
ActiveSheet.Hyperlinks.Add _
Anchor:=lRange.Cells(i), _
Address:="", _
SubAddress:=.Address(RowAbsolute:=False, ColumnAbsolute:=False), _
ScreenTip:=" ", _
TextToDisplay:="0"
.Value = "0"
End With
Next

lRange.Font.Size = 12
lRange.Font.Underline = False
lRange.Font.Color = vbBlack
End Sub

'*************************************************************************
'ハイパーリンクがクリックされたら数字を一つ上げる
'*************************************************************************
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
With ActiveCell
.Value = .Value + 1
End With
End Sub


めちゃ短くなった。ハイパーリンクを設定するとセルの書式が何かに初期化されるのがちょっと面倒。
あと、クリック間隔が短くなると、セルが編集モードになってしまいます。で、それを解除しようと別のセルをうかつに触ると予定外のセルがカウント上がる罠にはまります。

エクセルでセルをクリックしてカウンターもどきにする(1)

EXCELでカウンターのように、ボタンをクリックすると数字が[1、2、3、4・・・]と...
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1210789317

上のような動作をさせたくなりました。でもボタンやスピンボタンをおくと印刷したときに邪魔だし、スピンボタンだと100マスぐらいあるとちっさくてボタンが押せないのでどうにかしようとあがいてみました。

EXCEL(VBA) セルをクリックしたときの処理
http://oshiete.goo.ne.jp/qa/345340.html

>シートをクリックしただけで発生するイベントは無いのではないでしょうか
> 多少強引なやりかたとしては、次のような方法もあるにはあります。
>(1)セルと同じ大きさテキストなしのラベルを貼り付け、それぞれにマクロを登録する
>(2)登録したマクロのプロシージャ内で、クリックされたオートシェープの名前等により
> クリックされたことにするセルを判断する
>(3)マクロプロシージャ内にセルのselectメソッドを書いておけば、
>SelectionChangeイベントではキーボードによるセル移動などにも反応してしまったり、
>現在選択されているセルをクリックしても反応しないという問題があります

#標準モジュール
'**************************************************
'選択したセルに順序を書き込む関数
'http://www.k1simplify.com/vba/tipsleaf/leaf22.html
'**************************************************
Sub Test1()
Dim LoopArea As Range
Set LoopArea = Selection
For i = 1 To LoopArea.Count
LoopArea.Cells(i).Value = i
Next
End Sub


#標準モジュール
'***********************************************
'選択したセルにセルの名前(A1 とか)を書き込む関数
'http://home.att.ne.jp/zeta/gen/excel/c04p54.htm
'***********************************************
Sub Test2()
Dim LoopArea As Range
Set LoopArea = Selection
For i = 1 To LoopArea.Count
With LoopArea.Cells(i)
.Value = .Address(RowAbsolute:=False, ColumnAbsolute:=False)
End With
Next
End Sub


■ 調べもの ■
[excel][vba]枠線だけのオートシェイプを作るマクロ その1
http://blog.livedoor.jp/qoozy/archives/52556504.html

エクセルVBAで角丸四角形のオートシェイプを作成 msoShapeRoundedRectangle
http://www.excel-excel.com/tips/shape/shp_133.html

#標準モジュール
'****************************************************
'選択範囲のサイズで四角形を作成する関数
'http://www.excel-excel.com/tips/shape/shp_133.html
'http://blog.livedoor.jp/qoozy/archives/52556504.html
'****************************************************
Sub Test3()
Dim lType As String
Dim lShape As Shape

lType = msoShapeRectangle
'四角 msoShapeRectangle
'角丸四角形 msoShapeRoundedRectangle
'円 msoShapeOval
With Selection
Set lShape = ActiveSheet.Shapes.AddShape(Type:=lType, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
lShape.Name = "シェイプRoundedRectangle"
End With
Set lShape = Nothing
End Sub


#標準モジュール
'****************************************************
'選択範囲のサイズで枠だけの四角形を作成する関数
'(わかりにくいのでちょっと内側+うっすら色つき)
'http://www.excel-excel.com/tips/shape/shp_133.html
'http://blog.livedoor.jp/qoozy/archives/52556504.html
'****************************************************
Sub Test4()
Dim lType As String
Dim lShape As Shape

lType = msoShapeRectangle
'四角 msoShapeRectangle
'角丸四角形 msoShapeRoundedRectangle
'円 msoShapeOval
With Selection
Set lShape = ActiveSheet.Shapes.AddShape(Type:=lType, _
Left:=.Left + 1, Top:=.Top + 1, Width:=.Width - 2, Height:=.Height - 2)
lShape.Name = "シェイプRoundedRectangle"
End With

lShape.Select

'塗りつぶしの設定
With Selection.ShapeRange.Fill
'.Visible = msoFalse '塗りつぶしの有無
.Visible = msoTrue '塗りつぶしの有無
.ForeColor.RGB = RGB(255, 0, 255) '塗りつぶしの色
.Transparency = 0.9 '塗りつぶしの透明度
End With
'線の設定
With Selection.ShapeRange.Line
.Visible = msoTrue '線の有無)
.Style = msoLineSingle '線の種類(実線)
.ForeColor.RGB = RGB(0, 0, 0) '線の色
.Transparency = 0 '線の透明度
.Weight = 1 '線の太さ
End With

Set lShape = Nothing
End Sub


■ 調べもの ■
Excel VBAでオートシェイプに登録したマクロ名を取得する
http://blog.ch3cooh.jp/entry/20081121/1357113549

OnActionのマクロに引数を渡す方法と、それActionControlプロパティで出来るよ!ってお話
http://d.hatena.ne.jp/so_blue/20101116/1289918205

Shape.OnAction プロパティ (Excel)
http://msdn.microsoft.com/ja-jp/library/office/ff834436(v=office.15).aspx

マクロ付きShapeオブジェクトでどれが呼び出したかを知る
http://blogs.yahoo.co.jp/chika_z/1036381.html

Office TANAKA - Excel VBAステートメント[On Errorステートメント]
http://officetanaka.net/excel/vba/statement/OnError.htm

#標準モジュール
'*************************************************
'選択範囲のサイズで四角形を作成してマクロを設定
'http://d.hatena.ne.jp/so_blue/20101116/1289918205
'*************************************************
Sub Test5()
Dim lType As String
Dim lShape As Shape

lType = msoShapeRectangle
With Selection
Set lShape = ActiveSheet.Shapes.AddShape(Type:=lType, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
lShape.Name = "シェイプRoundedRectangle"
lShape.OnAction = "Test5a"
End With
Set lShape = Nothing
End Sub

Sub Test5a()
MsgBox "テスト"
End Sub


#標準モジュール
'****************************************************
'選択範囲のサイズで四角形を作成してましなマクロを設定
'http://blogs.yahoo.co.jp/chika_z/1036381.html
'****************************************************
Sub Test6()
Dim lType As String
Dim lShape As Shape

lType = msoShapeRectangle
With Selection
Set lShape = ActiveSheet.Shapes.AddShape(Type:=lType, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
lShape.Name = "シェイプRoundedRectangle"
lShape.OnAction = "Test6a"
End With
Set lShape = Nothing
End Sub

Sub Test6a()
Dim lShape As Shape
On Error Resume Next
Set lShape = ActiveSheet.Shapes(Application.Caller)
MsgBox lShape.Name
End Sub


#標準モジュール
'**********************************************************************
'選択範囲の各セルと重なる四角形を作成してセル名称を表示するマクロを設定
'**********************************************************************
Sub Test7()
Dim LoopArea As Range
Dim lShape As Shape

Set LoopArea = Selection
For i = 1 To LoopArea.Count
With LoopArea.Cells(i)
Set lShape = ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
lShape.Name = .Address(RowAbsolute:=False, ColumnAbsolute:=False)
lShape.OnAction = "Test7a"

lShape.Select

With Selection.ShapeRange.Fill
.Visible = msoTrue '塗りつぶしの有無
.ForeColor.RGB = RGB(255, 0, 255) '塗りつぶしの色
.Transparency = 0.9 '塗りつぶしの透明度
End With
Selection.ShapeRange.Line.Visible = msoFalse

Set lShape = Nothing
End With
Next
End Sub

Sub Test7a()
Dim lShape As Shape
On Error Resume Next
Set lShape = ActiveSheet.Shapes(Application.Caller)
MsgBox lShape.Name
End Sub


■ 調べもの ■
12.3 ワークシート上のオートシェイプ(図形)を削除する
http://www.happy2-island.com/excelsmile/smile03/capter01203.shtml

'*****************************************************************
'自分以外のすべてのシェイプを削除する
'http://www.happy2-island.com/excelsmile/smile03/capter01203.shtml
'*****************************************************************
Sub Test8()
Dim i As Long
i = 1
Do Until i > ActiveSheet.Shapes.Count
With ActiveSheet
If .Shapes(i) Is .Shapes(Application.Caller) Then
i = i + 1
Else
.Shapes(i).Delete
End If
End With
Loop
End Sub

'**********************************************************************
'既存のシェイプを全部削除して、選択範囲の各セルと重なる四角形を作成して
'四角形にはセルの名前(A1 とか)を設定しておいて、クリックしたときに
'そのセル名称を使っていろいろするマクロを設定
'**********************************************************************
Sub Test9()
Dim i As Long
i = 1
Do Until i > ActiveSheet.Shapes.Count
With ActiveSheet
If .Shapes(i) Is .Shapes(Application.Caller) Then
i = i + 1
Else
.Shapes(i).Delete
End If
End With
Loop

Dim LoopArea As Range
Dim lShape As Shape

Set LoopArea = Selection
For i = 1 To LoopArea.Count
With LoopArea.Cells(i)
Set lShape = ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
lShape.Name = .Address(RowAbsolute:=False, ColumnAbsolute:=False)

lShape.Select

With Selection.ShapeRange.Fill
.Visible = msoTrue '塗りつぶしの有無
.ForeColor.RGB = RGB(255, 0, 255) '塗りつぶしの色
.Transparency = 0.9 '塗りつぶしの透明度
End With
Selection.ShapeRange.Line.Visible = msoFalse

lShape.OnAction = "Test9a"
Set lShape = Nothing
End With
Next
End Sub

'----------------------------------
'シェイプの置いてあるセルを選択する
'----------------------------------
Sub Test9a()
Dim lShape As Shape
On Error Resume Next
Set lShape = ActiveSheet.Shapes(Application.Caller)
ActiveSheet.Range(lShape.Name).Select
End Sub

'****************************************************************
'既存のシェイプを全部削除
'選択範囲の各セルと重なる四角形を作成
'選択範囲のセルの内容をクリア
'四角形にはセルの名前(A1 とか)を設定
'作成した四角形をクリックしたときにセルの名前を使ってセルの内容を
'書き換えるマクロを設定
'****************************************************************
Sub Test10()
Dim i As Long
i = 1
Do Until i > ActiveSheet.Shapes.Count
With ActiveSheet
If .Shapes(i) Is .Shapes(Application.Caller) Then
i = i + 1
Else
.Shapes(i).Delete
End If
End With
Loop

Dim LoopArea As Range
Dim lShape As Shape

Set LoopArea = Selection
For i = 1 To LoopArea.Count
With LoopArea.Cells(i)
.Value = ""
Set lShape = ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
lShape.Name = .Address(RowAbsolute:=False, ColumnAbsolute:=False)

lShape.Select

With Selection.ShapeRange.Fill
.Visible = msoTrue '塗りつぶしの有無
.ForeColor.RGB = RGB(255, 0, 255) '塗りつぶしの色
.Transparency = 0.9 '塗りつぶしの透明度
End With
Selection.ShapeRange.Line.Visible = msoFalse

lShape.OnAction = "Test10a"
Set lShape = Nothing
End With
Next
End Sub

'----------------------------------------
'シェイプの置いてあるセルをカウントアップ
'----------------------------------------
Sub Test10a()
Dim lShape As Shape
On Error Resume Next
Set lShape = ActiveSheet.Shapes(Application.Caller)
With ActiveSheet.Range(lShape.Name)
.Value = .Value + 1
.Select
End With
End Sub


一応動くことは動くけれども、クリアするときにすでに作成済みのオートシェイプが
全面に敷き詰めてあるので、「選択範囲のセルを~」の部分が邪魔をして若干面倒くさい。

一度、どうでもいいセルを選択した状態でクリアしておいてから~みたいない気持ちの
悪いことをする必要がありました。気持ち悪い。


■ 調べもの ■
ハイパーリンクのクリックでマクロを実行する
http://www.excel-wing.com/study/jitumu/941

これちょっといい感じかも。

今日の検索 パターン・ランゲージ

チームでのプロジェクトを成功させる秘訣34項目「コラボレーション・パターン」 - GIGAZINE
http://gigazine.net/news/20121128-collaboration-patterns/

パターン・ランゲージの考え方
http://collabpatterns.sfc.keio.ac.jp/patternlanguage.html

これからの創造社会(Creative Society)における基本スキルをまとめたパターン・ランゲージ3部作

Lazarusでテキストビューアを作ってみる Loogaroo(1)

しばらく前に使っていたノートが起動しなくなって、しょうもない作りかけのプログラムのソースコードごとお亡くなりになって、助け出すのも面倒なので、放置状態です。
で、更新頻度が激落ちだったんですが、心機一転してみることにしてみました。

こんな感じで。

Outlookのメールアイコンが出てたらメッセージを表示したい Notifire(7)

TImageListの中身をファイルに保存したり戻したりすることについて。

今まであまり使ったことのないTImageListに苦しんでいる日々ですけど何か。
ちょっと雰囲気が見えてきたのでこのままTImageListを使ってどうにかしたいと思います。で、操作のナチュラルさも含めてうまく行ったとして、少なくともメールのアイコンを保存したくなります。
そうなると最低1つのアイコンというか画像を保存したらいいんですけど、どうせTImageListにキープしてるんだから、TImageList.SaveToFile的なものはないのかと探してみました。

Outlookのメールアイコンが出てたらメッセージを表示したい Notifire(6)

画像を比較する、一致判定をすることについて。

バイナリの検索、書き換えをするには?:[2012/10/06]
バイナリファイルで文字列を検索するには?:[2012/10/06]
バイナリデータを数値化して比較するには?:[2012/10/06]

Outlookのメールアイコンが出てたらメッセージを表示したい Notifire(5)

通知領域に表示されているアイコンをバラす話。
バラすのはいいけどどうやって保持しようか。TImageListが使えないか試してみる。

ImageListに画像を追加する:[2012/10/05]

まず、Image1に通知領域全体を取得する。で、Image2に一つ切り出してImageList1に追加。次の一つを切り出してまたImageList1に追加。次の...としていけばよさそう。ちゃんと取得できているかどうかは、TImageListと関連付けできるコンポーネント(SpeedButtonとか)に表示させる。というはどうだろう。

Outlookのメールアイコンが出てたらメッセージを表示したい Notifire(4)

Outlookのメールアイコンが出てたらメッセージを表示したい Notifire(4)

なんの話をしてたのか曖昧になって来たけど、次は、通知領域に表示されているアイコンの数を数えて見ることにします。
単純な割り算じゃない感じです。
わざと通知領域のアイコンの数を増やしてみて、ゼロ(あれば)から5個ぐらいまでの縦横サイズを取得してみます。

Outlookのメールアイコンが出てたらメッセージを表示したい Notifire(3)

まずは、右下の通知領域を「掴む」ことから始めます。
Delphiで作ったプログラムでできてるんですが、Lazarusの使い心地というべきか、usesひとつとっても、どこでAPIを宣言されてるかわからなさすぎるので、それも含めてやってみます。