User:Rocarobin

From Lazarus wiki
Jump to navigationJump to search
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.
//update oct 20 2010
unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, sqlite3conn, sqldb, pqconnection, OracleConnection,
mysql50conn, IBConnection, db, dbf, memds, FileUtil,
LResources, Forms, Controls, Graphics, Dialogs, DBGrids, ComCtrls, StdCtrls,
DbCtrls, ExtCtrls, Grids,
PrintersDlgs, Printers;

type

  { TForm1 }

  TForm1 = class(TForm)

    Button6: TButton;
    Button5: TButton;
    Button3: TButton;
    Button2: TButton;
    Button1: TButton;
    Button7: TButton;
    Button9: TButton;

    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBGrid6: TDBGrid;
    DBGrid5: TDBGrid;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    DBGrid3: TDBGrid;
    DBGrid4: TDBGrid;

    DBMemo1: TDBMemo;
    DBMemo2: TDBMemo;
    ImageList1: TImageList;

    Label1: TLabel;
    Label13: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label12: TLabel;

    PageControl1: TPageControl;
    PrintDialog1: TPrintDialog;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;

    TabLeaders: TTabSheet;
    TabMembers: TTabSheet;
    TabPrints: TTabSheet;

    SQLTransaction1: TSQLTransaction;
    SQLQuery1: TSQLQuery;
    SQLQuery2: TSQLQuery;
    SQLQuery3: TSQLQuery;
    Datasource1: TDatasource;
    Datasource2: TDatasource;
    Datasource3: TDatasource;


    //CHOOSE YOUR SQL_CONNECTION
    SQLite3Connection1: TSQLite3Connection;
    SQLConnector1: TSQLConnector;
    MySQL50Connection1: TMySQL50Connection;
    OracleConnection1: TOracleConnection;
    IBConnection1: TIBConnection;
    PQConnection1: TPQConnection;


    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure DBGrid3CellClick(Column: TColumn);
    procedure DBGrid3TitleClick(Column: TColumn);
    procedure DBGrid4TitleClick(Column: TColumn);
    procedure FormShow(Sender: TObject);
    procedure TabLeadersShow(Sender: TObject);
    procedure TabMembersShow(Sender: TObject);
    procedure TabPrintsShow(Sender: TObject);


  private
    { private declarations }
    function DBGridToggleSort(AFieldName: String; dsGrid: TSQLQuery): boolean;
    function RecExists(tdb:TDatabase; selectfield:string; fromtable: string; whereequals:variant):boolean;
    procedure PrintDbGrid(dbGrid:TdbGrid);

  public
    { public declarations }
  end; 

var
  Form1: TForm1;


implementation

{ TForm1 }

//PRINT dbgrid
function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer;
begin
  Result:=Round(int64(nNumber)*int64(nNumerator)/nDenominator);
end;
procedure TForm1.PrintDbGrid(dbGrid:TdbGrid);
const
  LeftMargin = 0.05;
  TopMargin = 0.05;
  BottomMargin = 0.05;
var
  i: integer;
  x,y: integer;
begin
  if PrintDialog1.Execute then
    begin
    Printer.BeginDoc;
    Printer.Canvas.Font.Height := 72;

    //PLEASE CHANGE THE X AND Y / and DBGrid1(not set)
    Printer.Canvas.TextOut(1000,100,DBGrid1.SelectedField.Text);

    y := Round(TopMargin*Printer.PageHeight);
    dbGrid.DataSource.DataSet.First;
    while not dbGrid.DataSource.DataSet.Eof do
      begin
      x := Round(LeftMargin*Printer.PageWidth);
      for i := 0 to dbGrid.DataSource.DataSet.FieldCount-1 do
        begin
        printer.Canvas.TextOut(x,y,dbGrid.DataSource.DataSet.Fields[i].AsString);
        x := x + MulDiv(dbGrid.Columns[i].Width,72, dbGrid.Width);
        end;
      dbGrid.DataSource.DataSet.Next;
      y := y + printer.Canvas.TextHeight('A');
      if y > (1-TopMargin-BottomMargin)* Printer.PageHeight then
        begin
        y := Round(TopMargin*Printer.PageHeight);
        Printer.NewPage;
        end;
      end;
    Printer.EndDoc;
    end
    else
    label2.caption := 'NO PRINTER INSTALLED';
end;

//Sorting DBGrid Contents
function TForm1.DBGridToggleSort(AFieldName: String; dsGrid: TSQLQuery): boolean;
var
  ix: TIndexDef;
begin
 if dsGrid.IndexFieldNames <> '' then
 begin
   dsGrid.IndexFieldNames := '';
   ix := TIndexDef.Create(dsGrid.IndexDefs, AFieldName, AFieldName, [ixDescending]);
   dsGrid.IndexName := ix.Name;
 end
 else
 begin
   dsGrid.IndexName := '';
   dsGrid.IndexFieldNames := AFieldName;
 end;
end;


//check record exist
function TForm1.RecExists(tdb:TDatabase; selectfield:string; fromtable: string; whereequals:variant):boolean;
var qr:TSQLQuery;
begin
qr:=TSQLQuery.Create(self);
qr.DataBase := SQLite3Connection1;
qr.Params.CreateParam(ftUnknown,'we',ptUnknown);
qr.SQL.Text := 'select ' + selectfield + ' from ' + fromtable + ' where ' + selectfield + ' = :we';
qr.Params.ParamByName('we').AsString := whereequals;
qr.open;
if NOT qr.IsEmpty then result:=true else result:=false;
qr.Params.Clear;
qr.Close;
end;

//delete leader
procedure TForm1.Button2Click(Sender: TObject);
begin
  if SQLQuery1.RecordCount>0 then
  begin
  SQLQuery1.Delete;
  SQLQuery1.ApplyUpdates;
  SQLTransaction1.CommitRetaining;
  label2.caption := 'LEADER DELETED';
  end;
end;

//update leader
procedure TForm1.Button3Click(Sender: TObject);
begin
 if SQLQuery1.RecordCount>0 then
  begin
   SQLQuery1.Edit;
   SQLQuery1.Post;
   Sqlquery1.ApplyUpdates;
   SQLTransaction1.CommitRetaining;
   label2.caption := 'LEADER UPDATED';
   end;
end;

//newsave leaders
procedure TForm1.Button1Click(Sender: TObject);
begin
if Button1.Caption = 'New' then
begin
SQLQuery1.Insert;
Button1.Caption := 'Save';
Button2.Enabled := false;
Button3.Enabled := false;
DBGrid1.ReadOnly := True;
end
else
begin
if (DBEdit1.Text = '') or (DBEdit2.Text = '') then
begin
SQLQuery1.Cancel;
end;
if SQLQuery1.State = dsInsert then
begin

if RecExists(SQLite3Connection1, 'LEADER_ALIAS_NAME', 'LEADERS', DbEdit1.Text)
then
begin
SQLQuery1.Cancel;
label2.caption := 'LEADER ALREADY EXISTS';
end
else
begin
SQLQuery1.Post;
Sqlquery1.ApplyUpdates;
SQLTransaction1.CommitRetaining;
label2.caption := 'LEADER(S) UPDATED';
end;

end;
Button1.Caption := 'New';
Button2.Enabled := true;
Button3.Enabled := true;
DBGrid1.ReadOnly := False;
end;
end;


//newsave member
procedure TForm1.Button5Click(Sender: TObject);
begin
if Button5.Caption = 'New' then
begin
SQLQuery3.Insert;
Button5.Caption := 'Save';
Button6.Enabled := false;
Button7.Enabled := false;
DBGrid4.ReadOnly := True;
end
else
begin
if (DBEdit3.Text = '') or (DBEdit4.Text = '') then
begin
SQLQuery3.Cancel;
end;
if SQLQuery3.State = dsInsert then
begin

if RecExists(SQLite3Connection1, 'MEMBER_NAME', 'MEMBERS', DbEdit3.Text)
then
begin
SQLQuery3.Cancel;
label2.caption := 'MEMBER ALREADY EXISTS';
end
else
begin
SQLQuery3.Post;
Sqlquery3.ApplyUpdates;
SQLTransaction1.CommitRetaining;
label2.caption := 'MEMBER(S) UPDATED';
end;

end;
Button5.Caption := 'New';
Button6.Enabled := true;
Button7.Enabled := true;
DBGrid4.ReadOnly := False;
end;
end;

//delete a member
procedure TForm1.Button6Click(Sender: TObject);
begin
  if SQLQuery3.RecordCount>0 then
  begin
  SQLQuery3.Delete;
  SQLQuery3.ApplyUpdates;
  SQLTransaction1.CommitRetaining;
  label2.caption := 'MEMBER DELETED';
  end;
end;

//update a member
procedure TForm1.Button7Click(Sender: TObject);
begin
 if SQLQuery3.RecordCount>0 then
  begin
   SQLQuery3.Edit;
   SQLQuery3.Post;
   Sqlquery3.ApplyUpdates;
   SQLTransaction1.CommitRetaining;
   label2.caption := 'MEMBER UPDATED';
  end;
end;

procedure TForm1.DBGrid3CellClick(Column: TColumn);
begin
DbEdit4.Text := DBGrid3.SelectedField.Text;
end;

procedure TForm1.TabLeadersShow(Sender: TObject);
begin
label2.Caption := 'Query for Leaders';
end;

procedure TForm1.TabMembersShow(Sender: TObject);
begin
  label2.Caption := 'Query for Members';
end;

procedure TForm1.TabPrintsShow(Sender: TObject);
begin
   label2.Caption := 'Print Members according to Leader';
end;

procedure TForm1.DBGrid3TitleClick(Column: TColumn);
begin
  DBGridToggleSort(Column.FieldName, (Column.Field.DataSet as TSQLQuery));
end;

procedure TForm1.DBGrid4TitleClick(Column: TColumn);
begin
  DBGridToggleSort(Column.FieldName, (Column.Field.DataSet as TSQLQuery));
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
PrintDbGrid(DBGrid6);
end;


//(master-detail relationship)
{
    CHOOSE YOUR SQL_CONNECTION

    SQLite3Connection1 for SQLITE
    SQLConnector1 for MSSQL
    MySQL50Connection1 for MYSQL5
    OracleConnection1 for ORACLE
    IBConnection1 for INTERBASE
    PQConnection1 for POSTGRE

    Just replace  < SQLite3Connection1 > to any SQL con you would like
    eq., SQLite3Connection1 to MySQL50Connection1
}
procedure TForm1.FormShow(Sender: TObject);
begin
  SQLite3Connection1.Directory := '';
  SQLite3Connection1.DatabaseName := 'candid.db';
  SQLTransaction1.DataBase := SQLite3Connection1;
  SQLTransaction1.Action := caCommit;
  SQLTransaction1.Active := True;

  SQLite3Connection1.Transaction := SQLTransaction1;
  SQLite3Connection1.Connected := True;
  SQLQuery1.DataBase := SQLite3Connection1;
  SQLQuery1.SQL.Text := 'select distinct * from leaders';
  //SQLQuery1.SQL.Text := 'select * from leaders';
  SQLQuery1.Transaction := SQLTransaction1;
  SQLQuery1.UpdateMode := upWhereKeyOnly;

  Datasource1.DataSet := SQLQuery1;
  DbEdit1.DataField  := 'LEADER_ALIAS_NAME';
  DbEdit2.DataField  := 'PRECINCT_NUMBER';
  DbMemo1.DataField  := 'LEADER_NOTE';
  DbEdit1.DataSource := Datasource1;
  DbEdit2.DataSource := Datasource1;
  DbMemo1.DataSource := Datasource1;
  DBGrid1.DataSource := Datasource1;
  DBGrid3.DataSource := Datasource1;
  DBGrid5.DataSource := Datasource1;
  SQLQuery1.Open;


  SQLQuery2.DataBase := SQLite3Connection1;
  SQLQuery2.DataSource := Datasource1;
  SQLQuery2.Transaction := SQLTransaction1;
  SQLQuery2.UpdateMode := upWhereKeyOnly;
  SQLQuery2.SQL.Text := 'select distinct MEMBER_NAME from MEMBERS where MEMBER_LEADERS_NAME = :LEADER_ALIAS_NAME';
  //SQLQuery2.SQL.Text := 'select MEMBER_NAME from MEMBERS where MEMBER_LEADERS_NAME = :LEADER_ALIAS_NAME';
  Datasource2.DataSet := SQLQuery2;
  DBGrid2.DataSource := Datasource2;
  DBGrid6.DataSource := Datasource2;
  SQLQuery2.Open;

  SQLQuery3.DataBase := SQLite3Connection1;
  SQLQuery3.Transaction := SQLTransaction1;
  SQLQuery3.SQL.Text := 'select distinct * from MEMBERS';
  //SQLQuery3.SQL.Text := 'select * from MEMBERS';
  SQLQuery3.UpdateMode := upWhereKeyOnly;
  Datasource3.DataSet := SQLQuery3;
  DBGrid4.DataSource := Datasource3;
  DbEdit3.DataField  := 'MEMBER_NAME';
  DbEdit4.DataField  := 'MEMBER_LEADERS_NAME';
  DbMemo2.DataField  := 'MEMBER_NOTE';
  DbEdit3.DataSource := Datasource3;
  DbEdit4.DataSource := Datasource3;
  DbMemo2.DataSource := Datasource3;
  SQLQuery3.Open;
end;

initialization
  {$I unit1.lrs}

end.


THE SOURCE CODE: http://www.mediafire.com/file/wdb99x40alvjkxi/SQLdb_update2.zip