User:Rocarobin
From Lazarus wiki
Jump to navigationJump to searchThe 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