The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

│ English (en) │ français (fr) │
Exemple de relation Maître/Détail pour TSqlite3.

A propos de la démo

Cette démo est un exemple fonctionnel de comment utiliser le composant DataSet TSqlite3 de SQLite dans une relation Maître/Détail.

  Remarque: Ce composant ne fait pas partie des composants de base de données généraux de la SQLDB. SQLDB fournit TSQLite3Connection qui correspond à d'autres connecteurs de bases de données. Il est fortement recommandé de regarder dans TSQLite3Connection du fait de la facilité de changement vers une autre base de données ; utilisez seulement TSQLite3 si cela est réellement demandé.

Voir MasterDetail pour des instructions sur comment implémenter des relations Maître/Détail en utilisant des composants SQLdb standards (p.ex. sqlite3).

Auteur

David Stewart .. davesimplewear at yahoo dot com
NdT : Merci à Dave Stewart pour cet article.

Composants utilisés

TSqlite3
Standard Lazarus database components

License

Vous êtes libres de l'utiliser comme vous le voulez.

Téléchargement

L'exemple TSQLite3 peut être téléchargé depuis L'emplacement de téléchargement Lazarus-CCR de SF. Aussi depuis Freeware de David.

Captures d'écran

Cette capture d'écran montre la configuration de la table pour le Mapître/Détail.

Code du programme d'exemple

unit uMain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, db, sqlite3ds, FileUtil, LResources, Forms, Controls,
  Graphics, Dialogs, ComCtrls, ExtCtrls, Menus, DbCtrls, StdCtrls, DBGrids;

type

  { TfMain }

  TfMain = class(TForm)
    btnSelCust: TButton;
    btnAddSale: TButton;
    btnSaveEntry: TButton;
    btnDelEntry: TButton;
    DBNavigator3: TDBNavigator;
    dsCust: TDatasource;
    dsSales: TDatasource;
    dsStock: TDatasource;
    DBEdit1: TDBEdit;
    DBEdit10: TDBEdit;
    DBEdit12: TDBEdit;
    DBEdit13: TDBEdit;
    DBEdit14: TDBEdit;
    DBEdit15: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBEdit5: TDBEdit;
    DBEdit6: TDBEdit;
    DBEdit7: TDBEdit;
    DBEdit8: TDBEdit;
    DBEdit9: TDBEdit;
    dgSales: TDBGrid;
    DBNavigator1: TDBNavigator;
    DBNavigator2: TDBNavigator;
    Label1: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    miClose: TMenuItem;
    miFile: TMenuItem;
    mmMain: TMainMenu;
    nbMain: TNotebook;
    Panel1: TPanel;
    pnlSales: TPanel;
    pnlStock: TPanel;
    pnlCustomer: TPanel;
    pnlSelectCust: TPanel;
    pStock: TPage;
    pCustomer: TPage;
    pSales: TPage;
    sbMain: TStatusBar;
    TCustAddr: TStringField;
    TCustCustName: TStringField;
    TCustcustState: TStringField;
    TCustID: TAutoIncField;
    TCustpostCode: TStringField;
    TCustSuburb: TStringField;
    TSalescustID: TLongintField;
    TSalesID: TAutoIncField;
    TSalesitem: TStringField;
    TSalesitemNum: TStringField;
    TSalesprice: TFloatField;
    TSalessaleDate: TDateField;
    TSalesshipDate: TDateField;
    TStock: TSqlite3Dataset;
    TSales: TSqlite3Dataset;
    TCust: TSqlite3Dataset;
    TStockID: TAutoIncField;
    TStockitem: TStringField;
    TStockitemNum: TStringField;
    TStockprice: TFloatField;
    procedure btnAddSaleClick(Sender: TObject);
    procedure btnDelEntryClick(Sender: TObject);
    procedure btnSaveEntryClick(Sender: TObject);
    procedure btnSelCustClick(Sender: TObject);
    procedure dgSalesEditButtonClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure miCloseClick(Sender: TObject);
    private
    { private declarations }
  public
    { public declarations }
  end; 

var
  fMain: TfMain;

implementation
uses uCust, uSales;
{ TfMain }

procedure TfMain.miCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
   CanClose := MessageDlg('Are You Sure ?',mtConfirmation,[mbYes,mbNo],0)=mrYes;
end;

procedure TfMain.FormCreate(Sender: TObject);
var
n:integer;
c:TComponent;
FName:string;
begin
    fName := ExtractFilePath(ParamStr(0)) +'data/md.db3';
for n := 0 to ComponentCount -1 do
    begin
     c := Components[n];
     if c is TSqlite3Dataset then
     TSqlite3Dataset(c).FileName:= fName;
    end;
 for n := 0 to ComponentCount -1 do
    begin
     c := Components[n];
     if c is TSqlite3Dataset then
     TSqlite3Dataset(c).Open;
    end;
end;

procedure TfMain.FormDestroy(Sender: TObject);
var
n:integer;
c:TComponent;
begin
  for n := 0 to ComponentCount -1 do
    begin
     c := Components[n];
     if c is TSqlite3Dataset then
     TSqlite3Dataset(c).Close;
    end;
end;

procedure TfMain.FormShow(Sender: TObject);
begin
  nbMain.PageIndex:=0;
end;

procedure TfMain.dgSalesEditButtonClick(Sender: TObject);
begin
  if SearchDlg.ShowModalParts =mrOk then
     begin
       TSales.Edit;
       TSalesItemNum.Value := SearchDlg.PartNum;
       TSalesItem.Value := TStockitem.Value;
       TSalesPRICE.Value:= TStockPrice.Value;
     end;
end;

procedure TfMain.btnSelCustClick(Sender: TObject);
begin
  custDlg.CustName := TCustCUSTNAME.Value ;
     if CustDlg.ShowModalCust =mrOk then
     begin
       TCust.Edit;
       TCustCUSTNAME.Value := custDlg.CustName;
    end;
end;

procedure TfMain.btnAddSaleClick(Sender: TObject);
begin
  TSales.Append;
end;

procedure TfMain.btnDelEntryClick(Sender: TObject);
begin
  TSales.Delete;
end;

procedure TfMain.btnSaveEntryClick(Sender: TObject);
begin
  TSales.ApplyUpdates;
end;

initialization
  {$I uMain.lrs}

end.

uMain.lfm (edité)

object fMain: TfMain
  Left = 395
  Height = 332
  Top = 218
  Width = 534
  ActiveControl = nbMain
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Master Detail Example - SQLLite3'
  ClientHeight = 305
  ClientWidth = 534
  Font.Height = -13
  Font.Name = 'Sans'
  Menu = mmMain
  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  OnShow = FormShow
  Position = poScreenCenter
  LCLVersion = '0.9.27'
  object sbMain: TStatusBar
    Left = 0
    Height = 19
    Top = 286
    Width = 534
    AutoHint = True
    Panels = <>
  end
  object nbMain: TNotebook
    Left = 0
    Height = 286
    Top = 0
    Width = 534
    Align = alClient
    PageIndex = 0
    TabOrder = 1
    object pSales: TPage
      Caption = 'Sales'
      ClientWidth = 532
      ClientHeight = 259
      object Label3: TLabel
        Left = 0
        Height = 18
        Top = 241
        Width = 532
        Align = alBottom
        Caption = 'Select Customer First, then click in item number field to select item, then save'
        ParentColor = False
      end
      object pnlSelectCust: TPanel
        Left = 15
        Height = 216
        Top = 14
        Width = 232
        BevelInner = bvLowered
        BevelWidth = 2
        ClientHeight = 216
        ClientWidth = 232
        TabOrder = 0
        object Label1: TLabel
          Left = 4
          Height = 18
          Top = 4
          Width = 224
          Align = alTop
          Alignment = taCenter
          Caption = 'Customer Detail'
          Font.Height = -13
          Font.Name = 'Sans'
          Font.Style = [fsBold, fsItalic]
          ParentColor = False
          ParentFont = False
        end
        object Label2: TLabel
          Left = 24
          Height = 18
          Top = 31
          Width = 73
          Caption = 'First Name'
          Font.Height = -13
          Font.Name = 'Sans'
          Font.Style = [fsItalic]
          ParentColor = False
          ParentFont = False
        end
        object DBEdit1: TDBEdit
          Left = 24
          Height = 23
          Hint = 'Cust name'
          Top = 48
          Width = 184
          DataField = 'CustName'
          DataSource = dsCust
          ReadOnly = True
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 0
        end
        object DBEdit3: TDBEdit
          Left = 24
          Height = 23
          Hint = 'Address'
          Top = 72
          Width = 184
          DataField = 'Addr'
          DataSource = dsCust
          ReadOnly = True
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 1
        end
        object DBEdit4: TDBEdit
          Left = 24
          Height = 23
          Hint = 'Suburb/Town'
          Top = 96
          Width = 184
          DataField = 'Suburb'
          DataSource = dsCust
          ReadOnly = True
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 2
        end
        object DBEdit5: TDBEdit
          Left = 24
          Height = 23
          Hint = 'Postal Code'
          Top = 120
          Width = 80
          DataField = 'postCode'
          DataSource = dsCust
          ReadOnly = True
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 3
        end
        object DBEdit6: TDBEdit
          Left = 128
          Height = 23
          Hint = 'State'
          Top = 119
          Width = 80
          DataField = 'custState'
          DataSource = dsCust
          ReadOnly = True
          CharCase = ecUppercase
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 4
        end
        object btnSelCust: TButton
          Left = 24
          Height = 25
          Hint = 'Click to select a Customer'
          Top = 176
          Width = 184
          Caption = 'Select Customer'
          OnClick = btnSelCustClick
          ParentShowHint = False
          ShowHint = True
          TabOrder = 5
        end
        object DBNavigator3: TDBNavigator
          Left = 30
          Height = 22
          Top = 150
          Width = 170
          BevelOuter = bvNone
          ClientHeight = 22
          ClientWidth = 170
          DataSource = dsCust
          TabOrder = 6
          VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast]
        end
      end
      object pnlSales: TPanel
        Left = 255
        Height = 216
        Top = 14
        Width = 260
        BevelInner = bvLowered
        BevelWidth = 2
        ClientHeight = 216
        ClientWidth = 260
        TabOrder = 1
        object Label4: TLabel
          Left = 4
          Height = 18
          Top = 4
          Width = 252
          Align = alTop
          Alignment = taCenter
          Caption = 'Sales Detail'
          Font.Height = -13
          Font.Name = 'Sans'
          Font.Style = [fsBold, fsItalic]
          ParentColor = False
          ParentFont = False
        end
        object btnAddSale: TButton
          Left = 16
          Height = 25
          Hint = 'Add Another Sale'
          Top = 176
          Width = 72
          Caption = 'Add Sale'
          OnClick = btnAddSaleClick
          ParentShowHint = False
          ShowHint = True
          TabOrder = 0
        end
        object Panel1: TPanel
          Left = 4
          Height = 13
          Top = 22
          Width = 252
          Align = alTop
          BevelOuter = bvNone
          TabOrder = 1
        end
        object dgSales: TDBGrid
          Left = 4
          Height = 125
          Hint = 'Click Item Number Button to Select Item'
          Top = 35
          Width = 252
          Align = alTop
          Columns = <          
            item
              ButtonStyle = cbsEllipsis
              Title.Caption = 'item Number'
              Width = 100
              FieldName = 'itemNum'
            end          
            item
              Width = 150
              FieldName = 'item'
            end          
            item
              FieldName = 'price'
            end          
            item
              Title.Caption = 'sale Date'
              FieldName = 'saleDate'
            end          
            item
              Title.Caption = 'ship Date'
              FieldName = 'shipDate'
            end>
          DataSource = dsSales
          ShowHint = True
          TabOrder = 2
          TitleFont.Height = -13
          TitleFont.Name = 'Sans'
          OnEditButtonClick = dgSalesEditButtonClick
        end
        object btnSaveEntry: TButton
          Left = 95
          Height = 25
          Hint = 'Save Entry'
          Top = 176
          Width = 51
          Caption = 'Save'
          OnClick = btnSaveEntryClick
          ParentShowHint = False
          ShowHint = True
          TabOrder = 3
        end
        object btnDelEntry: TButton
          Left = 168
          Height = 25
          Hint = 'Delete Entry'
          Top = 176
          Width = 75
          Caption = 'Delete'
          OnClick = btnDelEntryClick
          ParentShowHint = False
          ShowHint = True
          TabOrder = 4
        end
      end
    end
    object pCustomer: TPage
      Caption = 'Customer'
      ClientWidth = 532
      ClientHeight = 259
      object pnlCustomer: TPanel
        Left = 95
        Height = 194
        Top = 30
        Width = 339
        BevelInner = bvLowered
        BevelWidth = 2
        ClientHeight = 194
        ClientWidth = 339
        TabOrder = 0
        object Label5: TLabel
          Left = 72
          Height = 18
          Top = 31
          Width = 73
          Caption = 'First Name'
          Font.Height = -13
          Font.Name = 'Sans'
          Font.Style = [fsItalic]
          ParentColor = False
          ParentFont = False
        end
        object Label7: TLabel
          Left = 4
          Height = 18
          Top = 4
          Width = 331
          Align = alTop
          Alignment = taCenter
          Caption = 'Customer Entry'
          Font.Height = -13
          Font.Name = 'Sans'
          Font.Style = [fsBold, fsItalic]
          ParentColor = False
          ParentFont = False
        end
        object DBEdit10: TDBEdit
          Left = 72
          Height = 23
          Hint = 'Cust name'
          Top = 48
          Width = 184
          DataField = 'CustName'
          DataSource = dsCust
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 0
        end
        object DBEdit12: TDBEdit
          Left = 72
          Height = 23
          Hint = 'Address'
          Top = 72
          Width = 184
          DataField = 'Addr'
          DataSource = dsCust
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 1
        end
        object DBEdit13: TDBEdit
          Left = 72
          Height = 23
          Hint = 'Suburb/Town'
          Top = 96
          Width = 184
          DataField = 'Suburb'
          DataSource = dsCust
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 2
        end
        object DBEdit14: TDBEdit
          Left = 72
          Height = 23
          Hint = 'Postal Code'
          Top = 120
          Width = 80
          DataField = 'postCode'
          DataSource = dsCust
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 3
        end
        object DBEdit15: TDBEdit
          Left = 176
          Height = 23
          Hint = 'State'
          Top = 119
          Width = 80
          DataField = 'custState'
          DataSource = dsCust
          CharCase = ecUppercase
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 4
        end
        object DBNavigator2: TDBNavigator
          Left = 45
          Height = 25
          Top = 154
          Width = 241
          BevelOuter = bvNone
          ClientHeight = 25
          ClientWidth = 241
          DataSource = dsCust
          TabOrder = 5
        end
      end
    end
    object pStock: TPage
      Caption = 'Stock'
      ClientWidth = 532
      ClientHeight = 259
      object pnlStock: TPanel
        Left = 95
        Height = 218
        Top = 22
        Width = 339
        BevelInner = bvLowered
        BevelWidth = 2
        ClientHeight = 218
        ClientWidth = 339
        TabOrder = 0
        object Label8: TLabel
          Left = 4
          Height = 18
          Top = 4
          Width = 331
          Align = alTop
          Alignment = taCenter
          Caption = 'Stock Entry'
          Font.Height = -13
          Font.Name = 'Sans'
          Font.Style = [fsBold, fsItalic]
          ParentColor = False
          ParentFont = False
        end
        object Label9: TLabel
          Left = 75
          Height = 18
          Top = 24
          Width = 83
          Caption = 'Part Number'
          Font.Height = -13
          Font.Name = 'Sans'
          Font.Style = [fsItalic]
          ParentColor = False
          ParentFont = False
        end
        object Label10: TLabel
          Left = 75
          Height = 18
          Top = 72
          Width = 75
          Caption = 'Description'
          Font.Height = -13
          Font.Name = 'Sans'
          Font.Style = [fsItalic]
          ParentColor = False
          ParentFont = False
        end
        object Label11: TLabel
          Left = 75
          Height = 18
          Top = 128
          Width = 33
          Caption = 'Price'
          Font.Height = -13
          Font.Name = 'Sans'
          Font.Style = [fsItalic]
          ParentColor = False
          ParentFont = False
        end
        object DBEdit7: TDBEdit
          Left = 75
          Height = 23
          Top = 40
          Width = 181
          DataField = 'itemNum'
          DataSource = dsStock
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 0
        end
        object DBEdit8: TDBEdit
          Left = 75
          Height = 23
          Top = 89
          Width = 181
          DataField = 'item'
          DataSource = dsStock
          MaxLength = 8192
          ParentShowHint = False
          ShowHint = True
          TabOrder = 1
        end
        object DBEdit9: TDBEdit
          Left = 75
          Height = 23
          Top = 145
          Width = 181
          DataField = 'price'
          DataSource = dsStock
          ParentShowHint = False
          ShowHint = True
          TabOrder = 2
        end
        object DBNavigator1: TDBNavigator
          Left = 48
          Height = 25
          Top = 183
          Width = 241
          BevelOuter = bvNone
          ClientHeight = 25
          ClientWidth = 241
          DataSource = dsStock
          ParentShowHint = False
          ShowHint = True
          TabOrder = 3
        end
      end
    end
  end
  object mmMain: TMainMenu
    left = 16
    top = 277
    object miFile: TMenuItem
      Caption = '&File'
      object miClose: TMenuItem
        Caption = '&Close'
        GlyphShowMode = gsmAlways
        Hint = 'Close Application'
        OnClick = miCloseClick
      end
    end
  end
  object dsCust: TDatasource
    DataSet = TCust
    left = 16
    top = 53
  end
  object dsSales: TDatasource
    DataSet = TSales
    left = 16
    top = 141
  end
  object dsStock: TDatasource
    DataSet = TStock
    left = 16
    top = 214
  end
  object TCust: TSqlite3Dataset
    AutoIncrementKey = True
    Options = []
    PrimaryKey = 'ID'
    SaveOnClose = True
    SaveOnRefetch = True
    SQL = 'Select * from cust;'
    TableName = 'cust'
    FieldDefs = <    
      item
        Name = 'ID'
        DataType = ftAutoInc
        Precision = -1
        Size = 0
      end    
      item
        Name = 'CustName'
        DataType = ftString
        Precision = -1
        Size = 8192
      end    
      item
        Name = 'Addr'
        DataType = ftString
        Precision = -1
        Size = 8192
      end    
      item
        Name = 'Suburb'
        DataType = ftString
        Precision = -1
        Size = 8192
      end    
      item
        Name = 'postCode'
        DataType = ftString
        Precision = -1
        Size = 8192
      end    
      item
        Name = 'custState'
        DataType = ftString
        Precision = -1
        Size = 8192
      end>
    left = 66
    top = 53
    object TCustID: TAutoIncField
      DisplayWidth = 10
      FieldKind = fkData
      FieldName = 'ID'
      Index = 0
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
    end
    object TCustCustName: TStringField
      DisplayWidth = 8192
      FieldKind = fkData
      FieldName = 'CustName'
      Index = 1
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Size = 8192
    end
    object TCustAddr: TStringField
      DisplayWidth = 8192
      FieldKind = fkData
      FieldName = 'Addr'
      Index = 2
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Size = 8192
    end
    object TCustSuburb: TStringField
      DisplayWidth = 8192
      FieldKind = fkData
      FieldName = 'Suburb'
      Index = 3
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Size = 8192
    end
    object TCustpostCode: TStringField
      DisplayWidth = 8192
      FieldKind = fkData
      FieldName = 'postCode'
      Index = 4
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Size = 8192
    end
    object TCustcustState: TStringField
      DisplayWidth = 8192
      FieldKind = fkData
      FieldName = 'custState'
      Index = 5
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Size = 8192
    end
  end
  object TSales: TSqlite3Dataset
    AutoIncrementKey = True
    IndexFieldNames = 'CustID'
    Options = []
    PrimaryKey = 'ID'
    SaveOnClose = True
    SaveOnRefetch = True
    SQL = 'Select * from sales;'
    TableName = 'sales'
    MasterSource = dsCust
    MasterFields = 'ID'
    FieldDefs = <    
      item
        Name = 'itemNum'
        DataType = ftString
        Precision = -1
        Size = 8192
      end    
      item
        Name = 'ID'
        DataType = ftAutoInc
        Precision = -1
        Size = 0
      end    
      item
        Name = 'custID'
        DataType = ftInteger
        Precision = -1
        Size = 0
      end    
      item
        Name = 'saleDate'
        DataType = ftDate
        Precision = -1
        Size = 0
      end    
      item
        Name = 'shipDate'
        DataType = ftDate
        Precision = -1
        Size = 0
      end    
      item
        Name = 'item'
        DataType = ftString
        Precision = -1
        Size = 8192
      end    
      item
        Name = 'price'
        DataType = ftFloat
        Precision = -1
        Size = 0
      end>
    left = 66
    top = 141
    object TSalesitemNum: TStringField
      DisplayWidth = 8192
      FieldKind = fkData
      FieldName = 'itemNum'
      Index = 0
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Size = 8192
    end
    object TSalesID: TAutoIncField
      DisplayWidth = 10
      FieldKind = fkData
      FieldName = 'ID'
      Index = 1
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
    end
    object TSalescustID: TLongintField
      DisplayWidth = 10
      FieldKind = fkData
      FieldName = 'custID'
      Index = 2
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
    end
    object TSalessaleDate: TDateField
      DisplayWidth = 10
      FieldKind = fkData
      FieldName = 'saleDate'
      Index = 3
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
    end
    object TSalesshipDate: TDateField
      DisplayWidth = 10
      FieldKind = fkData
      FieldName = 'shipDate'
      Index = 4
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
    end
    object TSalesitem: TStringField
      DisplayWidth = 8192
      FieldKind = fkData
      FieldName = 'item'
      Index = 5
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Size = 8192
    end
    object TSalesprice: TFloatField
      DisplayWidth = 10
      FieldKind = fkData
      FieldName = 'price'
      Index = 6
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Currency = True
      MaxValue = 0
      MinValue = 0
      Precision = -1
    end
  end
  object TStock: TSqlite3Dataset
    AutoIncrementKey = True
    Options = []
    PrimaryKey = 'ID'
    SaveOnClose = True
    SaveOnRefetch = True
    SQL = 'Select * from stock;'
    TableName = 'stock'
    FieldDefs = <    
      item
        Name = 'ID'
        DataType = ftAutoInc
        Precision = -1
        Size = 0
      end    
      item
        Name = 'item'
        DataType = ftString
        Precision = -1
        Size = 8192
      end    
      item
        Name = 'price'
        DataType = ftFloat
        Precision = -1
        Size = 0
      end    
      item
        Name = 'itemNum'
        DataType = ftString
        Precision = -1
        Size = 8192
      end>
    left = 66
    top = 214
    object TStockID: TAutoIncField
      DisplayWidth = 10
      FieldKind = fkData
      FieldName = 'ID'
      Index = 0
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
    end
    object TStockitem: TStringField
      DisplayWidth = 8192
      FieldKind = fkData
      FieldName = 'item'
      Index = 1
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Size = 8192
    end
    object TStockprice: TFloatField
      DisplayWidth = 10
      FieldKind = fkData
      FieldName = 'price'
      Index = 2
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Currency = True
      MaxValue = 0
      MinValue = 0
      Precision = -1
    end
    object TStockitemNum: TStringField
      DisplayWidth = 8192
      FieldKind = fkData
      FieldName = 'itemNum'
      Index = 3
      LookupCache = False
      ProviderFlags = [pfInUpdate, pfInWhere]
      ReadOnly = False
      Required = False
      Size = 8192
    end
  end
end

unit uCust;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls, Buttons, DBGrids,DB;

type

  { TcustDlg }

  TcustDlg = class(TForm)
    cancelBtn: TButton;
    dgCust: TDBGrid;
    edSearch: TEdit;
    Label1: TLabel;
    okBtn: TButton;
    pnlCust: TPanel;
    sbSearch: TSpeedButton;
    procedure dgCustDblClick(Sender: TObject);
    procedure edSearchChange(Sender: TObject);
    procedure sbSearchClick(Sender: TObject);
  private
    function GetCust: String;
    procedure SetCust(const AValue: String);
    { private declarations }
  public
    { public declarations }
    property CustName: String Read GetCust Write SetCust;
    function ShowModalCust:integer;
  end; 

var
  custDlg: TcustDlg;

implementation
uses uMain;
{ TcustDlg }

procedure TcustDlg.edSearchChange(Sender: TObject);
begin
  sbSearch.Enabled:=edSearch.Text<>'';
end;

procedure TcustDlg.dgCustDblClick(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TcustDlg.sbSearchClick(Sender: TObject);
begin
  if not fMain.TCust.Locate('CustName', edSearch.Text,[loCaseInsensitive, loPartialKey])
   then
      MessageDlg('No matching record found.', mtInformation, [mbOK], 0);
      edSearch.Color:=clRed;
end;

function TcustDlg.GetCust: String;
begin
  Result := fMain.TCustCustName.Value;
end;

procedure TcustDlg.SetCust(const AValue: String);
begin
  fMain.TCust.Locate('CustName',AValue,[loPartialKey,loCaseInsensitive]);
end;

function TcustDlg.ShowModalCust: integer;
begin
  Caption:='Select Customer Name';
  Result := ShowModal;
end;

initialization
  {$I uCust.lrs}

end.

unit uSales;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls, Buttons, DBGrids, DB;

type

  { TsearchDlg }

  TsearchDlg = class(TForm)
    cancelBtn: TButton;
    dgParts: TDBGrid;
    edSearch: TEdit;
    Label1: TLabel;
    okBtn: TButton;
    pnlParts: TPanel;
    sbSearch: TSpeedButton;
    procedure dgPartsDblClick(Sender: TObject);
    procedure edSearchChange(Sender: TObject);
    procedure sbSearchClick(Sender: TObject);
  private
    function GetPartNum: String;
    procedure SetPartNum(const AValue: String);
    { private declarations }
  public
    { public declarations }
    property PartNum:String Read GetPartNum Write SetPartNum;
    function ShowModalParts: Integer;
  end; 

var
  searchDlg: TsearchDlg;

implementation
uses uMain;
{ TsearchDlg }

procedure TsearchDlg.edSearchChange(Sender: TObject);
begin
  sbSearch.Enabled:=edSearch.Text<>'';
end;

procedure TsearchDlg.dgPartsDblClick(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TsearchDlg.sbSearchClick(Sender: TObject);
begin
  if not fMain.TStock.Locate('itemNum', edSearch.Text,[loCaseInsensitive, loPartialKey])
   then
      MessageDlg('No matching record found.', mtInformation, [mbOK], 0);
      edSearch.Color:=clRed;
end;

function TsearchDlg.GetPartNum: String;
begin
  Result := fMain.TStockitemNum.Value;
end;

procedure TsearchDlg.SetPartNum(const AValue: String);
begin
  fMain.TStock.Locate('itemNum',AValue,[loPartialKey,loCaseInsensitive]);
end;

function TsearchDlg.ShowModalParts: Integer;
begin
  Caption:='Select Item Number';
  Result := ShowModal;
end;

initialization
  {$I uSales.lrs}

end.

TSqlite3 Master Detail Example/fr

Contents

A propos de la démo

Auteur

Composants utilisés

License

Téléchargement

Captures d'écran

Code du programme d'exemple

Navigation menu

Page actions

Page actions

Personal tools

Navigation

Tools

Search