Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyStandardFile.p

Text File | 1997-03-06 | 6.7 KB | 255 lines | [TEXT/CWIE]

unit MyStandardFile;

interface

    uses
        StandardFile;

    type
        MySFReply = record
                Rgood: boolean;
                Rfolder: boolean;
                RfType: OSType;
                RvRefNum: integer;
                RdirID: longint;
                RfName: Str63;
            end;

    function MFSPt: Point;
    procedure GetFile (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; var reply: MySFReply);
    procedure GetFile1 (t: OSType; var reply: MySFReply);
{    procedure GetFolder (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; id: integer; var reply: MySFReply);}
{ NOTE: GetFolder must be passed a Dialog ID with Button 11 being a folder button }
{ NOTE: reply.copy should be interpreted as reply.folder }
    procedure PutFile (str, origName: Str255; var reply: MySFreply);
    procedure PutFolder (str, origName: Str255; id: integer; var reply: MySFreply);
{ NOTE: PutFolder must be passed a Dialog ID with Button 9 being a folder button }
{ NOTE: reply.copy should be interpreted as reply.folder }
    procedure SetSFFile (wdrn: integer; dirID: longint);
    procedure SegmentStandardFile;

implementation

    uses
        MyTypes, MyUtils, MySystemGlobals, MyFileSystemUtils, MyButtons;

 {$S StandardFile}
    procedure SegmentStandardFile;
    begin
    end;

    procedure SetSFFile (wdrn: integer; dirID: longint);
        var
            oe: OSErr;
            vrn: integer;
            procID: longint;
    begin
        if dirID = 0 then begin
            oe := GetWDInfo(wdrn, vrn, dirID, procID);
        end else begin
            vrn := wdrn;
        end;
        integerP(SFSaveDiskA)^ := -vrn;
        longintP(CurDirStoreA)^ := dirID;
    end;

    function MFSPt: Point;
        var
            pt: Point;
    begin
        pt.v := 40;
        pt.h := 40;
        MFSPt := pt;
    end;

    procedure SetStdReply (var reply: MySFReply; stdReply: StandardFileReply);
    begin
        with reply do begin
            Rgood := stdReply.sfGood;
            Rfolder := ord(stdReply.sfIsFolder) <> 0;        { Argghhh!  Bloody Apple and there C booleans! }
            RfType := stdReply.sfType;
            RvRefNum := stdReply.sfFile.vRefNum;
            RdirID := stdReply.sfFile.parID;
            RfName := stdReply.sfFile.name;
        end;
    end;

    procedure SetOldReply (var reply: MySFReply; oldReply: SFReply);
        var
            junk: OSErr;
    begin
        with reply do begin
            Rgood := oldReply.good;
            Rfolder := oldReply.copy;
            RfType := oldReply.fType;
            junk := GetDirID(oldReply.vRefNum, RvRefNum, RdirID);
            RfName := oldReply.fName;
        end;
    end;

    procedure GetFile (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; var reply: MySFReply);
        var
            stdReply: StandardFileReply;
            oldReply: SFReply;
    begin
        with reply do
            if has_NewStandardFile then begin
                StandardGetFile(ffilter, numTypes, @typeList, stdReply);
                SetStdReply(reply, stdReply);
            end
            else begin
                SFGetFile(MFSPt, '', ffilter, numTypes, @typeList, nil, oldReply);
                oldReply.copy := false;
                SetOldReply(reply, oldReply);
            end;
    end;

    procedure GetFile1 (t: OSType; var reply: MySFReply);
        var
            typeList: SFTypeList;
    begin
        if t = OSType(noType) then begin
            GetFile(nil, -1, typeList, reply);
        end else begin
            typeList[0] := t;
            GetFile(nil, 1, typeList, reply);
        end;
    end;

    procedure PutFile (str, origName: Str255; var reply: MySFreply);
        var
            stdReply: StandardFileReply;
            oldReply: SFReply;
    begin
        with reply do
            if has_NewStandardFile then begin
                StandardPutFile(str, origName, stdReply);
                SetStdReply(reply, stdReply);
            end
            else begin
                SFPutFile(MFSPt, str, origName, nil, oldReply);
                oldReply.copy := false;
                SetOldReply(reply, oldReply);
            end;
    end;

    var
        oldReply: SFReply;
        newReply: StandardFileReply;
{ item1 is ThisFolder }
        item1: integer;
        button1: boolean;
        active1: boolean;

    procedure SetButtons (dlg: DialogPtr);
        var
            new1: boolean;
    begin
        if has_NewStandardFile then begin
            new1 := newReply.sfFile.parID <> 1; { everywhere except  desktop???? }
        end
        else begin
            new1 := true;
        end;
        SetButton(dlg, item1, active1, new1);
    end;

    function ButtonModalFilter (dlg: DialogPtr; var er: EventRecord; var item: integer): boolean;
    begin
{$unused(item)}
        SetButtons(dlg);
        if (er.what = updateEvt) and (dlg = DialogPtr(er.message)) then begin
            UpdateButton(dlg, item1, active1);
        end;
        ButtonModalFilter := false;
    end;

    function ButtonModalFilterSys7 (dlg: DialogPtr; var er: EventRecord; var item: integer; data: Ptr): boolean;
    begin
{$unused(data)}
        ButtonModalFilterSys7 := ButtonModalFilter(dlg, er, item);
    end;

    function ButtonHook (item: integer; dlg: DialogPtr): integer;
    begin
        if not has_NewStandardFile or (GetWRefCon(dlg) = longint(sfMainDialogRefCon)) then begin
            if item = sfHookFirstCall then begin
                button1 := false;
                InitButton(dlg, item1, active1, active1);
                SetButtons(dlg);
            end;
            if active1 then begin
                if item <> sfHookLastCall then begin
                    button1 := item = item1;
                    if button1 then begin
                        item := sfItemOpenButton;
                    end;
                end;
            end;
        end;
        ButtonHook := item;
    end;

    function ButtonHookSys7 (item: integer; dlg: DialogPtr; data: Ptr): integer;
    begin
{$unused(data)}
        ButtonHookSys7 := ButtonHook(item, dlg);
    end;

    procedure PutFolder (str, origName: Str255; id: integer; var reply: MySFreply);
    begin
        if has_NewStandardFile then begin
            item1 := 13;
            active1 := true;
            CustomPutFile(str, origName, newReply, id + 1, MFSPt, @ButtonHookSys7, @ButtonModalFilterSys7, nil, nil, nil); {@ButtonModalFilterSys7}
            SetStdReply(reply, newReply);
            reply.Rfolder := button1;
        end
        else begin
            item1 := 9;
            active1 := true;
            SFPPutFile(MFSPt, str, origName, @ButtonHook, oldReply, id, nil);
            oldReply.copy := button1;
            SetOldReply(reply, oldReply);
        end;
    end;

(*
    function CallFileFilterSys7 (pb: CInfoPBPtr; addr: Ptr): boolean;
    inline
        $205F, $4E90;

    function FileFilterSys7 (pb: CInfoPBPtr; addr: Ptr): boolean;
    begin
        if (BAND(pb^.ioFlAttrib, $0010) = 0) and (addr <> nil) then begin
            FileFilterSys7 := CallFileFilterSys7(pb, addr);
        end else begin
            FileFilterSys7 := false;
        end;
    end;

    procedure GetFolder (ffilter: Ptr; numTypes: integer; typeList: SFTypeList; id: integer; var reply: MySFReply);
    begin
        if has_NewStandardFile then begin
            item1 := 10;
            active1 := true;
            CustomGetFile(@FileFilterSys7, numTypes, @typeList, newReply, id + 1, MFSpt, @ButtonHookSys7, @ButtonModalFilterSys7, nil, nil, ffilter);
            SetStdReply(reply, newReply);
            reply.Rfolder := button1;
        end
        else begin
            item1 := 11;
            active1 := true;
            SFPGetFile(MFSPt, '', ffilter, numTypes, @typeList, @ButtonHook, oldReply, id, nil);
            oldReply.copy := button1;
            SetOldReply(reply, oldReply);
        end;
    end;
*)

end.
    function Button11Hook (item: integer; dlg: DialogPtr): integer;
{ NOTE: Button11Hook sets Button11 when it converts Button 11 to Button 1 (Open) }
    function Button9Hook (item: integer; dlg: DialogPtr): integer;
{ NOTE: Button9Hook sets Button9 when it converts Button 9 to Button 1 (Save) }