[Gotisso-commit] SF.net SVN: gotisso:[6] trunk/lang
Status: Inactive
Brought to you by:
jmvaz
Menu
▾
▴
[Gotisso-commit] SF.net SVN: gotisso:[6] trunk/lang
|
From: <jm...@us...> - 2009-11-04 00:33:19
|
Revision: 6
http://gotisso.svn.sourceforge.net/gotisso/?rev=6&view=rev
Author: jmvaz
Date: 2009-11-04 00:33:09 +0000 (Wed, 04 Nov 2009)
Log Message:
-----------
initial commit
Added Paths:
-----------
documentation/doc.txt
trunk/backup/
trunk/gotisso.lpi
trunk/gotisso.lpr
trunk/gotisso.lps
trunk/gotisso.manifest
trunk/gotisso.rc
trunk/lang/
trunk/lang/gotisso.po
trunk/stringgridprinter.pas
trunk/u_classes.pas
trunk/u_consts.pas
trunk/u_ingredients.lfm
trunk/u_ingredients.lrt
trunk/u_ingredients.pas
trunk/u_main.lfm
trunk/u_main.lrt
trunk/u_main.pas
trunk/u_meal.lfm
trunk/u_meal.lrt
trunk/u_meal.pas
Added: documentation/doc.txt
===================================================================
--- documentation/doc.txt (rev 0)
+++ documentation/doc.txt 2009-11-04 00:33:09 UTC (rev 6)
@@ -0,0 +1,9 @@
+Program name:
+
+1. Menu du Jour
+2. Vapt Cook
+3. Gotisso
+
+Mission:
+
+With Gotisso you can plan your meals, generating shopping lists to help your domestic tasks. Future plans include a recipe manager.
Added: trunk/gotisso.lpi
===================================================================
--- trunk/gotisso.lpi (rev 0)
+++ trunk/gotisso.lpi 2009-11-04 00:33:09 UTC (rev 6)
@@ -0,0 +1,130 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="\"/>
+ <Version Value="7"/>
+ <General>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <TargetFileExt Value=".exe"/>
+ <Title Value="gotisso"/>
+ <UseAppBundle Value="False"/>
+ <UseXPManifest Value="True"/>
+ </General>
+ <i18n>
+ <EnableI18N Value="True"/>
+ <OutDir Value="lang"/>
+ </i18n>
+ <VersionInfo>
+ <ProjectVersion Value="0.0.0.0"/>
+ <Language Value="0416"/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="2">
+ <Item1>
+ <PackageName Value="Printer4Lazarus"/>
+ <MinVersion Minor="5" Valid="True"/>
+ </Item1>
+ <Item2>
+ <PackageName Value="LCL"/>
+ </Item2>
+ </RequiredPackages>
+ <Units Count="7">
+ <Unit0>
+ <Filename Value="gotisso.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="gotisso"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="u_main.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="fmMain"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="u_main"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="u_ingredients.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="fmIngredients"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="u_ingredients"/>
+ </Unit2>
+ <Unit3>
+ <Filename Value="stringgridprinter.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="StringGridPrinter"/>
+ </Unit3>
+ <Unit4>
+ <Filename Value="u_consts.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="u_consts"/>
+ </Unit4>
+ <Unit5>
+ <Filename Value="u_classes.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="u_classes"/>
+ </Unit5>
+ <Unit6>
+ <Filename Value="u_meal.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="fmMeal"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="u_meal"/>
+ </Unit6>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="8"/>
+ <PathDelim Value="\"/>
+ <SearchPaths>
+ <IncludeFiles Value="$(ProjOutDir)\"/>
+ <UnitOutputDirectory Value="..\..\output"/>
+ </SearchPaths>
+ <Parsing>
+ <SyntaxOptions>
+ <SyntaxMode Value="Delphi"/>
+ <CStyleOperator Value="False"/>
+ <AllowLabel Value="False"/>
+ </SyntaxOptions>
+ </Parsing>
+ <CodeGeneration>
+ <SmartLinkUnit Value="True"/>
+ <Checks>
+ <IOChecks Value="True"/>
+ <RangeChecks Value="True"/>
+ <OverflowChecks Value="True"/>
+ <StackChecks Value="True"/>
+ </Checks>
+ <VerifyObjMethodCallValidity Value="True"/>
+ </CodeGeneration>
+ <Linking>
+ <Debugging>
+ <GenerateDebugInfo Value="True"/>
+ </Debugging>
+ <LinkSmart Value="True"/>
+ <Options>
+ <Win32>
+ <GraphicApplication Value="True"/>
+ </Win32>
+ </Options>
+ </Linking>
+ <Other>
+ <Verbosity>
+ <ShoLineNum Value="True"/>
+ </Verbosity>
+ <CompilerPath Value="$(CompPath)"/>
+ <CreateMakefileOnBuild Value="True"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
Added: trunk/gotisso.lpr
===================================================================
--- trunk/gotisso.lpr (rev 0)
+++ trunk/gotisso.lpr 2009-11-04 00:33:09 UTC (rev 6)
@@ -0,0 +1,45 @@
+{
+ Copyright (C) 2009 João Marcelo S. Vaz
+
+ This file is part of Gotisso Meal Planner.
+
+ Gotisso Meal Planner is free software: you can redistribute it and/or
+ modify it under the terms of the GNU General Public License as published
+ by the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ Gotisso Meal Planner is distributed in the hope that it will be
+ useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+ of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+}
+program gotisso;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}
+ {$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}
+ {$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms
+ { you can add units after this },
+ u_main, Printer4Lazarus, u_ingredients, u_consts, u_classes, u_meal;
+
+{$IFDEF WINDOWS}{$R gotisso.rc}{$ENDIF}
+
+begin
+ Application.Title:= sTitle;
+ Application.Initialize;
+ Application.CreateForm(TfmMain, fmMain);
+ Application.CreateForm(TfmIngredients, fmIngredients);
+ Application.CreateForm(TfmMeal, fmMeal);
+ Application.Run;
+end.
+
Added: trunk/gotisso.lps
===================================================================
--- trunk/gotisso.lps (rev 0)
+++ trunk/gotisso.lps 2009-11-04 00:33:09 UTC (rev 6)
@@ -0,0 +1,378 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectSession>
+ <PathDelim Value="\"/>
+ <Version Value="7"/>
+ <Units Count="47">
+ <Unit0>
+ <Filename Value="gotisso.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="gotisso"/>
+ <CursorPos X="2" Y="7"/>
+ <TopLine Value="1"/>
+ <EditorIndex Value="0"/>
+ <UsageCount Value="63"/>
+ <Loaded Value="True"/>
+ <SyntaxHighlighter Value="Delphi"/>
+ </Unit0>
+ <Unit1>
+ <Filename Value="u_main.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="fmMain"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="u_main"/>
+ <CursorPos X="9" Y="114"/>
+ <TopLine Value="84"/>
+ <EditorIndex Value="1"/>
+ <UsageCount Value="63"/>
+ <Loaded Value="True"/>
+ <SyntaxHighlighter Value="Delphi"/>
+ </Unit1>
+ <Unit2>
+ <Filename Value="u_ingredients.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="fmIngredients"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="u_ingredients"/>
+ <CursorPos X="1" Y="21"/>
+ <TopLine Value="1"/>
+ <EditorIndex Value="3"/>
+ <UsageCount Value="61"/>
+ <Loaded Value="True"/>
+ <SyntaxHighlighter Value="Delphi"/>
+ </Unit2>
+ <Unit3>
+ <Filename Value="stringgridprinter.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="StringGridPrinter"/>
+ <CursorPos X="62" Y="8"/>
+ <TopLine Value="1"/>
+ <EditorIndex Value="6"/>
+ <UsageCount Value="60"/>
+ <Loaded Value="True"/>
+ <SyntaxHighlighter Value="Delphi"/>
+ </Unit3>
+ <Unit4>
+ <Filename Value="u_consts.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="u_consts"/>
+ <CursorPos X="1" Y="21"/>
+ <TopLine Value="1"/>
+ <EditorIndex Value="5"/>
+ <UsageCount Value="56"/>
+ <Loaded Value="True"/>
+ <SyntaxHighlighter Value="Delphi"/>
+ </Unit4>
+ <Unit5>
+ <Filename Value="u_classes.pas"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="u_classes"/>
+ <CursorPos X="1" Y="21"/>
+ <TopLine Value="1"/>
+ <EditorIndex Value="4"/>
+ <UsageCount Value="52"/>
+ <Loaded Value="True"/>
+ <SyntaxHighlighter Value="Delphi"/>
+ </Unit5>
+ <Unit6>
+ <Filename Value="u_meal.pas"/>
+ <IsPartOfProject Value="True"/>
+ <ComponentName Value="fmMeal"/>
+ <ResourceBaseClass Value="Form"/>
+ <UnitName Value="u_meal"/>
+ <CursorPos X="1" Y="21"/>
+ <TopLine Value="1"/>
+ <EditorIndex Value="2"/>
+ <UsageCount Value="29"/>
+ <Loaded Value="True"/>
+ <SyntaxHighlighter Value="Delphi"/>
+ </Unit6>
+ <Unit7>
+ <Filename Value="C:\Develop\lazarus\components\printers\printersdlgs.pp"/>
+ <UnitName Value="PrintersDlgs"/>
+ <CursorPos X="31" Y="56"/>
+ <TopLine Value="88"/>
+ <UsageCount Value="8"/>
+ </Unit7>
+ <Unit8>
+ <Filename Value="C:\Develop\lazarus\lcl\dialogs.pp"/>
+ <UnitName Value="Dialogs"/>
+ <CursorPos X="3" Y="439"/>
+ <TopLine Value="511"/>
+ <UsageCount Value="8"/>
+ </Unit8>
+ <Unit9>
+ <Filename Value="C:\Develop\lazarus\languages\README.txt"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="1"/>
+ <UsageCount Value="8"/>
+ <SyntaxHighlighter Value="None"/>
+ </Unit9>
+ <Unit10>
+ <Filename Value="C:\Develop\lazarus\lcl\defaulttranslator.pas"/>
+ <UnitName Value="DefaultTranslator"/>
+ <CursorPos X="16" Y="170"/>
+ <TopLine Value="132"/>
+ <UsageCount Value="9"/>
+ </Unit10>
+ <Unit11>
+ <Filename Value="C:\Develop\lazarus\lcl\lresources.pp"/>
+ <UnitName Value="LResources"/>
+ <CursorPos X="27" Y="105"/>
+ <TopLine Value="79"/>
+ <UsageCount Value="9"/>
+ </Unit11>
+ <Unit12>
+ <Filename Value="C:\Develop\lazarus\lcl\interfaces\win32\interfaces.pp"/>
+ <UnitName Value="Interfaces"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="1"/>
+ <UsageCount Value="8"/>
+ </Unit12>
+ <Unit13>
+ <Filename Value="C:\Develop\lazarus\fpc\2.2.2\source\packages\fcl-base\src\gettext.pp"/>
+ <UnitName Value="gettext"/>
+ <CursorPos X="35" Y="91"/>
+ <TopLine Value="221"/>
+ <UsageCount Value="8"/>
+ </Unit13>
+ <Unit14>
+ <Filename Value="D:\lazarus\lcl\printers.pas"/>
+ <UnitName Value="Printers"/>
+ <CursorPos X="30" Y="176"/>
+ <TopLine Value="160"/>
+ <UsageCount Value="9"/>
+ </Unit14>
+ <Unit15>
+ <Filename Value="D:\lazarus\components\printers\printer4lazarus.pas"/>
+ <UnitName Value="Printer4Lazarus"/>
+ <CursorPos X="21" Y="10"/>
+ <TopLine Value="1"/>
+ <UsageCount Value="9"/>
+ </Unit15>
+ <Unit16>
+ <Filename Value="D:\lazarus\components\printers\osprinters.pas"/>
+ <UnitName Value="OSPrinters"/>
+ <CursorPos X="13" Y="84"/>
+ <TopLine Value="52"/>
+ <UsageCount Value="8"/>
+ </Unit16>
+ <Unit17>
+ <Filename Value="D:\lazarus\components\printers\win32\winprinters_h.inc"/>
+ <CursorPos X="103" Y="73"/>
+ <TopLine Value="53"/>
+ <UsageCount Value="8"/>
+ </Unit17>
+ <Unit18>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\win32\windows.pp"/>
+ <UnitName Value="windows"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="32"/>
+ <UsageCount Value="8"/>
+ </Unit18>
+ <Unit19>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\win\wininc\struct.inc"/>
+ <CursorPos X="13" Y="4936"/>
+ <TopLine Value="4918"/>
+ <UsageCount Value="8"/>
+ </Unit19>
+ <Unit20>
+ <Filename Value="D:\lazarus\components\printers\printersdlgs.pp"/>
+ <UnitName Value="PrintersDlgs"/>
+ <CursorPos X="32" Y="118"/>
+ <TopLine Value="90"/>
+ <UsageCount Value="8"/>
+ </Unit20>
+ <Unit21>
+ <Filename Value="D:\lazarus\components\printers\win32\winprndialogs.inc"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="270"/>
+ <UsageCount Value="8"/>
+ </Unit21>
+ <Unit22>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\packages\winunits-base\src\winver.pp"/>
+ <UnitName Value="winver"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="13"/>
+ <UsageCount Value="8"/>
+ </Unit22>
+ <Unit23>
+ <Filename Value="D:\lazarus\components\printers\win32\winprinters.inc"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="806"/>
+ <UsageCount Value="8"/>
+ </Unit23>
+ <Unit24>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\win\wininc\redef.inc"/>
+ <CursorPos X="24" Y="619"/>
+ <TopLine Value="601"/>
+ <UsageCount Value="8"/>
+ </Unit24>
+ <Unit25>
+ <Filename Value="D:\lazarus\lcl\forms.pp"/>
+ <UnitName Value="Forms"/>
+ <CursorPos X="30" Y="830"/>
+ <TopLine Value="826"/>
+ <UsageCount Value="8"/>
+ </Unit25>
+ <Unit26>
+ <Filename Value="D:\lazarus\lcl\lclclasses.pp"/>
+ <UnitName Value="LCLClasses"/>
+ <CursorPos X="3" Y="38"/>
+ <TopLine Value="32"/>
+ <UsageCount Value="8"/>
+ </Unit26>
+ <Unit27>
+ <Filename Value="D:\lazarus\lcl\graphics.pp"/>
+ <UnitName Value="Graphics"/>
+ <CursorPos X="8" Y="67"/>
+ <TopLine Value="47"/>
+ <UsageCount Value="8"/>
+ </Unit27>
+ <Unit28>
+ <Filename Value="D:\lazarus\lcl\lcltype.pp"/>
+ <UnitName Value="LCLType"/>
+ <CursorPos X="3" Y="863"/>
+ <TopLine Value="845"/>
+ <UsageCount Value="8"/>
+ </Unit28>
+ <Unit29>
+ <Filename Value="C:\Develop\lazarus\lcl\lcltype.pp"/>
+ <UnitName Value="LCLType"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="52"/>
+ <UsageCount Value="8"/>
+ </Unit29>
+ <Unit30>
+ <Filename Value="C:\Develop\lazarus\fpc\2.2.4\source\rtl\win\wininc\struct.inc"/>
+ <CursorPos X="6" Y="4936"/>
+ <TopLine Value="4926"/>
+ <UsageCount Value="8"/>
+ </Unit30>
+ <Unit31>
+ <Filename Value="C:\Develop\lazarus\lcl\include\winapih.inc"/>
+ <CursorPos X="38" Y="4"/>
+ <TopLine Value="1"/>
+ <UsageCount Value="8"/>
+ </Unit31>
+ <Unit32>
+ <Filename Value="C:\Develop\lazarus\lcl\lclintf.pas"/>
+ <UnitName Value="LCLIntf"/>
+ <CursorPos X="1" Y="1"/>
+ <TopLine Value="4"/>
+ <UsageCount Value="8"/>
+ </Unit32>
+ <Unit33>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\objpas\classes\classesh.inc"/>
+ <CursorPos X="19" Y="364"/>
+ <TopLine Value="343"/>
+ <UsageCount Value="18"/>
+ </Unit33>
+ <Unit34>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\win32\classes.pp"/>
+ <UnitName Value="Classes"/>
+ <CursorPos X="7" Y="28"/>
+ <TopLine Value="10"/>
+ <UsageCount Value="11"/>
+ </Unit34>
+ <Unit35>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\objpas\types.pp"/>
+ <UnitName Value="types"/>
+ <CursorPos X="27" Y="120"/>
+ <TopLine Value="102"/>
+ <UsageCount Value="11"/>
+ </Unit35>
+ <Unit36>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\inc\objpash.inc"/>
+ <CursorPos X="22" Y="153"/>
+ <TopLine Value="135"/>
+ <UsageCount Value="10"/>
+ </Unit36>
+ <Unit37>
+ <Filename Value="D:\lazarus\lcl\include\customcombobox.inc"/>
+ <CursorPos X="51" Y="939"/>
+ <TopLine Value="920"/>
+ <UsageCount Value="9"/>
+ </Unit37>
+ <Unit38>
+ <Filename Value="D:\lazarus\lcl\stdctrls.pp"/>
+ <UnitName Value="StdCtrls"/>
+ <CursorPos X="24" Y="569"/>
+ <TopLine Value="551"/>
+ <UsageCount Value="10"/>
+ </Unit38>
+ <Unit39>
+ <Filename Value="D:\lazarus\lcl\widgetset\wsstdctrls.pp"/>
+ <UnitName Value="WSStdCtrls"/>
+ <CursorPos X="1" Y="407"/>
+ <TopLine Value="5"/>
+ <UsageCount Value="9"/>
+ </Unit39>
+ <Unit40>
+ <Filename Value="D:\lazarus\lcl\include\customlistbox.inc"/>
+ <CursorPos X="1" Y="598"/>
+ <TopLine Value="580"/>
+ <UsageCount Value="10"/>
+ </Unit40>
+ <Unit41>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\inc\wstringh.inc"/>
+ <CursorPos X="11" Y="30"/>
+ <TopLine Value="12"/>
+ <UsageCount Value="10"/>
+ </Unit41>
+ <Unit42>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\objpas\classes\stringl.inc"/>
+ <CursorPos X="3" Y="392"/>
+ <TopLine Value="392"/>
+ <UsageCount Value="10"/>
+ </Unit42>
+ <Unit43>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\objpas\classes\persist.inc"/>
+ <CursorPos X="82" Y="35"/>
+ <TopLine Value="35"/>
+ <UsageCount Value="10"/>
+ </Unit43>
+ <Unit44>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\inc\systemh.inc"/>
+ <CursorPos X="11" Y="664"/>
+ <TopLine Value="646"/>
+ <UsageCount Value="10"/>
+ </Unit44>
+ <Unit45>
+ <Filename Value="D:\lazarus\lcl\interfaces\win32\win32listsl.inc"/>
+ <CursorPos X="1" Y="206"/>
+ <TopLine Value="188"/>
+ <UsageCount Value="10"/>
+ </Unit45>
+ <Unit46>
+ <Filename Value="D:\lazarus\fpc\2.2.4\source\rtl\objpas\rtlconst.inc"/>
+ <CursorPos X="3" Y="34"/>
+ <TopLine Value="16"/>
+ <UsageCount Value="10"/>
+ </Unit46>
+ </Units>
+ <General>
+ <ActiveEditorIndexAtStart Value="1"/>
+ </General>
+ <JumpHistory Count="2" HistoryIndex="1">
+ <Position1>
+ <Filename Value="u_meal.pas"/>
+ <Caret Line="92" Column="5" TopLine="1"/>
+ </Position1>
+ <Position2>
+ <Filename Value="u_main.pas"/>
+ <Caret Line="2" Column="9" TopLine="1"/>
+ </Position2>
+ </JumpHistory>
+ </ProjectSession>
+ <Debugging>
+ <Exceptions Count="2">
+ <Item1>
+ <Name Value="ECodetoolError"/>
+ </Item1>
+ <Item2>
+ <Name Value="EFOpenError"/>
+ </Item2>
+ </Exceptions>
+ </Debugging>
+</CONFIG>
Added: trunk/gotisso.manifest
===================================================================
--- trunk/gotisso.manifest (rev 0)
+++ trunk/gotisso.manifest 2009-11-04 00:33:09 UTC (rev 6)
@@ -0,0 +1,17 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
+ <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>
+ <description>Your application description here.</description>
+ <dependency>
+ <dependentAssembly>
+ <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>
+ </dependentAssembly>
+ </dependency>
+ <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
+ <security>
+ <requestedPrivileges>
+ <requestedExecutionLevel level="asInvoker" uiAccess="false"/>
+ </requestedPrivileges>
+ </security>
+ </trustInfo>
+</assembly>
\ No newline at end of file
Added: trunk/gotisso.rc
===================================================================
--- trunk/gotisso.rc (rev 0)
+++ trunk/gotisso.rc 2009-11-04 00:33:09 UTC (rev 6)
@@ -0,0 +1,6 @@
+#define RT_MANIFEST 24
+#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
+#define ISOLATIONAWARE_MANIFEST_RESOURCE_ID 2
+#define ISOLATIONAWARE_NOSTATICIMPORT_MANIFEST_RESOURCE_ID 3
+
+CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "gotisso.manifest"
Added: trunk/lang/gotisso.po
===================================================================
--- trunk/lang/gotisso.po (rev 0)
+++ trunk/lang/gotisso.po 2009-11-04 00:33:09 UTC (rev 6)
@@ -0,0 +1,240 @@
+msgid ""
+msgstr "Content-Type: text/plain; charset=UTF-8"
+
+#: TFMINGREDIENTES.BTFECHAR.CAPTION
+msgctxt "TFMINGREDIENTES.BTFECHAR.CAPTION"
+msgid "Fechar"
+msgstr ""
+
+#: TFMINGREDIENTES.BTIMPRIMIR.CAPTION
+msgctxt "TFMINGREDIENTES.BTIMPRIMIR.CAPTION"
+msgid "Imprimir..."
+msgstr ""
+
+#: TFMINGREDIENTES.CAPTION
+msgctxt "TFMINGREDIENTES.CAPTION"
+msgid "Ingredientes"
+msgstr ""
+
+#: TFMINGREDIENTS.BTFECHAR.CAPTION
+msgctxt "TFMINGREDIENTS.BTFECHAR.CAPTION"
+msgid "Fechar"
+msgstr ""
+
+#: TFMINGREDIENTS.BTIMPRIMIR.CAPTION
+msgctxt "TFMINGREDIENTS.BTIMPRIMIR.CAPTION"
+msgid "Imprimir..."
+msgstr ""
+
+#: TFMINGREDIENTS.CAPTION
+msgctxt "TFMINGREDIENTS.CAPTION"
+msgid "Ingredientes"
+msgstr ""
+
+#: TFMMAIN.BTCARLIMPAR.CAPTION
+msgctxt "TFMMAIN.BTCARLIMPAR.CAPTION"
+msgid "Limpar"
+msgstr ""
+
+#: TFMMAIN.BTCARREMOVER.CAPTION
+msgctxt "TFMMAIN.BTCARREMOVER.CAPTION"
+msgid "Remover"
+msgstr ""
+
+#: TFMMAIN.BTIMPRIMIR.CAPTION
+msgctxt "TFMMAIN.BTIMPRIMIR.CAPTION"
+msgid "Imprimir..."
+msgstr ""
+
+#: TFMMAIN.BTINGREDIENTES.CAPTION
+msgid "Lista de Ingredientes..."
+msgstr ""
+
+#: TFMMAIN.BTNOVA.CAPTION
+msgid "Nova..."
+msgstr ""
+
+#: TFMMAIN.BUTTON8.CAPTION
+msgid "Button1"
+msgstr ""
+
+#: TFMMAIN.CAPTION
+msgid "fmMain"
+msgstr ""
+
+#: TFMMAIN.GBCARDAPIO.CAPTION
+msgctxt "TFMMAIN.GBCARDAPIO.CAPTION"
+msgid "Cardápio"
+msgstr ""
+
+#: TFMMAIN.SGCARDAPIO.COLUMNS.TITLE.CAPTION
+msgid "Pratos"
+msgstr ""
+
+#: TFMMEAL.BTADICIONAR.CAPTION
+msgctxt "TFMMEAL.BTADICIONAR.CAPTION"
+msgid "Adicionar"
+msgstr ""
+
+#: TFMMEAL.BTADICIONAREFECHAR.CAPTION
+msgctxt "TFMMEAL.BTADICIONAREFECHAR.CAPTION"
+msgid "Adicionar e Fechar"
+msgstr ""
+
+#: TFMMEAL.BTDOWN.CAPTION
+msgctxt "TFMMEAL.BTDOWN.CAPTION"
+msgid "Abaixo"
+msgstr ""
+
+#: TFMMEAL.BTFECHAR.CAPTION
+msgctxt "TFMMEAL.BTFECHAR.CAPTION"
+msgid "Fechar"
+msgstr ""
+
+#: TFMMEAL.BTLIMPAR.CAPTION
+msgctxt "TFMMEAL.BTLIMPAR.CAPTION"
+msgid "Limpar"
+msgstr ""
+
+#: TFMMEAL.BTPRATO.CAPTION
+msgctxt "TFMMEAL.BTPRATO.CAPTION"
+msgid "Adicionar"
+msgstr ""
+
+#: TFMMEAL.BTREMOVER.CAPTION
+msgctxt "TFMMEAL.BTREMOVER.CAPTION"
+msgid "Remover"
+msgstr ""
+
+#: TFMMEAL.BTUP.CAPTION
+msgctxt "TFMMEAL.BTUP.CAPTION"
+msgid "Acima"
+msgstr ""
+
+#: TFMMEAL.CAPTION
+msgid "fmMeal"
+msgstr ""
+
+#: TFMMEAL.DEDATA.CANCELCAPTION
+msgctxt "TFMMEAL.DEDATA.CANCELCAPTION"
+msgid "Cancelar"
+msgstr ""
+
+#: TFMMEAL.DEDATA.DIALOGTITLE
+msgctxt "TFMMEAL.DEDATA.DIALOGTITLE"
+msgid "Escolha a data"
+msgstr ""
+
+#: TFMMEAL.DEDATA.OKCAPTION
+msgctxt "TFMMEAL.DEDATA.OKCAPTION"
+msgid "OK"
+msgstr ""
+
+#: TFMMEAL.GBREFEICAO.CAPTION
+msgctxt "TFMMEAL.GBREFEICAO.CAPTION"
+msgid "Refeição"
+msgstr ""
+
+#: TFMMEAL.LBLREFEICAO.CAPTION
+msgctxt "TFMMEAL.LBLREFEICAO.CAPTION"
+msgid "Refeição:"
+msgstr ""
+
+#: TFMMEAL.LBPRATO.CAPTION
+msgctxt "TFMMEAL.LBPRATO.CAPTION"
+msgid "Prato:"
+msgstr ""
+
+#: TFMMEAL.LBTIPO.CAPTION
+msgctxt "TFMMEAL.LBTIPO.CAPTION"
+msgid "Tipo:"
+msgstr ""
+
+#: TFMREFEICAO.BTADICIONAR.CAPTION
+msgctxt "TFMREFEICAO.BTADICIONAR.CAPTION"
+msgid "Adicionar"
+msgstr ""
+
+#: TFMREFEICAO.BTADICIONAREFECHAR.CAPTION
+msgctxt "TFMREFEICAO.BTADICIONAREFECHAR.CAPTION"
+msgid "Adicionar e Fechar"
+msgstr ""
+
+#: TFMREFEICAO.BTDOWN.CAPTION
+msgctxt "TFMREFEICAO.BTDOWN.CAPTION"
+msgid "Abaixo"
+msgstr ""
+
+#: TFMREFEICAO.BTFECHAR.CAPTION
+msgctxt "TFMREFEICAO.BTFECHAR.CAPTION"
+msgid "Fechar"
+msgstr ""
+
+#: TFMREFEICAO.BTLIMPAR.CAPTION
+msgctxt "TFMREFEICAO.BTLIMPAR.CAPTION"
+msgid "Limpar"
+msgstr ""
+
+#: TFMREFEICAO.BTPRATO.CAPTION
+msgctxt "TFMREFEICAO.BTPRATO.CAPTION"
+msgid "Adicionar"
+msgstr ""
+
+#: TFMREFEICAO.BTREMOVER.CAPTION
+msgctxt "TFMREFEICAO.BTREMOVER.CAPTION"
+msgid "Remover"
+msgstr ""
+
+#: TFMREFEICAO.BTUP.CAPTION
+msgctxt "TFMREFEICAO.BTUP.CAPTION"
+msgid "Acima"
+msgstr ""
+
+#: TFMREFEICAO.CAPTION
+msgid "fmRefeicao"
+msgstr ""
+
+#: TFMREFEICAO.DEDATA.CANCELCAPTION
+msgctxt "TFMREFEICAO.DEDATA.CANCELCAPTION"
+msgid "Cancelar"
+msgstr ""
+
+#: TFMREFEICAO.DEDATA.DIALOGTITLE
+msgctxt "TFMREFEICAO.DEDATA.DIALOGTITLE"
+msgid "Escolha a data"
+msgstr ""
+
+#: TFMREFEICAO.DEDATA.OKCAPTION
+msgctxt "TFMREFEICAO.DEDATA.OKCAPTION"
+msgid "OK"
+msgstr ""
+
+#: TFMREFEICAO.GBREFEICAO.CAPTION
+msgctxt "TFMREFEICAO.GBREFEICAO.CAPTION"
+msgid "Refeição"
+msgstr ""
+
+#: TFMREFEICAO.LBLREFEICAO.CAPTION
+msgctxt "TFMREFEICAO.LBLREFEICAO.CAPTION"
+msgid "Refeição:"
+msgstr ""
+
+#: TFMREFEICAO.LBPRATO.CAPTION
+msgctxt "TFMREFEICAO.LBPRATO.CAPTION"
+msgid "Prato:"
+msgstr ""
+
+#: TFMREFEICAO.LBTIPO.CAPTION
+msgctxt "TFMREFEICAO.LBTIPO.CAPTION"
+msgid "Tipo:"
+msgstr ""
+
+#: u_consts.serror
+msgid "Error!!!"
+msgstr ""
+
+#: u_consts.stitle
+msgctxt "u_consts.stitle"
+msgid "Gotisso Meal Planner"
+msgstr ""
+
Added: trunk/stringgridprinter.pas
===================================================================
--- trunk/stringgridprinter.pas (rev 0)
+++ trunk/stringgridprinter.pas 2009-11-04 00:33:09 UTC (rev 6)
@@ -0,0 +1,1108 @@
+unit StringGridPrinter;
+{
+This comment block may not be removed or altered.
+No other restrictions are placed on the use of this code.
+TStringGridPrinter unit version 1.2
+Copyright Jonathan Eaton/pr...@on.../August 1999
+
+adapted for FPC/Lazarus by João Marcelo S. Vaz - october/2009
+}
+interface
+
+uses
+ {LCLIntf, LCLType,} Grids, Printers, Graphics, Forms, Classes;
+
+type
+ TPagePosition = (ppNone,ppTopLeft,ppTopMiddle,ppTopRight,ppBottomLeft,
+ ppBottomMiddle,ppBottomRight);
+ TColumnJustification = (cjLeft,cjMiddle,cjRight);
+ THandleExcessText = (hetClip,hetClipAndMark,hetCharWrap,hetWordWrap);
+
+ TColumnFormat = class
+ private
+ //formatting for selected cell (set by SetCellFormatting)
+ CellIsFixed:boolean;
+ CellJustification:TColumnJustification;
+ CellHandleExcessText:THandleExcessText;
+ CellWordDelimChars:string;
+ public
+ //formatting for data cells
+ Justification:TColumnJustification;
+ HandleExcessText:THandleExcessText;
+ WordDelimChars:string;
+ //formatting for cells in fixed rows/columns
+ FixedJustification:TColumnJustification;
+ FixedHandleExcessText:THandleExcessText;
+ FixedWordDelimChars:string;
+ procedure Assign(AColumnFormat:TColumnFormat);
+ constructor Create;
+ procedure SetCellFormatting(AStringGrid:TStringGrid;Col,Row:longInt);
+ end;
+
+ TStringGridPrinter = class
+ private
+ DefaultHandleExcessText,DefaultFixedHandleExcessText:THandleExcessText;
+ DefaultWordDelimChars:string;
+ FStringGrid:TStringGrid;
+ ScreenToPrinterX,ScreenToPrinterY:double;
+ GridCellMarPix:longInt;
+ LeftMarInPix,RightMarInPix,TopMarInPix,BotMarInPix,PrintHeightInPix,
+ PrintWidthInPix,GridTopInPix,GridHeightInPix,TitleTopInPix,
+ TitleLeftInPix,PageNumTopInPix,PageNumLeftInPix:longInt;
+ NonPrintLeftRight,NonPrintTopBottom:longInt;
+ HasHorizontalPages:boolean;
+ VPageCount,HPageCount:longInt;
+ sgPage:TStringGrid;
+ ColumnFormatList:TList;
+ procedure AddGridLines(CellLeft,CellTop:longInt);
+ procedure AdjustColWidths;
+ procedure AdjustRowHeights;
+ function ClipText(StringIn:string;CanvasIn:TCanvas;MaxPix:longInt;
+ Just:TColumnJustification):string;
+ function ColsThisPage(StartingCol:longInt):longInt;
+ function PPIScaleX(PixelsIn:longInt):longInt;
+ function PPIScaleY(PixelsIn:longInt):longInt;
+ procedure PrintPageGrid(CellLeft,CellTop:longInt);
+ function RowsThisPage(StartingRow:longInt):longInt;
+ procedure SetGridCellMarPix;
+ procedure SetMarInPixels;
+ procedure SetScreenToPrinter;
+ procedure SetsgPage(LeftCol,RightCol,TopRow,BottomRow:longInt);
+ procedure SetStringGrid(StringGridIn:TStringGrid);
+ procedure SetTitlePositions;
+ procedure WrapTextToStringList(StringIn:string;CanvasIn:TCanvas;WrappedList:TStringList;
+ MaxPix:longInt;WrapChars:string);
+ public
+ LeftMarInInches:double;
+ RightMarInInches:double;
+ TopMarInInches:double;
+ BotMarInInches:double;
+ PrintGridLines: Boolean;
+ RepeatFixedCols: Boolean;
+ RepeatFixedRows: Boolean;
+ ShadeFixed: Boolean;
+ MarkClipped: Boolean;
+ NoMorePages: Boolean;
+ TitlePosition: TPagePosition;
+ PageNumPosition:TPagePosition;
+ Title:string;
+ PageNumText:string;
+ GridFont:TFont;
+ PageNumFont:TFont;
+ TitleFont:TFont;
+ FixedCellFont:TFont;
+ ShadeFixedColor:TColor;
+ constructor Create;
+ destructor Destroy; override;
+ property AStringGrid:TStringGrid read FStringGrid write SetStringGrid;
+ function GetColumnFormat(Col:longInt):TColumnFormat; overload;
+ function GetColumnFormat(ColName:string):TColumnFormat; overload;
+ procedure Print;
+ procedure SetHandleExcessText(HandleExcessText,FixedHandleExcessText:
+ THandleExcessText;WordDelimChars:string);
+ end;
+
+implementation
+
+uses
+ Dialogs,SysUtils;
+
+//methods of TColumnFormat
+procedure TColumnFormat.Assign(AColumnFormat:TColumnFormat);
+begin
+ Justification := AColumnFormat.Justification;
+ HandleExcessText := AColumnFormat.HandleExcessText;
+ WordDelimChars := AColumnFormat.WordDelimChars;
+ FixedJustification := AColumnFormat.FixedJustification;
+ FixedHandleExcessText := AColumnFormat.FixedHandleExcessText;
+ FixedWordDelimChars := AColumnFormat.FixedWordDelimChars;
+ CellIsFixed := AColumnFormat.CellIsFixed;
+ CellJustification := AColumnFormat.CellJustification;
+ CellHandleExcessText := AColumnFormat.CellHandleExcessText;
+ CellWordDelimChars := AColumnFormat.CellWordDelimChars;
+end;
+
+constructor TColumnFormat.Create;
+begin
+ inherited Create;
+ Justification := cjLeft;
+ HandleExcessText := hetClip;
+ WordDelimChars := ' -/\,;:';
+ FixedJustification := cjLeft;
+ FixedHandleExcessText := hetWordWrap;
+ FixedWordDelimChars := ' -/\,;:';
+ CellIsFixed := false;
+ CellJustification := cjLeft;
+ CellHandleExcessText := hetClip;
+ CellWordDelimChars := '';
+end;
+
+procedure TColumnFormat.SetCellFormatting(AStringGrid:TStringGrid;
+ Col,Row:longInt);
+//set the selected cell members based on whether or not the cell is fixed
+begin
+ if (Col < AStringGrid.FixedCols) or (Row < AStringGrid.FixedRows) then begin
+ CellIsFixed := true;
+ CellJustification := FixedJustification;
+ CellHandleExcessText := FixedHandleExcessText;
+ if (FixedHandleExcessText <> hetWordWrap) then begin
+ CellWordDelimChars := '';
+ end else begin
+ CellWordDelimChars := FixedWordDelimChars;
+ end;
+ end else begin
+ CellIsFixed := false;
+ CellJustification := Justification;
+ CellHandleExcessText := HandleExcessText;
+ if (HandleExcessText <> hetWordWrap) then begin
+ CellWordDelimChars := '';
+ end else begin
+ CellWordDelimChars := WordDelimChars;
+ end;
+ end;
+end;
+
+//methods of TStringGridPrinter
+procedure TStringGridPrinter.AddGridLines(CellLeft,CellTop:longInt);
+//sgPage represents a page full. Draw the grid lines for that page on
+//the printer canvas
+var
+ TotalRowHeight,TotalColWidth,RowAt,RowC,ColAt,ColC:longInt;
+begin
+ Printer.Canvas.Brush.Style := bsClear;
+
+ ColAt := CellLeft;
+ for ColC := 0 to sgPage.ColCount - 1 do begin
+ ColAt := ColAt + PPIScaleX(sgPage.ColWidths[ColC]);
+ end;
+ TotalColWidth := ColAt;
+
+ RowAt := CellTop;
+ for RowC := 0 to sgPage.RowCount - 1 do begin
+ RowAt := RowAt + PPIScaleY(sgPage.RowHeights[RowC]);
+ end;
+ TotalRowHeight := RowAt;
+
+ ColAt := CellLeft;
+ for ColC := 0 to sgPage.ColCount - 1 do begin
+ ColAt := ColAt + PPIScaleX(sgPage.ColWidths[ColC]);
+ Printer.Canvas.MoveTo(ColAt,CellTop);
+ Printer.Canvas.LineTo(ColAt,TotalRowHeight);
+ end;
+
+ RowAt := CellTop;
+ for RowC := 0 to sgPage.RowCount - 1 do
+ begin
+ RowAt := RowAt + PPIScaleY(sgPage.RowHeights[RowC]);
+ Printer.Canvas.MoveTo(CellLeft,RowAt);
+ Printer.Canvas.LineTo(TotalColWidth,RowAt);
+ end;
+
+ Printer.Canvas.Rectangle(CellLeft,CellTop,ColAt,RowAt);
+end;
+
+procedure TStringGridPrinter.AdjustColWidths;
+//This is a little fudging. I don't want a column that has no clipping in the
+//grid to have some clipping in the print-out, so I'm going to find the
+//longest text in the column, and if it's just a little bit wider than the
+//column width, I'm going to make the column width a little bit wider to
+//accomodate it
+var
+ ColC,RowC,MaxTextLength,CellTextLength,ThisDif,MaxDif,AdjDif:longInt;
+ CellText:String;
+begin
+ if (FStringGrid <> nil) then begin
+ AdjDif := PPIScaleX(GridCellMarPix);
+ for ColC := 0 to FStringGrid.ColCount - 1 do begin
+ MaxTextLength := PPIScaleX(FStringGrid.ColWidths[ColC] -
+ (GridCellMarPix * 2));
+ MaxDif := 0;
+ for RowC := 0 to FStringGrid.RowCount - 1 do begin
+ if (ColC < FStringGrid.FixedCols) or (RowC < FStringGrid.FixedRows)
+ then begin
+ Printer.Canvas.Font.Assign(FixedCellFont);
+ end else begin
+ Printer.Canvas.Font.Assign(GridFont);
+ end;
+ CellText := FStringGrid.Cells[ColC,RowC];
+ CellTextLength := Printer.Canvas.TextWidth(CellText);
+ ThisDif := CellTextLength - MaxTextLength;
+ if (ThisDif > MaxDif) then MaxDif := ThisDif;
+ end;
+ if (MaxDif <> 0) and (MaxDif < AdjDif) then begin
+ FStringGrid.ColWidths[ColC] := FStringGrid.ColWidths[ColC] +
+ Round(MaxDif/ScreenToPrinterY) + 1;
+ end;
+ end;
+ end;
+end;
+
+procedure TStringGridPrinter.AdjustRowHeights;
+//Check for columns with word or char wrapping, and adjust the height of the
+//row to accomodate the text
+var
+ CellText:string;
+ WrappedTextList:TStringList;
+ CellTextHeight,MaxPix,ColC,RowC:longInt;
+ ColFormat:TColumnFormat;
+// TextMetrics:TTextMetric;
+begin
+ if (FStringGrid <> nil) then begin
+ WrappedTextList := TStringList.Create;
+ Printer.Canvas.Font.Assign(GridFont);
+// GetTextMetrics(Printer.Canvas.Handle,TextMetrics);
+ try
+ for ColC := 0 to FStringGrid.ColCount - 1 do begin
+ ColFormat := TColumnFormat(ColumnFormatList[ColC]);
+ for RowC := 0 to FStringGrid.RowCount - 1 do begin
+ CellText := FStringGrid.Cells[ColC,RowC];
+ if (CellText <> '') then begin
+ ColFormat.SetCellFormatting(FStringGrid,ColC,RowC);
+ if (ColFormat.CellIsFixed) then begin
+ Printer.Canvas.Font.Assign(FixedCellFont);
+ end else begin
+ Printer.Canvas.Font.Assign(GridFont);
+ end;
+ if (ColFormat.CellHandleExcessText in
+ [hetCharWrap,hetWordWrap]) then begin
+ MaxPix := PPIScaleX(FStringGrid.ColWidths[ColC] -
+ (GridCellMarPix * 2));
+ if (Printer.Canvas.TextWidth(CellText) > MaxPix) then begin
+ WrapTextToStringList(CellText,Printer.Canvas,
+ WrappedTextList,MaxPix,ColFormat.CellWordDelimChars);
+ if (WrappedTextList.Count > 1) then begin
+ //must be sure that the row height will be big
+ //enough, so first I'm going to calculate it as if
+ //for the printer canvas, then convert it back to
+ //the string grid. Funky - but it works
+ CellTextHeight :=
+ (Printer.Canvas.Font.FontData.Height * WrappedTextList.Count) +
+ PPIScaleY(GridCellMarPix * 2);
+ {(TextMetrics.tmHeight * WrappedTextList.Count) +
+ PPIScaleY(GridCellMarPix * 2); }
+ CellTextHeight :=
+ Round(CellTextHeight/ScreenToPrinterY) + 1;
+ if CellTextHeight > FStringGrid.RowHeights[RowC] then
+ begin
+ FStringGrid.RowHeights[RowC] := CellTextHeight;
+ end;
+ end;
+ end;
+ end; //excess text should be wrapped
+ end; //cell has text
+ end; //check every cell in column for wrapping
+ end; //check column for wrapping
+ finally
+ WrappedTextList.Free;
+ end;
+ end;
+end;
+
+function TStringGridPrinter.ClipText(StringIn:string;CanvasIn:TCanvas;
+ MaxPix:longInt;Just:TColumnJustification):string;
+//I tried to let windows do the clipping, but it kept allowing text to cross my
+//grid lines, so finally I decided to do it myself.
+var
+ AveCharWidth,CharStartAt,CharsInString:longInt;
+
+ procedure GetNewString;
+ begin
+ case Just of
+ cjLeft:begin
+ Result := copy(StringIn,1,CharsInString);
+ end;
+ cjMiddle:begin
+ CharStartAt := (Length(StringIn) - CharsInString) div 2;
+ if (CharStartAt < 1) then CharStartAt := 1;
+ Result := copy(StringIn,CharStartAt,CharsInString);
+ end;
+ cjRight:begin
+ Result := copy(StringIn,(Length(StringIn) - CharsInString)+1,
+ CharsInString);
+ end;
+ end;
+ end;
+
+begin
+ Result := StringIn;
+ if (Result) = '' then Exit;
+ AveCharWidth := CanvasIn.TextWidth(Result) div Length(Result);
+ CharsInString := (MaxPix div AveCharWidth);
+ GetNewString;
+
+ while (CanvasIn.TextWidth(Result) < MaxPix) and (Result <> StringIn) do begin
+ inc(CharsInString);
+ GetNewString;
+ end;
+
+ while (CanvasIn.TextWidth(Result) > MaxPix) and (Result <> '') do begin
+ dec(CharsInString);
+ GetNewString;
+ end;
+
+ if (Result = '') then Result := StringIn[1];
+end;
+
+function TStringGridPrinter.ColsThisPage(StartingCol:longInt):longInt;
+//calculate the number of columns that can fit on this page.
+var
+ ColC,TotalColWidth:longInt;
+begin
+ Result := 0;
+ if (FStringGrid <> nil) then begin
+ TotalColWidth := 0;
+
+ if (RepeatFixedCols) and (StartingCol > 0) then begin
+ for ColC := 0 to FStringGrid.FixedCols - 1 do begin
+ TotalColWidth := TotalColWidth +
+ PPIScaleX(FStringGrid.ColWidths[ColC]);
+ end;
+ end;
+
+ for ColC := StartingCol to FStringGrid.ColCount - 1 do
+ begin
+ TotalColWidth := TotalColWidth + PPIScaleX(FStringGrid.ColWidths[ColC]);
+ if (TotalColWidth <= PrintWidthInPix) then inc(Result) else Exit;
+ end;
+ end;
+end;
+
+constructor TStringGridPrinter.Create;
+begin
+ inherited Create;
+ ColumnFormatList := TList.Create;
+ DefaultHandleExcessText := hetClip;
+ DefaultFixedHandleExcessText := hetWordWrap;
+ DefaultWordDelimChars := ' -/\,;:';
+ FStringGrid := nil;
+ sgPage := nil;
+ GridFont := TFont.Create;
+ TitleFont := TFont.Create;
+ FixedCellFont := TFont.Create;
+ PageNumFont := TFont.Create;
+ ShadeFixedColor := $00f0f0f0;
+ ScreenToPrinterX := 1;
+ ScreenToPrinterY := 1;
+ LeftMarInInches := 1;
+ RightMarInInches := 1;
+ TopMarInInches := 1;
+ BotMarInInches := 1;
+ PrintGridLines := true;
+ TitlePosition := ppTopMiddle;
+ PageNumPosition := ppTopRight;
+ PageNumText := 'page ';
+end;
+
+destructor TStringGridPrinter.Destroy;
+var
+ ColC:longInt;
+begin
+ if (sgPage <> nil) then sgPage.Free;
+ GridFont.Free;
+ TitleFont.Free;
+ FixedCellFont.Free;
+ PageNumFont.Free;
+ for ColC := 0 to ColumnFormatList.Count - 1 do
+ begin
+ TColumnFormat(ColumnFormatList[ColC]).Free;
+ end;
+ ColumnFormatList.Free;
+ if (FStringGrid <> nil) then FStringGrid.Free;
+ inherited Destroy;
+end;
+
+function TStringGridPrinter.GetColumnFormat(Col:longInt):TColumnFormat;
+begin
+ Result := nil;
+ if (FStringGrid = nil) then Exit;
+ if (Col < 0) then Exit;
+ if (Col >= ColumnFormatList.Count) then Exit;
+ Result := TColumnFormat(ColumnFormatList[Col]);
+end;
+
+function TStringGridPrinter.GetColumnFormat(ColName:string):TColumnFormat;
+var
+ UColName:string;
+ ColC:longInt;
+begin
+ Result := nil;
+ if (FStringGrid = nil) then Exit;
+ UColName := UpperCase(ColName);
+ for ColC := 0 to ColumnFormatList.Count - 1 do begin
+ if (UColName = UpperCase(FStringGrid.Cells[ColC,0])) then begin
+ Result := TColumnFormat(ColumnFormatList[ColC]);
+ end;
+ end;
+end;
+
+function TStringGridPrinter.PPIScaleX(PixelsIn:longInt):longInt;
+begin
+ Result := Round(ScreenToPrinterX * PixelsIn);
+end;
+
+function TStringGridPrinter.PPIScaleY(PixelsIn:longInt):longInt;
+begin
+ Result := Round(ScreenToPrinterY * PixelsIn);
+end;
+
+procedure TStringGridPrinter.Print;
+var
+ ColS,RowS,StartingRow,StartingCol:longInt;
+ VPagesDone,HPagesDone,FirstPage:boolean;
+begin
+ if (FStringGrid <> nil) then begin
+ StartingCol := 0;
+ try
+ Printer.BeginDoc;
+ SetScreenToPrinter;
+ SetMarInPixels;
+ SetTitlePositions;
+ AdjustColWidths;
+ AdjustRowHeights;
+
+ HPagesDone := false;
+ FirstPage := true;
+
+ HPageCount := 0;
+ repeat
+ inc(HPageCount);
+ ColS := ColsThisPage(StartingCol);
+ if (StartingCol = 0) and (ColS < FStringGrid.ColCount) then begin
+ HasHorizontalPages := true;
+ end;
+ if (ColS > 0) then begin
+ VPagesDone := false;
+ StartingRow := 0;
+ VPageCount := 0;
+ repeat
+ inc(VPageCount);
+ if FirstPage then FirstPage := false else Printer.NewPage;
+ RowS := RowsThisPage(StartingRow);
+ if (RowS > 0) then begin
+ if (sgPage <> nil) then begin
+ sgPage.Free;
+ sgPage := nil;
+ end;
+ SetsgPage(StartingCol,(StartingCol+ColS)-1,
+ StartingRow,(StartingRow+RowS)-1);
+ PrintPageGrid(LeftMarInPix,GridTopInPix);
+ if PrintGridLines then begin
+ AddGridLines(LeftMarInPix,GridTopInPix);
+ end;
+ StartingRow := StartingRow + RowS;
+ if StartingRow >= (FStringGrid.RowCount - 1) then begin
+ VPagesDone := true;
+ end;
+ end else begin
+ VPagesDone := true;
+ end;
+ until (VPagesDone) or (NoMorePages);
+
+ StartingCol := StartingCol + ColS;
+ if StartingCol >= (FStringGrid.ColCount - 1) then begin
+ HPagesDone := true;
+ end;
+ end else begin
+ HPagesDone := true;
+ end;
+ until (HPagesDone) or (NoMorePages);
+ Printer.EndDoc;
+ finally
+ end;
+ end;
+end;
+
+procedure TStringGridPrinter.PrintPageGrid(CellLeft,CellTop:longInt);
+var
+ ColC,RowC,CellTextLength,MaxTextLength,LeftPos,TopPos,LineC,
+ CellRight:longInt;
+ TextOutRect,ClipMarkRect:TRect;
+ CellText,AllPageNumText:string;
+ WrappedTextList:TStringList;
+ ColFormat:TColumnFormat;
+// TextMetrics:TTextMetric;
+ Clipped:boolean;
+begin
+ if (sgPage <> nil) then begin
+ Printer.Canvas.Brush.Style := bsClear;
+ if (Title <> '') and (TitlePosition <> ppNone) then begin
+ Printer.Canvas.Font.Assign(TitleFont);
+ Printer.Canvas.TextOut(TitleLeftInPix,TitleTopInPix,Title);
+ end;
+
+ if (PageNumPosition <> ppNone) then begin
+ if HasHorizontalPages then begin
+ AllPageNumText := PageNumText+' '+IntToStr(VPageCount)+'/'+
+ IntToStr(HPageCount);
+ end else begin
+ AllPageNumText := PageNumText+' '+IntToStr(VPageCount);
+ end;
+
+ Printer.Canvas.Font.Assign(PageNumFont);
+ Printer.Canvas.TextOut(PageNumLeftInPix,PageNumTopInPix,
+ AllPageNumText);
+ end;
+
+// GetTextMetrics(Printer.Canvas.Handle,TextMetrics);
+
+ WrappedTextList := TStringList.Create;
+
+ for ColC := 0 to sgPage.ColCount - 1 do begin
+ ColFormat := TColumnFormat(sgPage.Objects[ColC,0]);
+ CellRight := CellLeft + PPIScaleX(sgPage.ColWidths[ColC]);
+
+ TextOutRect.Left := CellLeft;
+ TextOutRect.Top := CellTop;
+ TextOutRect.Right := CellRight;
+
+ MaxTextLength := PPIScaleX(sgPage.ColWidths[ColC] -
+ (GridCellMarPix * 2));
+
+ for RowC := 0 to sgPage.RowCount - 1 do begin
+ ColFormat.SetCellFormatting(sgPage,ColC,RowC);
+
+ LeftPos := TextOutRect.Left + PPIScaleX(GridCellMarPix);
+ TopPos := TextOutRect.Top + PPIScaleY(GridCellMarPix);
+
+ TextOutRect.Bottom := TextOutRect.Top +
+ PPIScaleY(sgPage.RowHeights[RowC]);
+
+ if (ColC < sgPage.FixedCols) or (RowC < sgPage.FixedRows) then begin
+ Printer.Canvas.Font.Assign(FixedCellFont);
+ if ShadeFixed then begin
+ Printer.Canvas.Brush.Color := ShadeFixedColor;
+ Printer.Canvas.Brush.Style := bsSolid;
+ Printer.Canvas.FillRect(TextOutRect);
+ Printer.Canvas.Brush.Color := clWhite;
+ Printer.Canvas.Brush.Style := bsClear;
+ end;
+ end else begin
+ Printer.Canvas.Font.Assign(GridFont);
+ end;
+
+ CellText := Trim(sgPage.Cells[ColC,RowC]);
+ CellTextLength := Printer.Canvas.TextWidth(CellText);
+
+ case ColFormat.CellHandleExcessText of
+ hetClip:begin
+ if (CellTextLength > MaxTextLength) then begin
+ CellText := Trim(ClipText(CellText,Printer.Canvas,
+ MaxTextLength,ColFormat.CellJustification));
+ CellTextLength := Printer.Canvas.TextWidth(CellText);
+ end;
+
+ case ColFormat.Justification of
+ cjMiddle:LeftPos := TextOutRect.Left +
+ PPIScaleX(GridCellMarPix) +
+ ((MaxTextLength - CellTextLength) div 2);
+ cjRight:LeftPos := TextOutRect.Left +
+ PPIScaleX(GridCellMarPix) +
+ (MaxTextLength - CellTextLength);
+ end;
+
+ Printer.Canvas.TextOut(LeftPos,TopPos,CellText);
+ end;
+ hetClipAndMark:begin
+ Clipped := false;
+ if (CellTextLength > MaxTextLength) then begin
+ Clipped := true;
+ CellText := Trim(ClipText(CellText,Printer.Canvas,
+ MaxTextLength,ColFormat.CellJustification));
+ CellTextLength := Printer.Canvas.TextWidth(CellText);
+ end;
+
+ case ColFormat.Justification of
+ cjMiddle:LeftPos := TextOutRect.Left +
+ PPIScaleX(GridCellMarPix) +
+ ((MaxTextLength - CellTextLength) div 2);
+ cjRight:LeftPos := TextOutRect.Left +
+ PPIScaleX(GridCellMarPix) +
+ (MaxTextLength - CellTextLength);
+ end;
+
+ if Clipped then begin
+ Printer.Canvas.Brush.Color := clSilver;
+ Printer.Canvas.Brush.Style := bsSolid;
+ ClipMarkRect.Top := TextOutRect.Top + PPIScaleX(GridCellMarPix);
+ ClipMarkRect.Bottom := TextOutRect.Bottom - PPIScaleX(GridCellMarPix);
+ case ColFormat.CellJustification of
+ cjLeft:begin
+ ClipMarkRect.Left := LeftPos + CellTextLength;
+ ClipMarkRect.Right := TextOutRect.Right;
+ Printer.Canvas.FillRect(ClipMarkRect);
+ end;
+ cjMiddle:begin
+ ClipMarkRect.Left := TextOutRect.Left;
+ ClipMarkRect.Right := LeftPos;
+ Printer.Canvas.FillRect(ClipMarkRect);
+ ClipMarkRect.Left := LeftPos + CellTextLength;
+ ClipMarkRect.Right := TextOutRect.Right;
+ Printer.Canvas.FillRect(ClipMarkRect);
+ end;
+ cjRight:begin
+ ClipMarkRect.Left := TextOutRect.Left;
+ ClipMarkRect.Right := LeftPos;
+ Printer.Canvas.FillRect(ClipMarkRect);
+ end;
+ end;
+ Printer.Canvas.Brush.Color := clWhite;
+ Printer.Canvas.Brush.Style := bsClear;
+ end;
+
+ Printer.Canvas.TextOut(LeftPos,TopPos,CellText);
+ end;
+ hetCharWrap,hetWordWrap:begin
+ if (CellTextLength > MaxTextLength) then begin
+ WrapTextToStringList(CellText,Printer.Canvas,
+ WrappedTextList,MaxTextLength,
+ ColFormat.CellWordDelimChars);
+ for LineC := 0 to WrappedTextList.Count - 1 do begin
+ CellText := WrappedTextList[LineC];
+ CellTextLength := Printer.Canvas.TextWidth(CellText);
+ case ColFormat.Justification of
+ cjMiddle:LeftPos := TextOutRect.Left +
+ PPIScaleX(GridCellMarPix) +
+ ((MaxTextLength - CellTextLength) div 2);
+ cjRight:LeftPos := TextOutRect.Left +
+ PPIScaleX(GridCellMarPix) +
+ (MaxTextLength - CellTextLength);
+ end;
+
+ Printer.Canvas.TextOut(LeftPos,TopPos,CellText);
+
+ {TopPos := TopPos + TextMetrics.tmHeight;}
+ TopPos := TopPos + Printer.Canvas.Font.FontData.Height
+ end;
+ end else begin
+ case ColFormat.Justification of
+ cjMiddle:LeftPos := TextOutRect.Left +
+ PPIScaleX(GridCellMarPix) +
+ ((MaxTextLength - CellTextLength) div 2);
+ cjRight:LeftPos := TextOutRect.Left +
+ PPIScaleX(GridCellMarPix) +
+ (MaxTextLength - CellTextLength);
+ end;
+
+ Printer.Canvas.TextOut(LeftPos,TopPos,CellText);
+ end;
+ end;
+ end;
+ TextOutRect.Top := TextOutRect.Bottom;
+ end;
+ CellLeft := CellRight;
+ end;
+ WrappedTextList.Free;
+ end;
+end;
+
+function TStringGridPrinter.RowsThisPage(StartingRow:longInt):longInt;
+var
+ RowC,TotalRowHeight:longInt;
+begin
+ Result := 0;
+ if (FStringGrid <> nil) then begin
+ TotalRowHeight := 0;
+ if (RepeatFixedRows) and (StartingRow > 0) then begin
+ for RowC := 0 to FStringGrid.FixedRows - 1 do begin
+ TotalRowHeight := TotalRowHeight +
+ PPIScaleY(FStringGrid.RowHeights[RowC]);
+ end;
+ end;
+
+ for RowC := StartingRow to FStringGrid.RowCount - 1 do
+ begin
+ TotalRowHeight := TotalRowHeight + PPIScaleY(FStringGrid.RowHeights[RowC]);
+ if (TotalRowHeight <= GridHeightInPix) then inc(Result) else Exit;
+ end;
+ end;
+end;
+
+procedure TStringGridPrinter.SetGridCellMarPix;
+begin
+ if (FStringGrid <> nil) then begin
+ FStringGrid.Canvas.Font.Assign(GridFont);
+ GridCellMarPix := FStringGrid.Canvas.TextWidth('x') div 2;
+ if (GridCellMarPix < 1) then GridCellMarPix := 1;
+ end;
+end;
+
+procedure TStringGridPrinter.SetHandleExcessText(HandleExcessText,
+ FixedHandleExcessText:THandleExcessText;WordDelimChars:string);
+var
+ ColC:longInt;
+ ColumnFormat:TColumnFormat;
+begin
+ DefaultHandleExcessText := HandleExcessText;
+ DefaultFixedHandleExcessText := FixedHandleExcessText;
+ DefaultWordDelimChars := WordDelimChars;
+ for ColC := 0 to ColumnFormatList.Count - 1 do begin
+ ColumnFormat := TColumnFormat(ColumnFormatList[ColC]);
+ ColumnFormat.HandleExcessText := HandleExcessText;
+ ColumnFormat.FixedHandleExcessText := FixedHandleExcessText;
+ ColumnFormat.WordDelimChars := WordDelimChars;
+ end;
+end;
+
+procedure TStringGridPrinter.SetMarInPixels;
+begin
+
+{
+
+ PHYSICALWIDTH := Printer.PaperSize.PaperRect.PhysicalRect.Right-PhysicalRect.Left; // GetDeviceCaps(Handle, PHYSICALWIDTH);
+ PHYSICALHEIGHT := Printer.PaperSize.PaperRect.PhysicalRect.Bottom-PhysicalRect.Top; // GetDeviceCaps(Handle, PHYSICALHEIGHT);
+ PHYSICALOFFSETX := Printer.PaperSize.PaperRect.WorkRect.Left; //GetDeviceCaps(Handle, PHYSICALOFFSETX);
+ PHYSICALOFFSETX := Printer.PaperSize.PaperRect.WorkRect.Top; //GetDeviceCaps(Handle, PHYSICALOFFSETX);
+ PageWidth := Printer.PaperSize.PaperRect.WorkRect.Right-WorkRect.Left; // this is the same as PageWidth
+ PageHeight := Printer.PaperSize.PaperRect.WorkRect.Bottom-WorkRect.Top; // this is the same as PageHeight
+
+}
+
+
+ NonPrintLeftRight := Printer.PaperSize.PaperRect.WorkRect.Left;;
+ NonPrintTopBottom := Printer.PaperSize.PaperRect.WorkRect.Top ;
+
+ LeftMarInPix := Round(Printer.XDPI * LeftMarInInches) - NonPrintLeftRight;
+ RightMarInPix := Round(Printer.XDPI * RightMarInInches) - NonPrintLeftRight;
+ TopMarInPix := Round(Printer.YDPI * TopMarInInches) - NonPrintTopBottom;
+ BotMarInPix := Round(Printer.YDPI * BotMarInInches) - NonPrintTopBottom;
+ PrintWidthInPix := Printer.PageWidth - (LeftMarInPix + RightMarInPix);
+ PrintHeightInPix := Printer.PageHeight - (TopMarInPix + BotMarInPix);
+
+ if (LeftMarInPix < 0) then LeftMarInPix := 0;
+ if (RightMarInPix < 0) then RightMarInPix := 0;
+ if (TopMarInPix < 0) then TopMarInPix := 0;
+ if (BotMarInPix < 0) then BotMarInPix := 0;
+
+ GridTopInPix := TopMarInPix;
+ GridHeightInPix := PrintHeightInPix;
+end;
+
+procedure TStringGridPrinter.SetScreenToPrinter;
+begin
+ ScreenToPrinterX := 1;
+ ScreenToPrinterY := 1;
+
+ if Printer.XDPI = 0 then Exit;
+ if Printer.YDPI = 0 then Exit;
+ if ScreenInfo.PixelsPerInchX = 0 then Exit;
+ if ScreenInfo.PixelsPerInchY = 0 then Exit;
+
+ ScreenToPrinterX := Printer.XDPI/ScreenInfo.PixelsPerInchX;
+ ScreenToPrinterY := Printer.YDPI/ScreenInfo.PixelsPerInchY;
+end;
+
+procedure TStringGridPrinter.SetsgPage(LeftCol,RightCol,TopRow,
+ BottomRow:longInt);
+//Create a StringGrid which represents what will fit on one page based on
+//margins, column widths, paper size, etc... Also, if fixed rows, cols are to
+//be repeated on each new page, these need to be added to the sgPage StringGrid.
+var
+ ColS,RowS,ColC,RowC,FixedColShift,FixedRowShift:longInt;
+begin
+ if (FStringGrid <> nil) then begin
+ ColS := (RightCol - LeftCol) + 1;
+ RowS := (BottomRow - TopRow) + 1;
+ FixedColShift := 0;
+ FixedRowShift := 0;
+
+ if (sgPage = nil) then begin
+ sgPage := TStringGrid.Create(FStringGrid.Parent);
+ sgPage.Font.Assign(FStringGrid.Font);
+ end;
+
+ sgPage.FixedCols := 0;
+ sgPage.FixedRows := 0;
+ if (LeftCol = 0) or (RepeatFixedCols) then begin
+ sgPage.FixedCols := FStringGrid.FixedCols;
+ end;
+ if (TopRow = 0) or (RepeatFixedRows) then begin
+ sgPage.FixedRows := FStringGrid.FixedRows;
+ end;
+
+ if ((RepeatFixedCols) and (FStringGrid.FixedCols > 0) and (LeftCol > 0))
+ then begin
+ FixedColShift := FStringGrid.FixedCols;
+ end;
+
+ if ((RepeatFixedRows) and (FStringGrid.FixedRows > 0) and (TopRow > 0))
+ then begin
+ FixedRowShift := FStringGrid.FixedRows;
+ end;
+
+ if (FixedColShift > 0) then begin
+ sgPage.ColCount := Cols + FStringGrid.FixedCols;
+ FixedColShift := FStringGrid.FixedCols;
+ for ColC := 0 to FixedColShift - 1 do begin
+ sgPage.ColWidths[ColC] := FStringGrid.ColWidths[ColC];
+ sgPage.Objects[ColC,0] := GetColumnFormat(ColC);
+ for RowC := TopRow to BottomRow do begin
+ sgPage.Cells[ColC,(RowC-TopRow)+FixedRowShift]
+ := FStringGrid.Cells[ColC,RowC];
+ end;
+ end;
+ end else begin
+ sgPage.ColCount := ColS;
+ end;
+
+ if (FixedRowShift > 0) then begin
+ sgPage.RowCount := RowS + FStringGrid.FixedRows;
+ FixedRowShift := FStringGrid.FixedRows;
+ for RowC := 0 to FStringGrid.FixedRows - 1 do begin
+ sgPage.RowHeights[RowC] := FStringGrid.RowHeights[RowC];
+ for ColC := LeftCol to RightCol do begin
+ sgPage.Cells[(ColC-LeftCol)+FixedColShift,RowC]
+ := FStringGrid.Cells[ColC,RowC];
+ end;
+ end;
+ end else begin
+ sgPage.RowCount := RowS;
+ end;
+
+ if ((FixedColShift > 0) and (FixedRowShift > 0)) then
+ begin
+ for ColC := 0 to FixedColShift - 1 do begin
+ for RowC := 0 to FixedRowShift - 1 do begin
+ sgPage.Cells[ColC,RowC] := FStringGrid.Cells[ColC,RowC];
+ end;
+ end;
+ end;
+
+ for ColC := LeftCol to RightCol do begin
+ sgPage.ColWidths[(ColC-LeftCol)+FixedColShift] :=
+ FStringGrid.ColWidths[ColC];
+ end;
+
+ for RowC := TopRow to BottomRow do begin
+ sgPage.RowHeights[(RowC-TopRow)+FixedRowShift] :=
+ FStringGrid.RowHeights[RowC];
+ end;
+
+ for ColC := LeftCol to RightCol do begin
+ sgPage.Objects[(ColC-LeftCol)+FixedColShift,0] := GetColumnFormat(ColC);
+ for RowC := TopRow to BottomRow do begin
+ sgPage.Cells[(ColC-LeftCol)+FixedColShift,
+ (RowC-TopRow)+FixedRowShift] := FStringGrid.Cells[ColC,RowC...
[truncated message content] |