home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Utilities / Miscellaneous / CopyPaste 3.3.4 / CopyPaste Tools Sourcecode / Code Comment / Code Comment.p < prev    next >
Encoding:
Text File  |  1997-06-06  |  2.5 KB  |  101 lines  |  [TEXT/CWIE]
  1. {•This sourcecode is an example for creating a FKey coderesource with•}
  2. {•Metrowerks Pascal. It is copyrighted by Peter Hoerster and released•}
  3. {•for free use in any Shareware or Freeware product as a way to thank all•}
  4. {•programmers who share code snippets. You may put this sources on any•}
  5. {•CD ROM or any Archive Server but you may not sell it. •}
  6.  
  7. {• For comments please write to <hoerster@muenster.de>•}
  8.  
  9.  
  10. unit CodeComment;
  11.  
  12. interface
  13.  
  14.     uses
  15.         Types, OSUtils, GestaltEqu, Script, notification, Resources, Events,
  16.          PascalA4, QuickDraw, ToolUtils, Memory, LowMem, Scrap;
  17.  
  18.  
  19.  
  20. {$MAIN}
  21.                         
  22.     procedure main;        
  23.  
  24. implementation
  25.  
  26.     procedure dopaste;
  27.     const
  28.         pastecode=2422;
  29.     var 
  30.         qel: EvQelPtr;
  31.     begin
  32.             if ppostevent(3, pastecode, qel) = noerr then
  33.             qel^.evtqmodifiers := cmdkey;
  34.     end;
  35.  
  36.     
  37.     
  38.     procedure main;
  39.         const
  40.             step = 1000;
  41.             tab = char(ord(9));
  42.             esc = char(ord(27));
  43.             Enter = char(ord(3));                                {the enter character}
  44.             Return = char(ord(13));                                {the return character}
  45.         Type
  46.             chararray=packed array[1..1]of char;
  47.             chararrayptr=^chararray;
  48.             chararrayhdl=^chararrayptr;
  49.         var
  50.             oldA4: LongInt;
  51.             myerr: oserr;
  52.             myclipsize, templongint: longint;
  53.             myclipHandle: handle;
  54.             substhandle: Handle;
  55.             i: integer;
  56.             subst: str15;
  57.             wasreturn:boolean;
  58.     begin
  59.         oldA4 := SetCurrentA4;
  60.         wasreturn:=false;
  61.         myclipsize := GetScrap(nil, 'TEXT', templongint);
  62.         mycliphandle := Tempnewhandle(myclipsize,myerr);
  63.         if myerr=noerr then 
  64.             begin
  65.                 myclipsize := GetScraP(myclipHandle, 'TEXT', templongint);
  66.                 if myclipsize > 0 then
  67.                     begin
  68.                         if chararrayhdl(mycliphandle)^^[myclipsize]=return then
  69.                             begin
  70.                                 myclipsize:=myclipsize-1;
  71.                                 wasreturn:=true;
  72.                             end;
  73.                         sethandlesize(mycliphandle,myclipsize+2);
  74.                         blockmove(mycliphandle^, pointer(ord4(mycliphandle^)+2),myclipsize);
  75.                         subst := '123';
  76.                         subst[1]:=return;
  77.                         subst[2]:='/';
  78.                         subst[3]:='/';
  79.                         blockmove(@subst[2], mycliphandle^,2);
  80.                         
  81.                         substhandle := newhandle(3);
  82.                         blockmove(@subst[1], substhandle^, 3);
  83.                         subst :=return;
  84.                         subst[1] := return;
  85.                         i := ReplaceText(mycliphandle, substhandle, subst);
  86.                         if wasreturn=true then
  87.                             begin
  88.                                 myerr:=ptrandhand(@subst[1],mycliphandle,1);
  89.                             end;
  90.                         myerr := ZeroScrap;
  91.                         myclipsize:=gethandlesize(mycliphandle);
  92.                         Temphlock(mycliphandle,myerr);
  93.                         myerr := putscrap(myclipsize, 'TEXT', myclipHandle^);
  94.                         Temphunlock(myCliphandle,myerr);
  95.                         dopaste;
  96.                     end;
  97.             end;
  98.         TempDisposeHandle(myCliphandle,myerr);
  99.         oldA4 := SetA4(oldA4);
  100.     end;
  101. end.