📄 unit1.pas

📁 Delphi 7组件与分布式应用开发源码,介绍了基础的组件应用实例
💻 PAS
字号:
unit Unit1;

interface

uses
  SysUtils, Classes, HTTPApp, DBWeb, DBBdeWeb, DB, DBTables, HTTPProd;

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

var
  WebModule1: TWebModule1;

implementation

{$R *.dfm}

function ReplaceChar(const s: string; ch1: char; ch2: char): string;
var
  i: integer;
begin
  Result := s;
  for i := 1 to Length (Result) do
    if Result [i] = ch1 then Result [i] := ch2;
end;

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  HtmlStr: TStringList;
begin
  Query1.Close;
  Query1.SQL.Clear;
  Query1.SQL.Add('select distinct continent from country');
  Query1.Open;

  HtmlStr := TStringList.Create;
  HtmlStr.Add('<html>');
  HtmlStr.Add('<body>');
  HtmlStr.Add('<h3>这是使用TQueryTableProducer构件的例子</h3>');
  //
  HtmlStr.Add('<p>查询所有的国家</p>');
  HtmlStr.Add('<p><a href="/scripts/MyWebApp8.exe/SQLResult?all=">查询</a></p>');
  //
  HtmlStr.Add('<p>按所在大洲查询</p>');
  while not Query1.Eof do
  begin
    HtmlStr.Add('<p><a href="/scripts/MyWebApp8.exe/SQLResult?continent=' +
                ReplaceChar(Query1.Fields[0].asString, ' ', '+') + '">' +
                Query1.Fields[0].asString + '</a></p>');
    Query1.Next;
  end;
  Query1.Close;
  //
  HtmlStr.Add('<p>查询人口大于一千万的国家</p>');
  HtmlStr.Add('<p><a href="/scripts/MyWebApp8.exe/SQLResult?population=">查询</a></p>');
  //
  HtmlStr.Add('</body>');
  HtmlStr.Add('</html>');
  Response.Content := HtmlStr.Text;
  Handled := True;
end;

procedure TWebModule1.WebModule1WebActionItem2Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  s: String;
begin
  Query2.Close;
  Query2.SQL.Clear;
  if Request.QueryFields.IndexOfName('all') <> -1 then
  begin
    QueryTableProducer1.Header.Add('<p>查询所有的国家</p>');
    Query2.SQL.Add('select * from country');
  end
  else if Request.QueryFields.IndexOfName('continent') <> -1 then
  begin
    QueryTableProducer1.Header.Add('<p>按所在大洲查询</p>');
    Query2.SQL.Add('select * from country where continent=:continent');
    s := Request.QueryFields.Values['continent'];
    Query2.ParamByName('continent').Value := ReplaceChar(s, '+', ' ');
  end
  else if Request.QueryFields.IndexOfName('population') <> -1 then
  begin
    QueryTableProducer1.Header.Add('<p>查询人口大于一千万的国家</p>');
    Query2.SQL.Add('select * from country where population>10000000');
  end;
  Query2.Open;
  QueryTableProducer1.Footer.Add('<p>谢谢使用</p>');
  Response.Content := QueryTableProducer1.Content;
  Handled := True;
end;

procedure TWebModule1.QueryTableProducer1FormatCell(Sender: TObject;
  CellRow, CellColumn: Integer; var BgColor: THTMLBgColor;
  var Align: THTMLAlign; var VAlign: THTMLVAlign; var CustomAttrs,
  CellData: String);
begin
  if CellRow = 0 then Exit;
  if CellColumn = 4 then
  begin
    if StrToInt(CellData) > 10000000 then BgColor := 'Olive';
  end;
end;

end.
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -