ざつだ ん。 (2013/01/01~)
2013/01/04
新年あけましておめでとうございます m(_ _)m
今年もよろしくお願い致します。
去年のやり残し
昨年は 第 24 回デベロッパーキャンプ に講師として参加しましたが、その際に "*.docx / *.xlsx / *.pptx は zip で固められた xml 形式のドキュメントだよ" 的な事を喋りました。xml は TXMLDocument で処理できますし、zip は TZipFile で処理できます。
で、重要なのは TZipFile は実ファイルとして解凍しなくても読み書きできるという点です。ちょっとサンプルを例示してみましょう。
まず、Excel で空のドキュメントを作り、Book1.xlsx として保存します。
確認のために *.xlsx がどういう構造になっているか調べてみましょう。拡張子を *.zip に変更し、適当なアーカイバで解凍します。
ツリー構造はこのようになっています。xml ファイルのエンコーディングは UTF-8 です。
.
│ [Content_Types].xml
│
├─docProps
│ app.xml
│ core.xml
│
├─xl
│ │ styles.xml
│ │ workbook.xml
│ │
│ ├─theme
│ │ theme1.xml
│ │
│ ├─worksheets
│ │ sheet1.xml
│ │ sheet2.xml
│ │ sheet3.xml
│ │
│ └─_rels
│ workbook.xml.rels
│
└─_rels
.rels
|
XE2 / XE3 を使って、この Book1.xlsx を処理してみましょう。フォーム (VCL / FMX どちらでも構わない) にボタンとメモを貼り、ボタンのイベントハンドラに以下のように記述します。
uses
..., XMLDoc, Zip;
procedure TForm1.Button1Click(Sender: TObject);
var
zip: TZipFile;
Buf: TBytes;
U8Enc: TUTF8Encoding;
begin
zip := TZipFile.Create;
U8Enc := TUTF8Encoding.Create;
try
zip.Open('Book1.xlsx', zmRead);
zip.Read('xl/worksheets/sheet1.xml', Buf); // Sheet1 を TBytes に読み込む
Memo1.Lines.Text := FormatXMLData(U8Enc.GetString(Buf)); // TBytes (UTF-8) -> String -> XML 整形
finally
U8Enc.Free;
zip.Free;
end;
end;
|
ボタンを押下すると、Sheet1 の XML がメモに表示されます。
文字列の単純な置換なら、XML をテキストファイルとして扱い、文字列を置換したものをそのまま TZipFile.Write() で書き出せば OK です。
複雑な事をやろうとするならば、各 xml を TXMLDocument に読み込んでノードを操作するか、あらかじめ、[新規作成 | その他] の Delphi プロジェクト▶XML▶XML データバインディング で XML 操作クラスを生成する必要があります。前者は読み込むドキュメントが不定の場合 (但し難易度高)、後者は読み込むドキュメントのフォーマットが決まっている場合に利用します。面倒臭がって、すべてをテキストファイル操作で済ませようとするとドツボにはまる事間違いなしです。
話が横に逸れてしまいましたが TZipFile は実ファイルに解凍しなくても処理できますので、例えば *.jar の書き換えアプリケーション等を作るのは簡単です。また、複数のファイルを固めた環境ファイル / リソースファイルを独自に実装する事もできます。
2013/01/05
元ネタは [delphi-users:2939] TImageかTImageViewerに画像を表示した時の背景色 です。
TImage / TImageControl / TImageViewer は、いずれも画像を保持するコントロールですが、用途によって使い分ける必要があります。
TPaintBox は自前で図形を描画するのに使います。
TImage |
標準で背景が透過する |
- |
TRectangle の子にし、TRectangle の Fill / Stroke プロパティで色を変更する |
TImageControl |
クリックすると画像選択ダイアログが出る フォーカスを持つ |
カスタムスタイルを作成し、imagecontrol1style▶background の SourceLookup を空にする |
カスタムスタイルを作成し、imagecontrol1style▶background の下に TRectangle をぶら下げ、Image を Rectangle の下にぶらさげる。TRectangle の Align を alClient にした上で、Fill / Stroke プロパティで色を変更する。背景透過の処理も同時に行っておくとベター |
TImageViewer |
パニング/拡大縮小が有効 フォーカスを持つ |
カスタムスタイルを作成し、imageviewer1style▶background の SourceLookup を空にする |
カスタムスタイルを作成し、imageviewer1style▶background▶content の下に TRectangle をぶら下げ、TRectangle の Align を alClient にした上で、Fill / Stroke プロパティで色を変更する。背景透過の処理も同時に行っておくとベター |
上記の背景色変更方法はスタイルがデフォルト時のものです。FMX スタイルが適用されている場合には、異なる対処方法を採らなくてはならない事があります。
背景を透過してみた所です。背景のグラデーションですか?オブジェクトインスペクタでフォームの Fill プロパティをダブルクリックしてみましょう。
背景色を (クラウディアたんなので) Azure に変更してみた所です。
構造ペインで表示される構造はこのようになります。
繰り返しになりますが、VCL のスタイルはテーマ / スキンですが、FMX のスタイルは HTML における CSS のような位置付けになっています。スタイルを変更して外観が変わるようなら、その部分はカスタマイズ可能という事を覚えておくといいでしょう。
2013/01/06
FireMonkey アプリケーションでリソースファイルを使う
元ネタは [Delphi Q&A] FifrMonkeyでのResourceの利用 です。
KHE000221 さんのレスにもあるように TResourceStream は使えます。ただ、VCL だと TBitmap や TJpegImage に LoadFromResourceName() メソッドがあるのですが、FMX の TBitmap にはそれがありません。ここはクラスヘルパの出番のようです。
unit FMX.ResourceHelper;
interface
uses
System.Classes, System.Types, FMX.Types;
{$DEFINE USE_BITMAPHELPER}
{$IFDEF USE_BITMAPHELPER}
type
TBitmapExtention =
class helper for TBitmap
public
procedure LoadFromResourceName(Instance: THandle; const Name: string;
ResType: PChar = RT_RCDATA);
end;
{$ENDIF}
function LoadFromResource(Bitmap: TBitmap; Instance: THandle;
const ResName: string; ResType: PChar = RT_RCDATA): Boolean;
function ResourceToFile(const FileName: string; Instance: THandle;
const ResName: string; ResType: PChar = RT_RCDATA): Boolean;
const
RT_CURSOR = PChar(1);
RT_BITMAP = PChar(2);
RT_ICON = PChar(3);
RT_MENU = PChar(4);
RT_DIALOG = PChar(5);
RT_STRING = PChar(6);
RT_FONTDIR = PChar(7);
RT_FONT = PChar(8);
RT_ACCELERATOR = PChar(9);
RT_MESSAGETABLE = PChar(11);
{$IFDEF MSWINDOWS}
{$EXTERNALSYM RT_CURSOR}
{$EXTERNALSYM RT_BITMAP}
{$EXTERNALSYM RT_ICON}
{$EXTERNALSYM RT_MENU}
{$EXTERNALSYM RT_DIALOG}
{$EXTERNALSYM RT_STRING}
{$EXTERNALSYM RT_FONTDIR}
{$EXTERNALSYM RT_FONT}
{$EXTERNALSYM RT_ACCELERATOR}
{$EXTERNALSYM RT_MESSAGETABLE}
{$ENDIF}
implementation
{$IFDEF USE_BITMAPHELPER}
{ TBitmapExtention }
procedure TBitmapExtention.LoadFromResourceName(Instance: THandle; const Name: string;
ResType: PChar);
begin
LoadFromResource(Self, Instance, Name, ResType);
end;
{$ENDIF}
{ Functions }
function LoadFromResource(Bitmap: TBitmap; Instance: THandle;
const ResName: string; ResType: PChar): Boolean;
var
rs: TResourceStream;
begin
result := False;
rs := TResourceStream.Create(Instance, ResName, ResType);
try
Bitmap.LoadFromStream(rs);
result := True;
finally
rs.Free;
end;
end;
function ResourceToFile(const FileName: string; Instance: THandle;
const ResName: string; ResType: PChar): Boolean;
var
rs: TResourceStream;
begin
result := False;
rs := TResourceStream.Create(Instance, ResName, ResType);
try
rs.SaveToFile(FileName);
result := True;
finally
rs.Free;
end;
end;
end.
|
既存の TBitmap のクラスヘルパとバッティングするようであれば、{$DEFINE USE_BITMAPHELPER} をコメントアウトして、関数版の LoadFromResource() を使うといいでしょう。オマケで、リソースをファイルとして保存する ResourceToFile() 関数も含まれています。
uses
..., FMX.ResourceHelper;
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Bitmap.LoadFromResourceName(HInstance, 'CLAUDIA'); // クラスヘルパ版
//LoadFromResource(Image1.Bitmap, HInstance, 'CLAUDIA'); // 関数版
end;
|
上記コードはリソースから Image1 (TImage) に PNG 画像 (RCDATA: "CLAUDIA") をロードします。
もちろん OS X でも動作します。
単一バイナリにこだわらないのであれば 01/04 の雑談で書いた TZipFile を使う方法もアリかと思います。無圧縮 zip ならば読み込みのオーバーヘッドも無視できる範囲だと思いますし。
2013/01/07
System.Zip.TZipFile のアレをちょっといじったのをちょっといじると? (XE3) - 再掲載
あれ?2012/12/08 に書いたはずの記事がない。デブキャンで東京に行ってた時の記事だから、こっちに戻ってきた時にマージして消したのか?
...という訳で再掲載です。内容は "Delphi XE3でZIPファイルを解凍するときにファイル名のエンコーディングをバイト列から判別するようにしたい (山本隆の開発日誌)" に関するものでしたが、ちょっとだけ詳しく書いてみます。
まずは zip と TZipFile の実装のおさらいです。
- TZipFile は UTF-8 ファイル名に対応している
- "UTF-8 ファイル名を使う / 使わない" は UTF8Support プロパティで切り替えられる
- UTF8Support が False の場合に使われる文字エンコーディングは CP437 (IBM PC / MS-DOS)
- クラスメソッド ExtractZipFile / ZipDirectoryContents は、常に "UTF8Support = True"
- ZIP で UTF-8 が使えるようになったのは 2007/08 の事 (general purpose bit flag の Bit 11)
- 漢字を含むファイル名の zip は general purpose bit flag の Bit 11 が 0 、つまり、Codepage 437 の所に Shift_JIS (CP932) を突っ込んだものが多い
- Windows も 7 以前の標準機能では "Bit 11 = 0" でロケール依存の ANSI コードページのファイル名になっている (Vista の発売は 2006/11)
- UTF-8 ファイル名に対応していないアーカイバも数多く存在する
TZipFile の実装は仕様上は正しいのですが、世の中には規格外の zip ファイルが数多く存在します。
- 2007/08 以前に作られた CP437 以外のファイル名な zip はすべて規格外
- Windows 7 以前の Windows で、OS 標準機能の zip で作られた zip ファイルはすべて規格外
- Mac OS X の Finder で作られた zip ファイルはすべて規格外
- Java の一部機能で作られた zip ファイルも規格外のものがある
まとめると以下のようになります。
○ |
0 |
437 IBM PC / MS-DOS |
PKZip (CP437) |
○ |
1 |
65001 UTF-8 |
PKZip (UTF-8) |
× |
0 |
932 Shift_JIS |
Windows 7 以前の 日本語版 Windows の標準機能で扱える zip または、Windows で動作する古いアーカイバで作られた zip ファイル |
× |
0 |
65001 UTF-8 |
OS X の Finder で作られた zip ファイル |
× |
0 |
20932 EUC-JP |
古い Linux で作られた zip ファイル |
× |
0 |
65001 Modified UTF-8 |
Java の一部機能で作られた zip ファイル |
で、"TZipFile が 'Bit 11 が立った UTF-8' か 'CP437' にしか対応しないのは現実的ではない"、という判断で、TZipFile をいじった記事が以下になります。
変更点は次の通りです。
- Open メソッドに、UTF-8 フラグとコードページを指定できるようにした
- ExtractZipFile クラスメソッドに、UTF-8 フラグとコードページを指定できるようにした
- ZipDirectoryContents クラスメソッドに、UTF-8 フラグとコードページを指定できるようにした
この "改変版 System.Zip.TZipFile" の XE3 版に文字コード判定機能を付けてしまおうというのが、山本隆さんの記事になります。記事中では、文字エンコーディング判定ルーチンを組み込む事によって日本語ファイル名が使われている zip ファイルを (自動で) 正しく扱えるようにしています。
このままでは日本語以外の文字エンコーディングな zip を自動判別できませんが、別途文字エンコーディング判定ルーチンを自前で実装する事により、中国語や韓国語の自動判別も可能になります。日本語ファイル名限定ではない、とても汎用的な実装だと思います。スバラシイ!
やっつけですが、こんなのが作れる、と (画像をクリックするとバイナリを DL できます)。
文字エンコーディング判定ルーチンは totonica さんの EncodeDetect ではなく、独自のものを使っています。テキストファイルの文字コード認識ならば EncodeDetect の方が精度が高くていいのですが、ファイル名のように文字数が少ないものだと UTF-8 を誤判定する事があるからです。
2013/01/12
隠し属性のフォルダとファイルを除外してファイルをリストアップ
元ネタは "[delphi-users:2952] TDirectory.GetFilesで隠しフォルダ配下のファイルは列挙したくない"です。
以下のようなフォルダ構成があったとします。
C:\TEST
│ noname.txt
│
├─AAA
│ noname.txt
│
└─BBB
│ noname.txt
│
└─CCC
│ noname.txt
│
└─DDD
noname.txt
|
C:\TEST\BBB\BBB が隠し属性のフォルダで、C:\TEST を検索する時の要件は次の通りです。
- ディレクトリ BBB 内のファイルを列挙してはならない。
- ディレクトリ BBB 以下のサブフォルダ内のファイルを列挙してはならない。
つまり、このようになります。
- C:\TEST\noname.txt
- C:\TEST\AAA\noname.txt
- C:\TEST\BBB\noname.txt (列挙しない)
- C:\TEST\BBB\CCC\noname.txt (列挙しない)
- C:\TEST\BBB\CCC\DDD\noname.txt (列挙しない)
同様に C:\TEST\BBB\CCC を検索する時は次のようになります。
- C:\TEST\BBB\CCC\noname.txt (列挙しない)
- C:\TEST\BBB\CCC\DDD\noname.txt (列挙しない)
Delphi-freeml に投稿したコードは以下になります。
uses
..., System.Types, System.IOUtils;
function EnumFiles_WithOutHidden(const Path: string; SearchPattern: string): TStringDynArray;
var
FA: TFileAttributes;
dPath, dCPath, PathRoot: string;
Hidden_Flg: Boolean;
HiddenList, PathList: TStringDynArray;
begin
// 配列を初期化
SetLength(result, 0);
// 絶対パスを生成
if TPath.IsRelativePath(Path) then
dPath := TPath.GetFullPath(Path)
else
dPath := ExcludeTrailingPathDelimiter(Path);
// 上の階層のフォルダを検索
Hidden_Flg := False;
PathRoot := ExcludeTrailingPathDelimiter(TPath.GetPathRoot(dPath));
dCPath := dPath;
repeat
FA := TDirectory.GetAttributes(dCPath);
if (TFileAttribute.faHidden in FA) then
begin
Hidden_Flg:= True;
Break;
end;
dCPath := ExcludeTrailingPathDelimiter(TPath.GetDirectoryName(dCPath + '.a'));
until (dCPath = PathRoot);
// 指定フォルダが隠し属性フォルダ内だったら抜ける
if Hidden_Flg then
Exit;
// 指定パス以下の隠しフォルダを列挙
HiddenList := TDirectory.GetDirectories(dPath, '*.*', TSearchOption.soAllDirectories,
function (const Path: string; const SearchRec: TSearchRec): Boolean
begin
result := ((faHidden and SearchRec.Attr) > 0);
end);
// 隠しフォルダ内のフォルダは隠しフォルダとみなす
PathList := TDirectory.GetDirectories(dPath, '*.*', TSearchOption.soAllDirectories,
function (const Path: string; const SearchRec: TSearchRec): Boolean
var
l: Integer;
begin
result := ((faHidden and SearchRec.Attr) > 0);
if result then
Exit;
for l:=Low(HiddenList) to High(HiddenList) do
begin
if Pos(HiddenList[l], Path) = 1 then
begin
result := True;
break;
end;
end;
end);
// 指定パス以下のファイルを列挙
result := TDirectory.GetFiles(dPath, SearchPattern, TSearchOption.soAllDirectories,
function (const Path: string; const SearchRec: TSearchRec): Boolean
begin
result := ((faHidden and SearchRec.Attr) = 0) and
(IndexText(Path, PathList) = -1);
end);
end;
|
投稿したものにも書いてありますが、"TDirectory.GetFiles を必ず使う" という縛りがあるので、列挙効率はあまりよくないと思います。
偽Fusa の "親フォルダが隠し属性ついていたら、TDirectory.GetFiles でぶん回す必要無いよな。" というツッコミは、正直意味がよくわかりません。
- "if Hidden_Flg then" が見えてない
- 隠し属性のフォルダのサブフォルダは必ず隠し属性が付いていると思っている
- TDirectory.GetDirectories の実際の動作を確認していない
このいずれかだろうとは思いますが、本当はもっと簡単にできる方法があるのかもしれません。Delphi-freeml にコードを投稿してくれれば話は早いのに。
Delphi-freeml に投稿するとインデントが失われる (関数内関数とか無名メソッドとかが読みにくくなる) ので投稿しませんでしたが、FindFirst / FindNext / FindClose を使ったものが以下になります。
uses
..., System.Types, System.IOUtils, System.StrUtils, System.Masks;
function EnumFiles_WithOutHidden(const Path: string; SearchPattern: string): TStringDynArray;
var
FA: TFileAttributes;
dPath, dCPath, PathRoot: string;
Hidden_Flg: Boolean;
{ Begin EnumFiles() }
function EnumFiles(const Path: string; SearchPattern: string): TStringDynArray;
var
i: Integer;
SL: TStringList;
{ Begin _EnumFiles() }
procedure _EnumFiles(const Path: string; SearchPattern: string);
var
sr: TSearchRec;
begin
if FindFirst(Path + '*.*', faAnyFile and (not faHidden), sr) = 0 then
begin
repeat
if (sr.Attr and faDirectory) > 0 then
begin
if StringReplace(sr.Name, '.', '' ,[rfReplaceAll]) <> '' then
_EnumFiles(Path + sr.Name + PathDelim, SearchPattern);
end
else
begin
if MatchesMask(sr.Name, SearchPattern) then
SL.Add(Path + sr.Name);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;
{ End _EnumFiles() }
begin
SL := TStringList.Create;
try
_EnumFiles(IncludeTrailingPathDelimiter(Path), SearchPattern);
SetLength(result, SL.Count);
for i:=Low(result) to High(result) do
result[i] := SL[i];
finally
SL.Free;
end;
end;
{ End EnumFiles() }
begin
// 配列を初期化
SetLength(result, 0);
// 絶対パスを生成
if TPath.IsRelativePath(Path) then
dPath := TPath.GetFullPath(Path)
else
dPath := ExcludeTrailingPathDelimiter(Path);
// 上の階層のフォルダを検索
Hidden_Flg := False;
PathRoot := ExcludeTrailingPathDelimiter(TPath.GetPathRoot(dPath));
dCPath := dPath;
repeat
FA := TDirectory.GetAttributes(dCPath);
if (TFileAttribute.faHidden in FA) then
begin
Hidden_Flg:= True;
Break;
end;
dCPath := ExcludeTrailingPathDelimiter(TPath.GetDirectoryName(dCPath + '.a'));
until (dCPath = PathRoot);
// 指定フォルダが隠し属性フォルダ内だったら抜ける
if Hidden_Flg then
Exit;
// 指定パス以下の "隠しフォルダ内と隠しファイル" を除くファイルを列挙
result := EnumFiles(dPath, SearchPattern);
end;
|
こちらは再帰で隠し属性フォルダ以下の探索を打ち切るので、多少は効率がいいかもしれませんが、関数の仕様を前出のコードに合わせているので少々冗長な所があります。
もっと効率のいい検索方法をご存知の方は教えていただけると有難いです m(_ _)m。
2013/01/22
TCheckBox の文字色と背景色を変えたい (Delphi)
元ネタは
です。奇しくも同時期 (3 日違い) に投稿された質問でした。
さて、Windows の CheckBox はテーマが有効だと、文字色 / 背景色が変更できません...つまり、この仕様はテーマ依存な訳です。これを変更するには幾つかの方法があります。
- ランタイムテーマを無効にする
- TCheckBox の下に TLabel を貼る
- オーナードローする
ランタイムテーマを無効にする方法は見た目がすっかり変わってしまいます。TLabel を貼る方法は TCheckBox が多いと面倒です。オーナードローするには派生コンポーネントを作る必要があり、これまた面倒です。
どれも一長一短なのですが、比較的軽微な修正ですむ妥協案が stackoverflow に投稿されています ("How can you change the font color of a theme-enabled control?")。このコードでは背景色が変更できませんが、少しいじると背景色も変更できるようになります。
フォームに TCheckBox を 3 つ置いた時のコードは以下のようになります。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
{ 定義部追加 (ここから) ---------------------------------------------------- }
TCheckBox = class(Vcl.StdCtrls.TCheckBox) // XE2 またはそれ以降
//TCheckBox = class(StdCtrls.TCheckBox) // XE またはそれ以前
private
FOriginalCaption: string;
_MySetCap: Boolean;
procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
end;
{ 定義部追加 (ここまで) ---------------------------------------------------- }
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ 実装部追加 (ここから) ------------------------------------------------------ }
procedure TCheckbox.CMTextChanged(var Message: TMessage);
begin
inherited;
if _MySetCap then
Exit;
FOriginalCaption := Caption;
end;
procedure TCheckbox.WMPaint(var msg: TWMPaint);
var
BtnWidth: Integer;
canv: TControlCanvas;
begin
BtnWidth := GetSystemMetrics(SM_CXMENUCHECK);
_MySetCap := True;
if not (csDesigning in ComponentState) then
Caption := '';
_MySetCap := False;
inherited;
canv := TControlCanvas.Create;
try
canv.Control := Self;
canv.Font := Font;
if not Self.ParentColor then
begin
canv.Brush.Color := Self.Color;
canv.FloodFill(BtnWidth + 1, 0, canv.Pixels[BtnWidth + 1, 0], fsSurface);
end;
if not Self.ParentFont then
begin
SetBkMode(canv.Handle, Ord(TRANSPARENT));
canv.Font.Color := Self.Font.Color;
canv.TextOut(BtnWidth + 1, 2, FOriginalCaption);
end;
finally
canv.Free;
end;
end;
{ 実装部追加 (ここまで) ------------------------------------------------------ }
end.
|
背景色 (TCheckBox.Color) を有効にするには、TCheckBox.ParentColor を False に設定してください。
以下のようにすれば、背景色で正しく塗りつぶされない件がどうにかなりますが、文字列の背景色しか塗りつぶされません。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
{ 定義部追加 (ここから) ---------------------------------------------------- }
TCheckBox = class(Vcl.StdCtrls.TCheckBox) // XE2 またはそれ以降
//TCheckBox = class(StdCtrls.TCheckBox) // XE またはそれ以前
private
FOriginalCaption: string;
_MySetCap: Boolean;
procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
end;
{ 定義部追加 (ここまで) ---------------------------------------------------- }
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ 実装部追加 (ここから) ------------------------------------------------------ }
procedure TCheckbox.CMTextChanged(var Message: TMessage);
begin
inherited;
if _MySetCap then
Exit;
FOriginalCaption := Caption;
end;
procedure TCheckbox.WMPaint(var msg: TWMPaint);
var
BtnWidth: Integer;
canv: TControlCanvas;
begin
BtnWidth := GetSystemMetrics(SM_CXMENUCHECK);
_MySetCap := True;
if not (csDesigning in ComponentState) then
Caption := '';
_MySetCap := False;
inherited;
canv := TControlCanvas.Create;
try
canv.Control := Self;
canv.Font := Font;
if not Self.ParentFont then
begin
if Self.ParentColor then
SetBkMode(canv.Handle, Ord(TRANSPARENT))
else
begin
SetBkMode(canv.Handle, Ord(OPAQUE));
canv.Brush.Color := Self.Color;
end;
canv.Font.Color := Self.Font.Color;
canv.TextOut(BtnWidth + 1, 2, FOriginalCaption);
end;
finally
canv.Free;
end;
end;
{ 実装部追加 (ここまで) ------------------------------------------------------ }
end.
|
Windows の作法で TCheckBox がテーマ依存なのはいいとして、.NET に AutoCheck プロパティが実装されている事には微妙に納得がいきません (w
テーマな外見のコントロールとそうでないコントロールを混在させる (Delphi)
TCheckBox の文字色と背景色を変更できるようになると、実用性はともかく面白いことができるようになります。
"画像はハメコミ合成ではありません" と念のために断っておきます。
コード的には以下のように SetWindowTheme() API を呼んでいるだけです (UxTheme で定義されています)。
uses
..., UxTheme;
SetWindowTheme(Edit1.Handle, '', '');
|
TCheckBox の文字色と背景色を変えたい (Delphi) のコードを組み込んでいないと、以下の画像のようになってしまいます。
TCheckbox だけでなく、TRadioButton にも同様の処理が必要になります。また、無理矢理テーマを外しているので、予測できないような問題が起こるかもしれません...ご利用は計画的に。
2013/01/24
続・TCheckBox の文字色と背景色を変えたい (Delphi)
WordWrap プロパティが使えない等、諸々の問題を妥協できる範囲で解決してみました。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Themes;
type
{ 定義部追加 (ここから) ---------------------------------------------------- }
TCheckBox = class(Vcl.StdCtrls.TCheckBox) // XE2 またはそれ以降
//TCheckBox = class(StdCtrls.TCheckBox) // XE またはそれ以前
private
FOriginalCaption: string;
_MySetCap: Boolean;
procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
end;
{ 定義部追加 (ここまで) ---------------------------------------------------- }
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ 実装部追加 (ここから) ------------------------------------------------------ }
procedure TCheckbox.CMTextChanged(var Message: TMessage);
begin
inherited;
if _MySetCap then
Exit;
FOriginalCaption := Caption;
end;
procedure TCheckbox.WMPaint(var msg: TWMPaint);
var
BtnWidth: Integer;
canv: TControlCanvas;
dRect, dSrcRect, dDstRect: TRect;
dStr: string;
dFlgs: TTextFormat;
dAdjust: Integer;
rgn: HRGN;
begin
// テーマが無効か、ParentColor と ParentFont が True なら
// オリジナルの描画を呼び出して抜ける
if (not ThemeServices.ThemesEnabled) or
(Self.ParentColor and Self.ParentFont) then
begin
inherited;
Exit;
end;
// Caption 文字列の退避
_MySetCap := True;
if not (csDesigning in ComponentState) then
Caption := '';
_MySetCap := False;
// オリジナルの描画方法で "チェックボックス + 空文字列" を描画
inherited;
canv := TControlCanvas.Create;
try
// 文字列領域 (フォーカス矩形-1) を取得
canv.Control := Self;
BtnWidth := GetSystemMetrics(SM_CXMENUCHECK);
dRect := Rect(BtnWidth, 1, Self.Width-1, Self.Height-1);
// 背景色で塗り潰し
if Self.ParentColor then
SetBkMode(canv.Handle, Ord(TRANSPARENT))
else
begin
canv.Brush.Color := Self.Color;
canv.FillRect(dRect);
end;
// TextRect のパラメータ生成
dSrcRect := dRect;
dSrcRect.Left := dSrcRect.Left + 2;
dSrcRect.Right := dSrcRect.Right - 2;
dStr := FOriginalCaption;
dFlgs := [tfLeft, tfVerticalCenter];
if Self.WordWrap then
dFlgs := dFlgs + [tfEditControl, tfWordBreak];
// 描画領域を取得
Include(dFlgs, tfCalcRect);
dDstRect := dSrcRect;
canv.TextRect(dDstRect, dStr, dFlgs);
Exclude(dFlgs, tfCalcRect);
// 描画領域を計算
dAdjust := ((dSrcRect.Bottom - dSrcRect.Top) - (dDstRect.Bottom - dDstRect.Top)) div 2;
dDstRect.Top := dDstRect.Top + dAdjust;
dDstRect.Bottom := dDstRect.Bottom + dAdjust;
// 文字列を描画
canv.Font := Self.Font;
rgn := CreateRectRgn(dRect.Left, dRect.Top, dRect.Right, dRect.Bottom);
SelectClipRgn(canv.Handle, rgn);
canv.TextRect(dDstRect, dStr, dFlgs);
SelectClipRgn(canv.Handle, HRGN(nil));
DeleteObject(rgn);
finally
canv.Free;
end;
end;
{ 実装部追加 (ここまで) ------------------------------------------------------ }
end.
|
個人的に使うかと言われれば...微妙ですね。"Enabled = False" の場合のグレーアウトの表現が難しくなっちゃいますし、フォーカス矩形の表示位置は OS / テーマ 依存だと思いますし...。
かと言って、本格的にオーナードローしようとすると、Delphi のバージョンによってやらなきゃいけない事が違うんですよね...XE2 からは VCL テーマがありますし。
2013/01/25
Delphi Include File (*.inc)
さて、先日は TCheckBox 絡みのコードを書いたのですが、ちょっと面倒な事があります。このコードを記述したフォームを継承したとしても、継承フォームに TCheckbox を追加で貼り付けると色変更が効かないのです...つまり、色変更をしたいフォームすべてにあのコードを記述するしかありません。
面倒ですけれど、百歩譲ってコピペするとしましょう。件のコードにバグがあったり、仕様変更したい場合にはすべてのフォームを見直さなくてはならなくなります。フォームが 100 あればすべてを見直さなければなりません (sed 等を使って一括置換するってのもアリはアリですけど...)。ではこれをインクルードファイルを使って解決してみましょう。
まず、あのコードを CheckboxFix.inc という名前でファイルにします。コードは以下のようになります。
[CheckboxFix.inc] |
// -----------------------------------------------------------------------------
// 宣言部のコード
// -----------------------------------------------------------------------------
{$IFNDEF CHBFIX_PASS1}
type
TCheckBox = class(Vcl.StdCtrls.TCheckBox) // XE2 またはそれ以降
//TCheckBox = class(StdCtrls.TCheckBox) // XE またはそれ以前
private
FOriginalCaption: string;
_MySetCap: Boolean;
procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
end;
{$ENDIF}
// -----------------------------------------------------------------------------
// 実装部のコード
// -----------------------------------------------------------------------------
{$IFDEF CHBFIX_PASS1}
procedure TCheckbox.CMTextChanged(var Message: TMessage);
begin
inherited;
if _MySetCap then
Exit;
FOriginalCaption := Caption;
end;
procedure TCheckbox.WMPaint(var msg: TWMPaint);
var
BtnWidth: Integer;
canv: TControlCanvas;
dRect, dSrcRect, dDstRect: TRect;
dStr: string;
dFlgs: TTextFormat;
dAdjust: Integer;
rgn: HRGN;
begin
// テーマが無効か、ParentColor と ParentFont が True なら
// オリジナルの描画を呼び出して抜ける
if (not ThemeServices.ThemesEnabled) or
(Self.ParentColor and Self.ParentFont) then
begin
inherited;
Exit;
end;
// Caption 文字列の退避
_MySetCap := True;
if not (csDesigning in ComponentState) then
Caption := '';
_MySetCap := False;
// オリジナルの描画方法で "チェックボックス + 空文字列" を描画
inherited;
canv := TControlCanvas.Create;
try
// 文字列領域 (フォーカス矩形-1) を取得
canv.Control := Self;
BtnWidth := GetSystemMetrics(SM_CXMENUCHECK);
dRect := Rect(BtnWidth, 1, Self.Width-1, Self.Height-1);
// 背景色で塗り潰し
if Self.ParentColor then
SetBkMode(canv.Handle, Ord(TRANSPARENT))
else
begin
canv.Brush.Color := Self.Color;
canv.FillRect(dRect);
end;
// TextRect のパラメータ生成
dSrcRect := dRect;
dSrcRect.Left := dSrcRect.Left + 2;
dSrcRect.Right := dSrcRect.Right - 2;
dStr := FOriginalCaption;
dFlgs := [tfLeft, tfVerticalCenter];
if Self.WordWrap then
dFlgs := dFlgs + [tfEditControl, tfWordBreak];
// 描画領域を取得
Include(dFlgs, tfCalcRect);
dDstRect := dSrcRect;
canv.TextRect(dDstRect, dStr, dFlgs);
Exclude(dFlgs, tfCalcRect);
// 描画領域を計算
dAdjust := ((dSrcRect.Bottom - dSrcRect.Top) - (dDstRect.Bottom - dDstRect.Top)) div 2;
dDstRect.Top := dDstRect.Top + dAdjust;
dDstRect.Bottom := dDstRect.Bottom + dAdjust;
// 文字列を描画
canv.Font := Self.Font;
rgn := CreateRectRgn(dRect.Left, dRect.Top, dRect.Right, dRect.Bottom);
SelectClipRgn(canv.Handle, rgn);
canv.TextRect(dDstRect, dStr, dFlgs);
SelectClipRgn(canv.Handle, HRGN(nil));
DeleteObject(rgn);
finally
canv.Free;
end;
end;
{$ENDIF}
{$DEFINE CHBFIX_PASS1}
|
*.inc ファイルは [ファイル | 新規作成 | その他] で "テキストファイル" を選ぶと作れます。保存の際に CheckboxFix.inc という名前にしてください。
フォームの方のコードは次のようになります。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Themes;
{$I 'CheckboxFix.inc'} // 1 回目のインクルード
type
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{$I 'CheckboxFix.inc'} // 2 回目のインクルード
end.
|
CheckboxFix.inc を 2 回インクルードしているのは、C / C++ を使った事のある方からすると不思議に思えるかもしれません。Delphi ユーザの方でも、途中まで読んで 「宣言部と定義部に 2 つのインクルードファイルを使うんだろ?」 と思われたかもしれませんね。
これは "{$DEFINE} で指定された 'コンパイラ指令用の条件シンボル' はそのユニット内だけで有効" というのを使ったトリック的なコードです。
初回のインクルードでは、条件シンボル "CHBFIX_PASS1" が定義されていないので宣言部のコードが読み込まれ、実装部のコードは無視されます。最後まで読み込まれたら、そこで CHBFIX_PASS1 が定義されます。二回目のインクルードでは、条件シンボル "CHBFIX_PASS1" が定義されているので宣言部のコードが無視され、実装部のコードが読み込まれます。最後まで読み込まれたら、また CHBFIX_PASS1 が定義されますが、動作に影響はありません。ユニット内で {$DEFINE} により定義された条件シンボルのスコープはユニットなので、{$UNDEF CHBFIX_PASS1} する必要もありません。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Themes;
{$IFNDEF CHBFIX_PASS1}
// 宣言部のコード (読み込まれる)
{$ENDIF}
{$IFDEF CHBFIX_PASS1}
// 実装部のコード (無視される)
{$ENDIF}
{$DEFINE CHBFIX_PASS1} // ここで CHBFIX_PASS1 が定義される
type
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{$IFNDEF CHBFIX_PASS1}
// 宣言部のコード (無視される)
{$ENDIF}
{$IFDEF CHBFIX_PASS1}
// 実装部のコード (読み込まれる)
{$ENDIF}
{$DEFINE CHBFIX_PASS1} // {$UNDEF CHBFIX_PASS1} で定義を解除する必要はない
end.
|
このように展開されるという事です。Delphi のインクルードファイルは、"そこに別ファイルが読み込まれる"ような感じになります (begin ~ end 内の一部だけをインクルードする事はできませんので、ファイルを差し込んでいるというのも少し違いますが)。
インクルードファイルを効果的に使えば、コードを集約してリファクタリングみたいな事ができる場合があります。もちろん、コードはそこに展開されるのですから生成されたバイナリが小さくなる訳ではありませんが、あっちこっちにコピペコードがとっ散らかるのを防ぐことができます。
この "条件シンボル + 2 回インクルード" の手法は "Templates in Object Pascal (EDN)" のコメ欄で知りました。元ネタは {$IFNDEF} ({$DEFINE name}) {$ELSE} {$ENDIF} で書かれていますが、
{$IFNDEF SECOND_PASS}
// -----------------------------------------------------------------------------
// 宣言部のコード
// -----------------------------------------------------------------------------
{ ここに宣言部のコードを記述}
{$DEFINE SECOND_PASS}
{$ELSE}
// -----------------------------------------------------------------------------
// 実装部のコード
// -----------------------------------------------------------------------------
{ ここに実装部のコードを記述}
{$ENDIF}
|
or
// -----------------------------------------------------------------------------
// 宣言部のコード
// -----------------------------------------------------------------------------
{$IFNDEF SECOND_PASS}
{ ここに宣言部のコードを記述}
{$DEFINE SECOND_PASS}
// -----------------------------------------------------------------------------
// 実装部のコード
// -----------------------------------------------------------------------------
{$ELSE}
{ ここに実装部のコードを記述}
{$ENDIF}
|
{$ELSE} を使うと宣言部のコードと実装部のコードを分けて書けない (インクルードファイル内に、さらに条件コンパイル指令があると読みにくくなる) ので、個人的には多少冗長になったとしても {$ELSE} を使わないコードの方が好きです。
// -----------------------------------------------------------------------------
// 宣言部のコード
// -----------------------------------------------------------------------------
{$IFNDEF SECOND_PASS}
{ ここに宣言部のコードを記述}
{$ENDIF}
// -----------------------------------------------------------------------------
// 実装部のコード
// -----------------------------------------------------------------------------
{$IFDEF SECOND_PASS}
{ ここに実装部のコードを記述}
{$ENDIF}
{$DEFINE SECOND_PASS}
|
コメントが書きやすいですしね。
なお、インクルードファイルは uses と違い〔Ctrl〕+ 左クリック でファイルを開く事はできませんが、キャレットを '~.inc' の中に置いて 〔Ctrl〕+〔Enter〕すればファイルを開く事ができます。
身も蓋もない事を言ってしまうと...
今回の件だけなら、普通は別ユニットにして、
[uCheckBoxFix.pas] |
unit uCheckBoxFix;
interface
uses
System.Classes, System.SysUtils, Winapi.Windows, Winapi.Messages,
Vcl.Graphics, Vcl.Controls, Vcl.StdCtrls, Vcl.Themes;
type
TCheckBox = class(Vcl.StdCtrls.TCheckBox) // XE2 またはそれ以降
//TCheckBox = class(StdCtrls.TCheckBox) // XE またはそれ以前
private
FOriginalCaption: string;
_MySetCap: Boolean;
procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
end;
implementation
procedure TCheckbox.CMTextChanged(var Message: TMessage);
begin
// 省略
end;
procedure TCheckbox.WMPaint(var msg: TWMPaint);
begin
// 省略
end;
end.
|
フォームの方に、
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Unit1, Vcl.StdCtrls, uCheckBoxFix;
type
TCheckBox = uCheckBoxFix.TCheckBox; // これを追加
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
end.
|
ってやるんでしょうけどね。インクルードファイルを使うやり方が効果的なのは "Templates in Object Pascal (EDN)" にもあるように、(演算子のオーバーロードのような) 決まりきったコードを外に出す時くらいでしょうかね。
共通部分を外に出す
TCheckBox の文字色 / 背景色の問題は TRadioButton にもあります。やる事は全く同じなので、普通にやると同じコードを 2 回書かなくてはなりません。
先述のインクルードファイルを使って共通部分を一つにしてみましょう。
[ThemeFix.inc] |
// -----------------------------------------------------------------------------
// 宣言部のコード
// -----------------------------------------------------------------------------
{$IFNDEF THEMEFIX_PASS1}
private
FOriginalCaption: string;
_MySetCap: Boolean;
procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
end;
{$ENDIF}
// -----------------------------------------------------------------------------
// 実装部のコード
// -----------------------------------------------------------------------------
{$IFDEF THEMEFIX_PASS1}
procedure _TThemeFix.CMTextChanged(var Message: TMessage);
begin
inherited;
if _MySetCap then
Exit;
FOriginalCaption := Caption;
end;
procedure _TThemeFix.WMPaint(var msg: TWMPaint);
var
BtnWidth: Integer;
canv: TControlCanvas;
dRect, dSrcRect, dDstRect: TRect;
dStr: string;
dFlgs: TTextFormat;
dAdjust: Integer;
rgn: HRGN;
begin
// テーマが無効か、ParentColor と ParentFont が True なら
// オリジナルの描画を呼び出して抜ける
if (not ThemeServices.ThemesEnabled) or
(Self.ParentColor and Self.ParentFont) then
begin
inherited;
Exit;
end;
// Caption 文字列の退避
_MySetCap := True;
if not (csDesigning in ComponentState) then
Caption := '';
_MySetCap := False;
// オリジナルの描画方法で "チェックボックス + 空文字列" を描画
inherited;
canv := TControlCanvas.Create;
try
// 文字列領域 (フォーカス矩形-1) を取得
canv.Control := Self;
BtnWidth := GetSystemMetrics(SM_CXMENUCHECK);
dRect := Rect(BtnWidth, 1, Self.Width-1, Self.Height-1);
// 背景色で塗り潰し
if Self.ParentColor then
SetBkMode(canv.Handle, Ord(TRANSPARENT))
else
begin
canv.Brush.Color := Self.Color;
canv.FillRect(dRect);
end;
// TextRect のパラメータ生成
dSrcRect := dRect;
dSrcRect.Left := dSrcRect.Left + 2;
dSrcRect.Right := dSrcRect.Right - 2;
dStr := FOriginalCaption;
dFlgs := [tfLeft, tfVerticalCenter];
if Self.WordWrap then
dFlgs := dFlgs + [tfEditControl, tfWordBreak];
// 描画領域を取得
Include(dFlgs, tfCalcRect);
dDstRect := dSrcRect;
canv.TextRect(dDstRect, dStr, dFlgs);
Exclude(dFlgs, tfCalcRect);
// 描画領域を計算
dAdjust := ((dSrcRect.Bottom - dSrcRect.Top) - (dDstRect.Bottom - dDstRect.Top)) div 2;
dDstRect.Top := dDstRect.Top + dAdjust;
dDstRect.Bottom := dDstRect.Bottom + dAdjust;
// 文字列を描画
canv.Font := Self.Font;
rgn := CreateRectRgn(dRect.Left, dRect.Top, dRect.Right, dRect.Bottom);
SelectClipRgn(canv.Handle, rgn);
canv.TextRect(dDstRect, dStr, dFlgs);
SelectClipRgn(canv.Handle, HRGN(nil));
DeleteObject(rgn);
finally
canv.Free;
end;
end;
{$ENDIF}
{$DEFINE THEMEFIX_PASS1}
|
[uCheckBoxFix.pas] |
unit uCheckBoxFix;
interface
uses
System.Classes, System.SysUtils, Winapi.Windows, Winapi.Messages,
Vcl.Graphics, Vcl.Controls, Vcl.StdCtrls, Vcl.Themes;
type
_TThemeFix = class(Vcl.StdCtrls.TCheckBox) // XE2 またはそれ以降
//_TThemeFix = class(StdCtrls.TCheckBox) // XE またはそれ以前
{$I 'ThemeFix.inc'}
implementation
{$I 'ThemeFix.inc'}
end.
|
[uRadioButtonFix.pas] |
unit uRadioButtonFix;
interface
uses
System.Classes, System.SysUtils, Winapi.Windows, Winapi.Messages,
Vcl.Graphics, Vcl.Controls, Vcl.StdCtrls, Vcl.Themes;
type
_TThemeFix = class(Vcl.StdCtrls.TRadioButton) // XE2 またはそれ以降
//_TThemeFix = class(StdCtrls.TRadioButton) // XE またはそれ以前
{$I 'ThemeFix.inc'}
implementation
{$I 'ThemeFix.inc'}
end.
|
このようにして共通化できます。使い方は次の通りです。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, uCheckBoxFix, uRadioButtonFix;
type
TCheckBox = class(uCheckBoxFix._TThemeFix ); // 追加
TRadioButton = class(uRadioButtonFix._TThemeFix); // 追加
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
end.
|
実用的かどうかはさておき、"こんな事もできますよ" という例でした。
2013/01/29
Vista でメモリ 1GB (最大 2GB)、CPU も非力な Intel Celeron M 440 (1.86GHz) というオイオイなノート PC。2007年夏モデルだから、5 年半前の機種という事になる。型番の後ろに B が付くのは "ベスト電器モデル" だから。
クソ遅い以外は問題ないので CPU を交換する事にした。社内に、全く動作しない Toshiba dynabook Satellite T30 166E/5W があったので、Core 2 Duo を頂くことにする。こちらも無線 LAN は内蔵していないわ、DVD-ROM だわで、ちょっとオイオイではある。
上記サイトの分解手順を参考にして、サクっと CPU 交換完了。起動してみたらちゃんと動いた。めでたしめでたし...では終わらんのよなぁ (^-^)
いろいろと検証すると不可解な現象に遭遇する。AC アダプタ挿すとハングアップするとか、BIOS 画面が出なくなったら HDD 抜かないと起動しないとか。熱暴走というより、フルパワーになったら電源足りてないとか、省電力機構がうまく動いてないとかそんな感じ。要は BIOS が T5500 に対応していないのだろうと思う。
仕方ないのでメモリを 1.5GB にして、Toshiba dynabook Satellite T30 166E/5W の黒キーボードを移植する事にした(白は汚れが目立つので予備にしようかと)。そのうちメモリと HDD を増設すっか。
追記: AC アダプタで起動しない/フリーズするのは有名な問題らしく、CPU 裏の NEC TOKIN OE128 (Proadlizer=プロードライザ) が劣化しているのが原因のようです。
2013/01/30
XE3 Update2 リリース
Rad Studio / Delphi / C++Builder XE3 の Update 2 がリリースされました。
リリースノートはこちらです。主に C++Builder 向けのアップデートのようです。Resolved で Checked In の QC がまだまだあるので、比較的早期に Update3 がリリースされる気がします。ひょっとすると Mobile Studio のリリースに合わせて出してくるのかもしれませんね。
2013/01/31
タイトルのまんまですが。アップグレード対象は
- Windows XP SP3
- Windows Vista
- Windows 7
- Windows 8 Consumer Preview
- Windows 8 Release Preview
となっています。Windows 8 Enterprise 90 日評価版からはアップグレードできませんが、Windows 7 Enterprise 90 日評価版からは何故かアップグレードできるようです。
MSDN とかに加入してる人にはメリットはないかもしれませんが、「一つ位持っていてもいいか」 と思っちゃう値段ですね。Windows 8 Pro には Media Center が付属していませんが、今なら Windows Media Center Pack も無償で入手できます。
小宮さん作の正規表現ライブラリです。「SkRegExp は逆方向検索できない」 とダメ出しされたとか...ここにも書いてありますが、理屈を考えればサポートしていない理由は簡単に想像できるでしょうにね。
細川さんによる TCheckBox の件の別解。VCL Style を用いた手法で TCheckBox の文字色 / 背景色の変更を実現するというものです。