main.pas

来自「《Delphi开发人员指南》配书原码」· PAS 代码 · 共 83 行

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, DBTables, DBWeb, Db;

type
  TWebModule1 = class(TWebModule)
    Session1: TSession;
    Query1: TQuery;
    QueryTableProducer1: TQueryTableProducer;
    procedure QueryTableProducer1GetTableCaption(Sender: TObject;
      var Caption: String; var Alignment: THTMLCaptionAlignment);
    procedure QueryTableProducer1FormatCell(Sender: TObject; CellRow,
      CellColumn: Integer; var BgColor: THTMLBgColor;
      var Align: THTMLAlign; var VAlign: THTMLVAlign; var CustomAttrs,
      CellData: String);
    procedure WebModule1WebActionItem1Action(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure QueryTableProducer1CreateContent(Sender: TObject;
      var Continue: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;  

implementation

{$R *.DFM}

procedure TWebModule1.QueryTableProducer1GetTableCaption(Sender: TObject;
  var Caption: String; var Alignment: THTMLCaptionAlignment);
begin
  Caption := '<B><FONT SIZE="+2" COLOR="RED">Delinquent Accounts</FONT></B>';
  Alignment := caTop;
end;

procedure TWebModule1.QueryTableProducer1FormatCell(Sender: TObject;
  CellRow, CellColumn: Integer; var BgColor: THTMLBgColor;
  var Align: THTMLAlign; var VAlign: THTMLVAlign; var CustomAttrs,
  CellData: String);
var
  Owed, Paid, Total: Currency;
begin
     if CellRow = 0 then Exit; // Don't process the header row
     if CellColumn = 3 then //if the column is the Amount Owed Column
     begin
         //Calculate the amount that the company owes
         Paid := Query1.FieldByName('AmountPaid').AsCurrency;
         Total := Query1.FieldByName('ItemsTotal').AsCurrency;
         Owed := Total - Paid;
         //Set CellData to amount owed
         CellData := FormatFloat('$0.00', Owed);
         //if it is greater than zero, then highlight the cell.
         if Owed > 0 then
         begin
            BgColor := 'RED';
         end;
         Query1.Next; //Advance the query since we came to the end of a row
     end;
end;

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
     Response.Content := QueryTableProducer1.Content;
end;

procedure TWebModule1.QueryTableProducer1CreateContent(Sender: TObject;
  var Continue: Boolean);
begin
    QueryTableProducer1.MaxRows := Query1.RecordCount;
    Query1.First;
    Continue := True;
end;

end.