インコとチョコグラその3

アカハラウロコインコのお腹がかなり赤くなってきました。月末で丁度生後6か月です。
3月6日に上げた写真と同じアングルから撮れたので比較するとわかりやすいかも。

(このくらいの距離でカメラを向けるとなぜかボワッと膨らみます)

家にきた2月11日はこんな感じ

ほとんど赤みがありません。初日からずいぶん人懐っこい仔でした。当初から(今も相変わらず)ビビリで飛び回ってますが、かなり慣れてます。

チョコグラの幼魚のほうですが、29匹無事に育ってます。
真面目に定規で大きさを測ったところ32～33mmあるようです。餌を多目に与えてるのでまた成長速度があがった感じ

インコもチョコグラも元気

相変わらずblog放置気味ですが、インコもチョコグラも元気にしてます

すっかり家にも慣れて

でろーんとしたり、

手に持たれかかって寝たりしてます。
メスなので本当は背中などを撫ぜる癖はつけたくないけど(将来、過発情させたくないので)、背中から手で包まれるのが一番安心するみたい。

昼間、一羽で寂しそうなので仲間を迎える予定。繁殖させるつもりなないのでカゴは一緒にはしないけど、今度はオスが良いと思ってる。オスが来たら思う存分撫ぜ回す予定。

チョコグラも徐々には大きくなってます。29匹ちゃんと生きてます

写真だと成長具合はわかりにくいかな

インコ

blogを放置気味でしたが、先月からインコを飼ってます。

ウロコインコという種類。正確にはアカハラウロコインコといって南米の中型インコです。
2011年11月1日生まれ♀。来た当初は62～66g。3/6現在で66～68g。よく慣れてます。そしてよく噛みます^^;) これから時々blogにも登場するかも。

あ、チョコグラの稚魚もちゃんと育ってます。ブラインシュリンプから乾燥飼料に切り替えたので成長は遅いですが。（見た目にはあまり大きくなってませんが大きな個体は25mmくらいにはなってます）

チョコレートグラミーの稚魚(吐き出しから35日目)

あまり変化ないような気もしますが、チョコグラの稚魚の写真。大きい個体は18～19mmくらい。
縞模様が親に近づいてます

産卵ネットがかなり手狭になってきた：(この画像だけ32日目)

オスがまた卵を咥えてます

チョコレートグラミーの稚魚(吐き出しから29日目)

吐き出しから29日目。一番大きい個体は16～17mmくらい。他は15mm以下な感じ。
成長が緩やかになってきたかな

毎日数えてるんだけど、いつの間にか30匹になってしまってます。調子を崩したような感じもなかったので、産卵ネットから餌やり用のプラケースに移す時か、プラケースの水を変えるときに本水槽に逃げ出してしまったのかも。最近体がしっかりしてきていて、掬うときに少し飛び出しそうになるので。
本水槽を目を凝らしてみても見つかりません。どこへいった

チョコレートグラミーの稚魚(吐き出ししから21日目)

チョコレートグラミーの稚魚、順調に成長してます。
一番大きい個体は全長12mmくらい？かな。尾びれが透明なので正確にはわからず。

2つの産卵ネットに分けて育てていましたが成長の差が出てきたので、成長がよさそうな45cm CUBE水槽にすべて収容しました。一回りくらいの差が出てるかも。

チョコレートグラミー産卵＆孵化

一昨年導入したチョコグラが産卵しました。
去年も一度産卵して、オスが卵を咥えていたんだけど、グッピー用の産卵ケース（底が細くなってるタイプ）に隔離したせいか、親魚を疲弊させ、死なせてしまっていました。

その後、何回か卵を咥えているっぽい事があったけどそのままにしていたんですが、去年の12月に明らかに卵を咥えている個体がいたので、ためしに隔離していました。（今回は産卵ネットのみで底が平らなので親魚の負担も少なかった様子）

年明けくらいに稚魚を吐くといいなと思ってたところ12/29に稚魚を吐きだしていました：

最初は4匹だけだったのが、最終的には41匹も吐き出してました。かなり小さなオスだったので思いの他稚魚の数が多くてびっくり。
残念ながら稚魚を吐きだす瞬間を一度も目撃できず。

とりあえず20匹をチョコグラの親水槽に浮かべたネットに、残りの21匹を45cm Cubeに浮かべておきました。

ただ、年末で家を留守にする時期だったため稚魚へのエサは31日の朝にブラインを与えることができたものの、1/4までほぼ絶食状態でした。早めに帰宅したものの、冷凍ブラインは食べないし、粉餌ももちろん食べません。ブラインの孵化には24時間以上かかるので結構焦りました。

吐き出し後8日目(1/5)：

後で稚魚の数を数えたところ、チョコグラの親水槽の稚魚は20匹から12匹に減ってしまってました。申し訳ない。
45cm Cubeのほうは21匹全て生きていたものの、10日目までに、生まれた時からベリースライダー？のようだった個体を含め2匹を死なせてしまい、現状は19匹の計31匹になってます。
親水槽よりも45cm cubeのほうが生存率がよかった理由はわからず。ミジンコ類が結構湧いていたからかもしれません。

吐き出し後15日目(1/12)：

最初の絶食が悪かったのか、ネットで見かける繁殖例に比べて少し小さいかな。目測7mmくらい。
でもしっかりとチョコレートグラミーの体型になってきてます。眼をギョロっと動かして可愛い。

» 続きを読む

FireMonkeyでのショートカット(Windows)

以前の記事でWindowsのショートカットの動作にも問題があると書きましたが、解決法を上げるのを忘れてました。

私の見逃しかもしれませんが、FireMonkey/Winのコード中にはショートカットキー処理するコードがありません。
実際にショートカットを設定しても動作しないので、間違ってはいないと思います。おそらくまだ作りかけなんでしょう。
この件に関しては、そのうちアップデートで治ると思いますので正式対応を待ってもいいと思っていますが、 エンバカの公式フォーラムで困っている人がいるのを見つけたので(無理やりな)解決方法を書いておきます。

まず次のようなクラスを作ります:

interface
{$IFDEF MSWINDOWS}
uses
  System.Classes, Winapi.Windows, Winapi.Messages, FMX.Menus;

type
  TAccelkeyTable = class
  private
    var FTable : array of TMenuItem;
  protected

  public
    procedure Init;
    procedure Add(menuitem : TMenuItem);
    procedure Remove(menuitem : TMenuItem);
    function  Translate(var msg : TMsg) : Boolean;
    function  CheckShortCut(Handle : HWND; var Key: Word; var KeyChar: System.WideChar;  Shift: TShiftState): Boolean;
  end;

var
  AccelKeyTable : TAccelKeyTable = nil;


{$ENDIF}
implementation
{$IFDEF MSWINDOWS}

{ TAccelkeyTable }

procedure TAccelkeyTable.Add(menuitem: TMenuItem);
var
  i : integer;
begin
  i := Length(FTable);
  SetLength(FTable, i+1);
  FTable[i] := menuitem;
end;

procedure TAccelkeyTable.Init;
begin
  Initialize(FTable);
end;

procedure TAccelkeyTable.Remove(menuitem: TMenuItem);
var
  i, cnt : integer;
begin
  cnt := Length(FTable);
  for i := 0 to cnt-1 do
  begin
    if FTable[i] = menuitem then
    begin
      FTable[i] := nil;
      break;
    end;
  end;
end;

function TAccelkeyTable.Translate(var msg: TMsg): Boolean;
var
  Shift : TShiftState;
  Key : Word;
  KeyChar : System.WideChar;
begin
  result := false;
  if msg.message = WM_KEYDOWN then
  begin
    Shift := [];
    if (GetKeyState(VK_SHIFT) and $80) <> 0 then Shift := Shift + [ssShift]
    else if (GetKeyState(VK_CONTROL) and $80) <> 0 then Shift := Shift + [ssCtrl]
    else if (GetKeyState(VK_MENU) and $80) <> 0 then Shift := Shift + [ssAlt];

    Key := LOWORD(msg.wparam);
    KeyChar := System.WideChar(LOWORD(msg.lParam));
    result := CheckShortCut(msg.hwnd, Key, KeyChar, Shift);
  end;
end;

function TAccelkeyTable.CheckShortCut(Handle : HWND; var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState) : Boolean;
var
  i, cnt : integer;
  sc : TShortCut;
begin
  result := false;

  sc := scNone;
  if ssShift in Shift then sc := sc or scShift
  else if ssCtrl in Shift then sc := sc or scCtrl
  else if ssAlt in Shift then sc := sc or scAlt;

  if Key > 32 then
  begin
    sc := sc or Key;
    //Application.MainForm.Caption := ShortCutToText(sc); // debug
    cnt := Length(FTable);
    for i := 0 to cnt-1 do
    begin
      if (FTable[i] <> nil) and (FTable[i].ShortCut = sc) then
      begin
        SendMessage(Handle, WM_COMMAND, NativeUInt( FTable[i] ), 0);
        result := true;
        break;
      end;
    end;
  end;
end;

initialization

{$ENDIF}
end.

このクラスのインスタンスを作り、ショートカットを設定したTMenuItemをすべて登録してください：

  AccelKeyTable.Add( mnuSaveAs );
  AccelKeyTable.Add( mnuCopy );
    ....
みたいな感じ

個人的にはTMainMenu/TMenuItemを派生したクラスを作って自動で登録するようにしてます。

次に、ショートカットキーが押された時にコマンドを実行するための処理を呼び出します。FireMonkeyのソースコードを見るとWM_COMMANDのwparamにTMenuItemのインスタンスを渡してメッセージを送ることでTMenuItem.Clickが実行されるようなので、キーイベントでWM_COMMANDをSendMessage()してやるようにします。

これも個人的にはFMX.Platform.Winのメッセージループを書き換えたりして実験してますが、もう少し単純にフォームのKeyDown()メソッドをoverrideして呼び出す方法を記載しておきます。

interface
　　・・・
type
  TForm1 = class(TForm)
　　・・・
　protected
　　・・・
     procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override;
　　・・・
　　・・・
  end;

implementation

　　・・・

procedure TForm1.KeyDown(var Key: Word; var KeyChar: System.WideChar;  Shift: TShiftState);
begin
{$ifdef MSWINDOWS}
  if not AccelKeyTable.CheckShortCut(FmxHandleToHWND(Handle), Key, KeyChar, Shift) then
    inherited;
{$else}
  inherited;
{$endif}
end;

　　・・・

FireMonkey小ネタ その2

昨日の記事、一つ問題が解決したので更新しました

昨日書こうと思ってたのに忘れてた小ネタを2つ追加。
調べればすぐにわかる情報ですが、FireMonkey向けの情報として一か所にまとまっていることにも意味があると思うので掲載。

6.TControl.ClientToScreen(), TControl.ScreenToClient()の代わり
FireMonkeyの場合、LocalToScreen()とScreenToLocal()が該当の機能です。・・・が、なぜかprotectedメンバーなので外部からアクセスできません。
・・・ですが、IControlのメソッドなのでコントロールをIControlでキャストすればアクセスできます。

screen := (ctrl as IControl).localToScreen(local);
や
local := (ctrl as IControl).ScreenToLocal(screen);
みたいな感じ

こういうVCLと同じ機能は名前もアクセス指定子もVCL準拠にして欲しかった。
何か意図するところがあるんでしょうけど。


7.マウスカーソル位置の取得・変更
マウス位置はPlatform.GetMousePos()で取得可能ですが、マウス位置を変更する方法が用意されていません。
マウス位置を変更するアプリは行儀が悪いってのは置いておいて、たまにやりたくなるのでこんなクラスを作りました。

unit FMXMouse;

interface
uses
  System.Types, FMX.Platform
{$ifdef MSWINDOWS}
  ,Winapi.Windows
{$endif}
{$ifdef MACOS}
  ,Macapi.CoreGraphics, Macapi.CocoaTypes
{$endif}
  ;

type
  TMouse = class
  public
    procedure SetCursorPos(const point : TPointF);
    function  GetCursorPos: TPointF;

    property CursorPos : TPointF read GetCursorPos write SetCursorPos;
  end;

var
  Mouse : TMouse = nil;

implementation


{ TMouse }

{$ifdef MACOS}
procedure TMouse.SetCursorPos(const point: TPointF);
var
  cgpoint : NSPoint;
begin
  cgpoint.x := point.X;
  cgpoint.y := point.Y;
  CGWarpMouseCursorPosition(cgpoint);
end;
{$endif}

{$ifdef MSWINDOWS}
procedure TMouse.SetCursorPos(const point: TPointF);
begin
  Winapi.Windows.SetCursorPos(round(point.X), round(point.Y));
end;
{$endif}

function TMouse.GetCursorPos: TPointF;
begin
  result := Platform.GetMousePos;
end;

initialization

  Mouse := TMouse.Create;

finalization

  Mouse.Free;

end.

ユニット名、クラス名などはお好きにどうぞ。
マウス座標なのでTPointでも良いのですが、FireMonkey内ではTPointFが使われることが多いのでTPointFで座標を返すようにしました

FireMonkey小ネタ5つ(未解決ネタも含む)

1．WinとOSXでMouseUpイベントの引数の値が違う
VCLやWinのFMXだとMouseUpイベントのShiftにはUpしたボタンの情報が含まれませんがOSXでは含まれます。
(例えば左ボタンのUPイベントなのにssLeftがShiftに含まれる)

なので以下のようなコードでMouseUp時に他のマウスボタンが押されていないことを確認する処理があるとWin/OSXで異なった結果になります

  if Shift*[ssLeft,ssMiddle,ssRight] = [] then
    ...

仕方ないので、こう書いて回避

  case Button of
    TMouseButton.mbLeft  : Shift := Shift - [ssLeft];
    TMouseButton.mbRight : Shift := Shift - [ssRight];
    TMouseButton.mbMiddle: Shift := Shift - [ssMiddle] ;
  end;

  if Shift * [ssLeft, ssMiddle, ssRight] = [] then
    ...

2.自作コンポーネントにTBitmap型のプロパティを持たせて、画像をシリアライズしようとすると画像がだんだんと劣化する

どうやらα値が無いBitmapの場合はjpegで格納するようです。

jpegで格納されても全然うれしくないのでTBitmapを派生した次のようなクラスのインスタンスをTBitmap型のプロパティに突っ込んで回避。必ずPNGでシリアライズされるようになります

interface
  TESXBitmap = class(TBitmap)
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure ReadBitmap(Stream: TStream);
    procedure WriteBitmap(Stream: TStream);
  end;
  
implementation
{ TESXBitmap }

procedure TESXBitmap.DefineProperties(Filer: TFiler);
begin
  Filer.DefineBinaryProperty('PNG', ReadBitmap, WriteBitmap, Width * Height > 0);
end;

procedure TESXBitmap.ReadBitmap(Stream: TStream);
begin
  LoadFromStream(Stream);
end;

procedure TESXBitmap.WriteBitmap(Stream: TStream);
var
  Filter: TBitmapCodec;
  this : TBitmap;
begin
  filter := DefaultBitmapCodecClass.Create;
  this := self;
  filter.SaveToStream(Stream, this, 'png');
  filter.Free;
end;

3．自作コンポーネント内部で動的に生成したサブコンポーネントもシリアライズされてしまう

内部で生成したサブコンポーネントのParentに自作コンポーネントを指定すると、.fmxにシリアライズされます。シリアライズされる前提で設計すれば問題ないかもしれないですが、interface部に公開したくないワンオフのサブコンポーネントまで シリアライズしようとするので困りもの。

今の所回避方法がわかってないので、デザイン時はサブコンポーネントを生成しないようにして回避してます。
回避方法について情報をお持ちの方、教えてください。

20111015: @onimaro2010さんから情報をいただきました。サブコンポーネントを生成した後に、Storedプロパティをfalseにすれば良いようです。ありがとうございます。


4．非VisualコンポーネントはTComponentから派生しないと、TDataModuleに置けない

例えばFireMonkeyアプリでしか使わないからと、TFmxObjectを派生してコンポーネントをつくると、フォームには配置できるのにDataModuleには配置できなくなります。

20111018: @lynatanさんから情報をいただきました。DelphiQ&Aに投稿されていた記事によると、DataModuleのClassGroupプロパティを変更すればようようです。上の例だとFMX.Types.TFmxObjectにすればOK


5．自作コンポーネント用のstyleをパッケージに含ませる方法がわからない
styleファイルをrcdataにしてリソースに含ませるのかなと思いますが方法がわからない。ご存じの方教えてください。