home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / ctcoll95.zip / PARALLEL / DSUSERP.P < prev    next >
Text File  |  1995-03-22  |  10KB  |  316 lines
  1. { DSUserProcs.p fƒr DropShell, ⌐ c╒t und C.Meyer 3/95. Teile von Leonard Rosenthol }
  2.  
  3. unit DSUserProcs;
  4. interface
  5.  
  6.     uses
  7.         Folders, Serial, AppleTalk, Processes, PPCToolbox, EPPC, Notification, AppleEvents, DSGlobals, DSUtils;
  8.  
  9. { Interface-Definitionen }
  10.  
  11.     procedure InstallOtherEvents;
  12.  
  13.     procedure OpenApp;
  14.     procedure QuitApp;
  15.  
  16.     function PreFlightDocs (opening: Boolean; var userDataHandle: univ Handle): Boolean;
  17.     procedure OpenDoc (myFSSPtr: FSSpecPtr; opening: Boolean; userDataHandle: univ Handle);
  18.     procedure PostFlightDocs (opening: Boolean; userDataHandle: univ Handle);
  19.  
  20.     procedure SelectFile;
  21.     procedure InitUserGlobals;
  22.     procedure DisposeUserGlobals;
  23.  
  24. implementation
  25.  
  26. {$S Main}
  27.  
  28. { Von DSAppleEvents wèhren Initialisierung aufgerufen, }
  29. { sowohl beim Anklicken als auch bei Drag & Drop. }
  30. { Erlaubt die Installation weiterer AE-Handler }
  31.     procedure InstallOtherEvents;
  32.     begin
  33.     end;
  34.  
  35. { 'oapp' Event empfangen.  Wird nicht angesprungen, wenn }
  36. { Drag&Drop zum Programmstart fƒhrte }
  37.     procedure OpenApp;
  38.     begin
  39.         gOApped := TRUE;
  40.     end;
  41.  
  42. { QUIT Event empfangen }
  43.     procedure QuitApp;
  44.     begin
  45.         gDone := TRUE;        { und Tschƒº! }
  46.     end;
  47.  
  48. { Gemeinsame Routine vor der Einzelbehandlung der mit 'pdoc' oder 'odoc' }
  49. { geÜffneten Dateien. Ggf. hier Datenbereiche initialisieren usw. }
  50. { userDataHandle ist fƒr eigene erweiterungen frei und muº selbst}
  51. { erstellt und abgebaut werden. }
  52.     function PreFlightDocs (opening: Boolean; var userDataHandle: univ Handle): Boolean;
  53.     begin
  54.         PreFlightDocs := opening;        { wie aufgerufen und ƒbergeben }
  55.     end;
  56.  
  57. { Diese Routine wird fƒr jedes einzelne mit 'pdoc' oder 'odoc' ƒbergebene }
  58. { Dokument aufgerufen. Hier: Datei ggf. konvertieren und an Port senden }
  59.     procedure OpenDoc (myFSSPtr: FSSpecPtr; opening: Boolean; userDataHandle: univ Handle);
  60.         var
  61.             whichWindow: WindowPtr;
  62.             whichPart: integer;
  63.             aLongInt, Index, Base, Table: LongInt;
  64.             aInt, refNum, Error: Integer;
  65.             aRect: Rect;
  66.             picH: PicHandle;
  67.             TextBuffHandle: Handle;
  68.             ConvPtr, TextBuffPtr: Ptr;
  69.             TextLng, TextIndex, TextBar, OldTextBar: LongInt;
  70.             myCurs: CursHandle;
  71.             ch: Char;
  72.             aStr: Str255;
  73.             outRefNum, inRefNum: Integer;
  74.             HskFlags: SerShk;
  75.  
  76.         procedure SmallEventHandler;
  77. { Kleine Event-Loop wèhrend der Ausgabe, damit Programm auch in den Hintergrund }
  78. { gestellt oder abgebrochen werden kann. Nimmt absichtlich keine High-Level-Events}
  79. { entgegen, sondern prƒft nur, ob welche anliegen. Wenn ja, wird gOAppend gesetzt}
  80. { und die Applikation bricht nicht automatisch ab, weil der User noch ein weiteres File}
  81. { "gedroppt" hat. }
  82.         begin
  83.             if eventAvail(highLevelEventMask, gEvent) then
  84.                 gOApped := TRUE;
  85.             gWasEvent := WaitNextEvent(mDownMask + keyDownMask + autoKeyMask, gEvent, 10, nil);
  86.             case gEvent.what of
  87.                 mouseDown: 
  88.                     begin
  89.                         whichPart := FindWindow(gEvent.where, whichWindow);
  90.                         case whichPart of
  91.                             inSysWindow: 
  92.                                 SystemClick(gEvent, whichWindow);
  93.                             inDrag: 
  94.                                 DragWindow(whichWindow, gEvent.where, screenBits.bounds);
  95.                         end;
  96.                     end;
  97.                 keyDown, autoKey: 
  98.                     begin
  99.                         ch := CHR(BitAnd(gEvent.message, charCodeMask));
  100.                         if ch = '.' then
  101.                             TextIndex := TextLng - 1; { Ende }
  102.                     end;
  103.             end; {case}
  104.         end;
  105.  
  106.     begin
  107.         if gDocNo > 7 then
  108. { rechte Hèlfte des Statusfensters lÜschen }
  109.             begin
  110.                 aRect := gSplashScreen^.VisRgn^^.rgnBBox;
  111.                 aRect.left := aRect.left + 80;
  112.                 eraseRect(aRect);
  113.                 gDocNo := 0;
  114.             end;
  115.  
  116. { Buffer einrichten und Datei in Buffer lesen }
  117.         myCurs := GetCursor(watchCursor);
  118.         SetCursor(myCurs^^);                      { bitte warten... }
  119.         if FSpOpenDF(myFSSPtr^, fsCurPerm, refNum) = noErr then
  120.             begin
  121.                 Error := GetEOF(refNum, TextLng);
  122.                 TextBuffHandle := NewHandle(TextLng + 16);
  123.                 HLock(TextBuffHandle);
  124.                 if TextBuffHandle = nil then
  125.                     ErrorAlert(kErrStringID, kMemErr, 45)
  126.                 else
  127.                     Error := FSRead(refNum, TextLng, TextBuffHandle^);
  128.                 if Error <> noErr then
  129.                     begin
  130.                         ErrorAlert(kErrStringID, kMemErr, 46);
  131.                         TextLng := 0;
  132.                     end;
  133.             end;
  134.         Error := FSClose(refNum);
  135. { Handshake-Flags und Parameter fƒr serielle Schnittstelle setzen }
  136.         HskFlags.fCTS := 1;        { CTS-Handshake ein }
  137.         HskFlags.fDTR := 1;    { DTR-Handshake ein }
  138.         HskFlags.fxOn := 0;        { Software-Handshake aus }
  139.         HskFlags.xOn := char(17);
  140.         HskFlags.xOff := char(19);
  141.         if gPrefs.Port = kModemPortItem then
  142.             aStr := '.AOut'
  143.         else
  144.             aStr := '.BOut';
  145. { Treiber Üffnen und ggf. Fehlermeldung ausgeben }
  146.         ErrorAlert(kErrStringID, kDrivErr, OpenDriver(aStr, outRefNum));
  147.         Error := SerReset(outRefNum, baud57600 + stop10 + noParity + data8);
  148.         Error := SerHShake(outRefNum, HskFlags);
  149. { Epson-Escape-Sequenz zusammenbasteln: Normalschrift ESC-!-1. }
  150. { String-Variable ist hier nur Mittel zum Zweck (Byte-Array) }
  151.         aStr := '! ';        { nach Bedarf zu èndern }
  152.         aStr[0] := char(27);
  153.         aStr[2] := char(1);
  154.         aLongInt := 3;
  155.         if gPrefs.PCKonv then
  156.             Error := FSWrite(outRefNum, aLongInt, @aStr);
  157. { Zwar sieht die Pointer-Arithmetik in Pascal durch die Typecasts etwas }
  158. { umstèndlich aus, das Kompilat ist aber nicht schlechter als reiner C-Code. }
  159. { Pointer auf gerade eingelesenen Textbuffer: }
  160.         Base := ord(TextBuffHandle^);
  161. { Pointer auf Tabelle Mac/MSDOS-Konvertierung mit anschlieºender }
  162. { Korrektur fƒr SignedBytes (wg. SignedByte-Pointer!): }
  163.         Table := ord(gConAHandle^) + 128;
  164.         if TextLng > 1 then
  165.             begin
  166.                 aRect.bottom := 115;
  167.                 aRect.left := 18;
  168.                 aRect.right := 43;
  169.                 TextFont(geneva);
  170.                 TextSize(10);
  171.                 TextFace([]);
  172.                 moveTo(80, 22 + 14 * gDocNo);
  173.                 WriteDraw(myFSSPtr^.name, ' (', TextLng : 1, ' Zeichen)');
  174.                 TextBar := 0;
  175.                 for TextIndex := 0 to TextLng - 1 do
  176.                     begin
  177.                         OldTextBar := TextBar;
  178.                         TextBar := TextIndex * 100 div TextLng + 1;
  179.                         if TextBar > OldTextBar then
  180.                             begin
  181.                                 if TextBar mod 4 = 0 then    { das ist oft genug }
  182.                                     SmallEventHandler;
  183.                                 aRect.Top := aRect.Bottom - TextBar;
  184.                                 FrameRect(aRect);
  185.                                 InsetRect(aRect, 1, 1);
  186.                                 EraseRect(aRect);
  187.                                 InsetRect(aRect, -1, -1);
  188.                             end;
  189.                         aLongInt := 1;
  190.                         TextBuffPtr := Ptr(Base + TextIndex);
  191. { Zeichen in Tabelle mit Mac/MSDOS-Konvertierung abgreifen }
  192.                         ConvPtr := Ptr(Table + TextBuffPtr^);
  193.                         if gPrefs.PCKonv then
  194.                             begin
  195.                                 Error := FSWrite(outRefNum, aLongInt, ConvPtr);
  196.                                 if TextBuffPtr^ = 13 then
  197. { Wenn gewƒnscht, Linefeed fƒr PC-Drucker einfƒgen }
  198.                                     begin
  199.                                         aStr[0] := char(10);
  200.                                         Error := FSWrite(outRefNum, aLongInt, @aStr);
  201.                                     end;
  202.                             end
  203.                         else
  204.                             Error := FSWrite(outRefNum, aLongInt, TextBuffPtr);
  205.                     end;
  206.             end;
  207.  
  208.         if TextBuffHandle <> nil then
  209.             begin
  210.                 HUnlock(TextBuffHandle);
  211.                 DisposHandle(TextBuffHandle);                { das war der Text-Buffer }
  212.             end;
  213.  
  214. { Wenn gewƒnscht, Formfeed senden }
  215.         aStr[0] := char(12);
  216.         aLongInt := 1;
  217.         if gPrefs.PCKonv then
  218.             Error := FSWrite(outRefNum, aLongInt, @aStr);
  219.         Error := CloseDriver(outRefNum);
  220.         InitCursor;
  221.         gDocNo := gDocNo + 1;
  222.     end;
  223.  
  224. { Gemeinsame Routine, nachdem alle Dokumente behandelt wurden }
  225.     procedure PostFlightDocs (opening: Boolean; userDataHandle: univ Handle);
  226.     begin
  227.         if (opening) and (not gOApped) then
  228.             gDone := TRUE;    {bei echtem 'odoc' beenden}
  229.  
  230. { laut Empfehlung in der Apple Event Registry nicht bei }
  231. { 'pdoc', sondern auf  'quit' vom Finder warten }
  232.     end;
  233.  
  234. { Datei manuell auswèhlen}
  235.     procedure SelectFile;
  236.         var
  237.             stdReply: StandardFileReply;
  238.             theTypeList: SFTypeList;
  239.     begin
  240.         StandardGetFile(nil, -1, theTypeList, stdReply);
  241.         if (stdReply.sfGood) then                        { nicht abgebrochen }
  242.             SendODOCToSelf(stdReply.sfFile);        { Event an uns selbst }
  243.     end;
  244.  
  245. { Eigene Datenstrukturen initialisieren. Fenster existieren bereits }
  246.     procedure InitUserGlobals;
  247.         var
  248.             Error, PrefVRefNum, refNum: Integer;
  249.             PrefDirID, count: LongInt;
  250.             PrefSpec: FSSpec;
  251.         var
  252.             picH: PicHandle;
  253.             aRect: Rect;
  254.     begin
  255. { Status-Screen updaten }
  256.         setPort(gSplashScreen);
  257.         ShowWindow(gSplashScreen);
  258.         aRect := gSplashScreen^.VisRgn^^.rgnBBox;
  259. { Bereich ist gƒltig, da neu gezeichnet: }
  260.         validRect(aRect);
  261.         picH := GetPicture(kPicID);
  262.         DrawPicture(picH, picH^^.picframe);
  263.  
  264. { Preferences-Folder ausfindig machen und Preferences lesen bzw. anlegen }
  265.         Error := FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, PrefVRefNum, PrefDirID);
  266.         if FSMakeFSSpec(PrefVRefNum, PrefDirID, kPrefName, PrefSpec) <> 0 then
  267.             begin
  268. { File existiert noch nicht: neue Prefs anlegen}
  269.                 ErrorAlert(kErrStringID, kFileErr, FSpCreate(PrefSpec, kCreator, kPrefType, -1));
  270.                 Error := FSpOpenDF(PrefSpec, fsCurPerm, refNum);
  271.                 gPrefs.PCKonv := false;
  272.                 gPrefs.Port := kPrintPortItem;
  273.                 count := sizeOf(gPrefs);
  274.                 Error := FSWrite(refNum, count, @gPrefs);
  275.             end
  276.         else
  277.             begin
  278. { File existiert: alte Prefs lesen }
  279.                 Error := FSpOpenDF(PrefSpec, fsCurPerm, refNum);
  280.                 count := sizeOf(gPrefs);
  281.                 Error := FSRead(refNum, count, @gPrefs);
  282.             end;
  283.         Error := FSClose(refNum);
  284.         gConAHandle := GetResource('ConA', kConAResNum);
  285.         Hlock(gConAHandle);
  286.         CheckItem(GetMenu(kOptionsNum), kDOSItem, gPrefs.PCKonv);
  287.         CheckItem(GetMenu(kOptionsNum), kPrintPortItem, false);
  288.         CheckItem(GetMenu(kOptionsNum), kModemPortItem, false);
  289.         SetItemMark(GetMenu(kOptionsNum), gPrefs.Port, '');    { Raute }
  290.     end;
  291.  
  292. { Wird kurz vor dem Beenden aufgerufen. Sollte }
  293. { Datenstrukturen entfernen, die oben installiert wurden }
  294.     procedure DisposeUserGlobals;
  295.         var
  296.             Error, PrefVRefNum, refNum: Integer;
  297.             PrefDirID, count: LongInt;
  298.             PrefSpec: FSSpec;
  299.     begin
  300. { Preferences-Folder ausfindig machen und Preferences schreiben }
  301.         Error := FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, PrefVRefNum, PrefDirID);
  302.         if FSMakeFSSpec(PrefVRefNum, PrefDirID, kPrefName, PrefSpec) = 0 then
  303.             begin
  304.                 Error := FSpOpenDF(PrefSpec, fsCurPerm, refNum);
  305.                 count := sizeOf(gPrefs);
  306.                 Error := FSWrite(refNum, count, @gPrefs);
  307.                 Error := FSClose(refNum);
  308.             end;
  309.  
  310.         if gConAHandle <> nil then
  311.             begin
  312.                 HUnlock(gConAHandle);
  313.                 ReleaseResource(gConAHandle);
  314.             end;
  315.     end;
  316. end.