u_dbgriddivpage.~pas

Ado和access结合,分页显示数据信息,体现cs结构的分页分格.

unit U_DbGridDivPage;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, DB, ADODB, ShellAPI, DBGrids, Grids;

Type
  TOb = ^TRec;
  TRec = Record
    ID:Integer;
    Name:String[100];
    Age:Integer;
  end;

type
  TF_SgDivPage = class(TForm)
    Panel14: TPanel;
    Panel16: TPanel;
    sbFirst: TSpeedButton;
    sbprior: TSpeedButton;
    sbNext: TSpeedButton;
    sbLast: TSpeedButton;
    sbAll: TSpeedButton;
    Panel1: TPanel;
    ADOQry: TADOQuery;
    ADOCnt: TADOConnection;
    Label9: TLabel;
    lblHomePage: TLabel;
    Label11: TLabel;
    lblEmail: TLabel;
    Label12: TLabel;
    Label10: TLabel;
    Label8: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    DBGrid: TDBGrid;
    DS: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure sbFirstClick(Sender: TObject);
    procedure sbpriorClick(Sender: TObject);
    procedure sbNextClick(Sender: TObject);
    procedure sbLastClick(Sender: TObject);
    procedure sbAllClick(Sender: TObject);
    procedure lblHomePageClick(Sender: TObject);
  private

    PageSize,FirstID,LastID:Integer;
    FList:TList;

    Procedure ImpDataAsc;//升序
    Procedure ImpDataDesc;//降序

    Procedure ShowToStringGrid;

    function IsValidChar(Key: Char): Boolean;

    Function GetListMaxID:Integer;
    Function GetListMinID:Integer;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  F_SgDivPage: TF_SgDivPage;
  
  Function comp(Item1, Item2: Pointer): Integer; //回调函数排序用

implementation

{$R *.dfm}

{ TForm1 }

function TF_SgDivPage.IsValidChar(Key: Char): Boolean;
begin
  {$IFNDEF TMSDOTNET}
  Result := (Key in [{DecimalSeparator,}'0'..'9']) or
    ((Key < #32) and (Key <> Chr(VK_RETURN)));
  {$ENDIF}

  {$IFDEF TMSDOTNET}
  Result :={ (Key = DecimalSeparator) or }(Key in ['0'..'9']) or
    ((Key < #32) and (Key <> Chr(VK_RETURN)));
  {$ENDIF}
end;

procedure TF_SgDivPage.ImpDataAsc;
Var
  aSql:String;
  aOb:TOb;
  i:Integer;
begin
  aSql:='Select Top ' + IntToStr(PageSize) + ' ID,Name,Age From uu987 Where ID>'+IntToStr(LastID)+' Order By ID Asc';
  with ADOQry Do
  begin
    Close;SQL.Clear;SQL.Add(aSql);Open;
  end;

  if FList<>nil then   //开始导入链表
  begin
    For i:=FList.Count-1 DownTo 0 do
      FList.Delete(i);
  end;
  with ADOQry do
  begin
    While Not ADOQry.Eof do
    begin
      New(aOb);
      aOb.ID:=FieldByName('ID').AsInteger;
      aOb.Name:=FieldByName('Name').AsString;
      aOb.Age:=FieldByName('Age').AsInteger;
      FList.Add(aOb);
      Next;
    end;
  end;
end;

procedure TF_SgDivPage.ShowToStringGrid;
Var
  aOb:TOb;
  i:integer;
begin
  if FList.Count=0 then Exit;
end;

procedure TF_SgDivPage.FormCreate(Sender: TObject);
begin
  PageSize:=10;
  FirstID:=0;
  LastID := 0;
  FList := TList.Create;
  ImpDataAsc;
  ShowToStringGrid;
end;

procedure TF_SgDivPage.FormClose(Sender: TObject;
  var Action: TCloseAction);
Var
  i:Integer;  
begin
  ADOQry.Close;
  ADOCnt.Connected := False;
  For i:=FList.Count-1 DownTo 0 do
    FList.Delete(i);
  FList.Free;
end;

function TF_SgDivPage.GetListMaxID: Integer;
Var
  i:Integer;
  aOb:TOb;
begin
  Result := 0;
  For i:=0 to FList.Count-1 do
  begin
    aOb:=FList.Items[i];
    if aOb.ID>Result then
      Result := aOb.ID;
  end;
end;

procedure TF_SgDivPage.sbFirstClick(Sender: TObject);
begin
  LastID := 0;
  ImpDataAsc;
  ShowToStringGrid;
end;

procedure TF_SgDivPage.sbpriorClick(Sender: TObject);
begin
  FirstID:=GetListMinID;
  ImpDataDesc;
  FList.Sort(@Comp);
  ShowToStringGrid;
end;

procedure TF_SgDivPage.ImpDataDesc;
Var
  aSql:String;
  aOb:TOb;
  i:Integer;
begin
  aSql:='Select Top ' + IntToStr(PageSize) + ' ID,Name,Age From uu987 Where ID<'+IntToStr(FirstID)+' Order By ID Desc';
  with ADOQry Do
  begin
    Close;SQL.Clear;SQL.Add(aSql);Open;
  end;

  if FList<>nil then   //开始导入链表
  begin
    For i:=FList.Count-1 DownTo 0 do
      FList.Delete(i);
  end;
  with ADOQry do
  begin
    While Not ADOQry.Eof do
    begin
      New(aOb);
      aOb.ID:=FieldByName('ID').AsInteger;
      aOb.Name:=FieldByName('Name').AsString;
      aOb.Age:=FieldByName('Age').AsInteger;
      FList.Add(aOb);
      Next;
    end;
  end;
end;

function TF_SgDivPage.GetListMinID: Integer;
Var
  i:Integer;
  aOb:TOb;
begin
  //Result := 0 ;
  if FList.Count>0 then
    Result := TOb(FList.Items[0]).ID;
  For i:=0 to FList.Count-1 do
  begin
    aOb:=FList.Items[i];
    if aOb.ID<Result then
      Result := aOb.ID;
  end;
end;

procedure TF_SgDivPage.sbNextClick(Sender: TObject);
begin
  LastID := GetListMaxID;
  ImpDataAsc;
  ShowToStringGrid;
end;

procedure TF_SgDivPage.sbLastClick(Sender: TObject);
Var
  aSql:String;
  aOb:TOb;
  i:Integer;
begin
  aSql:='Select Top ' + IntToStr(PageSize) + ' ID,Name,Age From uu987 Order By ID Desc';
  with ADOQry Do
  begin
    Close;SQL.Clear;SQL.Add(aSql);Open;
  end;

  if FList<>nil then   //开始导入链表
  begin
    For i:=FList.Count-1 DownTo 0 do
      FList.Delete(i);
  end;
  with ADOQry do
  begin
    While Not ADOQry.Eof do
    begin
      New(aOb);
      aOb.ID:=FieldByName('ID').AsInteger;
      aOb.Name:=FieldByName('Name').AsString;
      aOb.Age:=FieldByName('Age').AsInteger;
      FList.Add(aOb);
      Next;
    end;
  end;
  FList.Sort(@Comp);
  ShowToStringGrid;
end;

procedure TF_SgDivPage.sbAllClick(Sender: TObject);
Var
  aSql:String;
  aOb:TOb;
  i:Integer;
begin
  aSql:='Select ID,Name,Age From uu987 Order By ID Desc';
  with ADOQry Do
  begin
    Close;SQL.Clear;SQL.Add(aSql);Open;
  end;

  if FList<>nil then   //开始导入链表
  begin
    For i:=FList.Count-1 DownTo 0 do
      FList.Delete(i);
  end;
  with ADOQry do
  begin
    While Not ADOQry.Eof do
    begin
      New(aOb);
      aOb.ID:=FieldByName('ID').AsInteger;
      aOb.Name:=FieldByName('Name').AsString;
      aOb.Age:=FieldByName('Age').AsInteger;
      FList.Add(aOb);
      Next;
    end;
  end;
  ShowToStringGrid;
end;

Function comp(Item1, Item2: Pointer): Integer;
begin
  if TOb(Item1).ID > TOb(Item2).ID then
    Result:=1
  else if TOb(Item1).ID < TOb(Item2).ID then
    Result:= -1
  else
    Result:=0;
end;

procedure TF_SgDivPage.lblHomePageClick(Sender: TObject);
Var
  Url:String;
begin
  Url:='http://www.uu987.com';
  try
    ShellExecute(Handle, nil, PChar(Url), nil, nil, SW_SHOWNORMAL);
  except
    Application.MessageBox('Internet Explorer调用失败！', '错误', MB_ICONWARNING);
  end;
end;
end.