home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyFinderControl.p < prev    next >
Encoding:
Text File  |  1996-07-21  |  3.3 KB  |  126 lines  |  [TEXT/CWIE]
  1. unit MyFinderControl;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Files;
  7.         
  8.     function FinderSetColour( const spec: FSSpec; colour: integer ): OSErr;
  9.  
  10. implementation
  11.  
  12.     uses
  13.         AppleEvents, AERegistry, AEPackObject, AEObjects,
  14.         MyAEUtils, MyFileSystemUtils;
  15.     
  16.     function CreateFinderEvent (classid, eventid: AEEventID; var event: AEDesc): OSErr;
  17.         var
  18.             target: AEDesc;
  19.             err: OSErr;
  20.     begin
  21.         AECreate( target );
  22.         AECreate( event );
  23.         err := CreateSignatureDesc( 'MACS', target );
  24.         if err = noErr then begin
  25.             err := AECreateAppleEvent( classid, eventid, target, kAutoGenerateReturnID, kAnyTransactionID, event );
  26.         end;
  27.         AEDestroy( target );
  28.         if err <> noErr then begin
  29.             AEDestroy( event );
  30.         end;
  31.         CreateFinderEvent := err;
  32.     end;
  33.  
  34.     function FinderSetColour( const spec: FSSpec; colour: integer ): OSErr;
  35.         var
  36.             err: OSErr;
  37.             event, reply: AppleEvent;
  38.             result: longint;
  39.             obj, name_desc, prop_desc, parent: AEDesc;
  40.             fullpath: Str255;
  41.     begin
  42.         AECreate( event );
  43.         AECreate( reply );
  44.         AECreate( obj );
  45.         AECreate( name_desc );
  46.         AECreate( prop_desc );
  47.         AECreate( parent );
  48.  
  49.         err := CreateFinderEvent( kAECoreSuite, kAESetData, event );
  50.  
  51.         if err = noErr then begin
  52.             err := FSSpecToFullPath( spec, fullpath );
  53.         end;
  54.         if err = noErr then begin
  55.             err := CreateStringDesc( fullpath, name_desc );
  56.         end;
  57.         if err = noErr then begin
  58.             err := CreateTypeDesc( 'labi', prop_desc );
  59.         end;
  60.         if err = noErr then begin
  61.             err := CreateObjSpecifier(cItem, AENull, formName, name_desc, false, parent);
  62.         end;
  63.         if err = noErr then begin
  64.             err := CreateObjSpecifier(cLongInteger, parent, formPropertyID, prop_desc, false, obj);
  65.         end;
  66.  
  67.         if err = noErr then begin
  68.             err := AEPutParamDesc( event, keyDirectObject, obj );
  69.         end;
  70.         if err = noErr then begin
  71.             err := PutLongToAERecord( event, keyAEData, colour );
  72.         end;
  73.         if err = noErr then begin
  74.             err := AESend( event, reply, kAEWaitReply, kAENormalPriority, kAEDefaultTimeout, nil, nil);
  75.         end;
  76.         if (err = noErr) & (GetLongFromAERecord( event, keyErrorNumber, result ) = noErr) then begin
  77.             err := result;
  78.         end;
  79.  
  80.         AEDestroy( event );
  81.         AEDestroy( reply );
  82.         AEDestroy( obj );
  83.         AEDestroy( name_desc );
  84.         AEDestroy( prop_desc );
  85.         AEDestroy( parent );
  86.         FinderSetColour := err;
  87.     end;
  88.  
  89. end.
  90.  
  91.     function FinderSetColour( const spec: FSSpec; colour: integer ): OSErr;
  92.         var
  93.             err: OSErr;
  94.             event, reply: AppleEvent;
  95.             result: longint;
  96.     begin
  97.         err := CreateFinderEvent( kAECoreSuite, kAESetData, event );
  98.         if err = noErr then begin
  99.             err := PutFSSpecToAERecord( event, keyDirectObject, spec );
  100.         end;
  101.         if err = noErr then begin
  102.             err := PutLongToAERecord( event, keyAEData, colour );
  103.         end;
  104.         if err = noErr then begin
  105.             err := AESend( event, reply, kAEWaitReply, kAENormalPriority, kAEDefaultTimeout, nil, nil);
  106.         end;
  107.         if (err = noErr) & (GetLongFromAERecord( event, keyErrorNumber, result ) = noErr) then begin
  108.             err := result;
  109.         end;
  110.         FinderSetColour := err;
  111.     end;
  112.  
  113.         ffspec, null, formName, path string, filedesc
  114.         integer, filedesc, formPropertyID, typeType:labi
  115.         
  116.         desired class, container, key form, key data desc, dispose inputs, result
  117.         formPropertyID, typeType:labi
  118.         
  119.             err := CreateObjSpecifier(cItem, root_desc, formName, name_desc, false, parent);
  120.         end; (* if *)
  121.         if err = noErr then begin
  122.             err := CreateObjSpecifier(cQDPoint, parent, formPropertyID, prop_desc, false, obj);
  123.         end; (* if*)
  124.  
  125.  
  126.