TweetFollow Us on Twitter

PictPack
Volume Number:9
Issue Number:5
Column Tag:4th Dimension

Related Info: Picture Utilities

PictPack - A Package of 4D Externals

Managing picture variables in 4D Externals

By Kent Miller, Arlington, Texas

Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.

About the author

Kent Miller is the author of 4D Balloon Help and 4D Chooser, both published by Business Network of Oklahoma City. His Email addresses are KPMiller@aol.com or KPMILLER on America Online.

In this article, I will develop a small 4D package that reads PICT files into picture variables, writes picture variables to PICT files, and returns information about 4D picture variables. I will also attempt to illustrate three things:

• How to read and write a PICT file

• How to free up extra memory for your 4D external

• Using a 4D EntryPoint to put a PicHandle into a picture variable

PicHandles and PICT files contain the exact same information except a PICT file has 512 bytes of information at the beginning (to hold information such as the name of the creating program and copyright information). So, if you want to read a PICT, you simply skip the first 512 bytes of the file and then read the rest into a PicHandle. To write one, you just write 512 bytes of something and then write a PicHandle.

The ReadPict Procedure

The ReadPict external takes two parameters, the name of the picture variable to put the picture in and an integer that returns an error. The procedure prompts the user to select a file. When a file is chosen, it reads the picture if it can free up enough memory.

After a 4D database is used for a while, memory gets pretty full and you will probably need to free up some space before reading the picture. I was under the impression that a call to NewHandle made every effort to free up a block of memory, but it seems like I can get a bigger handle more reliably (at least in a 4D external) by calling CompactMem with the amount of memory I want before making the NewHandle call.

A picture field in 4D is made up of two things, a PicHandle and a 6-byte PicEnd record that 4D uses to determine where and how to draw the picture. The PicEnd record is defined like this:

{1}

 PicEnd = record
 origin : Point;
 transferMode : integer;
 end;

The PicEnd record goes (strangely enough) at the end of the picture. Since we had the foresight when we allocated memory to allocate enough for the PicHandle plus the PicEnd, we can just use BlockMove and some fancy pointer arithmetic to put the record at the end of the PicHandle.

{2}

with myPicEnd do
 begin
 origin.h := 0;
 origin.v := 0;
 transfer := srcCopy;
 end;
BlockMove(@myPicEnd, Ptr(ord(thePic^) + 
 GetHandleSize(thePic) - 6), 6);

We use a 4D EntryPoint routine to put the picture back into 4D. 4D has some really convoluted variant record structures it uses to pass information to and from externals. We need two of these structures to put the picture into 4D-the VarRec contains the information we want to send to 4D and the ParmBlock is used whenever you need to make a 4D EntryPoint call.

We fill the VarRec like this:

{3}

       myVarRec.varKind := PICT;
       myVarRec.picSize := GetHandleSize(thePic);
       myVarRec.PP := PicHandle(thePic);

and we fill the ParmBlock like this:

{4}

       Blk4D.Name := PtrList^[1].S^;
       Blk4D.HH := @myVarRec;
       Blk4D.ClearOldVariable := true;

and call the EntryPoint:

{5}

       Call4D(EX_PUT_VARIABLE, Blk4D);

There are 2 reasons I call 4D to put the information into the variable instead of just directly passing a picture variable. In a database that is compiled with 4D Compiler, 4D doesn’t pre-initalize variables it passes you. So, there really isn’t anyway to tell if a variable is valid or not unless you leave the responsibility of initialization to the 4D developer. This isn’t a big deal if it is an integer or longint, but if you think it is a valid PicHandle and try to dispose it, bad things can happen. If you don’t dispose it, you take the chance of the memory becoming lost in the heap. The second reason is assuming the handle is valid, I never can decide what to do with the handle 4D passes. Should I dispose it? What if 4D has another copy of it somewhere? This method eliminates that confusion and I recommend that anytime you need to pass a picture (or text) variable back to 4D you use the EntryPoint routines.

The only other thing of note in this procedure is that once you give 4D the PicHandle, don’t dispose it. After you make the EntryPoint call, 4D becomes responsible for managing the PicHandle. Sample 4D code to call ReadPict is shown in Figure 1.

Figure 1 - Sample 4D Code calling ReadPict

The SavePict Procedure

There are three parameters to the SavePict procedure, the picture variable to save, the creator type for the file, and a place to return an error. I can pass a picture variable this time since I am just going to use it, not replace it. First, I call GetHandleSize to see if the PicHandle from 4D looks valid. If it does, the procedure uses StandardPutFile to get a path for the file. Next, it opens the file and writes 512 bytes of zeros. Then it determines how many bytes of the PicHandle to write by calling GetHandleSize and subtracting 6 bytes for the PicEnd record. Finally, it writes those bytes to the file.

{6}

       count := GetHandleSize(Handle(pic)) - 6;
       err := FSWrite(newFileRefNum, count, Ptr(pic^));

Sample 4D code to call the SavePict procedure is given in Figure 2.

Figure 2 - Sample 4D Code calling SavePict

The ReturnPictInfo Procedure

I have also written a small procedure to get information about pictures for the sake of completeness. I use the System 7 call GetPictInfo to return information about picture fields. Any information could be returned from the package, but I just picked what I think would be the most useful to the user. The parameters to this procedure are the picture variable, 3 integers for the length, width, and depth (number of bits-per-pixel) of the picture, and 2 longints for the size in bytes and number of colors in the picture. Figure 3 shows 4D code to call this procedure.

Figure 3 - Sample 4D Code calling ReturnPictInfo

Loose Ends

All the record definitions and constants I use in the package that aren’t standard Macintosh structures are defined in the Access0 library that is included in the 4D External Kit.

These procedures are lumped into a package, but I suppose that they could’ve just as easily be broken up into separate externals. Being in a package just makes it easier to move them in and out of a database. They can also be grouped together into a popup menu in the 4D design environment using ‘FON#’ and ‘THM#‘ resources. If you have 4D 3.0, you can create these resources with the new 4D External Mover that comes with it. Otherwise those resource templates are included in the 4D External Kit.

This package, like every 4D package, will require 2 resources to be recognized by 4D. The ‘4BNX’ resource groups your package with other resources needed by your package. In our case, the only resource we need besides the ‘4DPX’ (the package itself) is the ‘STR#’ resource that lists the procedures in our package with their parameters. You can create these resources in ResEdit using the templates that come with the 4D External Kit. The ‘4BNX’ and ‘STR#’ resources are included with the source listing in Rez format.

I have used the System 7 file system calls and used the System 7 Picture Utilities Package, so making the package run in System 6 is left as an exercise for the reader.

Think Pascal Project

Figure 4 - The Think Pascal project window

{7}
Source Code
unit PictPack;

interface

 uses
  SANE, Access0, Palettes, PictUtil;

 procedure main (ProcNum: Longint; 
 PtrList: PackageVariablesPtr; var Data: handle; 
 var FuncPtr: PackRetParam);

implementation

 procedure readPict (var thePic: Handle; 
 var theerr: integer);
 FORWARD;

 procedure savePict (var pic: PicHandle; 
 var creator: str255; var err: integer);
 FORWARD;

 procedure ReturnPictInfo (var thePictHandle: PicHandle; 
 var length, width, depth: integer; 
 var colors, size: longint);
 FORWARD;

 procedure main (ProcNum: Longint; 
 PtrList: PackageVariablesPtr; var Data: handle; 
 var FuncPtr: PackRetParam);

  var
   thePic: Handle;
   Blk4D: ParmBlock;
   staticResNum: integer;
   theerr: OSErr;
   myVarRec: VarRec;

 begin
  case ProcNum of
   -1: 
    begin { Init - I’m not allocating any memory}
    end;

   -2: 
    begin { deInit }
    end;

   1: {read a Pict}
    begin
     PtrList^[2].I^ := noErr;
     thePic := nil;
     ReadPict(thePic, PtrList^[2].I^);
     if PtrList^[2].I^ = noErr then  
      begin
       myVarRec.varKind := PICT;
       myVarRec.picSize := GetHandleSize(thePic);
       myVarRec.PP := PicHandle(thePic);
       Blk4D.Name := PtrList^[1].S^;
       Blk4D.HH := @myVarRec;
       Blk4D.ClearOldVariable := true;
       Call4D(EX_PUT_VARIABLE, Blk4D);
       PtrList^[2].I^ := Blk4D.error;
      end;
    end;

   2: {save a Pict}
    begin
     if GetHandleSize(handle(PtrList^[1].P^)) <= 0 then
      PtrList^[4].I^ := -1
     else
      SavePict(PtrList^[1].P^, PtrList^[2].S^, 
 PtrList^[3].I^);
    end;

   3: 
    ReturnPictInfo(PtrList^[1].P^, PtrList^[2].I^, 
 PtrList^[3].I^, PtrList^[4].I^, PtrList^[5].L^, 
 PtrList^[6].L^);
  end;  {case ProcNum}
 end;

 procedure readPict (var thePic: Handle; 
 var theErr: integer);

  var
   reply: StandardFileReply;
   theTypeList: SFTypeList;
   thePicFile: integer;
   bytes, t: longint;
   myPicEnd: PicEnd;
   err: integer;

 begin
  theTypeList[0] := ‘PICT’;
  StandardGetFile(nil, 1, theTypeList, reply);
  if not (reply.sfGood) then
   theErr := -1
  else
   begin
    theErr := FSPOpenDF(reply.sfFile, fsCurPerm, 
 thePicFile);
    if theErr = noErr then
     begin
      theErr := GetEOF(thePicFile, bytes);
      bytes := bytes - 512;
      {need to leave 6 bytes for 4D’s PicEnd}
      t := compactMem(bytes + 6);
      thePic := NewHandle(bytes + 6);
      if thePic = nil then
       theErr := memError
      else
       begin
        Hlock(thePic);
        theErr := SetFPos(thePicFile, 1, 512);
        theErr := FSRead(thePicFile, bytes, thePic^);
        with myPicEnd do  {put on the 4D picEnd record}
         begin
          origin.h := 0;
          origin.v := 0;
            transfer := srcCopy;
         end;
        BlockMove(@myPicEnd, Ptr(ord(thePic^) + 
 GetHandleSize(thePic) - 6), 6);
        HUnLock(thePic);
       end;
      err := FSClose(thePicFile);
     end;
   end;
 end;

 procedure savePict (var pic: PicHandle; 
 var creator: str255; var err: integer);

  var
   theErr: OSErr;
   p: PTR;
   newFileRefNum: integer;
   picSize: longint;
   c: OSType;
   count: longint;
   reply: StandardFileReply;
 
begin
  if pic <> nil then
   begin
    StandardPutFile(‘Save a PICT file ’, 
 ‘PICT from 4D’, reply);
    if (reply.sfGood) then
     begin
      {If the file already exists, replace it}
      theErr := FSpDelete(reply.sfFile); 
      if length(creator) = 4 then
       begin
        BlockMove(@creator[1], @c, 4);
        err := FSpCreate(reply.sfFile, c, 
 ‘PICT’, reply.sfScript);
       end
      else
       err := FSpCreate(reply.sfFile, ‘SPNT’, 
 ‘PICT’, reply.sfScript);
      if err = noErr then
       begin
        err := FSpOpenDF(reply.sfFile, 
 fsRdWrPerm, newFileRefNum);
        if err = noErr then
         begin
          p := NewPtrClear(512);
          if p = nil then
           err := MemError
          else
           begin
            count := 512;
            err := FSWrite(newFileRefNum, count, p);
            if err = noErr then
             begin
              {Take off 6 bytes for the picEnd}
              count := GetHandleSize(Handle(pic)) - 6; 
              err := FSWrite(newFileRefNum, count, 
 ptr(ord(pic^)));
             end;
            DisposPtr(p);
           end;
          err := FSClose(newFileRefNum);
         end;
       end; {NoErr on FSpCreate}
     end;
   end;
 end;

 procedure ReturnPictInfo (var thePictHandle: PicHandle; 
 var length, width, depth: integer; 
 var colors, size: longint);

  var
   thePictInfo: PictInfo;
   saveHandleState: integer;
   theErr: OSErr;

 begin
  saveHandleState := HGetState(Handle(thePictHandle));     
  {save the original state}

  {GetPictInfo can move memory}
  HLock(Handle(thePictHandle));  
  theErr := GetPictInfo(thePictHandle, thePictInfo, 
 returnColorTable, 1, systemMethod, 0);

  if theErr = noErr then
   begin
    if thePictInfo.theColorTable <> nil then
     DisposHandle(Handle(thePictInfo.theColorTable));
    width := thePictInfo.sourceRect.right - 
 thePictInfo.sourceRect.left;
    length := thePictInfo.sourceRect.bottom - 
 thePictInfo.sourceRect.top;
    depth := thePictInfo.depth;
    colors := thePictInfo.uniqueColors;
    size := GetHandleSize(handle(thePictHandle));
  end;
  HSetState(Handle(thePictHandle), saveHandleState);
 end;

end.
Other Resources DeRez-ed

resource ‘4BNX’ (128) {
 { /* array 4BNXArray: 1 elements */
 /* [1] */
 ‘STR#’,/*Type */
 128,   /*Local ID*/
 128    /*Global ID*/
 }
};

resource ‘STR#’ (128) {
 { /* array StringArray: 3 elements */
 /* [1] */
 “ReadPict(&S;&I)”,
 /* [2] */
 “SavePict(&P;&S;&I)”,
 /* [3] */
 “ReturnPictInfo(&P;&I;&I;&I;&L;&L)”
 }
};

 

Community Search:
MacTech Search:

Software Updates via MacUpdate

Ellipsis - Touch. Explore. Survive. (...
Ellipsis - Touch. Explore. Survive. 1.0 Device: iOS Universal Category: Games Price: $2.99, Version: 1.0 (iTunes) Description: | Read more »
Ys Chronicles II (Games)
Ys Chronicles II 1.0.0 Device: iOS Universal Category: Games Price: $4.99, Version: 1.0.0 (iTunes) Description: After a hard fight to recover the six sacred books in Ys Chronicles I, Adol is back for a sequel! | Read more »
FINAL FANTASY Ⅸ (Games)
FINAL FANTASY Ⅸ 1.0.4 Device: iOS Universal Category: Games Price: $16.99, Version: 1.0.4 (iTunes) Description: ==========●Special sale price for the FINAL FANTASY IX release! ●20% off from February 10 to February 21, 2016... | Read more »
Tennis Club Story (Games)
Tennis Club Story 1.03 Device: iOS Universal Category: Games Price: $4.99, Version: 1.03 (iTunes) Description: Aim for the ace position of tennis club prestige in this simulation! Your leadership decides if players make it to the big... | Read more »
Juggernaut Wars guide - How to use skill...
Juggernaut Warsis a brand new auto-RPG on iOS and Android that challenges you to build a team of heroes, send them out into various different missions to defeat waves of heroes, and level them up to increase their power. The actual combat itself... | Read more »
Check out the new Pirate Attack update i...
Love pirates and board games? Well, you'll love the new Pirate Attack themed update that just launched in Game of Dice. It adds a bunch of new content themed around pirates, like an all new event map based on a pirate ship which revamps the toll... | Read more »
Splash Cars guide - How to paint the tow...
Splash Cars is an arcade driving game that feels like a hybrid between Dawn of the Plow and Splatoon. In it, you'll need to drive a car around to repaint areas of a town that have lost all of their color. Check out these tips to help you perform... | Read more »
The best video player on mobile
We all know the stock video player on iOS is not particularly convenient, primarily because it asks us to hook a device up to iTunes to sync video in a world that has things like Netflix. [Read more] | Read more »
Four apps to help improve your Super Bow...
Super Bowl Sunday is upon us, and whether you’re a Panthers or a Broncos fan you’re no doubt gearing up for it. [Read more] | Read more »
LooperSonic (Music)
LooperSonic 1.0 Device: iOS Universal Category: Music Price: $4.99, Version: 1.0 (iTunes) Description: LooperSonic is a multi-track audio looper and recorder that will take your loops to the next level. Use it like a loop pedal to... | Read more »

Price Scanner via MacPrices.net

App Annie Reveals Future of the App Economy:...
App Annie, a San Francisco based mobile app data and insights platform, has launched its first comprehensive app economy forecast. This new offering will provide brands, agencies, investors and app... Read more
Apple restocks Certified Refurbished Mac mini...
Apple has restocked Certified Refurbished 2014 Mac minis, with models available starting at $419. Apple’s one-year warranty is included with each mini, and shipping is free: - 1.4GHz Mac mini: $419 $... Read more
What iPad Pro Still Needs To Make It Truly Pr...
I love my iPad Air 2. So much that I’m grudgingly willing to put up with its compromises and limitations as a production tool in order to take advantage of its virtues. However, since a computer for... Read more
21-inch 3.1GHz 4K on sale for $1399, $100 off...
B&H Photo has the 21″ 3.1GHz 4K iMac on sale $1399 for a limited time. Shipping is free, and B&H charges NY sales tax only. Their price is $100 off MSRP: - 21″ 3.1GHz 4K iMac (MK452LL/A): $... Read more
Apple price trackers, updated continuously
Scan our Apple Price Trackers for the latest information on sales, bundles, and availability on systems from Apple’s authorized internet/catalog resellers. We update the trackers continuously: - 15″... Read more
Save up to $240 with Apple Certified Refurbis...
Apple is now offering Certified Refurbished 12″ Retina MacBooks for up to $240 off the cost of new models. Apple will include a standard one-year warranty with each MacBook, and shipping is free. The... Read more
Apple refurbished 13-inch Retina MacBook Pros...
Apple has Certified Refurbished 13″ Retina MacBook Pros available for up to $270 off the cost of new models. An Apple one-year warranty is included with each model, and shipping is free: - 13″ 2.7GHz... Read more
Apple refurbished Time Capsules available for...
Apple has certified refurbished Time Capsules available for $120 off MSRP. Apple’s one-year warranty is included with each Time Capsule, and shipping is free: - 2TB Time Capsule: $179, $120 off - 3TB... Read more
13-inch 2.5GHz MacBook Pro (refurbished) avai...
Apple has Certified Refurbished 13″ 2.5GHz MacBook Pros available for $829, or $270 off the cost of new models. Apple’s one-year warranty is standard, and shipping is free: - 13″ 2.5GHz MacBook Pros... Read more
Apple refurbished 15-inch Retina MacBook Pros...
Apple has Certified Refurbished 2015 15″ Retina MacBook Pros available for up to $380 off the cost of new models. An Apple one-year warranty is included with each model, and shipping is free: - 15″ 2... Read more

Jobs Board

Lead Engineer - *Apple* OSX & Hardware...
Lead Engineer - Apple OSX & Hardware **Job ID:** 3125919 **Full/Part\-Time:** Full\-time **Regular/Temporary:** Regular **Listed:** 2016\-02\-10 **Location:** Cary, Read more
Simply Mac *Apple* Specialist- Service Repa...
Simply Mac is the largest premier retailer of Apple products in the nation. In order to support our growing customer base, we are currently looking for a driven Read more
Infrastructure Engineer - *Apple* /Mac - Rem...
…part of a team Requires proven problem solving skills Preferred Additional: Apple Certified System Administrator (ACSA) Apple Certified Technical Coordinator (ACTC) Read more
Lead Engineer - *Apple* OSX & Hardware...
Lead Engineer - Apple OSX & Hardware **Job ID:** 3125919 **Full/Part\-Time:** Full\-time **Regular/Temporary:** Regular **Listed:** 2016\-02\-10 **Location:** Cary, Read more
*Apple* System Analyst - ATOS IT Services...
Apple System AnalystReference no.198783CountryUSARegionUS - CALIFORNIACityUS - CALIFORNIA - BURBANKPosition TypeProfessionalJob AreaIT SupportJob TypeFull Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.