🍸 👲🏻 👰🏾 macOS上のDelphiでObjective-Cのコードブロックを使用する：ブリッジの構築方法 👨🏾‍🏫 👨🏿‍🏫 🍀

おそらく、ゴム製のアヒルのデバッグ方法と呼ばれるプログラミングの問題を解決する素晴らしい方法を聞いたことがあるでしょう。この方法の本質は、トイレに座って、リラックスし、水におもちゃのアヒルを置いて、解決策が見つからない問題の本質を彼に説明することです。そして、奇跡的に、そのような会話の後、解決策が見つかりました。

Habrに関する前回の記事では、macOS用のWi-Fiネットワークを検査するプログラムの開発について話しましたが、Habrがアヒルの子であることが判明しました。DelphiのObjective-Cからコードブロックを実装する方法を考え出すことができなかった。そしてそれは助けた！啓発が来て、それはすべてうまくいきました。思考の流れと最終結果についてお伝えしたいと思います。

したがって、前の記事を読んでいない人のために、もう一度問題の本質を簡単に概説してください。コード下ブロック - C ++、及びDelphiでサポートされていないのObjective-Cの言語機能。より正確には、Delphiはその対応のコードブロックを持っていますが、それは私達のMacOS用APIの各1から期待するコードブロック、と互換性がありません。実際、多くのクラスには、完了ハンドラーとしてコードブロックを使用する関数があります。最も単純な例- beginWithCompletionHandlerクラスNSSavePanel

とNSOpenPanel

。送信されたコードブロックは、ダイアログが閉じたときに実行されます。

 - (IBAction)openExistingDocument:(id)sender { NSOpenPanel* panel = [NSOpenPanel openPanel]; // This method displays the panel and returns immediately. // The completion handler is called when the user selects an // item or cancels the panel. [panel beginWithCompletionHandler:^(NSInteger result){ if (result == NSFileHandlingPanelOKButton) { NSURL* theDoc = [[panel URLs] objectAtIndex:0]; // Open the document. } }]; }

アヒルの子と話した後、私は間違った終わりから問題に近づいていることに気付きました。確かに、この問題はDelphiだけに存在するわけではありません。したがって、他の言語での問題の解決方法から始める必要があります。 Googleの手、そして私たちは、非常に近いPythonとJavaScriptのための私達のトピックコードにあるこことここ。良いスタート：彼らが成功すれば、我々は成功するでしょう。実際には、我々は、フィールドだけで、正しい形式で塗りつぶしを構造を作成する必要があり、そのような構造体へのポインタで、それによって魔法のランプ、私たちは、私たちはブロックするように期待し、これらのクラスのメソッドのMacOSの、渡すことができるようになりますことを。もう少しGugleniya、我々は見つけるヘッダーアップルのサイト上に：

 struct Block_descriptor { unsigned long int reserved; unsigned long int size; void (*copy)(void *dst, void *src); void (*dispose)(void *); }; struct Block_layout { void *isa; int flags; int reserved; void (*invoke)(void *, ...); struct Block_descriptor *descriptor; // imported variables };

パスカルでそれを述べています：

  Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal;

今、ブロックのビットを読み出す（後ブロックが実装されている方法とHabré、 Objective-Cの：両方の作業単位）最も単純な実施例においては、我々は膝で、確立をブロックするように進みます。

 Var OurBlock: Block_Literal; function CreateBlock: pointer; var aDesc: PBlock_Descriptor; begin FillChar(OurBlock, SizeOf(Block_Literal), 0); // Isa –    -,      //    , "NSBlock". OurBlock.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); //    .    cdecl,    . OurBlock.Invoke := @InvokeCallback; //    Block_Descriptor New(aDesc); aDesc.Reserved := 0; //   aDesc.Size := SizeOf(Block_Literal); OurBlock.Descriptor := aDesc; result:= @OurBlock; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ILocalobjectとして'NSBlock'））.GetObjectID）。 Var OurBlock: Block_Literal; function CreateBlock: pointer; var aDesc: PBlock_Descriptor; begin FillChar(OurBlock, SizeOf(Block_Literal), 0); // Isa –    -,      //    , "NSBlock". OurBlock.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); //    .    cdecl,    . OurBlock.Invoke := @InvokeCallback; //    Block_Descriptor New(aDesc); aDesc.Reserved := 0; //   aDesc.Size := SizeOf(Block_Literal); OurBlock.Descriptor := aDesc; result:= @OurBlock; end;

フィールドflags

我々は簡単にするために予備ゼロを行います。後で便利になります。今のところ、空のコールバック関数を宣言する必要があります。コールバック関数への最初の引数は、のインスタンスへのポインタであるNSBlock

、および他のパラメータのリストは、コードブロックの原因となりココアクラスの特定の方法に依存します。上記の例では、とNSSavePanel

、タイプの単一の引数を持つプロシージャNSInteger

。それでは、初心者向けに書きましょう。

 procedure InvokeCallback (aNSBlock: pointer; i1: NSInteger); cdecl; begin Sleep(0); end;

重要な瞬間、ゴールで撃った：

  FSaveFile := TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; objc_msgSendP2( (FSaveFile as ILocalObject).GetObjectID, sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), (NSWin as ILocalObject).GetObjectID, CreateBlock );
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     。  FSaveFile := TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; objc_msgSendP2( (FSaveFile as ILocalObject).GetObjectID, sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), (NSWin as ILocalObject).GetObjectID, CreateBlock );
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ：'））、  FSaveFile := TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; objc_msgSendP2( (FSaveFile as ILocalObject).GetObjectID, sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), (NSWin as ILocalObject).GetObjectID, CreateBlock );

ファイル保存ダイアログが開き、[OK]または[キャンセル]を押して...はい！私たちは、に設定されているポイント、破るために取得Sleep(0)

およびはい、引数i1

、我々がクリックされたダイアログ内のどのボタンに応じて、0または1のどちらかになります。勝利！アヒルの子と私は幸せですが、多くの仕事があります。

コールバック引数の数とタイプは異なる場合があります。最も人気のある特定のセットがありますが、柔軟性が必要です。
多数のコードブロックを同時に動作させることができます。例えば、我々は完了のためのコール完了ハンドラを使用してファイルをダウンロードして、並行して、オープンしてファイル保存ダイアログを閉じることができます。まず、2番目に作成したブロックコードが機能し、ファイルがダウンロードされると、最初のブロックコードが機能します。記録を残しておくといいでしょう。
何らかの方法でコールバックの原因となったブロックを特定し、このブロックに対応するDelphiコードを呼び出す必要があります。
それはすべての利便性と美しさを失わずに匿名のデルファイの方法とコードブロックの間の橋渡しをするために素晴らしいことです。次のような呼び出しをお願いします。

 SomeNSClassInstance.SomeMethodWithCallback ( Arg1, Arg2, TObjCBlock.CreateBlockWithProcedure( procedure (p1: NSInteger) begin if p1 = 0 then ShowMessage ('Cancel') else ShowMessage ('OK'); end) );

コールバックビューから始めましょう。明らかに、最も簡単で信頼性の高い方法は、関数の種類ごとにコールバックを作成することです。

 procedure InvokeCallback1 (aNSBlock: pointer; p1: pointer); cdecl; procedure InvokeCallback2 (aNSBlock: pointer; p1, p2: pointer); cdecl; procedure InvokeCallback3 (aNSBlock: pointer; p1, p2, p3: pointer); cdecl;

などなど。しかし、どういうわけか退屈でエレガントではないでしょうか？したがって、思考はさらに私たちを導く。あなたは、コールバックの一種類のみを宣言した場合、必要な数の引数を読んで、スタックを引数とクロールの番号を知るために、コールバックを引き起こしたユニットの識別情報をキャプチャしますか？

 procedure InvokeCallback (aNSBlock: pointer); cdecl; var i, ArgNum: integer; p: PByte; Args: array of pointer; begin i:= FindMatchingBlock(aNSBlock); if i >= 0 then begin p:= @aNSBlock; Inc(p, Sizeof(pointer)); //      ArgNum:= GetArgNum(...); if ArgNum > 0 then begin SetLength(Args, ArgNum); Move(p^, Args[0], SizeOf(pointer) * ArgNum); end; ... end;

いい考え？いいえ、悪いです。これは、32ビットのコードで動作しますが、64ビットコードにはCDECLが起こらないいないため、64ビットで地獄にクラッシュしますが、一つの共通の呼び出し規約、CDECLとは異なり、引数なしでは、スタック内にあり、しかしプロセッサのレジスタに。それでは、さらに簡単に、次のようなコールバックを宣言します。

 function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl;

そして、必要なだけの引数を読みます。残りの引数にはゴミがありますが、それらには対処しません。また、コードブロックで結果が必要な場合に備えて、プロシージャを機能するように変更しました。免責事項：このアプローチの安全性がわからない場合は、個々のコールバック関数の種類ごとに使用しています。アプローチはかなり安全だと思うが、彼らが言うように、好みは異なる。

識別部に関しては、すべての非常に簡単であることが判明： aNSBlock

コールバックへの最初の引数として、私たちに来て、まったく同じ示しDescriptor

、我々は、作成時にブロックを割り当てます。

今、あなたは、異なる種類の匿名メソッドを行うことができ、私たちは教室のMacOSの中で実際に発生する、引数の可能なセットの90％をカバーし、我々は常にリストを展開することができます：

 type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     、PT3、PT4、PT5、PT6、PT7）。 type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ; CONST ATYPE：TProcType）：ポインタ。 type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end;

したがって、例えば、二つの引数のサイズであり、手順の作成部SizeOf(pointer)

、次のようになります。

 class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）：ポインタ。 class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）、TProcType.pt3）。 class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end;

CreateBlockWithCFuncは次のようになります。

 class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= BlockObj.AddNewBlock(aTProc, aType); end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ; CONST ATYPE：TProcType）：ポインタ。 class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= BlockObj.AddNewBlock(aTProc, aType); end;

そうです。我々はBlockObj、シングルトンクラスのインスタンスにアピールTObjCBlockList

すべてこの経済を管理するために必要とされ、ユニット利用可能外ではありません。

  TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList;

私たちのクラスの「心」はここで勝ちます：

 function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin //           SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); //      FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; //  ,       . , //  copy  displose. ?   . FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; //         : FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); //   -: aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     CONST ATYPE：TProcType）：ポインタ。 function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin //           SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); //      FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; //  ,       . , //  copy  displose. ?   . FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; //         : FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); //   -: aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ]にSizeOf（TBlockInfo）、 function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin //           SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); //      FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; //  ,       . , //  copy  displose. ?   . FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; //         : FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); //   -: aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     BlockStructure.Isa：= NSClassFromString（（StrToNSStr（ 'NSBlock'） function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin //           SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); //      FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; //  ,       . , //  copy  displose. ?   . FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; //         : FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); //   -: aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ：= @InvokeCallback ;. function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin //           SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); //      FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; //  ,       . , //  copy  displose. ?   . FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; //         : FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); //   -: aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end;
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     BlockStructure.Flags：= BLOCK_HAS_COPY_DISPOSE。 function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin //           SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); //      FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; //  ,       . , //  copy  displose. ?   . FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; //         : FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); //   -: aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end;

まあ、すべての基本を書きました。わずかな微妙な点のみが残っています。

まず、異なるスレッドのクラスインスタンスを操作できるように、スレッドセーフを追加する必要があります。それは非常に単純であり、適切なコードを追加しました。

第二に、私たちは知る必要があり、作成した構造を最終的に「ネイル」することができます。配列要素FBlockList

。一見すると、それはすぐにシステムがコールバックを起こしているようとして、ユニットを除去することができるようです： - さんが行われ、すべてのファイルをロードし、完了ハンドラーと呼ばれていました。実際、これは常にそうではありません。何度でも呼び出されるブロックがあります。例えば、この方法ではimageWithSize：ひっくり返さ：drawingHandler：クラスNSImage

万回を発生することが、あなたが知っているように、という絵を描きますブロックへのポインタを渡す必要があります。それは私たちが便利になることをここにあるaDesc.dispose_helper := @DisposeCallback

。プロシージャコールDisposeCallback

ちょうどユニットがもはや必要ないことを通知します、あなたが安全に削除することができます。

ケーキの上のチェリー

そして、同じユニットでセルフテストを書きましょうか？コンパイラの次のバージョンまたは64ビットに切り替えると、突然何かが壊れます。 Cocoaクラスにアクセスせずにブロックをテストするにはどうすればよいですか？これには、Delphiで次のように宣言する必要がある特別な低レベル関数があることがわかります。

  function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock';

最初の関数は、引数として渡したブロックを呼び出すC関数へのポインターを返します。 2番目は単にメモリを「クリーン」にします。我々は素晴らしいクラスの助けを借りて、ブロックを作成する必要がありますので[OK]を、それを渡すimp_implementationWithBlock

、ユニットが働いたかを確認するために受信したアドレスにして屏息で関数を呼び出します。すべてをやろうとしています。オプション1、 ナイーブ：

 class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; func : procedure ( p1, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); func(pointer(1), pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end;

起動して...おっと。 P1 = 1、P2 = 3、P3 = 4、P4 =デブリ：匿名メソッドに陥ります。なに...？誰がデュースを食べましたか？そして、最後のパラメーターのゴミはなぜですか？これは、という事実が判明しimp_implementationWithBlock

あなたのようにブロックを呼び出すことができますトランポリン、返すIMP

。問題は、あるIMP

のObjective-Cには常に2つの最初の引数、必要としていた(id self, SEL _cmd)

すなわちオブジェクトおよびセレクターへのポインター、およびコードブロックの最初に必要な引数は1つだけです。引数のリスト編集を呼び出すときにトランポリンが返さ：第二引数は_cmd

、不要として捨て、その場所に最初の引数を書かれているが、最初の引数の代わりにへのポインタを代入するNSBlock

。

はい、このように、トランポリンは気付かれずに忍び寄りました。さて、第二の選択肢、右：

 class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // , _cmd  ! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end;

これですべてがスムーズになり、ブロックの操作を楽しむことができます。ユニット全体をダウンロードすることができ、ここで以下閲覧します。コメント（「記憶、ここにあなたの記憶が流れている」）と改善のための提案を歓迎します。

完全なソースコード

 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     、いかなる種類の保証もなく、明示または {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     商品性の保証、 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     請求、損害またはその他の {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     、不法行為もしくはその他から生じます、 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     .Wnd。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     completionHandler：'））、 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     、 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     、PT3、PT4、PT5、PT6、PT7）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ; CONST ATYPE：TProcType）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     、P3、P4：ポインタ）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     .LocProc）（）; {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     .LocProc）（P1）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     .LocProc）（P1、P2）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     .LocProc）（P1、P2、P3）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     .LocProc）（P1、P2、P3、P4）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     .LocProc）（NSinteger（P1））。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     [I] .LocProc）（aRect））。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）、TProcType.pt1）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）、TProcType.pt2）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）、TProcType.pt6）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）、TProcType.pt7）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ; CONST ATYPE：TProcType）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）; {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     P2、P3、P4：ポインタ）。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     コードブロックのセルフテストが失敗しました！'）; {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     CONST ATYPE：TProcType）：ポインタ。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ]にSizeOf（TBlockInfo）、 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     BlockStructure.Isa：（ILocalobjectとして（StrToNSStr（ 'NSBlock'））.GetObjectID）= NSClassFromString。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ：= @InvokeCallback ;. {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     BlockStructure.Flags：= BLOCK_HAS_COPY_DISPOSE。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ：= aDesc ;. {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ）] BlockStructure ;. {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     ：整数。 {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.
      
      

        
        
        
      

    
        
        
        
      
      

        
        
        
      

    
     （aCurrBlock）.Descriptor {*******************************************************} { } { Implementation of Objective-C Code Blocks } { } { Copyright(c) 2017 TamoSoft Limited } { } {*******************************************************} { LICENSE: Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: You may not use the Software in any projects published under viral licenses, including, but not limited to, GNU GPL. The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE } //USAGE EXAMPLE // // FSaveFile :=TNSSavePanel.Wrap(TNSSavePanel.OCClass.savePanel); // NSWin := WindowHandleToPlatform(Screen.ActiveForm.Handle).Wnd; // objc_msgSendP2( // (FSaveFile as ILocalObject).GetObjectID, // sel_getUid(PAnsiChar('beginSheetModalForWindow:completionHandler:')), // (NSWin as ILocalObject).GetObjectID, // TObjCBlock.CreateBlockWithProcedure( // procedure (p1: NSInteger) // begin // if p1 = 0 // then ShowMessage ('Cancel') // else ShowMessage ('OK'); // end) // ); unit Mac.CodeBlocks; interface uses System.SysUtils, Macapi.ObjectiveC, Macapi.Foundation, Macapi.Helpers, Macapi.ObjCRuntime, Macapi.CocoaTypes; type TProc1 = TProc; TProc2 = TProc<pointer>; TProc3 = TProc<pointer, pointer>; TProc4 = TProc<pointer, pointer, pointer>; TProc5 = TProc<pointer, pointer, pointer, pointer>; TProc6 = TProc<NSInteger>; TProc7 = TFunc<NSRect, boolean>; TProcType = (ptNone, pt1, pt2, pt3, pt4, pt5, pt6, pt7); TObjCBlock = record private class procedure SelfTest; static; class function CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; static; public class function CreateBlockWithProcedure(const aProc: TProc1): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc2): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc3): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc4): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc5): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc6): pointer; overload; static; class function CreateBlockWithProcedure(const aProc: TProc7): pointer; overload; static; end; implementation function imp_implementationWithBlock(block: id): pointer; cdecl; external libobjc name _PU + 'imp_implementationWithBlock'; function imp_removeBlock(anImp: pointer): integer; cdecl; external libobjc name _PU + 'imp_removeBlock'; type Block_Descriptor = packed record Reserved: NativeUint; Size: NativeUint; copy_helper: pointer; dispose_helper: pointer; end; PBlock_Descriptor = ^Block_Descriptor; Block_Literal = packed record Isa: pointer; Flags: integer; Reserved: integer; Invoke: pointer; Descriptor: PBlock_Descriptor; end; PBlock_Literal = ^Block_Literal; TBlockInfo = packed record BlockStructure: Block_Literal; LocProc: TProc; ProcType: TProcType; end; PBlockInfo = ^TBlockInfo; TObjCBlockList = class (TObject) private FBlockList: TArray<TBlockInfo>; procedure ClearAllBlocks; public constructor Create; destructor Destroy; override; function AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; function FindMatchingBlock(const aCurrBlock: pointer): integer; procedure ClearBlock(const idx: integer); property BlockList: TArray<TBlockInfo> read FBlockList ; end; var BlockObj: TObjCBlockList; function InvokeCallback(aNSBlock, p1, p2, p3, p4: pointer): pointer; cdecl; var i: integer; aRect: NSRect; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then begin case BlockObj.BlockList[i].ProcType of TProcType.pt1: TProc1(BlockObj.BlockList[i].LocProc)(); TProcType.pt2: TProc2(BlockObj.BlockList[i].LocProc)(p1); TProcType.pt3: TProc3(BlockObj.BlockList[i].LocProc)(p1, p2); TProcType.pt4: TProc4(BlockObj.BlockList[i].LocProc)(p1, p2, p3); TProcType.pt5: TProc5(BlockObj.BlockList[i].LocProc)(p1, p2, p3, p4); TProcType.pt6: TProc6(BlockObj.BlockList[i].LocProc)(NSinteger(p1)); TProcType.pt7: begin aRect.origin.x := CGFloat(p1); aRect.origin.y := CGFloat(p2); aRect.size.width := CGFloat(p3); aRect.size.height:= CGFloat(p4); result:= pointer(TProc7(BlockObj.BlockList[i].LocProc)(aRect)); end; end; end; finally TMonitor.Exit(BlockObj); end; end; end; procedure DisposeCallback(aNSBlock: pointer) cdecl; var i: integer; begin if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try i:= BlockObj.FindMatchingBlock(aNSBlock); if i >= 0 then BlockObj.ClearBlock(i); finally TMonitor.Exit(BlockObj); end; end; TNSObject.Wrap(aNSBlock).release; end; procedure CopyCallback(scr, dst: pointer) cdecl; begin // end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc1): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt1); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc2): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt2); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc3): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt3); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc4): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt4); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc5): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt5); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc6): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt6); end; class function TObjCBlock.CreateBlockWithProcedure(const aProc: TProc7): pointer; begin result:= CreateBlockWithCFunc(TProc(aProc), TProcType.pt7); end; class function TObjCBlock.CreateBlockWithCFunc(const aTProc: TProc; const aType: TProcType): pointer; begin result:= nil; if Assigned(BlockObj) then begin TMonitor.Enter(BlockObj); try result:= BlockObj.AddNewBlock(aTProc, aType); finally TMonitor.Exit(BlockObj); end; end; end; class procedure TObjCBlock.SelfTest; var p: pointer; test: NativeUint; // Yes, _cmd is ignored! func : procedure ( p1, _cmd, p2, p3, p4: pointer); cdecl; begin test:= 0; p:= TObjCBlock.CreateBlockWithProcedure( procedure (p1, p2, p3, p4: pointer) begin test:= NativeUint(p1) + NativeUint(p2) + NativeUint(p3) + NativeUint(p4); end); @func := imp_implementationWithBlock(p); // Yes, _cmd is ignored! func(pointer(1), nil, pointer(2), pointer(3), pointer(4)); imp_removeBlock(@func); if test <> (1 + 2 + 3 + 4) then raise Exception.Create('Objective-C code block self-test failed!'); end; {TObjCBlockList} constructor TObjCBlockList.Create; begin inherited; end; destructor TObjCBlockList.Destroy; begin TMonitor.Enter(Self); try ClearAllBlocks; finally TMonitor.Exit(Self); end; inherited Destroy; end; procedure TObjCBlockList.ClearBlock(const idx: integer); begin Dispose(FBlockList[idx].BlockStructure.Descriptor); FBlockList[idx].BlockStructure.isa:= nil; FBlockList[idx].LocProc:= nil; Delete(FBlockList, idx, 1); end; function TObjCBlockList.AddNewBlock(const aTProc: TProc; const aType: TProcType): pointer; var aDesc: PBlock_Descriptor; const BLOCK_HAS_COPY_DISPOSE = 1 shl 25; begin SetLength(FBlockList, Length(FBlockList) + 1); FillChar(FBlockList[High(FBlockList)], SizeOf(TBlockInfo), 0); FBlockList[High(FBlockList)].BlockStructure.Isa := NSClassFromString ((StrToNSStr('NSBlock') as ILocalobject).GetObjectID); FBlockList[High(FBlockList)].BlockStructure.Invoke := @InvokeCallback; FBlockList[High(FBlockList)].BlockStructure.Flags := BLOCK_HAS_COPY_DISPOSE; FBlockList[High(FBlockList)].ProcType := aType; FBlockList[High(FBlockList)].LocProc := aTProc; New(aDesc); aDesc.Reserved := 0; aDesc.Size := SizeOf(Block_Literal); aDesc.copy_helper := @CopyCallback; aDesc.dispose_helper := @DisposeCallback; FBlockList[High(FBlockList)].BlockStructure.Descriptor := aDesc; result:= @FBlockList[High(FBlockList)].BlockStructure; end; procedure TObjCBlockList.ClearAllBlocks(); var i: integer; begin for i := High(FBlockList) downto Low(FBlockList) do ClearBlock(i); end; function TObjCBlockList.FindMatchingBlock(const aCurrBlock: pointer): integer; var i: integer; begin result:= -1; if aCurrBlock <> nil then begin for i:= Low(FBlockList) to High(FBlockList) do begin if FBlockList[i].BlockStructure.Descriptor = PBlock_Literal(aCurrBlock).Descriptor then Exit(i); end; end; end; initialization BlockObj:=TObjCBlockList.Create; TObjCBlock.SelfTest; finalization FreeAndNil(BlockObj); end.

macOS上のDelphiでObjective-Cのコードブロックを使用する：ブリッジの構築方法

ケーキの上のチェリー

More articles: