Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project ADOSORT

Project Structure


ADOSORT.DPR

program AdoSort;

uses
  Forms,
  SortForm in 'SortForm.pas' {FormSort};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFormSort, FormSort);
  Application.Run;
end.

SORTFORM.PAS

unit SortForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Db, ADODB, Grids, DBGrids;

type
  TFormSort = class(TForm)
    ADODataSet: TADODataSet;
    DataSource: TDataSource;
    DBGrid: TDBGrid;
    ADOConnection: TADOConnection;
    Panel1: TPanel;
    Splitter1: TSplitter;
    ListFields: TListBox;
    Label1: TLabel;
    btnSort: TButton;
    btnIndex: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    btnFilter: TButton;
    EditFilter: TEdit;
    Label3: TLabel;
    btnSave: TButton;
    btnLoad: TButton;
    cbConnected: TCheckBox;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure btnSortClick(Sender: TObject);
    procedure btnIndexClick(Sender: TObject);
    procedure Edit1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Edit1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Edit2Click(Sender: TObject);
    procedure btnFilterClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
    procedure cbConnectedClick(Sender: TObject);
  public
    { Public declarations }
  end;

var
  FormSort: TFormSort;

implementation

{$R *.DFM}

procedure TFormSort.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to AdoDataSet.FieldDefs.Count - 1 do
    ListFields.Items.Add (AdoDataSet.FieldDefs [I].Name);
end;

procedure TFormSort.btnSortClick(Sender: TObject);
var
  t: Cardinal;
  strSort: string;
begin
  t := GetTickCount;
  strSort := Edit1.Text;
  if CheckBox1.Checked then
    strSort := strSort + ' DESC';
  if Edit2.Text <> '' then
    strSort := strSort + ',' + Edit2.Text;
  if CheckBox2.Checked then
    strSort := strSort + ' DESC';
  if Edit3.Text <> '' then
    strSort := strSort + ',' + Edit3.Text;
  if CheckBox3.Checked then
    strSort := strSort + ' DESC';
  AdoDataSet.Sort := strSort;
  Caption := 'AdoSort - ' + IntToStr (GetTickCount - t);
end;

procedure TFormSort.btnIndexClick(Sender: TObject);
begin
  // add index on PartNo
  AdoDataSet.Recordset.Fields[ListFields.ItemIndex].
    Properties['Optimize'].Set_Value (True);
end;

procedure TFormSort.Edit1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TListBox;
end;

procedure TFormSort.Edit1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  (Sender as TEdit).Text := (Source as TListBox).Items [
    (Source as TListBox).ItemIndex];
end;

procedure TFormSort.Edit2Click(Sender: TObject);
begin
  (Sender as TEdit).Text := '';
end;

procedure TFormSort.btnFilterClick(Sender: TObject);
begin
  AdoDataSet.Filter := EditFilter.Text;
  AdoDataSet.Filtered := True;
end;

procedure TFormSort.btnSaveClick(Sender: TObject);
begin
  if SaveDialog.Execute and not
      FileExists (SaveDialog.FileName)then
    AdoDataSet.SaveToFile (SaveDialog.FileName);
end;

procedure TFormSort.btnLoadClick(Sender: TObject);
begin
  if OpenDialog.Execute then
    AdoDataSet.LoadFromFile (OpenDialog.FileName);
  cbConnected.Checked := True;
end;

procedure TFormSort.cbConnectedClick(Sender: TObject);
begin
  AdoDataSet.Active := cbConnected.Checked;
end;

end.

SORTFORM.DFM

object FormSort: TFormSort
  Left = 269
  Top = 113
  Width = 696
  Height = 549
  Caption = 'AdoSort'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 241
    Top = 0
    Width = 3
    Height = 522
    Cursor = crHSplit
  end
  object DBGrid: TDBGrid
    Left = 244
    Top = 0
    Width = 444
    Height = 522
    Align = alClient
    DataSource = DataSource
    TabOrder = 0
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 241
    Height = 522
    Align = alLeft
    TabOrder = 1
    object Label1: TLabel
      Left = 24
      Top = 16
      Width = 30
      Height = 13
      Caption = 'Fields:'
    end
    object Label2: TLabel
      Left = 32
      Top = 156
      Width = 37
      Height = 13
      Caption = 'Sort on:'
    end
    object Label3: TLabel
      Left = 32
      Top = 352
      Width = 22
      Height = 13
      Caption = 'Filter'
    end
    object ListFields: TListBox
      Left = 24
      Top = 32
      Width = 185
      Height = 105
      DragMode = dmAutomatic
      ItemHeight = 13
      MultiSelect = True
      TabOrder = 0
    end
    object btnSort: TButton
      Left = 32
      Top = 272
      Width = 185
      Height = 25
      Caption = '&Sort'
      TabOrder = 1
      OnClick = btnSortClick
    end
    object btnIndex: TButton
      Left = 32
      Top = 312
      Width = 185
      Height = 25
      Caption = '&Index Field'
      TabOrder = 2
      OnClick = btnIndexClick
    end
    object Edit1: TEdit
      Left = 32
      Top = 176
      Width = 97
      Height = 21
      ReadOnly = True
      TabOrder = 3
      Text = 'PartNo'
      OnDragDrop = Edit1DragDrop
      OnDragOver = Edit1DragOver
    end
    object Edit2: TEdit
      Left = 32
      Top = 208
      Width = 97
      Height = 21
      ReadOnly = True
      TabOrder = 4
      OnClick = Edit2Click
      OnDragDrop = Edit1DragDrop
      OnDragOver = Edit1DragOver
    end
    object Edit3: TEdit
      Left = 32
      Top = 240
      Width = 97
      Height = 21
      ReadOnly = True
      TabOrder = 5
      OnClick = Edit2Click
      OnDragDrop = Edit1DragDrop
      OnDragOver = Edit1DragOver
    end
    object CheckBox1: TCheckBox
      Left = 144
      Top = 176
      Width = 80
      Height = 17
      Caption = 'Descending'
      TabOrder = 6
    end
    object CheckBox2: TCheckBox
      Left = 144
      Top = 208
      Width = 80
      Height = 17
      Caption = 'Descending'
      TabOrder = 7
    end
    object CheckBox3: TCheckBox
      Left = 144
      Top = 240
      Width = 80
      Height = 17
      Caption = 'Descending'
      TabOrder = 8
    end
    object btnFilter: TButton
      Left = 32
      Top = 400
      Width = 185
      Height = 25
      Caption = 'Apply &Filter'
      TabOrder = 9
      OnClick = btnFilterClick
    end
    object EditFilter: TEdit
      Left = 32
      Top = 368
      Width = 185
      Height = 21
      TabOrder = 10
      Text = 'PartNo > 10000'
    end
    object btnSave: TButton
      Left = 32
      Top = 456
      Width = 89
      Height = 25
      Caption = 'S&ave'
      TabOrder = 11
      OnClick = btnSaveClick
    end
    object btnLoad: TButton
      Left = 128
      Top = 456
      Width = 91
      Height = 25
      Caption = '&Load'
      TabOrder = 12
      OnClick = btnLoadClick
    end
    object cbConnected: TCheckBox
      Left = 80
      Top = 488
      Width = 97
      Height = 17
      Caption = '&Connected'
      Checked = True
      State = cbChecked
      TabOrder = 13
      OnClick = cbConnectedClick
    end
  end
  object ADODataSet: TADODataSet
    Active = True
    Connection = ADOConnection
    CursorType = ctStatic
    CommandText = 'items'
    CommandType = cmdTable
    IndexFieldNames = 'OrderNo'
    Parameters = <>
    Left = 336
    Top = 48
  end
  object DataSource: TDataSource
    DataSet = ADODataSet
    Left = 280
    Top = 40
  end
  object ADOConnection: TADOConnection
    Connected = True
    ConnectionString =
       'Provider=Microsoft.Jet.OLEDB.4.0;Password="";User ID=Admin;Data ' +
      'Source=c:\md5code\Part3\12\data\MdData.mdb;Mode=Share Deny None;' +
      'Extended Properties="";Locale Identifier=1033;Jet OLEDB:System d' +
      'atabase="";Jet OLEDB:Registry Path="";Jet OLEDB:Database Passwor' +
      'd="";Jet OLEDB:Engine Type=4;Jet OLEDB:Database Locking Mode=0;J' +
      'et OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transac' +
      'tions=1;Jet OLEDB:New Database Password="";Jet OLEDB:Create Syst' +
      'em Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don' +
      '''t Copy Locale on Compact=False;Jet OLEDB:Compact Without Replic'  +
      'a Repair=False;Jet OLEDB:SFP=False'
    LoginPrompt = False
    Mode = cmShareDenyNone
    Provider = 'Microsoft.Jet.OLEDB.4.0'
    Left = 384
    Top = 56
  end
  object OpenDialog: TOpenDialog
    DefaultExt = 'ado'
    Filter = 'ADO file (*.ado)|*.ado|Any file (*.*)|*.*'
    Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
    Left = 464
    Top = 48
  end
  object SaveDialog: TSaveDialog
    DefaultExt = 'ado'
    Filter = 'ADO file (*.ado)|*.ado|Any file (*.*)|*.*'
    Left = 520
    Top = 48
  end
end