'VBScript 'The line above must be the very first line of the file. ' 'NOTE: 'This GCS file will only work with characters saved by GCA 4! ' Const LastUpdated = 20070916 'Last Updated: September 16, 2007 ' ' This file based on charactersheet.gcs, with new options added by Rev. Pee Kitty ' Find the latest version at http://www.mygurps.com/ ' Const Stats = 1 Const Ads = 2 Const Disads = 3 Const Quirks = 4 Const Powers = 5 Const Perks = 5 Const Skills = 6 Const Spells = 7 Const Equipment = 8 Const Packages = 9 'Templates, Meta-traits Const AlignLeftTop = 0 Const AlignCenterTop = 1 Const AlignRightTop = 2 Const AlignLeftBottom = 3 Const AlignCenterBottom = 4 Const AlignRightBottom = 5 Const AlignLeftMiddle = 6 Const AlignCenterMiddle = 7 Const AlignRightMiddle = 8 Const AlignJustifyTop = 9 Const AlignJustifyBottom = 10 Const AlignJustifyMiddle = 11 Const BorderNone = 0 Const BorderBottom = 1 Const BorderTop = 2 Const BorderTopBottom = 3 Const BorderBox = 4 Const BorderColumns = 5 Const BorderColumnTopBottom = 6 Const BorderAll = 7 Const BorderBoxRows = 8 Const BorderBoxColumns = 9 Const BorderBelowHeader = 10 Const PushBasicsRight = False Const Grey = &HCCCCCC const optYesNo = 0 const optTrueFalse = 1 const optList = 2 'not yet supported const optListNumber = 3 'not yet supported const optListFlag = 4 'not yet supported const optColor = 5 const optFont = 6 const optText = 7 const MinSpace = 0.0625 const ChildIndentLeft = 0.125 Dim BoxWidth, BoxHeight dim BoxTop, BoxBottom Dim FormFont, FormFontSize Dim UserFont, UserFontSize Dim FormFontColor, UserFontColor Dim MinFontSize dim ColumnTop, ColumnWidth, ColumnHeight dim Column1Left, Column2Left Dim OverflowAds, OverflowPerks Dim OverflowDisads, OverflowQuirks Dim OverflowCultural, OverflowLanguages Dim OverflowSkills, OverflowTechniques, OverflowSpells Dim OverflowEquipment Dim OverflowHandWeapons, OverflowRangedWeapons dim GroupChildren '**************************************** 'Creating options '**************************************** Sub CharacterSheetOptions() 'AddOption(OptionName As Variant, ' Optional OptionType As Variant = 0, ' Optional OptionList As Variant = "", ' Optional OptionDefault As Variant = True, ' Optional UserPrompt As Variant = "Select an option") 'The spacer/headers used below are all headers. If you just want 'a spacer, then set UserPrompt = "" and no line will be drawn, either '* Fonts * OptionName = "HeaderFonts" OptionType = -1 UserPrompt = "Font and Text Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "FormFont" OptionType = optFont OptionDefault = "Times New Roman|10" UserPrompt = "Font for the form text items" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "FormFontColor" OptionType = optColor OptionDefault = 0 UserPrompt = "Color for the form text items" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "UserFont" OptionType = optFont OptionDefault = "Arial|10" UserPrompt = "Font for the user text items" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "UserFontColor" OptionType = optColor OptionDefault = 0 UserPrompt = "Color for the user text items" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "MinFontSize" OptionType = optText OptionDefault = "8" UserPrompt = "Minimum point size to which fonts may be reduced to fit them into given areas? (Integer values only.)" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt '* Template Item Options * OptionName = "HeaderTemplateItems" OptionType = -1 UserPrompt = "Template/Meta-Trait Item Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "ShowComponents" OptionType = optYesNo OptionDefault = False UserPrompt = "List the component traits under the template/meta-trait listing?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "ParagraphComponents" OptionType = optYesNo OptionDefault = True UserPrompt = "If yes for the above option, use a paragraph format instead of a line-by-line format?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt '* Advantage/Disadvantage Item Options * OptionName = "HeaderAdvantageItems" OptionType = -1 UserPrompt = "Advantage/Disadvantage Item Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "ShowAdBonuses" OptionType = optYesNo OptionDefault = False UserPrompt = "Show any bonuses received below the advantage/perk text?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "ShowAdConditionals" OptionType = optYesNo OptionDefault = False UserPrompt = "Show any conditional bonuses received below the advantage/perk text?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "ShowDisadBonuses" OptionType = optYesNo OptionDefault = False UserPrompt = "Show any bonuses received below the disadvantage/quirk text?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "ShowDisadConditionals" OptionType = optYesNo OptionDefault = False UserPrompt = "Show any conditional bonuses received below the disadvantage/quirk text?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt '* Skill Item Options * OptionName = "HeaderSkillItems" OptionType = -1 UserPrompt = "Skill Item Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "RemoveLanguageBox" OptionType = optYesNo UserPrompt = "Remove the Languages box to give more room for skills?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "RemoveCFandDRBox" OptionType = optYesNo UserPrompt = "Remove the DR and Cultural Familarity boxes to give more room for skills?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "ShowParry" OptionType = optYesNo OptionDefault = False UserPrompt = "Show Parry or Block, if applicable, under the appropriate skills?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "ShowSkillBonuses" OptionType = optYesNo OptionDefault = True UserPrompt = "Show any bonuses received below the skill text?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "ShowSkillConditionals" OptionType = optYesNo OptionDefault = True UserPrompt = "Show any conditional bonuses received below the skill text?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "ShowSpells" OptionType = optYesNo OptionDefault = True UserPrompt = "List spells after skills in the skills listing? (Selecting No will prevent listing of spells. Useful if you print a Grimoire, instead.)" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt '* Weapon Options * OptionName = "HeaderWeapons" OptionType = -1 UserPrompt = "Weapon Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "MoreHandWeaponSpace" OptionType = optYesNo UserPrompt = "Sacrifice space from the Notes section on the Equipment page to get more Hand Weapon space at the top?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "EvenMoreHandWeaponSpace" OptionType = optYesNo UserPrompt = "If yes to the above, also sacrifice space from the Ranged Weapons for even more Hand Weapon space?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "HideBite" OptionType = optYesNo UserPrompt = "Hide the weapon listing for Bite damage?" Options.AddOption OptionName, OptionType, , True, UserPrompt OptionName = "ShowMinST" OptionType = optYesNo OptionDefault = True UserPrompt = "Show a Min ST column for hand weapons?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "ShowSkillParry" OptionType = optYesNo OptionDefault = True UserPrompt = "Show a column for weapon skill & parry score, instead of the column for parry adjustment, for hand weapons?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "ShowRangedLevel" OptionType = optYesNo OptionDefault = True UserPrompt = "Show a Level column for weapon skill, for ranged weapons?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "HandWeaponsColumn" OptionType = optYesNo OptionDefault = False UserPrompt = "On the Hand Weapons Table sacrifice space from the Name column to give more room for the Damage column?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "RangedWeaponsColumn" OptionType = optYesNo OptionDefault = False UserPrompt = "On the Ranged Weapons Table sacrifice space from the Name column to give more room for the Damage column?" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt '* Miscellaneous Options * OptionName = "HeaderMisc" OptionType = -1 UserPrompt = "Miscellaneous Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "PrintBigStats" OptionType = optYesNo UserPrompt = "Print major attributes with oversized text?" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "PrintMovementBlock" OptionType = optYesNo UserPrompt = "Print a block for various movement rates, below the Encumbrance section?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "SplitFullLanguages" OptionType = optYesNo UserPrompt = "Would you like single language traits that cover both Spoken and Written forms to be printed with a value in each column?" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "ShowLangBonus" OptionType = optYesNo UserPrompt = "Show the applicable bonuses under languages?" Options.AddOption OptionName, OptionType, , True, UserPrompt OptionName = "PrintAllDR" OptionType = optYesNo UserPrompt = "Squish all DR values into the DR box?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "DRWider" OptionType = optYesNo UserPrompt = "Make the DR box wider? (This is good if you said Yes to the above option.)" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "NotesPage" OptionType = optYesNo UserPrompt = "Print the character's Description and Notes starting on a new page?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "NotesPage2Col" OptionType = optYesNo UserPrompt = "Use 2 columns for the new page of Description and Notes info? (If Yes for previous option.)" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "GroupChildren" OptionType = optYesNo UserPrompt = "Group child items under their parent items?" Options.AddOption OptionName, OptionType, , False, UserPrompt '* Hidden Items * OptionName = "HeaderHidden" OptionType = -1 UserPrompt = "Hidden Trait Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "ShowHiddenTemplates" OptionType = optYesNo UserPrompt = "Print hidden templates on the sheet?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "ShowHiddenAds" OptionType = optYesNo UserPrompt = "Print hidden advantages on the sheet?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "ShowHiddenPerks" OptionType = optYesNo UserPrompt = "Print hidden perks on the sheet?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "ShowHiddenDisads" OptionType = optYesNo UserPrompt = "Print hidden disadvantages on the sheet?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "ShowHiddenQuirks" OptionType = optYesNo UserPrompt = "Print hidden quirks on the sheet?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "ShowHiddenSkills" OptionType = optYesNo UserPrompt = "Print hidden skills on the sheet?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "ShowHiddenSpells" OptionType = optYesNo UserPrompt = "Print hidden spells on the sheet?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "ShowHiddenEquipment" OptionType = optYesNo UserPrompt = "Print hidden equipment on the sheet?" Options.AddOption OptionName, OptionType, , False, UserPrompt '* Lines Between Items * OptionName = "HeaderLines" OptionType = -1 UserPrompt = "Item Separation Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "LineAfterAds" OptionType = optYesNo UserPrompt = "Print a line after each advantage/perk?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "LineAfterDisads" OptionType = optYesNo UserPrompt = "Print a line after each disadvantage/quirk?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "LineAfterSkills" OptionType = optYesNo UserPrompt = "Print a line after each skill/technique?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "LineAfterSpells" OptionType = optYesNo UserPrompt = "Print a line after each spell?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "LineAfterLanguages" OptionType = optYesNo UserPrompt = "Print a line after each language?" Options.AddOption OptionName, OptionType, , False, UserPrompt '* Page Numbers * OptionName = "HeaderPageNumbers" OptionType = -1 UserPrompt = "Page Number Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "TemplatesPageNumbers" OptionType = optYesNo UserPrompt = "Include page numbers with templates?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "AdsPageNumbers" OptionType = optYesNo UserPrompt = "Include page numbers with advantages?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "DisadsPageNumbers" OptionType = optYesNo UserPrompt = "Include page numbers with disadvantages?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "SkillsPageNumbers" OptionType = optYesNo UserPrompt = "Include page numbers with skills?" Options.AddOption OptionName, OptionType, , False, UserPrompt OptionName = "SpellsPageNumbers" OptionType = optYesNo UserPrompt = "Include page numbers with spells?" Options.AddOption OptionName, OptionType, , False, UserPrompt '* Headers and Footers * OptionName = "HeaderFooter" OptionType = -1 UserPrompt = "Header and Footer Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "Header" OptionType = optText OptionDefault = "GURPS Character Assistant 4" UserPrompt = "Text for the header of your character sheet" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt OptionName = "Footer" OptionType = optText OptionDefault = "http://www.sjgames.com/gurps/characterassistant/||v%GCAVer%" UserPrompt = "Text for the footer of your character sheet" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt '* Logo * OptionName = "HeaderLogo" OptionType = -1 UserPrompt = "Logo Options" Options.AddOption OptionName, OptionType, , , UserPrompt OptionName = "Logo" OptionType = optText OptionDefault = "gurps logo.bmp" UserPrompt = "BMP to use as the logo at the top left of the standard pages" Options.AddOption OptionName, OptionType, , OptionDefault, UserPrompt End Sub '**************************************** 'The Main Module, where the form starts '**************************************** Sub Main() DebugLog "CharacterSheet.GCS (" & LastUpdated & ")" OverflowAds = 0 OverflowPerks = 0 OverflowDisads = 0 OverflowQuirks = 0 OverflowCultural = 0 OverflowLanguages = 0 OverflowSkills = 0 OverflowSpells = 0 OverflowEquipment = 0 OverflowHandWeapons = 0 OverflowRangedWeapons = 0 scalemode = 0 'inches 'get the font options optionFont = Options.Value("FormFont") 'debuglog "optionFont = " & optionFont FormFont = ReturnFontName(optionFont) FormFontSize = ReturnFontSize(optionFont) 'debuglog "FormFontSize = " & FormFontSize 'debuglog "FormFontBold = " & ReturnFontBold(optionFont) 'debuglog "FormFontItalic = " & ReturnFontItalic(optionFont) if FormFontSize > 50 then 'work around a bug in regional setting support 'debuglog "Bug work-around for font size setting." 'DebugLog "FormFontSize was " & FormFontSize FormFontSize = FormFontSize/100 'DebugLog "FormFontSize is now " & FormFontSize end if optionFont = Options.Value("UserFont") UserFont = ReturnFontName(optionFont) UserFontSize = ReturnFontSize(optionFont) if UserFontSize > 50 then 'work around a bug in regional setting support 'debuglog "Bug work-around for font size setting." 'DebugLog "UserFontSize was " & UserFontSize UserFontSize = UserFontSize/100 'DebugLog "UserFontSize is now " & UserFontSize end if MinFontSize = CInt(Options.Value("MinFontSize")) FormFontColor = Options.Value("FormFontColor") UserFontColor = Options.Value("UserFontColor") GroupChildren = Options.Value("GroupChildren") fontsize = FormFontSize fontname = FormFont ColumnWidth = 3.6875 Column1Left = 0.5 Column2Left = 4.3125 Call SetMargins Call SetHeader Call SetFooter ColumnHeight = PageHeight - MarginBottom '10.5 CurrentY = margintop Call PrintTopBlock CurrentY = margintop + .75 ColumnTop = CurrentY BoxWidth = 0.5 BoxHeight = 0.5 if Not Options.Value("PrintBigStats") then BoxHeight = 0.25 end if Call PrintStats Call PrintMovementLift BoxTop = CurrentY Call PrintEncumbrance BoxBottom = CurrentY DrawBox Column1Left, BoxTop, Column1Left+ColumnWidth, BoxBottom, False, ,-1 if Options.Value("PrintMovementBlock") then Call PrintMovement end if CurrentY = BoxBottom + .0625 BoxTop = CurrentY Call PrintAdsDisads(FormFontSize, UserFontSize, BoxTop) '* COLUMN 2 * '* COLUMN 2 * CurrentY = ColumnTop CurrentX = Column2Left if Options.Value("RemoveLanguageBox") then else BoxTop = CurrentY Call PrintLanguages(FormFontSize, UserFontSize, BoxTop) CurrentY = BoxBottom + .0625 end if if Options.Value("RemoveCFandDRBox") then else BoxTop = CurrentY Call PrintCultural(FormFontSize, UserFontSize, BoxTop) CurrentY = BoxTop Call PrintDR(FormFontSize, UserFontSize, BoxTop, BoxBottom) CurrentY = BoxBottom + .0625 end if BoxTop = CurrentY Call PrintReaction CurrentY = CurrentY + .0625 BoxBottom = CurrentY if BoxBottom - BoxTop < 1 then BoxBottom = BoxTop + 1 end if LeftSide = Column2Left+0.75 DrawBox LeftSide, BoxTop, PageWidth - MarginRight, BoxBottom, False, ,-1 DrawBox Column2Left, BoxTop, Column2Left+0.6875, BoxBottom, False, ,-1 MidLine = (BoxBottom-BoxTop)/2+BoxTop DrawLine Column2Left, MidLine, Column2Left+0.6875, MidLine CurrentY = BoxTop Call PrintParryBlock(MidLine) CurrentY = BoxBottom + .0625 BoxTop = CurrentY Call PrintSkills(FormFontSize, UserFontSize, BoxTop) '********** ' PAGE 1 Overflow '********** t = 0 t = t + OverflowAds t = t + OverflowPerks t = t + OverflowDisads t = t + OverflowQuirks t = t + OverflowCultural t = t + OverflowLanguages t = t + OverflowSkills ft = t + OverflowTechniques t = t + OverflowSpells IF t > 0 THEN NewPage Call SetMargins SetFormFont tW = TextWidth("DX") tH = TextHeight("DX") ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop if OverflowAds + OverflowPerks > 0 then BoxTop = CurrentY SetFormFont FontBold = True PrintCentered "ADVANTAGES AND PERKS (continued)", ColLeft, ColRight FontBold = False Call PrintOverflowAds(BoxTop, ColLeft, ColRight) 'if Ads overflowed, so did Disads BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY end if SetFormFont FontBold = True PrintCentered "DISADVANTAGES AND QUIRKS", ColLeft, ColRight FontBold = False OverflowDisads = 1 Call PrintOverflowDisads(BoxTop, ColLeft, ColRight) OverflowDisads = 0 end if if OverflowDisads + OverflowQuirks > 0 then BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY end if SetFormFont FontBold = True PrintCentered "DISADVANTAGES AND QUIRKS (continued)", ColLeft, ColRight FontBold = False Call PrintOverflowDisads(BoxTop, ColLeft, ColRight) end if if OverflowLanguages > 0 then NameLeft = ColLeft + MinSpace SpokenLeft = NameLeft + 1.5 WrittenLeft = SpokenLeft + .8125 BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY NameLeft = ColLeft + MinSpace SpokenLeft = NameLeft + 1.5 WrittenLeft = SpokenLeft + .8125 end if curTop = BoxTop SetFormFont FontBold = True CurrentY = curTop PrintAtLeft "Languages (continued)", NameLeft CurrentY = curTop PrintAtLeft "Spoken", SpokenLeft CurrentY = curTop PrintAtLeft "Written", WrittenLeft FontBold = False BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY end if Call PrintOverflowLanguages(BoxTop, ColLeft, ColRight) end if if OverflowCultural > 0 then NameLeft = ColLeft + MinSpace BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY end if SetFormFont FontBold = True PrintAtLeft "Cultural Familiarities (continued)", NameLeft FontBold = False Call PrintOverflowCultural(BoxTop, ColLeft, ColRight) end if if OverflowSkills + OverflowTechniques > 0 then NameLeft = ColLeft + MinSpace LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 SetFormFont FontBold = True PrintCentered "SKILLS (continued)", ColLeft, ColRight FontBold = False BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY NameLeft = ColLeft + MinSpace LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 end if curTop = BoxTop + tH CurrentY = curTop FontBold = True CurrentY = curTop PrintAtLeft "Name", NameLeft CurrentY = curTop PrintAtLeft "Level", LevelLeft CurrentY = curTop PrintAtLeft "Relative Level", RelLevelLeft FontBold = False BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY NameLeft = ColLeft + MinSpace LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 end if Call PrintOverflowSkills(BoxTop, ColLeft, ColRight) 'if Skills overflowed, so did Spells if char.count(Spells) >0 then If Options.Value("ShowSpells") Then BoxTop = CurrentY NameLeft = ColLeft + MinSpace LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY NameLeft = ColLeft + MinSpace LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 end if SetFormFont FontBold = True PrintAtLeft "Spells", NameLeft FontBold = False OverflowSpells = 1 Call PrintOverflowSpells(BoxTop, ColLeft, ColRight) OverflowSpells = 0 End If end if end if if OverflowSpells > 0 then NameLeft = ColLeft + MinSpace LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY NameLeft = ColLeft + MinSpace LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 end if SetFormFont FontBold = True PrintAtLeft "Spells (continued)", NameLeft FontBold = False curTop = BoxTop + tH CurrentY = curTop BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = MarginTop end if BoxTop = CurrentY NameLeft = ColLeft + MinSpace LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 end if curTop = BoxTop FontBold = True CurrentY = curTop PrintAtLeft "Name", NameLeft CurrentY = curTop PrintAtLeft "Level", LevelLeft 'CurrentY = curTop 'PrintAtLeft "Relative Level", RelLevelLeft FontBold = False BoxTop = CurrentY Call PrintOverflowSpells(BoxTop, ColLeft, ColRight) end if END IF '********** ' PAGE 2 '********** NewPage Call SetMargins CurrentX = MarginLeft CurrentY = MarginTop 'Place logo Logo = Options.Value("Logo") DrawBitmap cstr(Logo), MarginLeft, MarginTop, 2.25, 1 SetFormFont CurrentX = MarginLeft CurrentY = 1 PrintCentered "CHARACTER SHEET", MarginLeft, 2.25 Paragraph = "" SetUserFont TextBox "DXiq", MarginLeft, CurrentY, 2.25 - MarginLeft, 0, True, True tH = TextHei TextBox Char.Name, MarginLeft, CurrentY, 2.25 - MarginLeft, 0, True, True NameHeight = TextHei if NameHeight > tH then if Options.Value("MoreHandWeaponSpace") then if Options.Value("EvenMoreHandWeaponSpace") then TextBox Char.Name, MarginLeft, CurrentY, 2.25 - MarginLeft, 3.125, True else TextBox Char.Name, MarginLeft, CurrentY, 2.25 - MarginLeft, 2.125, True end if else TextBox Char.Name, MarginLeft, CurrentY, 2.25 - MarginLeft, 1.125, True end if else PrintCentered Char.Name, MarginLeft, 2.25 end if Paragraph = "" CostLeft = PageWidth-MarginRight-1.175 CostRight = PageWidth-MarginRight BoxTop = MarginTop 'CurrentY Call PrintHandWeapons(FormFontSize, UserFontSize, BoxTop) SetMargins CurrentY = BoxBottom + 0.0625 BoxTop = CurrentY Call PrintRangedWeapons(FormFontSize, UserFontSize, BoxTop) CurrentY = BoxBottom + 0.0625 NewTopLine = CurrentY BoxTop = CurrentY Call PrintEquipment(FormFontSize, UserFontSize, BoxTop) DrawBox CostLeft+.01, MarginTop, CostLeft+.0625, ColumnHeight, False, &HFFFFFF, &HFFFFFF SetMargins CurrentY = NewTopLine BoxTop = CurrentY Call PrintSpeedRange BoxBottom = CurrentY DrawBox MarginLeft, BoxTop, MarginLeft+1.875, BoxBottom, False, ,-1 NewBottomLine = BoxBottom CurrentY = NewTopLine MarginLeft = MarginLeft + 1.875 + 0.0625 BoxTop = CurrentY Call PrintHitLocation BoxBottom = CurrentY DrawBox MarginLeft, BoxTop, MarginLeft+1.25, BoxBottom, False, ,-1 CurrentY = BoxBottom + 0.0625 BoxTop = CurrentY Call PrintCopyright BoxBottom = CurrentY DrawBox MarginLeft, BoxTop, MarginLeft+1.25, NewBottomLine, False, ,-1 CurrentY = NewBottomLine + 0.0625 NotesTop = CurrentY SetMargins SetUserFont h2 = TextHeight("Sample Text") SetFormFont h = TextHeight("Sample Text") if h2 > h then h = h2 s = h * 8 PointTop = ColumnHeight - s CurrentY = PointTop Call PrintPoints s = PointTop - NotesTop - h l = cint(s / h)-2 CurrentY = NotesTop Call PrintNotes(PointTop) DrawBox MarginLeft, NotesTop, MarginLeft+3.1875, ColumnHeight, False, ,-1 '********** ' PAGE 2 Overflow ' ' The stuff on this page requires the entire width of the page, so it ' will not be two column like the previous overflow stuff '********** t = 0 t = t + OverflowHandWeapons t = t + OverflowRangedWeapons t = t + OverflowEquipment IF t > 0 THEN NewPage Call SetMargins SetFormFont tW = TextWidth("DX") tH = TextHeight("DX") ColLeft = MarginLeft ColRight = PageWidth - MarginRight CurrentX = MarginLeft CurrentY = MarginTop if OverflowHandWeapons > 0 then CountLeft = ColLeft + MinSpace NameLeft = CountLeft + 0.25 if Options.Value("HandWeaponsColumn") then DamageLeft = NameLeft + 1.75 ReachLeft = DamageLeft + 1.75 else DamageLeft = NameLeft + 1.75 ReachLeft = DamageLeft + 1 end if ParryLeft = ReachLeft + 0.5 if Options.Value("ShowMinST") then MinSTLeft = ParryLeft + 0.5 NotesLeft = MinSTLeft + 0.375 else NotesLeft = ParryLeft + 0.5 end if CostLeft = NotesLeft + 0.5 WeightLeft = CostLeft + 0.5 BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room NewPage CurrentX = MarginLeft CurrentY = MarginTop BoxTop = CurrentY end if SetFormFont FontBold = True PrintAtLeft "HAND WEAPONS (continued)", CountLeft FontBold = False BoxTop = BoxTop + tH if BoxTop + tH > ColumnHeight then 'ran out of room NewPage CurrentX = MarginLeft CurrentY = MarginTop BoxTop = CurrentY end if curTop = BoxTop FontBold = True CurrentY = curTop PrintAtLeft "Qty", CountLeft CurrentY = curTop PrintAtLeft "Weapon", NameLeft CurrentY = curTop PrintAtLeft "Damage", DamageLeft CurrentY = curTop PrintAtLeft "Reach", ReachLeft if Options.Value("ShowSkillParry") then CurrentY = curTop PrintAtLeft "Lvl(Pry)", ParryLeft else CurrentY = curTop PrintAtLeft "Parry", ParryLeft end if if Options.Value("ShowMinST") then CurrentY = curTop PrintAtLeft "ST", MinSTLeft end if CurrentY = curTop PrintAtLeft "Notes", NotesLeft CurrentY = curTop PrintAtLeft "Cost", CostLeft CurrentY = curTop PrintAtLeft "Weight", WeightLeft FontBold = False BoxTop = CurrentY Call PrintOverflowHandWeapons(BoxTop, ColLeft, ColRight) end if if OverflowRangedWeapons > 0 then CountLeft = ColLeft + MinSpace NameLeft = CountLeft + 0.25 if Options.Value("RangedWeaponsColumn") then DamageLeft = NameLeft + 1 AccLeft = DamageLeft + 1 else DamageLeft = NameLeft + 1.375 AccLeft = DamageLeft + 0.625 end if RangeLeft = AccLeft + 0.375 ROFLeft = RangeLeft + 1 ShotsLeft = ROFLeft + 0.375 STLeft = ShotsLeft + 0.625 BulkLeft = STLeft + 0.375 RclLeft = BulkLeft + 0.375 LCLeft = RclLeft + 0.25 NotesLeft = LCLeft + 0.25 if Options.Value("ShowRangedLevel") then ROFLeft = RangeLeft + 0.75 ShotsLeft = ROFLeft + 0.375 LevelLeft = ShotsLeft + 0.5625 STLeft = LevelLeft + 0.3125 end if WeightLeft = ColRight - 0.5 CostLeft = WeightLeft - 0.5 BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room NewPage CurrentX = MarginLeft CurrentY = MarginTop BoxTop = CurrentY end if SetFormFont FontBold = True PrintAtLeft "RANGED WEAPONS (continued)", CountLeft FontBold = False BoxTop = BoxTop + tH if BoxTop + tH > ColumnHeight then 'ran out of room NewPage CurrentX = MarginLeft CurrentY = MarginTop BoxTop = CurrentY end if curTop = BoxTop FontBold = True CurrentY = curTop PrintAtLeft "Qty", CountLeft CurrentY = curTop PrintAtLeft "Weapon", NameLeft CurrentY = curTop PrintAtLeft "Damage", DamageLeft CurrentY = curTop PrintAtLeft "Acc", AccLeft CurrentY = curTop PrintAtLeft "Range", RangeLeft CurrentY = curTop PrintAtLeft "RoF", ROFLeft CurrentY = curTop PrintAtLeft "Shots", ShotsLeft if Options.Value("ShowRangedLevel") then CurrentY = curTop PrintAtLeft "Lvl", LevelLeft end if CurrentY = curTop PrintAtLeft "ST", STLeft CurrentY = curTop PrintAtLeft "Bulk", BulkLeft CurrentY = curTop PrintAtLeft "Rcl", RclLeft CurrentY = curTop PrintAtLeft "LC", LCLeft CurrentY = curTop PrintAtLeft "Notes", NotesLeft CurrentY = curTop PrintAtLeft "Cost", CostLeft CurrentY = curTop PrintAtLeft "Weight", WeightLeft FontBold = False BoxTop = CurrentY Call PrintOverflowRangedWeapons(BoxTop, ColLeft, ColRight) end if if OverflowEquipment > 0 then ColLeft = MarginLeft ColRight = 4.125 CountLeft = ColLeft + MinSpace NameLeft = CountLeft + 0.25 LocationLeft = NameLeft + 1.75 WeightLeft = ColRight - .375 CostLeft = WeightLeft - .375 ColTop = CurrentY BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = ColTop 'MarginTop end if BoxTop = CurrentY CountLeft = ColLeft + MinSpace NameLeft = CountLeft + 0.25 LocationLeft = NameLeft + 1.75 WeightLeft = ColRight - .375 CostLeft = WeightLeft - .375 end if SetFormFont FontBold = True PrintAtLeft "ARMOR & POSSESSIONS (continued)", CountLeft FontBold = False curTop = BoxTop + tH CurrentY = curTop BoxTop = CurrentY if BoxTop + tH > ColumnHeight then 'ran out of room if ColLeft = 4.375 then NewPage Call SetMargins ColLeft = MarginLeft ColRight = 4.125 CurrentX = MarginLeft CurrentY = MarginTop else ColLeft = 4.375 ColRight = PageWidth - MarginRight CurrentX = ColLeft CurrentY = ColTop 'MarginTop end if BoxTop = CurrentY CountLeft = ColLeft + MinSpace NameLeft = CountLeft + 0.25 LocationLeft = NameLeft + 1.75 WeightLeft = ColRight - .375 CostLeft = WeightLeft - .375 end if curTop = BoxTop FontBold = True CurrentY = curTop PrintAtLeft "Qty", CountLeft CurrentY = curTop PrintAtLeft "Item", NameLeft CurrentY = curTop PrintAtLeft "Location", LocationLeft CurrentY = curTop PrintAtLeft "Cost", CostLeft CurrentY = curTop PrintAtLeft "Wgt", WeightLeft FontBold = False BoxTop = CurrentY Call PrintOverflowEquipment(BoxTop, ColLeft, ColRight) end if END IF '********** ' NOTES page '********** If Options.Value("NotesPage") then If Len(Char.portrait) = 0 Then If Len(Char.Description) = 0 Then If Len(Char.Notes) = 0 Then Exit Sub End If End If End If PrintNotesPage end if End Sub '**************************************** 'set the margins for the character sheets '**************************************** Sub SetMargins() MarginLeft = 0.5 MarginRight = 0.5 MarginTop = 0.5 MarginBottom = 0.5 End Sub '**************************************** 'Create the header for the character sheets '**************************************** Sub SetHeader() tmp = Options.Value("Header") tmp = replace(tmp, "%GCAVer%", GCAVer, 1, -1, 1) header = tmp End Sub '**************************************** 'Create the footer for the character sheets '**************************************** Sub SetFooter() tmp = Options.Value("Footer") tmp = replace(tmp, "%GCAVer%", GCAVer, 1, -1, 1) footer = tmp End Sub '**************************************** 'Set Font to the User Prefs '**************************************** Sub SetUserFont() FontName = UserFont FontSize = UserFontSize TextColor = UserFontColor End Sub '**************************************** 'Set Font to the Form Prefs '**************************************** Sub SetFormFont() FontName = FormFont FontSize = FormFontSize TextColor = FormFontColor End Sub '**************************************** 'Print the top block of info '**************************************** Sub PrintTopBlock Dim ListLoc tW = TextWidth("DX") tH = TextHeight("DX") 'Place logo Logo = Options.Value("Logo") DrawBitmap cstr(Logo), MarginLeft, MarginTop, 2.25, 1 'TOP LINE CurTop = MarginTop SetFormFont PrintAtLeft "Name ", 2.5 SetUserFont TextBox Char.Name, CurrentX, CurTop, 5-CurrentX, tH*2, False CurrentY = CurTop SetFormFont PrintAtLeft "Player ", 5 SetUserFont TextBox Char.Player, CurrentX, CurTop, 6.5-CurrentX, tH*2, False CurrentY = CurTop SetFormFont PrintAtRight "Point Total ", 7.25 SetUserFont PrintAtLeft Char.TotalPoints, 7.25 'SECOND LINE Paragraph = "" CurTop = CurrentY CurrentY = CurTop SetFormFont PrintAtLeft "Ht ", 2.5 SetUserFont TextBox Char.Height, CurrentX, CurTop, 3.375-CurrentX-MinSpace, tH*2, False CurrentY = CurTop SetFormFont PrintAtLeft "Wt ", 3.375 SetUserFont TextBox Char.Weight, CurrentX, CurTop, 4.25-CurrentX-MinSpace, tH*2, False CurrentY = CurTop SetFormFont PrintAtLeft "Size Modifier ", 4.25 ListLoc = char.ItemPositionByNameAndExt("Size Modifier", Stats) if ListLoc > 0 then SetUserFont Text = Char.Items(ListLoc).TagItem("score") end if CurrentY = CurTop SetFormFont PrintAtLeft "Age ", 5.25 SetUserFont TextBox char.age, 5.5, CurrentY, 0.75, tH*2, False CurrentY = CurTop SetFormFont PrintAtRight "Unspent Points ", 7.25 SetUserFont PrintAtLeft Char.UnspentPoints, 7.25 'THIRD LINE Paragraph = "" tW = TextWidth("Appearance") tH = TextHeight("Appearance") SetFormFont PrintAtLeft "Appearance", 2.5 SetUserFont 'Text = char.appearance TextBox char.appearance, 2.5 + tW + MinSpace, CurrentY, 4.5, 1 + tH - CurrentY SetFormFont CurrentX = MarginLeft CurrentY = 1 PrintCentered "CHARACTER SHEET", MarginLeft, 2.25 End Sub '**************************************** 'Print the stats '**************************************** Sub PrintStats() curTop = CurrentY 'Standard columns ScoreCol = MarginLeft + 0.375 CostCol = ScoreCol + 0.55 '***** ' ST box '***** curStat = "ST" curLabel = "ST" BoxTop = curTop BoxBottom = BoxTop + BoxHeight PrintStatBox curStat, curLabel, ScoreCol, CostCol, BoxTop, BoxBottom, False, False '***** ' DX box '***** curStat = "DX" curLabel = "DX" BoxTop = BoxBottom BoxBottom = BoxTop + BoxHeight PrintStatBox curStat, curLabel, ScoreCol, CostCol, BoxTop, BoxBottom, False, False '***** ' IQ box '***** curStat = "IQ" curLabel = "IQ" BoxTop = BoxBottom BoxBottom = BoxTop + BoxHeight PrintStatBox curStat, curLabel, ScoreCol, CostCol, BoxTop, BoxBottom, False, False '***** ' HT box '***** curStat = "HT" curLabel = "HT" BoxTop = BoxBottom BoxBottom = BoxTop + BoxHeight PrintStatBox curStat, curLabel, ScoreCol, CostCol, BoxTop, BoxBottom, False, False '******************** 'Set Up For Second Column of Stats '******************** ScoreCol = MarginLeft + 1.625 + 0.375 CostCol = ScoreCol + 0.55 '***** ' HP box '***** curStat = "Hit Points" curLabel = "HP" BoxTop = curTop BoxBottom = BoxTop + BoxHeight PrintStatBox curStat, curLabel, ScoreCol, CostCol, BoxTop, BoxBottom, True, True '***** ' Will box '***** curStat = "Will" curLabel = "Will" BoxTop = BoxBottom BoxBottom = BoxTop + BoxHeight PrintStatBox curStat, curLabel, ScoreCol, CostCol, BoxTop, BoxBottom, True, False '***** ' Per box '***** curStat = "Perception" curLabel = "Per" BoxTop = BoxBottom BoxBottom = BoxTop + BoxHeight PrintStatBox curStat, curLabel, ScoreCol, CostCol, BoxTop, BoxBottom, True, False '***** ' HP box '***** curStat = "Fatigue Points" curLabel = "FP" BoxTop = BoxBottom BoxBottom = BoxTop + BoxHeight PrintStatBox curStat, curLabel, ScoreCol, CostCol, BoxTop, BoxBottom, True, True CurrentY = BoxBottom End Sub '**************************************** 'Print the Stat Boxes '**************************************** Sub PrintStatBox(curStat, curLabel, ScoreCol, CostCol, BoxTop, BoxBottom, SecondBox, DrawSecondBox) dim OverSize OverSize = False if Options.Value("PrintBigStats") then OverSize = True end if BoxLeft = ScoreCol BoxRight = BoxLeft + BoxWidth DrawBox BoxLeft, BoxTop, BoxRight, BoxBottom, False SetFormFont if OverSize then FontSize = FormFontSize + 4 end if FontBold = True CurrentY = ReturnCenterY(curLabel, BoxTop, BoxBottom) PrintAtRight curLabel, ScoreCol - 0.0625 FontBold = False ListLoc = char.ItemPositionByNameAndExt(curStat, Stats) if ListLoc > 0 then SetUserFont if OverSize then FontSize = UserFontSize + 4 end if CurrentY = ReturnCenterY(curLabel, BoxTop, BoxBottom) PrintCentered Char.Items(ListLoc).TagItem("score"), BoxLeft, BoxRight end if if SecondBox then if DrawSecondBox then DrawBox BoxRight, BoxTop, BoxRight + BoxWidth, BoxBottom, False SetFormFont FontSize = 6 th = TextHeight("CURRENT") CurrentY = BoxTop - th PrintCentered "CURRENT", BoxRight, BoxRight + BoxWidth end if newCostCol = CostCol + BoxWidth SetFormFont if OverSize then FontSize = FormFontSize + 4 end if CurrentY = ReturnCenterY(curLabel, BoxTop, BoxBottom) PrintAtLeft "[", newCostCol PrintAtRight "]", newCostCol + BoxWidth SetUserFont if OverSize then FontSize = UserFontSize + 4 end if if ListLoc > 0 then PrintCentered Char.Items(ListLoc).TagItem("points"), newCostCol, newCostCol + BoxWidth end if else SetFormFont if OverSize then FontSize = FormFontSize + 4 end if PrintAtLeft "[", CostCol PrintAtRight "]", CostCol + BoxWidth SetUserFont if OverSize then FontSize = UserFontSize + 4 end if if ListLoc > 0 then PrintCentered Char.Items(ListLoc).TagItem("points"), CostCol, CostCol + BoxWidth end if end if End Sub '**************************************** 'Print movement info '**************************************** Sub PrintMovementLift() CurrentY = CurrentY + .0625 DrawLine Column1Left, CurrentY, Column1Left + ColumnWidth, CurrentY CurrentY = CurrentY + .0625 CurTop = CurrentY CurrentX = MarginLeft SetFormFont if PushBasicsRight then PrintAtLeft "BASIC LIFT", Column1Left + MinSpace else PrintAtLeft "BASIC LIFT", Column1Left end if CurrentX = 1.5 SetUserFont ListLoc = char.ItemPositionByNameAndExt("Basic Lift", Stats) If ListLoc > 0 then 'Text = Char.Items(ListLoc).TagItem("score") tmp = Char.Items(ListLoc).TagItem("score") PrintAtLeft tmp, Column1Left + 1 End If CurrentX = MarginLeft + 1.5 SetFormFont PrintAtLeft "DAMAGE Thr", Column1Left + 1.625 SetUserFont tmp = Char.BaseTh PrintAtLeft tmp, Column1Left + 2.5 CurrentX = CurrentX + 0.125 SetFormFont PrintAtLeft "Sw", Column1Left + 3 SetUserFont tmp = Char.BaseSw PrintAtLeft tmp, Column1Left + 3.25 Paragraph = "" CurTop = CurrentY CurrentX = MarginLeft SetFormFont if PushBasicsRight then PrintAtLeft "BASIC SPEED", Column1Left + MinSpace else PrintAtLeft "BASIC SPEED", Column1Left end if CurrentX = 1.5 SetUserFont ListLoc = char.ItemPositionByNameAndExt("Basic Speed", Stats) If ListLoc > 0 then tmp = Char.Items(ListLoc).TagItem("score") PrintAtLeft tmp, Column1Left + 1 End If CostCol = Column1Left + 1.375 CostWidth = .3125 SetUserFont If ListLoc > 0 then tmp = Char.Items(ListLoc).TagItem("points") PrintCentered tmp, CostCol, CostCol + CostWidth End If SetFormFont PrintAtLeft "[", CostCol - MinSpace PrintAtRight "]", CostCol + CostWidth + MinSpace CurrentX = MarginLeft + 1.75 SetFormFont PrintAtLeft "BASIC MOVE", Column1Left + 1.875 SetUserFont ListLoc = char.ItemPositionByNameAndExt("Basic Move", Stats) If ListLoc > 0 then tmp = Char.Items(ListLoc).TagItem("score") PrintAtLeft tmp, Column1Left + 2.875 End If CostCol = Column1Left + 3.25 CostWidth = .3125 SetUserFont If ListLoc > 0 then tmp = Char.Items(ListLoc).TagItem("points") PrintCentered tmp, CostCol, CostCol + CostWidth End If SetFormFont PrintAtLeft "[", CostCol - MinSpace PrintAtRight "]", CostCol + CostWidth + MinSpace CurrentY = CurrentY + .0625 CurrentY = CurrentY + .125 End Sub '**************************************** 'Print Encumbrance info '**************************************** Sub PrintEncumbrance() EncRow = Char.EncumbranceLevel + 1 + 1 '+1 for header, +1 for fact that EncLevel 0 is a row SetFormFont CurrentY = CurrentY + .0625 StartTable TableColumns = 6 TableRows = 6 TableColumnWidth(1) = 1.3125 TableColumnWidth(2) = 0.4375 TableColumnWidth(3) = 0.625 TableColumnWidth(4) = 0.3125 TableColumnWidth(5) = 0.6875 TableColumnWidth(6) = 0.3125 TableCellFontName(2,2,6,2) = UserFont TableCellFontSize(2,2,6,2) = UserFontSize TableCellForeColor(2,2,6,2) = UserFontColor TableCellFontName(2,4,6,4) = UserFont TableCellFontSize(2,4,6,4) = UserFontSize TableCellForeColor(2,4,6,4) = UserFontColor TableCellFontName(2,6,6,6) = UserFont TableCellFontSize(2,6,6,6) = UserFontSize TableCellForeColor(2,6,6,6) = UserFontColor TableCellFontBold(EncRow, 2, EncRow, 6)=True TableCellFontBold(EncRow, 1, EncRow, 1)=True '* Header Setup TableCellColumnSpan(1,1,1,1) = 2 TableCellColumnSpan(1,3,1,3) = 2 TableCellColumnSpan(1,5,1,5) = 2 TableCellText(1,1,1,1) = "ENCUMBRANCE" TableCellText(1,3,1,3) = "MOVE" TableCellText(1,5,1,5) = "DODGE" TableCellFontBold(1,1,1,5) = True TableCellAlign(1,1,1,5) = AlignCenterTop '* Encumbrance Info TableCellText(2,1,2,1) = "None (0) = BL" TableCellText(3,1,3,1) = "Light (1) = 2 x BL" TableCellText(4,1,4,1) = "Medium (2) = 3 x BL" TableCellText(5,1,5,1) = "Heavy (3) = 6 x BL" TableCellText(6,1,6,1) = "X-Heavy (4) = 10 x BL" TableCellFontSize(2,1,2,1) = FormFontSize-1 TableCellFontSize(3,1,3,1) = FormFontSize-1 TableCellFontSize(4,1,4,1) = FormFontSize-1 TableCellFontSize(5,1,5,1) = FormFontSize-1 TableCellFontSize(6,1,6,1) = FormFontSize-1 TableCellFontName(2,1,2,1) = FormFont TableCellFontName(3,1,3,1) = FormFont TableCellFontName(4,1,4,1) = FormFont TableCellFontName(5,1,5,1) = FormFont TableCellFontName(6,1,6,1) = FormFont ListLoc = char.ItemPositionByNameAndExt("No Encumbrance", Stats) if ListLoc > 0 then TableCellText(2,2,2,2) = Char.Items(ListLoc).TagItem("score") end if ListLoc = char.ItemPositionByNameAndExt("Light Encumbrance", Stats) if ListLoc > 0 then TableCellText(3,2,3,2) = Char.Items(ListLoc).TagItem("score") end if ListLoc = char.ItemPositionByNameAndExt("Medium Encumbrance", Stats) if ListLoc > 0 then TableCellText(4,2,4,2) = Char.Items(ListLoc).TagItem("score") end if ListLoc = char.ItemPositionByNameAndExt("Heavy Encumbrance", Stats) if ListLoc > 0 then TableCellText(5,2,5,2) = Char.Items(ListLoc).TagItem("score") end if ListLoc = char.ItemPositionByNameAndExt("X-Heavy Encumbrance", Stats) if ListLoc > 0 then TableCellText(6,2,6,2) = Char.Items(ListLoc).TagItem("score") end if '* Move Info TableCellText(2,3,2,3) = "BM x 1" TableCellText(3,3,3,3) = "BM x 0.8" TableCellText(4,3,4,3) = "BM x 0.6" TableCellText(5,3,5,3) = "BM x 0.4" TableCellText(6,3,6,3) = "BM x 0.2" TableCellFontSize(2,3,2,3) = FormFontSize-1 TableCellFontSize(3,3,3,3) = FormFontSize-1 TableCellFontSize(4,3,4,3) = FormFontSize-1 TableCellFontSize(5,3,5,3) = FormFontSize-1 TableCellFontSize(6,3,6,3) = FormFontSize-1 TableCellFontName(2,3,2,3) = FormFont TableCellFontName(3,3,3,3) = FormFont TableCellFontName(4,3,4,3) = FormFont TableCellFontName(5,3,5,3) = FormFont TableCellFontName(6,3,6,3) = FormFont GroundMove = 1 ListLoc = char.ItemPositionByNameAndExt("Ground Move", Stats) if ListLoc > 0 then GroundMove = Char.Items(ListLoc).TagItem("score") end if 'if GroundMove = 0 then the creature is sessile or has no legs 'or something like that, so all move values will be 0, and we 'don't want to accidentally correct for that here. ListLoc = char.ItemPositionByNameAndExt("No Encumbrance Move", Stats) if ListLoc > 0 then ShowScore = Char.Items(ListLoc).TagItem("score") if GroundMove > 0 then if ShowScore < 1 then ShowScore = 1 end if TableCellText(2,4,2,4) = ShowScore end if ListLoc = char.ItemPositionByNameAndExt("Light Encumbrance Move", Stats) if ListLoc > 0 then ShowScore = Char.Items(ListLoc).TagItem("score") if GroundMove > 0 then if ShowScore < 1 then ShowScore = 1 end if TableCellText(3,4,3,4) = ShowScore end if ListLoc = char.ItemPositionByNameAndExt("Medium Encumbrance Move", Stats) if ListLoc > 0 then ShowScore = Char.Items(ListLoc).TagItem("score") if GroundMove > 0 then if ShowScore < 1 then ShowScore = 1 end if TableCellText(4,4,4,4) = ShowScore end if ListLoc = char.ItemPositionByNameAndExt("Heavy Encumbrance Move", Stats) if ListLoc > 0 then ShowScore = Char.Items(ListLoc).TagItem("score") if GroundMove > 0 then if ShowScore < 1 then ShowScore = 1 end if TableCellText(5,4,5,4) = ShowScore end if ListLoc = char.ItemPositionByNameAndExt("X-Heavy Encumbrance Move", Stats) if ListLoc > 0 then ShowScore = Char.Items(ListLoc).TagItem("score") if GroundMove > 0 then if ShowScore < 1 then ShowScore = 1 end if TableCellText(6,4,6,4) = ShowScore end if '* Dodge Info TableCellText(2,5,2,5) = "Dodge" TableCellText(3,5,3,5) = "Dodge - 1" TableCellText(4,5,4,5) = "Dodge - 2" TableCellText(5,5,5,5) = "Dodge - 3" TableCellText(6,5,6,5) = "Dodge - 4" TableCellFontSize(2,5,2,5) = FormFontSize-1 TableCellFontSize(3,5,3,5) = FormFontSize-1 TableCellFontSize(4,5,4,5) = FormFontSize-1 TableCellFontSize(5,5,5,5) = FormFontSize-1 TableCellFontSize(6,5,6,5) = FormFontSize-1 TableCellFontName(2,5,2,5) = FormFont TableCellFontName(3,5,3,5) = FormFont TableCellFontName(4,5,4,5) = FormFont TableCellFontName(5,5,5,5) = FormFont TableCellFontName(6,5,6,5) = FormFont ListLoc = char.ItemPositionByNameAndExt("Dodge", Stats) if ListLoc > 0 then Score = Char.Items(ListLoc).TagItem("score") ShowScore = Score if ShowScore < 1 then ShowScore = 1 TableCellText(2,6,2,6) = ShowScore ShowScore = Score - 1 if ShowScore < 1 then ShowScore = 1 TableCellText(3,6,3,6) = ShowScore ShowScore = Score - 2 if ShowScore < 1 then ShowScore = 1 TableCellText(4,6,4,6) = ShowScore ShowScore = Score - 3 if ShowScore < 1 then ShowScore = 1 TableCellText(5,6,5,6) = ShowScore ShowScore = Score - 4 if ShowScore < 1 then ShowScore = 1 TableCellText(6,6,6,6) = ShowScore end if 'EncRow = Char.EncumbranceLevel + 1 + 1 '+1 for header, +1 for fact that EncLevel 0 is a row 'TableCellFontBold(EncRow, 1, EncRow, 6)=True EndTable 'paragraph = "" End Sub '**************************************** 'Print Movement info '**************************************** Sub PrintMovement() BoxTop = CurrentY ColLeft = MarginLeft ColRight = 4.125 SetFormFont tW = TextWidth("DX") tH = TextHeight("DX") NameLeft = ColLeft + MinSpace EL0 = NameLeft + 1 EL1 = EL0 + .5 EL2 = EL1 + .5 EL3 = EL2 + .5 EL4 = EL3 + .5 NewTop = CurrentY FontBold = True PrintAtLeft "MOVEMENT", NameLeft 'print the scores CurrentY = NewTop tmp = "None" PrintCentered tmp, EL0, EL1 tmp = "Light" PrintCentered tmp, EL1, EL2 tmp = "Medium" PrintCentered tmp, EL2, EL3 tmp = "Heavy" PrintCentered tmp, EL3, EL4 tmp = "X-Heavy" PrintCentered tmp, EL4, ColRight FontBold = False CurrentY = NewTop + tH For i = 1 to 5 select case i case 1 curStat = "Air Move" case 2 curStat = "Ground Move" case 3 curStat = "Space Move" case 4 curStat = "Tunneling Move" case 5 curStat = "Water Move" end select NewTop = CurrentY ListLoc = Char.ItemPositionByNameAndExt(curStat, Stats) if ListLoc > 0 then BaseScore = Char.Items(ListLoc).TagItem("basescore") Score = Char.Items(ListLoc).TagItem("score") if Score <> 0 then 'calc size of area needed SetFormFont TextBox curStat, NameLeft, CurTop, EL0 - NameLeft, 0, True, True, False NameHeight = TextHei 'print the name CurrentY = NewTop TextBox curStat, NameLeft, CurrentY, EL0 - NameLeft, NameHeight, True SetUserFont if BaseScore = Score then 'print the scores CurrentY = NewTop tmp = Score PrintCentered tmp, EL0, EL1 tmp = int(Score * 0.8) PrintCentered tmp, EL1, EL2 tmp = int(Score * 0.6) PrintCentered tmp, EL2, EL3 tmp = int(Score * 0.4) PrintCentered tmp, EL3, EL4 tmp = int(Score * 0.2) PrintCentered tmp, EL4, ColRight else 'print the scores CurrentY = NewTop tmp = BaseScore & "/" & Score PrintCentered tmp, EL0, EL1 tmp = int(BaseScore * 0.8) & "/" & int(Score * 0.8) PrintCentered tmp, EL1, EL2 tmp = int(BaseScore * 0.6) & "/" & int(Score * 0.6) PrintCentered tmp, EL2, EL3 tmp = int(BaseScore * 0.4) & "/" & int(Score * 0.4) PrintCentered tmp, EL3, EL4 tmp = int(BaseScore * 0.2) & "/" & int(Score * 0.2) PrintCentered tmp, EL4, ColRight end if CurrentY = NewTop + NameHeight end if end if Next BoxBottom = CurrentY DrawBox Column1Left, BoxTop, Column1Left+ColumnWidth, BoxBottom, False, ,-1 End Sub '******************************************************************************** '* '* Print the Ads/Disads '* '******************************************************************************** '**************************************** 'Print One Item '**************************************** Function PrintAdType(SysSize, UserSize, curList, curItem, LeftIndent, ColLeft, ColRight) SetUserFont FontSize = UserSize NewTop = CurrentY tW = TextWidth("DX") tH = TextHeight("DX") NameLeft = ColLeft + MinSpace + LeftIndent CostColRight = ColRight CostColLeft = CostColRight - 0.375 'create the long-form name of the item tmp = Char.Items(curItem).FullName work = Char.Items(curItem).LevelName If work <> "" Then If Char.Items(curItem).TagItem("levelnames") <> "" Then tmp = tmp & " (" & work & ")" Else tmp = tmp & " " & work End If End If 'the False on the line below tells GCA not to include 'the values of the mods, True means it will. tmp = tmp & Char.Items(curItem).ExpandedModCaptions(False) 'page numbers PageNum = False select case curList case Packages if Options.Value("TemplatesPageNumbers") then PageNum = True case Ads, Perks if Options.Value("AdsPageNumbers") then PageNum = True case Disads, Quirks if Options.Value("DisadsPageNumbers") then PageNum = True end select if PageNum then pn = Char.Items(curItem).TagItem("page") if pn <> "" then tmp = tmp & " {p. " & pn & "}" end if end if 'calc size of area needed TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > ColumnHeight then 'ran out of room PrintAdType = False Exit Function end if 'draw the flag pic CurrentY = NewTop CurrentX = ColLeft 'DrawTraitFlagPic newfield 'print the name CurrentY = NewTop TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True SetFormFont FontSize = SysSize CurrentY = NewTop PrintAtLeft "[", CostColLeft PrintAtRight "]", CostColRight SetUserFont FontSize = UserSize PrintAtRight Char.Items(curitem).TagItem("points"), CostColRight - MinSpace * 1.5 SetFormFont FontSize = SysSize CurrentX = ColLeft CurrentY = NewTop + NameHeight 'print bonuses DoBonus = False select case curList case Ads, Perks if Options.Value("ShowAdBonuses") then DoBonus = True case Disads, Quirks if Options.Value("ShowDisadBonuses") then DoBonus = True end select if DoBonus then FontSize = CInt(SysSize / 2 + 2.5) tmp = Char.Items(curitem).TagItem("bonuslist") If tmp <> "" Then NewTop = CurrentY tmp = "Includes: " & tmp TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > ColumnHeight then 'ran out of room PrintAdType = False Exit Function end if TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True CurrentY = NewTop + NameHeight End If end if 'print conditionals DoBonus = False select case curList case Ads, Perks if Options.Value("ShowAdConditionals") then DoBonus = True case Disads, Quirks if Options.Value("ShowDisadConditionals") then DoBonus = True end select if DoBonus then tmp = Char.Items(curitem).TagItem("conditionallist") If tmp <> "" Then NewTop = CurrentY tmp = "Conditional: " & tmp TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > ColumnHeight then 'ran out of room PrintAdType = False Exit Function end if TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True CurrentY = NewTop + NameHeight End If end if SetFormFont FontSize = SysSize PostLine = False select case curList case Ads, Perks, Packages if Options.Value("LineAfterAds") then PostLine = True case Disads, Quirks if Options.Value("LineAfterDisads") then PostLine = True end select if PostLine then DrawLine ColLeft, CurrentY, Column1Left+ColumnWidth, CurrentY end if 'if PrintComponents, print any child items if Options.Value("ShowComponents") then tmp = Char.Items(curitem).TagItem("pkids") if tmp <> "" then 'it has components KeyList = Split(tmp, ",") if Options.Value("ParagraphComponents") then 'Paragraph Format CList = "" For i = LBound(KeyList) To UBound(KeyList) childItem = "k" & trim(KeyList(i)) childType = Char.Items(childItem).ItemType select case childType case Ads, Perks, Disads, Quirks, Packages tmp = Char.Items(childItem).FullName work = Char.Items(childItem).LevelName If work <> "" Then If Char.Items(childItem).TagItem("levelnames") <> "" Then tmp = tmp & " (" & work & ")" Else tmp = tmp & " " & work End If End If 'the False on the line below tells GCA not to include 'the values of the mods, True means it will. tmp = tmp & Char.Items(childItem).ExpandedModCaptions(False) if CList = "" then CList = tmp else CList = CList & "; " & tmp end if CList = CList & " [" & Char.Items(childItem).TagItem("points") & "]" case Skills, Spells tmp = Char.Items(childItem).FullNameTL 'print the level tmp = tmp & "-" & Char.Items(childItem).level 'print the rel level tmp = tmp & " (" & Char.Items(childItem).TagItem("stepoff") & Char.Items(childItem).TagItem("step") & ")" tmp = tmp & " [" & Char.Items(childItem).TagItem("points") & "]" if CList = "" then CList = tmp else CList = CList & "; " & tmp end if end select Next if CList <> "" then CList = CList & "." end if NewTop = CurrentY TextBox CList, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > ColumnHeight then 'ran out of room PrintAdType = False Exit Function end if TextBox CList, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True CurrentY = NewTop + NameHeight else 'Line by Line Format For i = LBound(KeyList) To UBound(KeyList) childItem = "k" & trim(KeyList(i)) childType = Char.Items(childItem).ItemType select case childType case Ads, Perks, Disads, Quirks, Packages Okay = PrintAdType(SysSize, UserSize, childType, childItem, LeftIndent + ChildIndentLeft, ColLeft, ColRight) case Skills, Spells Okay = PrintSkillType(SysSize, UserSize, childType, childItem, LeftIndent + ChildIndentLeft, ColLeft+MinSpace, ColRight+MinSpace) end select 'Okay = PrintAdType(SysSize, UserSize, curList, childItem, LeftIndent + ChildIndentLeft, ColLeft, ColRight) if Okay = False then PrintAdType = False exit function end if Next end if end if End If 'if GroupChildren, print any child items If GroupChildren then if Char.Items(curItem).ChildKeyList <> "" then 'it has children KeyList = Split(Char.Items(curItem).ChildKeyList, ",") For i = LBound(KeyList) To UBound(KeyList) childItem = trim(KeyList(i)) Okay = PrintAdType(SysSize, UserSize, curList, childItem, LeftIndent + ChildIndentLeft, ColLeft, ColRight) if Okay = False then PrintAdType = False exit function end if Next end if End If PrintAdType = True End Function '**************************************** 'Print the the Whole List '**************************************** Sub PrintAdsDisads(SysSize, UserSize, BoxTop) 'draw a box around our work area DrawBox Column1Left, BoxTop, Column1Left+ColumnWidth, ColumnHeight, False CurrentY = BoxTop SetFormFont FontSize = SysSize tW = TextWidth("DX") tH = TextHeight("DX") ColLeft = MarginLeft ColRight = 4.125 'NameLeft = ColLeft + MinSpace * 3 NameLeft = ColLeft + MinSpace CostColRight = ColRight CostColLeft = CostColRight - 0.375 curTop = CurrentY '***** '* Print Templates '***** if char.count(Packages) > 0 then FontBold = True PrintCentered "TEMPLATES AND METATRAITS", ColLeft, ColRight FontBold = False CurrentY = curTop + tH For curItem = 1 To Char.Items.Count If Char.Items(curItem).ItemType = Packages Then 'a package If Char.Items(curItem).TagItem("hide") = "" or Options.Value("ShowHiddenTemplates") = True Then 'not hidden Okay = PrintAdType(SysSize, UserSize, Packages, curItem, 0, ColLeft, ColRight) if Okay = False then 'ran out of room to print it if SysSize > MinFontSize then call PrintAdsDisads(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive 'OverflowAds = curItem Exit Sub end if end if End If End If Next CurrentY = CurrentY + tH end if '***** '* Print Ads '***** if CurrentY + tH > ColumnHeight then 'ran out of room if SysSize > MinFontSize then call PrintAdsDisads(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowAds = 1 Exit Sub end if end if FontBold = True PrintCentered "ADVANTAGES AND PERKS", ColLeft, ColRight FontBold = False curTop = CurrentY CurrentY = curTop + tH For curItem = 1 To Char.Items.Count If Char.Items(curItem).ItemType = Ads Then 'an ad Okay = True tmp = char.items(curItem).tagitem("cat") if incatlist("language", tmp) then 'a language, don't print it here Okay = False elseif incatlist("cultural familiarity", tmp) then 'a cultural familiarity, don't print it here Okay = False end if 'if it's a child, and GroupChildren is True, 'don't consider it printable here. if GroupChildren then if Char.Items(curItem).ParentKey <> "" then 'it has a parent Okay = False end if end if if Okay then If Char.Items(curItem).TagItem("hide") = "" or Options.Value("ShowHiddenAds") = True Then 'not hidden Okay = PrintAdType(SysSize, UserSize, Ads, curItem, 0, ColLeft, ColRight) if Okay = False then 'ran out of room to print it if SysSize > MinFontSize then call PrintAdsDisads(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowAds = curItem Exit Sub end if end if End If end if End If Next '***** '* Print Perks '***** For curItem = 1 To Char.Items.Count If Char.Items(curItem).ItemType = Perks Then 'a perk Okay = True 'if it's a child, and GroupChildren is True, 'don't consider it printable here. if GroupChildren then if Char.Items(curItem).ParentKey <> "" then 'it has a parent Okay = False end if end if if Okay then If Char.Items(curItem).TagItem("hide") = "" or Options.Value("ShowHiddenPerks") = True Then 'not hidden Okay = PrintAdType(SysSize, UserSize, Perks, curItem, 0, ColLeft, ColRight) if Okay = False then 'ran out of room to print it if SysSize > MinFontSize then call PrintAdsDisads(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowPerks = curItem Exit Sub end if end if End If end if End If Next '***** '* Print Disads '***** CurrentY = CurrentY + tH if CurrentY + tH > ColumnHeight then 'ran out of room if SysSize > MinFontSize then call PrintAdsDisads(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowDisads = 1 Exit Sub end if end if FontBold = True PrintCentered "DISADVANTAGES AND QUIRKS", ColLeft, ColRight FontBold = False curTop = CurrentY CurrentY = curTop + tH For curItem = 1 To Char.Items.Count If Char.Items(curItem).ItemType = Disads Then 'a disad Okay = True 'if it's a child, and GroupChildren is True, 'don't consider it printable here. if GroupChildren then if Char.Items(curItem).ParentKey <> "" then 'it has a parent Okay = False end if end if if Okay then If Char.Items(curItem).TagItem("hide") = "" or Options.Value("ShowHiddenDisads") = True Then 'not hidden Okay = PrintAdType(SysSize, UserSize, Disads, curItem, 0, ColLeft, ColRight) if Okay = False then 'ran out of room to print it if SysSize > MinFontSize then call PrintAdsDisads(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowDisads = curItem Exit Sub end if end if End If end if End If Next '***** '* Print Quirks '***** For curItem = 1 To Char.Items.Count If Char.Items(curItem).ItemType = Quirks Then 'a quirk Okay = True 'if it's a child, and GroupChildren is True, 'don't consider it printable here. if GroupChildren then if Char.Items(curItem).ParentKey <> "" then 'it has a parent Okay = False end if end if if Okay then If Char.Items(curItem).TagItem("hide") = "" or Options.Value("ShowHiddenQuirks") = True Then 'not hidden Okay = PrintAdType(SysSize, UserSize, Quirks, curItem, 0, ColLeft, ColRight) if Okay = False then 'ran out of room to print it if SysSize > MinFontSize then call PrintAdsDisads(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowQuirks = curItem Exit Sub end if end if End If end if End If Next paragraph = "" End Sub '**************************************** 'Print the Languages '**************************************** Sub PrintLanguages(SysSize, UserSize, BoxTop) CurrentY = BoxTop SetFormFont FontSize = SysSize tW = TextWidth("DX") tH = TextHeight("DX") ColLeft = Column2Left ColRight = PageWidth - MarginRight BoxBottom = BoxTop + 1 'draw a box around our work area DrawBox Column2Left, BoxTop, ColRight, BoxBottom, False 'NameLeft = ColLeft + MinSpace * 3 NameLeft = ColLeft + MinSpace SpokenLeft = NameLeft + 1.5 WrittenLeft = SpokenLeft + .8125 CostColRight = ColRight - MinSpace CostColLeft = CostColRight - 0.375 curTop = CurrentY FontBold = True CurrentY = curTop PrintAtLeft "Languages", NameLeft CurrentY = curTop PrintAtLeft "Spoken", SpokenLeft CurrentY = curTop PrintAtLeft "Written", WrittenLeft FontBold = False CurrentY = CurrentY + tH * 1.5 'Print them For i = 1 To Char.Items.Count If Char.Items(i).ItemType = Ads or Char.Items(i).ItemType = Disads Then If Char.Items(i).TagItem("hide") = "" or Options.Value("ShowHiddenAds") = True or Options.Value("ShowHiddenDisads") = True Then 'not hidden tmp = char.items(i).tagitem("cat") if incatlist("language", tmp) then LangPair = False NewTop = CurrentY SetUserFont FontSize = UserSize 'Print Name and Level tmpName = trim(char.items(i).name) if i < char.items.count then if lcase(tmpName) = lcase(char.items(i+1).name) then LangPair = True end if end if if LangPair then work = Char.Items(i).LevelName tmp2 = "(" & work & ")" work = Char.Items(i+1).LevelName tmp3 = "(" & work & ")" 'the False on the line below tells GCA not to include 'the values of the mods, True means it will. tmpName = tmpName & Char.Items(i).ExpandedModCaptions(False) 'calc size of area needed CurrentY = NewTop TextBox tmpName, NameLeft, CurrentY, SpokenLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintLanguages(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowLanguages = i Exit Sub end if end if CurrentY = NewTop TextBox tmpName, NameLeft, CurrentY, SpokenLeft - NameLeft, NameHeight, True CurrentY = NewTop TextBox tmp2, SpokenLeft, CurrentY, WrittenLeft - SpokenLeft, NameHeight, False CurrentY = NewTop TextBox tmp3, WrittenLeft, CurrentY, CostColLeft - WrittenLeft, NameHeight, False else 'a single language may be either a full, or a spoken/written only Partial = False tmpExt = lcase(trim(char.items(i).nameext)) if tmpExt = "spoken" or tmpExt = "written" then Partial = True tmpName = tmpName & Char.Items(i).ExpandedModCaptions(False) work = Char.Items(i).LevelName tmp2 = "(" & work & ")" tmp3 = "(" & work & ")" else if options.value("SplitFullLanguages") then 'Print it with values in both columns tmpName = tmpName & Char.Items(i).ExpandedModCaptions(False) work = Char.Items(i).LevelName tmp2 = "(" & work & ")" tmp3 = "(" & work & ")" else 'since it's both spoken & written, we can use all space available, 'and just put the level name with the item name work = Char.Items(i).LevelName tmpName = tmpName & " (" & work & ")" tmpName = tmpName & Char.Items(i).ExpandedModCaptions(False) end if end if 'calc size of area needed CurrentY = NewTop if Partial then TextBox tmpName, NameLeft, CurrentY, SpokenLeft - NameLeft, 0, True, True, False else if options.value("SplitFullLanguages") then TextBox tmpName, NameLeft, CurrentY, SpokenLeft - NameLeft, 0, True, True, False else TextBox tmpName, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False end if end if NameHeight = TextHei if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintLanguages(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowLanguages = i Exit Sub end if end if CurrentY = NewTop if Partial then TextBox tmpName, NameLeft, CurrentY, SpokenLeft - NameLeft, NameHeight, True if tmpExt = "spoken" then CurrentY = NewTop TextBox tmp2, SpokenLeft, CurrentY, WrittenLeft - SpokenLeft, NameHeight, False elseif tmpExt = "written" then CurrentY = NewTop TextBox tmp3, WrittenLeft, CurrentY, CostColLeft - WrittenLeft, NameHeight, False end if else if options.value("SplitFullLanguages") then TextBox tmpName, NameLeft, CurrentY, SpokenLeft - NameLeft, NameHeight, True CurrentY = NewTop TextBox tmp2, SpokenLeft, CurrentY, WrittenLeft - SpokenLeft, NameHeight, False CurrentY = NewTop TextBox tmp3, WrittenLeft, CurrentY, CostColLeft - WrittenLeft, NameHeight, False else TextBox tmpName, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True end if end if end if 'Get Points if LangPair then tmp = cint(Char.Items(i).TagItem("points")) + cint(Char.Items(i+1).TagItem("points")) else tmp = Char.Items(i).TagItem("points") end if 'Print Points SetFormFont FontSize = SysSize CurrentY = NewTop PrintAtLeft "[", CostColLeft PrintAtRight "]", CostColRight SetUserFont FontSize = UserSize PrintAtRight tmp, CostColRight - MinSpace * 1.5 SetFormFont FontSize = SysSize CurrentX = ColLeft CurrentY = NewTop + NameHeight 'print bonuses If Options.Value("ShowLangBonus") Then FontSize = CInt(SysSize / 2 + 2.5) tmp = Char.Items(i).TagItem("bonuslist") If tmp <> "" Then tmp = "Includes: " & tmp End If if LangPair then work = Char.Items(i+1).TagItem("bonuslist") If work <> "" Then if tmp <> "" then tmp = tmp & "; Includes: " & work else tmp = "Includes: " & work end if End If end if if tmp <> "" then NewTop = CurrentY TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintLanguages(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowLanguages = i Exit Sub end if end if TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True CurrentX = ColLeft CurrentY = NewTop + NameHeight end if 'print conditionals tmp = Char.Items(i).TagItem("conditionallist") If tmp <> "" Then tmp = "Conditional: " & tmp End If if LangPair then work = Char.Items(i+1).TagItem("conditionallist") If work <> "" Then if tmp <> "" then tmp = tmp & "; Conditional: " & work else tmp = "Conditional: " & work end if End If end if if tmp <> "" then NewTop = CurrentY TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintLanguages(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowLanguages = i Exit Sub end if end if TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True CurrentX = ColLeft CurrentY = NewTop + NameHeight end if End If if Options.Value("LineAfterLanguages") then DrawLine Column2Left, CurrentY, ColRight, CurrentY end if SetFormFont FontSize = SysSize if LangPair then i = i + 1 end if end if end if end if Next paragraph = "" End Sub '**************************************** 'Print Cultural '**************************************** Sub PrintCultural(SysSize, UserSize, BoxTop) CurrentY = BoxTop SetFormFont FontSize = SysSize tW = TextWidth("DX") tH = TextHeight("DX") ColLeft = Column2Left + 0.75 if Options.Value("DRWider") then ColLeft = Column2Left + 1 end if ColRight = PageWidth - MarginRight if Options.Value("PrintAllDR") then 'we're going to need more height to print all the DR locations BoxBottom = BoxTop + 1.5 else BoxBottom = BoxTop + 1 end if 'draw a box around our work area DrawBox ColLeft, BoxTop, ColRight, BoxBottom, False NameLeft = ColLeft + MinSpace CostColRight = ColRight - MinSpace CostColLeft = CostColRight - 0.375 curTop = CurrentY 'First, do TL FontBold = True CurrentY = curTop PrintAtLeft "TL:", NameLeft FontBold = False CurrentY = curTop SetUserFont FontSize = UserSize ListLoc = char.ItemPositionByNameAndExt("Tech Level", Stats) If ListLoc > 0 then PrintAtLeft Char.Items(ListLoc).TagItem("score"), NameLeft + 0.375 'points CurrentY = curTop SetFormFont FontSize = SysSize PrintAtLeft "[", CostColLeft PrintAtRight "]", CostColRight SetUserFont FontSize = UserSize PrintAtRight Char.Items(ListLoc).TagItem("points"), CostColRight - MinSpace * 1.5 SetFormFont FontSize = SysSize End If FontBold = False CurrentX = ColLeft CurrentY = curTop + tH curTop = CurrentY FontBold = True CurrentY = curTop PrintAtLeft "Cultural Familiarities", NameLeft FontBold = False CurrentX = ColLeft CurrentY = curTop + tH 'Print them For i = 1 To Char.Items.Count If Char.Items(i).ItemType = Ads or Char.Items(i).ItemType = Disads Then If Char.Items(i).TagItem("hide") = "" or Options.Value("ShowHiddenAds") = True or Options.Value("ShowHiddenDisads") = True Then 'not hidden tmp = char.items(i).tagitem("cat") if incatlist("cultural familiarity", tmp) then NewTop = CurrentY SetUserFont FontSize = UserSize 'Get Name tmp = Char.Items(i).FullNameTL 'Print Name 'calc size of area needed TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintCultural(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowCultural = i Exit Sub end if end if CurrentY = NewTop TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True 'Get Points tmp = Char.Items(i).TagItem("points") 'Print Points SetFormFont FontSize = SysSize CurrentY = NewTop PrintAtLeft "[", CostColLeft PrintAtRight "]", CostColRight SetUserFont FontSize = UserSize PrintAtRight tmp, CostColRight - MinSpace * 1.5 SetFormFont FontSize = SysSize CurrentX = ColLeft CurrentY = NewTop + NameHeight SetFormFont FontSize = SysSize end if end if end if Next paragraph = "" End Sub '**************************************** 'Print DR '**************************************** Sub PrintDR(SysSize, UserSize, BoxTop, BoxBottom) tW = TextWidth("DX") tH = TextHeight("DX") RightSide = 0.75 - MinSpace If Options.Value("DRWider") then RightSide = 1 - MinSpace end if DrawBox Column2Left, BoxTop, Column2Left+RightSide, BoxBottom, False ', ,-1 CurrentY = BoxTop if Options.Value("PrintAllDR") then SetFormFont FontSize = SysSize FontBold = True tH = TextHeight("DX") PrintCentered "DR", Column2Left, Column2Left+RightSide'+0.6875 FontBold = False CurrentY = CurrentY + tH 'get any bonus that applies, to include with protection value ListLoc = char.ItemPositionByNameAndExt("DR", Stats) If ListLoc > 0 then if Char.Items(ListLoc).TagItem("score") <> 0 then tmpDR = " +" & Char.Items(ListLoc).TagItem("score") end if End If 'print the values SetUserFont FontSize = UserSize tH = TextHeight("DX") 'NEW body area stuff here 'there are now ten default areas for i = 1 to char.body.count if char.body(i).display then if CurrentY + tH > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintDR(SysSize-1, UserSize-1, BoxTop, BoxBottom) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive Exit Sub end if end if tmpText = char.body(i).name PrintAtLeft tmpText, Column2Left + MinSpace tmp = Char.body(i).DR 'PrintAtRight tmp & tmpDR, Column2Left+0.6875 PrintAtRight tmp & tmpDR, Column2Left+RightSide-MinSpace CurrentY = CurrentY + tH end if next 'OLD body area stuff below if 1=2 then for i = 0 to 5 if CurrentY + tH > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintDR(SysSize-1, UserSize-1, BoxTop, BoxBottom) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive Exit Sub end if end if select case i case 0 tmpText = "Hd" case 1 tmpText = "Bdy" case 2 tmpText = "Arm" case 3 tmpText = "Leg" case 4 tmpText = "Hnd" case 5 tmpText = "Ft" end select PrintAtLeft tmpText, Column2Left + MinSpace tmp = Char.DR(cint(i)) PrintAtRight tmp & tmpDR, Column2Left+0.6875 CurrentY = CurrentY + tH next end if else SetFormFont PrintCentered "DR", Column2Left, Column2Left+RightSide'+0.6875 CurrentY = CurrentY + tH * 2 'tmp = Char.DR(1) tmp = Char.Body("Torso").DR SetUserFont ListLoc = char.ItemPositionByNameAndExt("DR", Stats) If ListLoc > 0 then if Char.Items(ListLoc).TagItem("score") <> 0 then tmp = tmp & " +" & Char.Items(ListLoc).TagItem("score") end if End If PrintCentered tmp, Column2Left, Column2Left+RightSide'+0.6875 end if End Sub '**************************************** 'Print Reaction '**************************************** Sub PrintReaction() SetFormFont tW = TextWidth("DX") tH = TextHeight("DX") ColLeft = Column2Left + 0.75 NameLeft = ColLeft + MinSpace '* 3 ColRight = PageWidth - MarginRight - MinSpace FontBold = True preview.PrintCentered "Reaction Modifiers", ColLeft, ColRight FontBold = False CurrentY = CurrentY + tH * 1.5 '***** '* APPEARANCE '***** 'print appearance reaction tmpLine = "" tmp = "Unappealing" l1 = char.ItemPositionByNameAndExt(tmp, Stats) If l1 > 0 Then 'see if it has a value If Char.Items(l1).TagItem("bonuslist") <> "" Then curVal = Char.Items(l1).TagItem("syslevels") If curVal >= 0 Then tmpLine = tmpLine & "+" & curVal Else tmpLine = tmpLine & curVal End If End If End If tmp = "Appealing" l2 = char.ItemPositionByNameAndExt(tmp, Stats) If l2 > 0 Then 'see if it has a value If Char.Items(l2).TagItem("bonuslist") <> "" Then curVal = Char.Items(l2).TagItem("syslevels") If curVal >= 0 Then tmpLine = tmpLine & "/+" & curVal Else tmpLine = tmpLine & "/" & curVal End If End If End If If tmpLine <> "" Then tmpLine = "{{\b Appearance: }" & tmpLine & "}" curTop = CurrentY TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, 0, True, True, False NameHeight = TextHei TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, NameHeight, True CurrentY = curTop + NameHeight Else tmpLine = "{\b Appearance: }" curTop = CurrentY TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, 0, True, True, False NameHeight = TextHei TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, NameHeight, True CurrentY = curTop + NameHeight End If FontSize = CInt(FormFontSize / 2 + 2.5) 'print bonuses for Unappealing If l1 > 0 Then tmp = Char.Items(l1).TagItem("bonuslist") tmpLine = "" If tmp <> "" Then tmpLine = "{\i Unappealing Includes: }" & tmp End If tmp = Char.Items(l1).TagItem("conditionallist") If tmp <> "" Then If tmpLine <> "" Then tmpLine = tmpLine & ". {\i Conditional: }" & tmp Else tmpLine = "{\i Unappealing Conditional: }" & tmp End If End If End If If tmpLine <> "" Then curTop = CurrentY tmpLine = "{" & tmpLine & "}" TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, 0, True, True, False NameHeight = TextHei TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, NameHeight, True CurrentY = curTop + NameHeight End If 'print bonuses for Appealing If l2 > 0 Then tmp = Char.Items(l2).TagItem("bonuslist") tmpLine = "" If tmp <> "" Then tmpLine = "{\i Appealing Includes: }" & tmp End If tmp = Char.Items(l2).TagItem("conditionallist") If tmp <> "" Then If tmpLine <> "" Then tmpLine = tmpLine & ". {\i Conditional: }" & tmp Else tmpLine = "{\i Appealing Conditional: }" & tmp End If End If End If If tmpLine <> "" Then curTop = CurrentY tmpLine = "{" & tmpLine & "}" TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, 0, True, True, False NameHeight = TextHei TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, NameHeight, True CurrentY = curTop + NameHeight End If FontSize = FormFontSize '***** '* Status Reaction Items '***** tmpLine = "{{\b Status: }" tmp = "Status" l1 = Char.ItemPositionByNameAndExt(tmp, Stats) If l1 > 0 Then tmp = Char.Items(l1).TagItem("score") If tmp >= 0 Then tmp = "+" & tmp End If tmpLine = tmpLine & tmp tmp = Char.Items(l1).TagItem("bonuslist") If tmp <> "" Then tmpLine = tmpLine & "; {\i Includes: }" & tmp End If tmpLine = tmpLine & "}" curTop = CurrentY TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, 0, True, True, False NameHeight = TextHei TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, NameHeight, True CurrentY = curTop + NameHeight 'print conditionals for Reaction FontSize = CInt(FormFontSize / 2 + 2.5) tmp = Char.Items(l1).TagItem("conditionallist") tmpLine = "" If tmp <> "" Then tmpLine = "Conditional: " & tmp End If If tmpLine <> "" Then curTop = CurrentY TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, 0, True, True, False NameHeight = TextHei TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, NameHeight, True CurrentY = curTop + NameHeight End If FontSize = FormFontSize End If '***** '* Other Reaction Items '***** tmpLine = "{{\b Other: }" tmp = "Reaction" l1 = Char.ItemPositionByNameAndExt(tmp, Stats) If l1 > 0 Then tmp = Char.Items(l1).TagItem("score") If tmp >= 0 Then tmp = "+" & tmp End If tmpLine = tmpLine & tmp tmp = Char.Items(l1).TagItem("bonuslist") If tmp <> "" Then tmpLine = tmpLine & "; {\i Includes: }" & tmp End If tmpLine = tmpLine & "}" curTop = CurrentY TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, 0, True, True, False NameHeight = TextHei TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, NameHeight, True CurrentY = curTop + NameHeight 'print conditionals for Reaction FontSize = CInt(FormFontSize / 2 + 2.5) tmp = Char.Items(l1).TagItem("conditionallist") tmpLine = "" If tmp <> "" Then tmpLine = "Conditional: " & tmp End If If tmpLine <> "" Then curTop = CurrentY TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, 0, True, True, False NameHeight = TextHei TextBox tmpLine, NameLeft, CurrentY, ColRight - NameLeft, NameHeight, True CurrentY = curTop + NameHeight End If FontSize = FormFontSize End If End Sub '**************************************** 'Print Parry/Block '**************************************** Sub PrintParryBlock(MidLine) CurTop = CurrentY Diff = MidLine - CurTop CurrentY = CurTop SetFormFont PrintCentered "PARRY", Column2Left, Column2Left+0.6875 CurrentY = CurrentY + Diff * 0.40 SetUserFont PrintCentered char.parryscore, Column2Left, Column2Left+0.6875 FontSize = CInt(UserFontSize / 2 + 2.5) tH = TextHeight("DX") CurrentY = MidLine - tH PrintCentered char.parryusing, Column2Left, Column2Left+0.6875 CurrentY = MidLine SetFormFont PrintCentered "BLOCK", Column2Left, Column2Left+0.6875 CurrentY = CurrentY + Diff * 0.40 SetUserFont PrintCentered char.blockscore, Column2Left, Column2Left+0.6875 FontSize = CInt(UserFontSize / 2 + 2.5) tH = TextHeight("DX") CurrentY = MidLine + Diff - tH PrintCentered char.blockusing, Column2Left, Column2Left+0.6875 End Sub '******************************************************************************** '* '* Print the Skills '* '******************************************************************************** '**************************************** 'Print One Item '**************************************** Function PrintSkillType(SysSize, UserSize, curList, curItem, LeftIndent, ColLeft, ColRight) tW = TextWidth("DX") tH = TextHeight("DX") NewTop = CurrentY SetUserFont FontSize = UserSize NameLeft = ColLeft + LeftIndent LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 CostColRight = ColRight - MinSpace CostColLeft = CostColRight - 0.375 'calc size of area needed tmpName = Char.Items(curItem).FullNameTL 'page numbers PageNum = False select case curList case Skills if Options.Value("SkillsPageNumbers") then PageNum = True case Spells if Options.Value("SpellsPageNumbers") then PageNum = True end select if PageNum then pn = Char.Items(curItem).TagItem("page") if pn <> "" then tmp = " {p. " & pn & "}" end if end if tmpName = tmpName & tmp TextBox tmpName, NameLeft, CurrentY, LevelLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > ColumnHeight then 'ran out of room PrintSkillType = False Exit Function end if 'draw the flag pic CurrentY = NewTop CurrentX = ColLeft 'DrawTraitFlagPic newfield 'print the name 'TextColor = UserColor CurrentY = NewTop TextBox tmpName, NameLeft, CurrentY, LevelLeft - NameLeft, NameHeight, True 'print the level CurrentY = NewTop PrintAtLeft Char.Items(curItem).level, LevelLeft 'print the rel level If Char.Items(curItem).TagItem("sd") = "0" and curList = Skills Then 'a technique CurrentY = NewTop tmp = Char.Items(curItem).TagItem("stepoff") & Char.Items(curItem).TagItem("step") PrintAtLeft tmp, RelLevelLeft end if CurrentY = NewTop SetFormFont FontSize = SysSize PrintAtLeft "[", CostColLeft PrintAtRight "]", CostColRight SetUserFont FontSize = UserSize PrintAtRight Char.Items(curitem).TagItem("points"), CostColRight - MinSpace * 1.5 SetFormFont FontSize = SysSize CurrentX = ColLeft CurrentY = NewTop + NameHeight 'print bonuses if curList = Skills then NewTop = CurrentY FontSize = CInt(SysSize / 2 + 2.5) tmp = "" if options.value("ShowParry") then tmp2 = Char.Items(curitem).TagItem("parrylevel") if tmp2 <> "" then tmp = "Parry: " & tmp2 end if tmp2 = Char.Items(curitem).TagItem("blocklevel") if tmp2 <> "" then tmp2 = "Block: " & tmp2 if tmp = "" then tmp = tmp2 else tmp = tmp & " " & tmp2 end if end if end if if options.value("ShowSkillBonuses") then tmp2 = Char.Items(curitem).TagItem("bonuslist") If tmp2 <> "" Then tmp2 = "Includes: " & tmp2 if tmp = "" then tmp = tmp2 else tmp = tmp & " Level " & tmp2 end if end if end if 'tmp = Char.Items(curitem).TagItem("bonuslist") If tmp <> "" Then 'tmp = "Includes: " & tmp TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > ColumnHeight then 'ran out of room PrintSkillType = False Exit Function end if TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True CurrentY = NewTop + NameHeight End If end if 'print conditionals if options.value("ShowSkillConditionals") then NewTop = CurrentY tmp = Char.Items(curitem).TagItem("conditionallist") If tmp <> "" Then tmp = "Conditional: " & tmp TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > ColumnHeight then 'ran out of room PrintSkillType = False Exit Function end if TextBox tmp, NameLeft, CurrentY, CostColLeft - NameLeft, NameHeight, True CurrentY = NewTop + NameHeight End If end if SetFormFont FontSize = SysSize PostLine = False select case curList case Skills if Options.Value("LineAfterSkills") then PostLine = True case Spells if Options.Value("LineAfterSpells") then PostLine = True end select if PostLine then 'DrawLine ColLeft-MinSpace, CurrentY, ColLeft-MinSpace+ColumnWidth, CurrentY DrawLine ColLeft-MinSpace, CurrentY, ColRight, CurrentY end if PrintSkillType = True End Function '**************************************** 'Print the whole list '**************************************** Sub PrintSkills(SysSize, UserSize, BoxTop) ColLeft = 4.375 ColRight = PageWidth - MarginRight 'draw a box around our work area DrawBox Column2Left, BoxTop, ColRight, ColumnHeight, False CurrentY = BoxTop SetFormFont FontSize = SysSize tW = TextWidth("DX") tH = TextHeight("DX") 'NameLeft = ColLeft + MinSpace * 3 NameLeft = ColLeft LevelLeft = NameLeft + 2 - MinSpace * 3 RelLevelLeft = LevelLeft + 0.625 CostColRight = ColRight - MinSpace CostColLeft = CostColRight - 0.375 FontBold = True PrintCentered "SKILLS", ColLeft, ColRight FontBold = False paragraph = "" curTop = CurrentY FontBold = True CurrentY = curTop PrintAtLeft "Name", NameLeft CurrentY = curTop PrintAtLeft "Level", LevelLeft CurrentY = curTop PrintAtLeft "Relative Level", RelLevelLeft 'TextBox "Relative Level", RelLevelLeft, CurrentY - tH, RelLevelLeft - LevelLeft, tH * 3, True FontBold = False '***** '* Print Skills '***** CurrentY = curTop + tH For curItem = 1 To Char.Items.Count If Char.Items(curItem).ItemType = Skills Then 'a skill If Char.Items(curItem).TagItem("hide") = "" or Options.Value("ShowHiddenSkills") = True Then 'not hidden If Char.Items(curItem).TagItem("sd") = "0" Then 'not a technique Okay = PrintSkillType(SysSize, UserSize, Skills, curItem, 0, ColLeft, ColRight) if Okay = False then 'ran out of room to print it if SysSize > MinFontSize then Call PrintSkills(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowSkills = curItem Exit Sub end if end if End If End If End If Next '***** '* Print Techniques '***** Found = False curTop = CurrentY For curItem = 1 To Char.Items.Count If Char.Items(curItem).ItemType = Skills Then 'a skill If Char.Items(curItem).TagItem("hide") = "" or Options.Value("ShowHiddenSkills") = True Then 'not hidden If Char.Items(curItem).TagItem("sd") <> "0" Then 'a technique if not Found then 'first one found Found = True FontBold = True if curTop + tH > ColumnHeight then 'ran out of room if SysSize > MinFontSize then call PrintSkills(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowTechniques = 1 Exit Sub end if end if 'print the name PrintAtLeft "Techniques", NameLeft FontBold = False CurrentY = CurrentY + tH end if Okay = PrintSkillType(SysSize, UserSize, Skills, curItem, 0, ColLeft, ColRight) if Okay = False then 'ran out of room to print it if SysSize > MinFontSize then Call PrintSkills(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowTechniques = curItem Exit Sub end if end if End If End If End If Next '***** '* Print Spells '***** If Options.Value("ShowSpells") Then if char.count(Spells) >0 then curTop = CurrentY if curTop + tH > ColumnHeight then 'ran out of room if SysSize > MinFontSize then call PrintSkills(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowSpells = 1 Exit Sub end if end if FontBold = True PrintAtLeft "Spells", ColLeft FontBold = False paragraph = "" curTop = CurrentY For curItem = 1 To Char.Items.Count If Char.Items(curItem).ItemType = Spells Then 'a spell If Char.Items(curItem).TagItem("hide") = "" or Options.Value("ShowHiddenSpells") = True Then 'not hidden Okay = PrintSkillType(SysSize, UserSize, Spells, curItem, 0, ColLeft, ColRight) if Okay = False then 'ran out of room to print it if SysSize > MinFontSize then Call PrintSkills(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowSpells = curItem Exit Sub end if end if End If End If Next end if End If paragraph = "" End Sub '**************************************** 'Print Hand Weapons '**************************************** Sub PrintHandWeapons(SysSize, UserSize, BoxTop) ColLeft = 2.25 ColRight = PageWidth - MarginRight BoxBottom = BoxTop + 1.125 if Options.Value("MoreHandWeaponSpace") then if Options.Value("EvenMoreHandWeaponSpace") then BoxBottom = BoxTop + 3.125 else BoxBottom = BoxTop + 2.125 end if end if CostBoxLeft = PageWidth-MarginRight-1.175 CostBoxRight = PageWidth-MarginRight 'draw a box around our work area DrawBox ColLeft, BoxTop, CostBoxLeft, BoxBottom, False DrawBox CostBoxLeft, BoxTop, CostBoxRight, BoxBottom, False CountLeft = ColLeft + MinSpace NameLeft = CountLeft + 0.25 if Options.Value("HandWeaponsColumn") then DamageLeft = NameLeft + 1.125 ReachLeft = DamageLeft + 1.125 else DamageLeft = NameLeft + 1.5 ReachLeft = DamageLeft + 0.75 end if ParryLeft = ReachLeft + 0.5 if Options.Value("ShowMinST") then MinSTLeft = ParryLeft + 0.5 NotesLeft = MinSTLeft + 0.375 else NotesLeft = ParryLeft + 0.5 end if CostLeft = CostBoxLeft + MinSpace * 1.25 WeightLeft = CostBoxRight - 0.5 CurrentY = BoxTop SetFormFont FontSize = SysSize tW = TextWidth("DX") tH = TextHeight("DX") FontBold = True PrintAtLeft "HAND WEAPONS", CountLeft FontBold = False curTop = CurrentY + tH FontBold = True CurrentY = curTop PrintAtLeft "Qty", CountLeft CurrentY = curTop PrintAtLeft "Weapon", NameLeft CurrentY = curTop PrintAtLeft "Damage", DamageLeft CurrentY = curTop PrintAtLeft "Reach", ReachLeft if Options.Value("ShowSkillParry") then CurrentY = curTop PrintAtLeft "Lvl(Pry)", ParryLeft else CurrentY = curTop PrintAtLeft "Parry", ParryLeft end if if Options.Value("ShowMinST") then CurrentY = curTop PrintAtLeft "ST", MinSTLeft end if CurrentY = curTop PrintAtLeft "Notes", NotesLeft CurrentY = curTop PrintAtLeft "Cost", CostLeft CurrentY = curTop PrintAtLeft "Weight", WeightLeft FontBold = False '***** '* Print Stuff '***** CurrentY = curTop + tH For i = 1 To Char.Items.Count 'If Char.Items(i).ItemType = Equipment Then 'allow any type of item to have weapon characteristics okay = False if char.items(i).tagitem("charreach") <> "" then 'we only want to include hand weapons here okay = True end if if Char.Items(i).TagItem("hide") <> "" then 'hidden, okay for non-stats, non-equipment if Char.Items(i).ItemType = Equipment or Char.Items(i).ItemType = Stats then okay = False end if end if if Options.Value("HideBite") then if Char.Items(i).TagItem("name") = "Bite" then okay = False end if end if if okay then 'If Char.Items(i).TagItem("hide") = "" Then 'not hidden ModeCount = Char.Items(i).DamageModeTagItemCount("charreach") CurMode = Char.Items(i).DamageModeTagItemAt("charreach") if ModeCount = 1 then 'Everything on 1 line SetUserFont FontSize = UserSize NewTop = CurrentY 'calc size of area needed TextBox Char.Items(i).FullNameTL, NameLeft, CurrentY, DamageLeft - NameLeft, 0, True, True, False NameHeight = TextHei DamageText = Char.Items(i).DamageModeTagItem(CurMode, "chardamage") if Char.Items(i).DamageModeTagItem(CurMode, "chararmordivisor") <> "" then DamageText = DamageText & " (" & Char.Items(i).DamageModeTagItem(CurMode, "chararmordivisor") & ")" end if DamageText = DamageText & " " & Char.Items(i).DamageModeTagItem(CurMode, "chardamtype") TextBox DamageText, DamageLeft, CurrentY, ReachLeft - DamageLeft, 0, True, True, False tmpHeight = TextHei if tmpHeight > NameHeight then NameHeight = tmpHeight if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintHandWeapons(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowHandWeapons = i Exit Sub end if end if 'draw the flag pic CurrentY = NewTop CurrentX = ColLeft 'DrawTraitFlagPic newfield 'print the qty CurrentY = NewTop PrintAtLeft Char.Items(i).tagitem("count"), CountLeft 'print the name CurrentY = NewTop TextBox Char.Items(i).FullNameTL, NameLeft, CurrentY, DamageLeft - NameLeft, NameHeight, True 'print the damage CurrentY = NewTop TextBox DamageText, DamageLeft, CurrentY, ReachLeft - DamageLeft, NameHeight, True 'print the reach CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charreach"), ReachLeft 'print the parry if Options.Value("ShowSkillParry") then ParryText = Char.Items(i).DamageModeTagItem(CurMode, "charskillscore") & " (" & Char.Items(i).DamageModeTagItem(CurMode, "charparryscore") & ")" else ParryText = Char.Items(i).DamageModeTagItem(CurMode, "charparry") end if CurrentY = NewTop PrintAtLeft ParryText, ParryLeft if Options.Value("ShowMinST") then CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charminst"), MinSTLeft end if 'print the notes CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "notes"), NotesLeft 'print the cost CurrentY = NewTop if Char.Items(i).ItemType = Equipment then PrintAtLeft Char.Items(i).tagitem("cost"), CostLeft end if 'print the weight CurrentY = NewTop PrintAtLeft Char.Items(i).tagitem("weight"), WeightLeft CurrentX = ColLeft CurrentY = NewTop + NameHeight SetFormFont FontSize = SysSize else 'base info on a line, then mode info on other lines SetUserFont FontSize = UserSize NewTop = CurrentY 'calc size of area needed TextBox Char.Items(i).FullNameTL, NameLeft, CurrentY, DamageLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintHandWeapons(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowHandWeapons = i Exit Sub end if end if 'draw the flag pic CurrentY = NewTop CurrentX = ColLeft 'DrawTraitFlagPic newfield 'print the qty CurrentY = NewTop PrintAtLeft Char.Items(i).tagitem("count"), CountLeft 'print the name CurrentY = NewTop TextBox Char.Items(i).FullNameTL, NameLeft, CurrentY, DamageLeft - NameLeft, NameHeight, True 'print the cost CurrentY = NewTop if Char.Items(i).ItemType = Equipment then PrintAtLeft Char.Items(i).tagitem("cost"), CostLeft end if 'print the weight CurrentY = NewTop PrintAtLeft Char.Items(i).tagitem("weight"), WeightLeft CurrentX = ColLeft CurrentY = NewTop + NameHeight SetFormFont FontSize = SysSize '* Now do the modes CurMode = Char.Items(i).DamageModeTagItemAt("charreach") Do okay = True if Options.Value("HideBite") then if Char.Items(i).DamageModeName(CurMode) = "Bite" then okay = False end if end if if okay then 'this mode is hand! SetUserFont FontSize = UserSize NewTop = CurrentY 'calc size of area needed TextBox " " & Char.Items(i).DamageModeName(CurMode), NameLeft, CurrentY, DamageLeft - NameLeft, 0, True, True, False NameHeight = TextHei DamageText = Char.Items(i).DamageModeTagItem(CurMode, "chardamage") if Char.Items(i).DamageModeTagItem(CurMode, "chararmordivisor") <> "" then DamageText = DamageText & " (" & Char.Items(i).DamageModeTagItem(CurMode, "chararmordivisor") & ")" end if DamageText = DamageText & " " & Char.Items(i).DamageModeTagItem(CurMode, "chardamtype") TextBox DamageText, DamageLeft, CurrentY, ReachLeft - DamageLeft, 0, True, True, False tmpHeight = TextHei if tmpHeight > NameHeight then NameHeight = tmpHeight if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintHandWeapons(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowHandWeapons = i Exit Sub end if end if 'print the name CurrentY = NewTop TextBox " " & Char.Items(i).DamageModeName(CurMode), NameLeft, CurrentY, DamageLeft - NameLeft, NameHeight, True 'print the damage CurrentY = NewTop TextBox DamageText, DamageLeft, CurrentY, ReachLeft - DamageLeft, NameHeight, True 'print the reach CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charreach"), ReachLeft 'print the parry if Options.Value("ShowSkillParry") then ParryText = Char.Items(i).DamageModeTagItem(CurMode, "charskillscore") & " (" & Char.Items(i).DamageModeTagItem(CurMode, "charparryscore") & ")" else ParryText = Char.Items(i).DamageModeTagItem(CurMode, "charparry") end if CurrentY = NewTop PrintAtLeft ParryText, ParryLeft if Options.Value("ShowMinST") then CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charminst"), MinSTLeft end if 'print the notes CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "notes"), NotesLeft CurrentX = ColLeft CurrentY = NewTop + NameHeight SetFormFont FontSize = SysSize end if CurMode = Char.Items(i).DamageModeTagItemAt("charreach", CurMode+1) Loop while CurMode > 0 end if 'end if end if 'End If Next End Sub '**************************************** 'Print Ranged Weapons '**************************************** Sub PrintRangedWeapons(SysSize, UserSize, BoxTop) ColLeft = MarginLeft ColRight = PageWidth - MarginRight BoxBottom = BoxTop + 2.125 if Options.Value("MoreHandWeaponSpace") then if Options.Value("EvenMoreHandWeaponSpace") then BoxBottom = BoxTop + 1.125 end if end if CostBoxLeft = PageWidth-MarginRight-1.175 CostBoxRight = PageWidth-MarginRight 'draw a box around our work area DrawBox ColLeft, BoxTop, CostBoxLeft, BoxBottom, False DrawBox CostBoxLeft, BoxTop, CostBoxRight, BoxBottom, False CountLeft = ColLeft + MinSpace NameLeft = CountLeft + 0.25 if Options.Value("RangedWeaponsColumn") then DamageLeft = NameLeft + 1 AccLeft = DamageLeft + 1 else DamageLeft = NameLeft + 1.375 AccLeft = DamageLeft + 0.625 end if RangeLeft = AccLeft + 0.375 ROFLeft = RangeLeft + 1 ShotsLeft = ROFLeft + 0.375 STLeft = ShotsLeft + 0.625 BulkLeft = STLeft + 0.375 RclLeft = BulkLeft + 0.375 LCLeft = RclLeft + 0.25 NotesLeft = LCLeft + 0.25 CostLeft = CostBoxLeft + MinSpace * 1.25 WeightLeft = CostBoxRight - 0.5 if Options.Value("ShowRangedLevel") then ROFLeft = RangeLeft + 0.75 ShotsLeft = ROFLeft + 0.375 LevelLeft = ShotsLeft + 0.5625 STLeft = LevelLeft + 0.3125 end if CurrentY = BoxTop SetFormFont FontSize = SysSize tW = TextWidth("DX") tH = TextHeight("DX") FontBold = True PrintAtLeft "RANGED WEAPONS", CountLeft FontBold = False curTop = CurrentY + tH FontBold = True CurrentY = curTop PrintAtLeft "Qty", CountLeft CurrentY = curTop PrintAtLeft "Weapon", NameLeft CurrentY = curTop PrintAtLeft "Damage", DamageLeft CurrentY = curTop PrintAtLeft "Acc", AccLeft CurrentY = curTop PrintAtLeft "Range", RangeLeft CurrentY = curTop PrintAtLeft "RoF", ROFLeft CurrentY = curTop PrintAtLeft "Shots", ShotsLeft if Options.Value("ShowRangedLevel") then CurrentY = curTop PrintAtLeft "Lvl", LevelLeft end if CurrentY = curTop PrintAtLeft "ST", STLeft CurrentY = curTop PrintAtLeft "Bulk", BulkLeft CurrentY = curTop PrintAtLeft "Rcl", RclLeft CurrentY = curTop PrintAtLeft "LC", LCLeft CurrentY = curTop PrintAtLeft "Notes", NotesLeft CurrentY = curTop PrintAtLeft "Cost", CostLeft CurrentY = curTop PrintAtLeft "Weight", WeightLeft FontBold = False '***** '* Print Stuff '***** CurrentY = curTop + tH For i = 1 To Char.Items.Count 'If Char.Items(i).ItemType = Equipment Then 'allow any type of item to have weapon characteristics okay = False if char.items(i).tagitem("charrangemax") <> "" then 'we only want to include ranged weapons here okay = True end if if Char.Items(i).TagItem("hide") <> "" then 'hidden, okay for non-stats, non-equipment if Char.Items(i).ItemType = Equipment or Char.Items(i).ItemType = Stats then okay = False end if end if if okay then 'If Char.Items(i).TagItem("hide") = "" Then 'not hidden ModeCount = Char.Items(i).DamageModeTagItemCount("charrangemax") CurMode = Char.Items(i).DamageModeTagItemAt("charrangemax") if ModeCount = 1 then 'Everything on 1 line SetUserFont FontSize = UserSize NewTop = CurrentY 'calc size of area needed TextBox Char.Items(i).FullNameTL, NameLeft, CurrentY, DamageLeft - NameLeft, 0, True, True, False NameHeight = TextHei DamageText = Char.Items(i).DamageModeTagItem(CurMode, "chardamage") if Char.Items(i).DamageModeTagItem(CurMode, "chararmordivisor") <> "" then DamageText = DamageText & " (" & Char.Items(i).DamageModeTagItem(CurMode, "chararmordivisor") & ")" end if DamageText = DamageText & " " & Char.Items(i).DamageModeTagItem(CurMode, "chardamtype") TextBox DamageText, DamageLeft, CurrentY, AccLeft - DamageLeft, 0, True, True, False tmpHeight = TextHei if tmpHeight > NameHeight then NameHeight = tmpHeight RangeText = Char.Items(i).DamageModeTagItem(CurMode, "charrangehalfdam") if RangeText = "" then RangeText = Char.Items(i).DamageModeTagItem(CurMode, "charrangemax") else RangeText = RangeText & " / " & Char.Items(i).DamageModeTagItem(CurMode, "charrangemax") end if TextBox RangeText, RangeLeft, CurrentY, ROFLeft - RangeLeft, 0, True, True, False tmpHeight = TextHei if tmpHeight > NameHeight then NameHeight = tmpHeight if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintRangedWeapons(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowRangedWeapons = i Exit Sub end if end if 'draw the flag pic CurrentY = NewTop CurrentX = ColLeft 'DrawTraitFlagPic newfield 'print the qty CurrentY = NewTop PrintAtLeft Char.Items(i).tagitem("count"), CountLeft 'print the name CurrentY = NewTop TextBox Char.Items(i).FullNameTL, NameLeft, CurrentY, DamageLeft - NameLeft, NameHeight, True 'print the damage CurrentY = NewTop TextBox DamageText, DamageLeft, CurrentY, AccLeft - DamageLeft, NameHeight, True 'print the acc CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "characc"), AccLeft 'print the range CurrentY = NewTop TextBox RangeText, RangeLeft, CurrentY, ROFLeft - RangeLeft, NameHeight, True 'print the rof CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charrof"), ROFLeft 'print the shots CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charshots"), ShotsLeft 'print the level if Options.Value("ShowRangedLevel") then CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charskillscore"), LevelLeft end if 'print the st CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charminst"), STLeft 'print the bulk CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "bulk"), BulkLeft 'print the rcl CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charrcl"), RclLeft 'print the lc CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "lc"), LCLeft 'print the notes CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "notes"), NotesLeft 'print the cost CurrentY = NewTop if Char.Items(i).ItemType = Equipment then PrintAtLeft Char.Items(i).tagitem("cost"), CostLeft end if 'print the weight CurrentY = NewTop PrintAtLeft Char.Items(i).tagitem("weight"), WeightLeft CurrentX = ColLeft CurrentY = NewTop + NameHeight SetFormFont FontSize = SysSize else 'base info on a line, then mode info on other lines SetUserFont FontSize = UserSize NewTop = CurrentY 'calc size of area needed TextBox Char.Items(i).FullNameTL, NameLeft, CurrentY, DamageLeft - NameLeft, 0, True, True, False NameHeight = TextHei if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintRangedWeapons(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowRangedWeapons = i Exit Sub end if end if 'draw the flag pic CurrentY = NewTop CurrentX = ColLeft 'DrawTraitFlagPic newfield 'print the qty CurrentY = NewTop PrintAtLeft Char.Items(i).tagitem("count"), CountLeft 'print the name CurrentY = NewTop TextBox Char.Items(i).FullNameTL, NameLeft, CurrentY, DamageLeft - NameLeft, NameHeight, True 'print the cost CurrentY = NewTop if Char.Items(i).ItemType = Equipment then PrintAtLeft Char.Items(i).tagitem("cost"), CostLeft end if 'print the weight CurrentY = NewTop PrintAtLeft Char.Items(i).tagitem("weight"), WeightLeft CurrentX = ColLeft CurrentY = NewTop + NameHeight SetFormFont FontSize = SysSize '* Now do the modes CurMode = Char.Items(i).DamageModeTagItemAt("charrangemax") Do 'this mode is ranged! SetUserFont FontSize = UserSize NewTop = CurrentY 'calc size of area needed TextBox " " & Char.Items(i).DamageModeName(CurMode), NameLeft, CurrentY, DamageLeft - NameLeft, 0, True, True, False NameHeight = TextHei DamageText = Char.Items(i).DamageModeTagItem(CurMode, "chardamage") if Char.Items(i).DamageModeTagItem(CurMode, "chararmordivisor") <> "" then DamageText = DamageText & " (" & Char.Items(i).DamageModeTagItem(CurMode, "chararmordivisor") & ")" end if DamageText = DamageText & " " & Char.Items(i).DamageModeTagItem(CurMode, "chardamtype") TextBox DamageText, DamageLeft, CurrentY, AccLeft - DamageLeft, 0, True, True, False tmpHeight = TextHei if tmpHeight > NameHeight then NameHeight = tmpHeight RangeText = Char.Items(i).DamageModeTagItem(CurMode, "charrangehalfdam") if RangeText = "" then RangeText = Char.Items(i).DamageModeTagItem(CurMode, "charrangemax") else RangeText = RangeText & " / " & Char.Items(i).DamageModeTagItem(CurMode, "charrangemax") end if TextBox RangeText, RangeLeft, CurrentY, ROFLeft - RangeLeft, 0, True, True, False tmpHeight = TextHei if tmpHeight > NameHeight then NameHeight = tmpHeight if NewTop + NameHeight > BoxBottom then 'ran out of room if SysSize > MinFontSize then call PrintRangedWeapons(SysSize-1, UserSize-1, BoxTop) Exit Sub else 'only go down to MinFontSize point type, and then just 'get out alive OverflowRangedWeapons = i Exit Sub end if end if 'print the name CurrentY = NewTop TextBox " " & Char.Items(i).DamageModeName(CurMode), NameLeft, CurrentY, DamageLeft - NameLeft, NameHeight, True 'print the damage CurrentY = NewTop TextBox DamageText, DamageLeft, CurrentY, AccLeft - DamageLeft, NameHeight, True 'print the acc CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "characc"), AccLeft 'print the range CurrentY = NewTop TextBox RangeText, RangeLeft, CurrentY, ROFLeft - RangeLeft, NameHeight, True 'print the rof CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charrof"), ROFLeft 'print the shots CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charshots"), ShotsLeft 'print the level if Options.Value("ShowRangedLevel") then CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charskillscore"), LevelLeft end if 'print the st CurrentY = NewTop PrintAtLeft Char.Items(i).DamageModeTagItem(CurMode, "charminst"), STLeft 'print the bulk CurrentY = NewTop