Marco Web Center |
Home: Code Repository: Mastering Delphi 5Project ADOSORT
Project StructureADOSORT.DPRprogram AdoSort; uses Forms, SortForm in 'SortForm.pas' {FormSort}; {$R *.RES} begin Application.Initialize; Application.CreateForm(TFormSort, FormSort); Application.Run; end. SORTFORM.PASunit 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.DFMobject 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
|
||
© Copyright Marco Cantù, 1995-2020, All rights reserved |