home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Report Writers / Crystal Repot 9.0 Full CD version / Setup.exe / Tools / Developers / PEDELF32.ZIP / pedelf32 / FORMULA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-30  |  10.8 KB  |  333 lines
  1. unit Formula;
  2.  
  3. interface
  4.  
  5. uses       
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Buttons;
  8.  
  9. type
  10.   TFrmFormulas = class(TForm)
  11.     PnlSelection: TPanel;
  12.     BtnGetSelect: TButton;
  13.     BtnCheckSelect: TButton;
  14.     BtnSetSelect: TButton;
  15.     BtnOKSelect: TBitBtn;
  16.     Bevel1: TBevel;
  17.     MemSelect: TMemo;
  18.     PnlGroup: TPanel;
  19.     Bevel2: TBevel;
  20.     MemGroup: TMemo;
  21.     BtnSetGroup: TButton;
  22.     BtnOKGroup: TBitBtn;
  23.     BtnCheckGroup: TButton;
  24.     BtnGetGroup: TButton;
  25.     PnlFormula: TPanel;
  26.     Bevel3: TBevel;
  27.     BtnGetFomula: TButton;
  28.     BtnCheckFormula: TButton;
  29.     BtnSetFormula: TButton;
  30.     BtnOKFormula: TBitBtn;
  31.     MemFormula: TMemo;
  32.     Bevel4: TBevel;
  33.     Label1: TLabel;
  34.     CmbFormulaNum: TComboBox;
  35.     Label2: TLabel;
  36.     Label3: TLabel;
  37.     CmbFormulaName: TComboBox;
  38.     function GetError(Const JobIn : Integer) : String;
  39.     procedure BtnGetSelectClick(Sender: TObject);
  40.     procedure BtnSetSelectClick(Sender: TObject);
  41.     procedure BtnOKSelectClick(Sender: TObject);
  42.     procedure BtnCheckSelectClick(Sender: TObject);
  43.     procedure FormShow(Sender: TObject);
  44.     procedure FormHide(Sender: TObject);
  45.     procedure CmbFormulaNumChange(Sender: TObject);
  46.     procedure BtnGetFormulaClick(Sender: TObject);
  47.     procedure BtnCheckFormulaClick(Sender: TObject);
  48.     procedure BtnOKFormulaClick(Sender: TObject);
  49.     procedure BtnSetFormulaClick(Sender: TObject);
  50.     procedure BtnGetGroupClick(Sender: TObject);
  51.     procedure BtnSetGroupClick(Sender: TObject);
  52.     procedure BtnCheckGroupClick(Sender: TObject);
  53.     procedure BtnOKGroupClick(Sender: TObject);
  54.  
  55.   private
  56.     { Private declarations }
  57.   public
  58.     { Public declarations }
  59.   end;
  60.  
  61. var
  62.   FrmFormulas: TFrmFormulas;
  63.  
  64. implementation
  65.  
  66. uses
  67.    Main, CRDelphi;
  68.  
  69. var
  70.    NameHandle, TextHandle : hWnd;
  71.    NameLength, TextLength : SmallInt;
  72.    TextBuffer, NameBuffer : PChar;
  73.  
  74. {$R *.DFM}
  75.  
  76. function TFrmFormulas.GetError(Const JobIn : Integer) : String;
  77. {This is my print engine error message capture function. It accepts
  78.  the job number as it parameter and then gets the error code and
  79.  message text and then passes this back out as a formatted string}
  80. var
  81.   Code : Integer;
  82.   StrHandle : hWnd;
  83.   Buffer : PChar;
  84.   Length : SmallInt;
  85.   Ret : Bool;
  86.  
  87. begin
  88.    Code := PEGetErrorCode(JobIn); {Get the Error code from the Crpe}
  89.    Ret := PEGetErrorText(JobIn, StrHandle, Length);  {Get the error message handle}
  90.  
  91.    Buffer := StrAlloc(Length);
  92.    {get the text from the text handle}
  93.    Ret := PEGetHandleString(StrHandle, Buffer, Length);
  94.  
  95.    GetError := IntToStr(Code) + ' - ' + StrPas(Buffer); {output the string}
  96.    StrDispose(Buffer);
  97. end;
  98.  
  99.  
  100. procedure TFrmFormulas.BtnGetSelectClick(Sender: TObject);
  101.  
  102. begin
  103.    {get the selection formula from the report}
  104.    if PEGetSelectionFormula(JobNumber, TextHandle, TextLength) then
  105.       begin
  106.          TextBuffer := StrAlloc(TextLength);
  107.          {get the text of the formula and display it on the form}
  108.          if PEGetHandleString(TextHandle, TextBuffer, TextLength) then
  109.             MemSelect.Text := StrPas(TextBuffer)
  110.          else
  111.             ShowMessage(GetError(JobNumber));   {show any errors}
  112.          StrDispose(TextBuffer);
  113.          BtnSetSelect.Enabled := True;
  114.       end
  115.    else
  116.       ShowMessage(GetError(JobNumber));    {show any errors}
  117. end;
  118.  
  119. procedure TFrmFormulas.BtnSetSelectClick(Sender: TObject);
  120. var
  121.  
  122.    Size : Integer;
  123.  
  124. begin
  125.    Size := MemSelect.GetTextLen;       {Get length of string in MemSelect.Text}
  126.    Inc(Size);                      {Add room for null character}
  127.    TextBuffer := StrAlloc(Size);
  128.    MemSelect.GetTextBuf(TextBuffer,Size);  {Puts MemSelect.Text into Buffer}
  129.  
  130.    {Set the selection formula}
  131.    If PESetSelectionFormula(JobNumber, TextBuffer)= False then
  132.       ShowMessage(GetError(JobNumber))
  133.    else
  134.       BtnCheckSelect.Enabled := True;
  135.    StrDispose(TextBuffer);
  136. end;
  137.  
  138. procedure TFrmFormulas.BtnOKSelectClick(Sender: TObject);
  139. begin
  140.    {clear all information on closing the form}
  141.    MemSelect.Clear;
  142.    BtnCheckSelect.Enabled := False;
  143.    BtnSetSelect.Enabled := False;
  144. end;
  145.  
  146. procedure TFrmFormulas.BtnCheckSelectClick(Sender: TObject);
  147. begin
  148.    {Check the Selection formula for errors}
  149.    if PECheckSelectionFormula(JobNumber) then
  150.       ShowMessage('The Syntax of the Selection Formula is correct')
  151.    else
  152.       ShowMessage(GetError(JobNumber));  {show error messages}
  153. end;
  154.  
  155. procedure TFrmFormulas.FormShow(Sender: TObject);
  156. var
  157.    Iterator, Formulas : Integer;
  158.  
  159. begin
  160.     case FormulaSender of
  161.       1: PnlSelection.Visible := True;  {Selection formula menu was chosen}
  162.       2: PnlGroup.Visible := True;      {GroupSelection formula menu was chosen}
  163.       3: begin                          {Formulas menu option was chosen}
  164.             PnlFormula.Visible := True;
  165.             {Get the number of formulas in the report}
  166.             Formulas := PEGetNFormulas(JobNumber);
  167.             if Formulas = 0 then
  168.                ShowMessage('There are no formulas in the Report')
  169.             else
  170.                begin
  171.                   for Iterator := 0 to Formulas - 1 do  {for each formula in the report}
  172.                      begin
  173.                         {get the information about each formula}
  174.                         if PEGetNthFormula(JobNumber, Iterator, Namehandle, NameLength, TextHandle, TextLength) then
  175.                            begin
  176.                               TextBuffer := StrAlloc(NameLength);
  177.                               CmbFormulaNum.Items.Add(IntToStr(Iterator)); {add the formula number to the combo box}
  178.                               {get the name of the formula}
  179.                               if PEGetHandleString(NameHandle, Textbuffer, NameLength) then
  180.                                  CmbFormulaName.Items.Add(StrPas(TextBuffer)) {add the name of the formula to the box}
  181.                               else
  182.                                  ShowMessage(GetError(JobNumber));  {show error messages}
  183.                               StrDispose(NameBuffer);
  184.                            end
  185.                         else
  186.                            ShowMessage(GetError(JobNumber));  {show error messages}
  187.                      end;
  188.                   CmbFormulaNum.ItemIndex := 0;
  189.                   CmbFormulaName.ItemIndex := 0;
  190.                end;
  191.             end;
  192.     end;
  193. end;
  194.  
  195. procedure TFrmFormulas.FormHide(Sender: TObject);
  196. begin
  197.     {clean up when closing the form}
  198.     case FormulaSender of
  199.       1: PnlSelection.Visible := False;
  200.       2: PnlGroup.Visible := False;
  201.       3: PnlFormula.Visible := False;
  202.     end;
  203. end;
  204.  
  205. procedure TFrmFormulas.CmbFormulaNumChange(Sender: TObject);
  206. begin
  207.    {set the name combo box to display the chosen formula}
  208.    CmbFormulaName.ItemIndex := CmbFormulaNum.ItemIndex;
  209.    MemFormula.Clear;  {clear away the text from the previous formula}
  210.    BtnCheckFormula.Enabled := False;
  211.    BtnSetFormula.Enabled := False;
  212. end;
  213.  
  214. procedure TFrmFormulas.BtnGetFormulaClick(Sender: TObject);
  215. var
  216.    Size : Integer;
  217.  
  218. begin
  219.    Size := CmbFormulaName.GetTextLen + 1;  {get the size of the formula name}
  220.    NameBuffer := StrAlloc(Size);          {increment it for space for the null}
  221.    {get the name of the formula and put it in a memory buffer}
  222.    CmbFormulaName.GetTextBuf(NameBuffer,Size); 
  223.  
  224.    {get the handle for the formula text from the report}
  225.    if PEGetFormula(JobNumber, NameBuffer, TextHandle, TextLength) then
  226.      begin
  227.         Textbuffer := Stralloc(TextLength);
  228.         {get the formula text from memory}
  229.         if PEGetHandleString(TextHandle, Textbuffer, TextLength) then
  230.            MemFormula.Text := StrPas(TextBuffer)  {put the formula text on the form}
  231.         else
  232.            ShowMessage(GetError(JobNumber));  {show error messages}
  233.      end
  234.    else
  235.       ShowMessage(GetError(JobNumber));  {show error messages}
  236.  
  237.    StrDispose(TextBuffer);
  238.    BtnSetFormula.Enabled := True;
  239.  
  240. end;
  241.  
  242. procedure TFrmFormulas.BtnCheckFormulaClick(Sender: TObject);
  243. begin
  244.    {check if the syntax for the formula is correct}
  245.    if PECheckFormula(JobNumber, Namebuffer) then
  246.       ShowMessage('The syntax for ' + StrPas(NameBuffer) + ' is Correct')
  247.    else
  248.       ShowMessage(GetError(JobNumber));  {show error messages}
  249.    StrDispose(NameBuffer);
  250. end;
  251.  
  252. procedure TFrmFormulas.BtnOKFormulaClick(Sender: TObject);
  253. begin
  254.     MemFormula.Clear;
  255.     CmbFormulaName.Clear;
  256.     CmbFormulaNum.Clear;
  257.     BtnSetFormula.Enabled := False;
  258.     BtnCheckFormula.Enabled := False;
  259. end;
  260.  
  261. procedure TFrmFormulas.BtnSetFormulaClick(Sender: TObject);
  262. var
  263.    Size : Integer;
  264.  
  265. begin
  266.    Size := MemFormula.GetTextLen + 1;  {get the size of the formula}
  267.  
  268.    TextBuffer := StrAlloc(Size);
  269.    MemFormula.GetTextBuf(TextBuffer,Size);  {get the text and place it in memory}
  270.  
  271.    if PESetFormula(JobNumber, NameBuffer, TextBuffer) = False then
  272.       ShowMessage(GetError(JobNumber))  {show error messages}
  273.    else
  274.       BtnCheckFormula.Enabled := True;
  275.    StrDispose(TextBuffer);
  276. end;
  277.  
  278. procedure TFrmFormulas.BtnGetGroupClick(Sender: TObject);
  279. begin
  280.    {get the Group selection formula from the report}
  281.    if PEGetGroupSelectionFormula(JobNumber, TextHandle, TextLength) then
  282.       begin
  283.          TextBuffer := StrAlloc(TextLength);
  284.          {get the text of the formula and display it on the form}
  285.          if PEGetHandleString(TextHandle, TextBuffer, TextLength) then
  286.             {place the group selection formula on the form}
  287.             MemGroup.Text := StrPas(TextBuffer)
  288.          else
  289.             ShowMessage(GetError(JobNumber));   {show any errors}
  290.          BtnSetGroup.Enabled := True;
  291.       end
  292.    else
  293.       ShowMessage(GetError(JobNumber));    {show any errors}
  294.    StrDispose(TextBuffer);
  295. end;
  296.  
  297. procedure TFrmFormulas.BtnSetGroupClick(Sender: TObject);
  298. var
  299.    Size : Integer;
  300.  
  301. begin
  302.    Size := MemGroup.GetTextLen;       {Get length of string in MemSelect.Text}
  303.    Inc(Size);                      {Add room for null character}
  304.    TextBuffer := StrAlloc(Size);
  305.    MemGroup.GetTextBuf(TextBuffer,Size);  {Puts MemSelect.Text into Buffer}
  306.  
  307.    {Set the group selection formula}
  308.    If PESetGroupSelectionFormula(JobNumber, TextBuffer)= False then
  309.       ShowMessage(GetError(JobNumber))  {show any errors}
  310.    else
  311.       BtnCheckGroup.Enabled := True;
  312.  
  313.    StrDispose(TextBuffer);
  314. end;
  315.  
  316. procedure TFrmFormulas.BtnCheckGroupClick(Sender: TObject);
  317. begin
  318.    {Check the syntax of the group selection formula}
  319.    if PECheckGroupSelectionFormula(JobNumber) then
  320.       ShowMessage('The Syntax of the Group Selection Formula is correct')
  321.    else
  322.       ShowMessage(GetError(JobNumber));  {show error messages}
  323. end;
  324.  
  325. procedure TFrmFormulas.BtnOKGroupClick(Sender: TObject);
  326. begin
  327.    MemGroup.Clear;
  328.    BtnCheckGroup.Enabled := False;
  329.    BtnSetGroup.Enabled := False;
  330. end;
  331.  
  332. end.
  333.