' This program was created by Michael R. Davis while in the employ ' of the Federal Communications Commission. Therefore, this software ' is free to all those who wish to use it. I do ask that you do ' not attempt to make a profit from the ideas expressed or implied ' in this project. If you have any questions or comments please ' contact me at mdavis@fcc.gov. ' This program was writen and tested on Windows 3.1 running MapInfo ' and MapBasic 3.05. Although it is assumed to run on all MapInfo ' platforms it has not been extensively tested. ' This program has been verified to run under: ' MI/MB W3.05 Windows 31 I486DX-33 ' MI/MB W4.02 Windows 95 I486DX-66 ' MI/MB W4.10 Windows 95 Pentium-133 ' MI/MB S3.06 Solaris 2.4 Sun SparcStation 5 ' MapInfo for Mac v3.0 ' MapInfo for PowerMac v4 ' ' Program edited January 13, 1998 to work with MapInfo ' for Windows version 5 and hopefully above. Include "mapbasic.def" Dim RegionVar as object Dim I% as SmallInt, J% as SmallInt, K% as SmallInt Dim GetLogic as Logical Dim GetString as String * 1 Dim GetInt(3) as SmallInt Dim Location as SmallInt Dim FileName as String Dim ColorRows as SmallInt Dim ColorCols as SmallInt Declare Sub Main Sub Main Set Event Processing off Set Progressbars off Close All Interactive Close Window MapBasic Close Window Help Close Window Statistics Close Window Legend Close Window Info Close Window Ruler Print chr$(12) Alter ButtonPad "Drawing" Hide Alter ButtonPad "ODBC" Hide Alter ButtonPad "Tools" Hide Alter ButtonPad "Main" Hide Alter ButtonPad "Standard" Hide Do Case SystemInfo(SYS_INFO_PLATFORM) Case PLATFORM_MAC 'Thanks to Roger Haldenby Print "Macintosh" If SystemInfo(SYS_INFO_MIVERSION) < 400 then FileName = ProgramDirectory$() + "Mapinfo Color" 'Mac Else FileName = ProgramDirectory$() + "Support Files:Mapinfo Color" 'Mac End if ColorRows = 15 'Haldenby ColorCols = 16 'Haldenby Case PLATFORM_WIN Print "Microsoft Windows" If SystemInfo(SYS_INFO_MIVERSION) < 500 then FileName = HomeDirectory$() + "MapInfow.clr" 'Win3.1x/Win95 Else FileName = ProgramDirectory$() + "MapInfow.clr" End if ColorRows = 16 ColorCols = 16 Case PLATFORM_MOTIF Print "Motif Windows (UNIX)" FileName = HomeDirectory$() + "MapInfo.clr" 'UNIX ColorRows = 8 ColorCols = 13 Case Else Print "System Code: " + Format$(SystemInfo(SYS_INFO_PLATFORM), "####0") Print "Don't know your platform please," Print "send setup information about" Print "your system to mdavis@fcc.gov" Print "Thanks," Print "Mike" End Program End Case If Not FileExists(FileName) then If Ask("You are currently using the default Color Palette. In order for this program to work you need to save the current Color Palette.","&Instructions","&Cancel") Then Set Window Message Position ( 0, 1) Units "in" Width 3.5 Units "in" Height 1.1 Units "in" ScrollBars On Print chr$(12) Print "To save the current Color Palette" Print " 1) Click on Options" Print " 2) Click on Custom Colors... " Print " 3) Click on the Save Colors check box so that an X appears" Print " 4) Click OK" Print " 5) Finally, run this program again." Else Print "Cancel" Close Window Message End If End Program End If Set Window Message Position ( 0, 3.58333) Units "in" Width 2.89583 Units "in" Height 0.97917 Units "in" ScrollBars On Print "Creating Color Palette from file" Print Space$(9) + FileName + "..." Create Table "COLORPAL" ("Red" Smallint, "Green" Smallint, "Blue" Smallint) file "ColorPal.tab" TYPE NATIVE Charset "WindowsLatin1" Create Map For COLORPAL CoordSys NonEarth Units "km" Bounds (0, -ColorRows) (ColorCols, 0) Set CoordSys NonEarth Units "km" Bounds (0, -ColorRows) (ColorCols, 0) Set Style Pen (2,2,0) Set Distance Units "km" Open File FileName for Binary Access Read as 1 For J% = 0 to ColorRows -1 Set Window Message Title "Creating Color Palette (" + Format$(J% * (75 \ (ColorRows - 1)), "#0") + "%)" For I% = 0 to ColorCols -1 Location = (J% * ColorCols + I%) * 4 For K% = 1 to 3 'This section reads in the three colors Blue, Green, Red. Get #1, Location + K% + 4, GetString Get #1, Location + K% + 4, GetLogic If Getlogic then GetInt(K%) = Asc(GetString) Else GetInt(K%) = 0 End if 'Print "'" + GetLogic + "' '" + asc(GetString) + "' '" + GetInt(K%) + "' '" + (Location + K% + 4) Next 'K% Set Style Brush MakeBrush(2, RGB( GetInt(3), GetInt(2), GetInt(1)), 0) Create Rect Into Variable RegionVar (I%, - J%) (I% + 1, - J% - 1) Insert Into COLORPAL ("Red", "Green", "Blue", obj) Values ( GetInt(3), GetInt(2), GetInt(1), RegionVar) Next ' I% Next ' J% Close File 1 Commit Table COLORPAL Map From COLORPAL Position (0,0) Units "in" Width 2.89583 Units "in" Height 2.89583 Units "in" Set Map Layer 1 Editable On Set Map Redraw Off Set Window FrontWindow() Title "MapInfo Color Palette Map" Set Window FrontWindow() ScrollBars Off Set Window Message Title "Creating Color Palette (80%)" Set Map CoordSys NonEarth Units "km" Center (ColorCols/2, -ColorRows/2) Zoom ColorCols + 0.2 Units "km" Preserve Zoom Display Zoom XY Units "km" Distance Units "km" Area Units "sq km" Set Map Layer 1 Display Graphic Set Map Redraw ON Set Window Message Title "Creating Color Palette (85%)" Print "Creating Layout for Color Palette..." Layout Position (2.97917,0) Units "in" Width 3.19792 Units "in" Height 4.09375 Units "in" Set CoordSys Layout Units "in" Create Frame (0.389583333333,1.661805555556) (8.104861111111,9.642361111111) Pen (1,1,0) Brush (2,16777215,16777215) Title "MapInfo Color Palette Map" Create Text "Federal Communications Commission\nOffice of Engineering and Technology\nMichael R. Davis (mdavis@fcc.gov)" (1.961805555556,9.789583333333) (6.538194444444,10.689583333333) Font ("Arial",1,18,128) Justify Center Create Text "MapInfo Color Palette" (2.104861111111,0.684027777778) (6.395138888889,1.177083333333) Font ("Arial",1,30,0) Set Window Message Title "Creating Color Palette (90%)" Set Layout Ruler Off Pagebreaks Off Frame Contents Active Zoom 35.7 Center (4.23939,5.49776) Extents To Fit Set CoordSys Earth Set Window FrontWindow() Title "MapInfo Color Palette Layout" Set Window Message Title "Creating Color Palette (95%)" Save Workspace as "Colorpal.wor" Print "Finished!" Set event processing on Set Window Message Title "Creating Color Palette (100%)" End Sub 'main