[lazarus] MySQL and Lazarus.
Jesus Reyes
jesusrmx at yahoo.com.mx
Wed Feb 19 14:38:01 EST 2003
--- Rainer Hamann <rainer at hamann-kiel.de> escribió: > I've a very
small component called TMySQLDB, which encapsulates
> mysql.pas,
> which is part of the fpc compiler. You will find it as attachment.
> Another
> component creates datagrids based on TMySQLDB and TStringGrid from
> Jesus R.,
> but this component has one bug, because one has to click on another
> cell
> before the upper left one can be used.
>
> Rainer Hamann
>
> > There ins`t database components for lazarus as is in delphi?
> > Where can i find some exemple codes for acessing MySQL from
> lazarus?
> > I`m used to mysql++ in c++ and got only sigv(Access violation) in
> my
> > tryings,i`m not used to pascal anymore(i once were a delphi
> programer but
> > from many years ago i work most with c++ and some tcl).
> >
> > _________________________________________________________________
> > To unsubscribe: mail lazarus-request at miraclec.com with
> > "unsubscribe" as the Subject
> > archives at http://www.lazarus.freepascal.org/mailarchives
> > unit datagrid;
>
> {$mode objfpc}{$H+}
>
> interface
>
> uses
> Classes, SysUtils, Controls, StdCtrls, ExtCtrls, Buttons,
> dynamicarray, grids,
> Calendar, Dialogs, LCLType, Forms, LMessages, Messages, FMySQLDB;
>
> type
> TColEditor = (dgNone, dgEdit, dgComboBox, dgDate);
> TOkDirection = (okRight, okDown);
>
> TDatePicker = class(TPanel)
> Calendar : TCalendar;
> Ok : TButton;
> public
> constructor Create(AOwner: TComponent);
> destructor Destroy;
> end;
>
> TOnCellChange = procedure(NewContent : string; ColNr, RowNr :
> integer) of Object;
> TOnCellEnter = procedure(ColNr, RowNr : integer) of Object;
>
> TDataGrid = class(TStringGrid)
> Timer : TTimer;
> private
> eRow, eCol, eRowLast, eColLast : integer; // selected
> cell, editing enabled
> IsTopLeftChange, TimerFirst : boolean;
> LastEditText : string;
> procedure LMExit(var Msg: TLMExit); message LM_EXIT;
> function GetDBIndex(DBCol, DBRow: Integer): string;
> procedure SetDBIndex(DBCol, DBRow: Integer; const AValue:
> string);
> public
> FDBIndex : TArray;
> OnCellChange : TOnCellChange;
> OnCellEnter : TOnCellEnter;
> OnEditorChange : TOnCellChange;
> public
> ColEditor : array[0..MaxSpalten] of TWinControl;
> ColEditorIsCopy : array[0..MaxSpalten] of boolean;
> ColEditorType : array[0..MaxSpalten] of TColEditor;
> OkDirection : TOkDirection;
> constructor Create(AOwner: TComponent); override;
> destructor Destroy; override;
> property DBIndex[ACol, ARow : integer] : string read
> GetDBIndex write SetDBIndex;
> // property ColCount: integer read FColCount write
> SetColCount;
> // property RowCount: integer read FRowCount write
> SetRowCount;
> procedure ChangeCellSelected(NewText : string);
> procedure ClearGrid(ColStart, RowStart : integer);
> procedure ComboBoxChange(Sender : TObject; var Key : char);
> procedure ComboBoxKeyDown(Sender : TObject; var Key: Word;
> Shift: TShiftState);
> procedure CopyEditType(FromCol, ToCol : integer);
> procedure DateClick(Sender : TObject);
> procedure EditExit;
> procedure EditKeyDown(Sender : TObject; var Key: Word;
> Shift: TShiftState);
> procedure EditorToCell(OldCol, OldRow : integer; var
> NewCol, NewRow : integer; var ok : boolean);
> procedure KeyDown(var Key: Word; Shift: TShiftState);
> override;
> procedure SelectCell(ColNr, RowNr : integer);
> procedure SelectEditType(ColNr : integer; EditType :
> TColEditor);
> procedure Selection(Sender: TObject; ColNr, RowNr :
> integer);
> procedure TimerEvent(Sender : TObject);
> procedure TopLeftChanged(Sender : TObject);
> end;
>
> implementation
>
> uses
> LowLevelProcs;
>
> constructor TDatePicker.Create(AOwner: TComponent);
> begin
> inherited Create(AOwner);
> Calendar := TCalendar.Create(AOwner);
> Calendar.Parent := self;
> Calendar.Top := 0;
> Calendar.Left := 0;
> Calendar.Visible := true;
> Ok := TButton.Create(AOwner);
> Ok.Parent := self;
> Ok.Caption := 'ok';
> Ok.Left := 0;
> Ok.Top := Calendar.Height + 1;
> Ok.Height := 24;
> Ok.Width := Calendar.Width;
> Ok.Visible := true;
> Width := Calendar.Width;
> Height := Calendar.Height + Ok.Height + 2;
> end;
>
> destructor TDatePicker.Destroy;
> begin
> Calendar.Free;
> Ok.Free;
> inherited;
> end;
>
>
> constructor TDataGrid.Create(AOwner: TComponent);
> var
> n : integer;
> begin
> inherited Create(AOwner);
> for n := 0 to MaxSpalten do begin
> ColEditor[n] := nil;
> ColEditorIsCopy[n] := false;
> end;
> eCol := -1;
> eRow := -1;
> IsTopLeftChange := false;
> LastEditText := '';
> OkDirection := okRight;
> OnSelection := @Selection;
> OnTopLeftChange := @TopLeftChanged;
> OnCellChange := nil;
> OnCellEnter := nil;
> OnEditorChange := nil;
> FDBIndex := TArray.Create;
> FDBIndex.SetLength(MaxSpalten, MaxZeilen);
> Timer := TTimer.Create(self);
> Timer.Enabled := false;
> Timer.Interval := 100;
> Timer.OnTimer := @TimerEvent;
> end;
>
> destructor TDataGrid.Destroy;
> var
> n : integer;
> begin
> for n := 0 to MaxSpalten do begin
> if not ColEditorIsCopy[n] and (ColEditor[n] <> nil) then
> begin
> ColEditor[n].Free;
> end;
> end;
> Timer.Free;
> FDBIndex.Free;
> inherited;
> end;
>
> procedure TDataGrid.LMExit(var Msg: TLMExit);
> var
> ok : boolean;
> begin
> if ColEditor[eCol] <> nil then begin
> EditorToCell(eCol, eRow, eCol, eRow, ok);
> end;
> end;
>
> procedure TDataGrid.ClearGrid(ColStart, RowStart : integer);
> var
> i, n : integer;
> begin
> if (eCol >= 0) and (ColEditor[eCol] <> nil) then begin
> ColEditor[eCol].Hide;
> end;
> for i := RowStart to RowCount-1 do begin
> for n := ColStart to ColCount-1 do begin
> Cells[n, i] := '';
> DBIndex[n, i] := '';
> end;
> end;
> end;
>
> procedure TDataGrid.ChangeCellSelected(NewText : string);
> begin
> if (eCol >= 0) and (eRow >= 0) {and (Cells[eCol, eRow] <>
> NewText)} then begin
> Cells[eCol, eRow] := NewText;
> if OnCellChange <> nil then begin
> OnCellChange(Newtext, eCol, eRow);
> end;
> end;
> eColLast := eCol;
> eRowLast := eRow;
> eCol := -1;
> eRow := -1;
> end;
>
> procedure TDataGrid.ComboBoxChange(Sender : TObject; var Key :
> char);
> var
> n : integer;
> exists : boolean;
> begin
> if (eCol >= 0) and (ColEditor[eCol] <> nil) then begin
> Application.ProcessMessages;
>
=== message truncated ===> unit fmysqldb;
>
> {$mode objfpc}{$H+}
>
> interface
>
> uses
> Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
> LResources, mysql, grids;
>
> const
> MaxSpalten = 20;
> MaxZeilen = 1000;
> MaxTables = 200;
> Alpha = ['a'..'z', 'A'..'Z', 'ä', 'ö', 'ü', 'Ä', 'Ö', 'Ü',
> 'ß', '_'];
> AlphaNumeric = ['0'..'9'] + Alpha;
>
> type
> TTable = record
> Name, UpStringName : string;
> end;
>
> TMySQLDB = class(TForm)
> procedure MySQLDBCREATE(Sender: TObject);
> private
> { private declarations }
> Connected : boolean;
> ErrorCode, RowCount, ColCount, TableCount : integer;
> SQL : PMYSQL;
> QMySQL : TMYSQL;
> recbuf : PMYSQL_RES;
> rowbuf : TMYSQL_ROW;
> Daten : array[0..MaxSpalten, 0..MaxZeilen] of string;
> Table : array[0..MaxTables] of TTable;
> public
> { public declarations }
> function Tabellenindex(Tabellenname : string) : integer;
> procedure KorrigiereTabellennamen(var Anfrage : string);
> function Connect(MySQLUser, MySQLPasswort, MySQLDatenbank,
> MySQLHost : string; MySQLPort : integer) : boolean;
> procedure Disconnect;
> function GetQuery(Anfrage : string; var Zeilenzahl, Spaltenzahl
> : integer) : integer;
> function SetQuery(Anfrage : string) : integer;
> procedure LiesElement(Zeile, Spalte : integer; var Wert :
> string);
> end;
>
> var
> MySQLDB: TMySQLDB;
>
> implementation
>
> uses
> LowLevelProcs;
>
> function TMySQLDB.Tabellenindex(Tabellenname : string) : integer;
> var
> n : integer;
> begin
> if Tabellenname <> '' then begin
> for n := 0 to TableCount-1 do begin
> if Tabellenname = Table[n].UpStringName then begin
> Tabellenindex := n;
> exit;
> end;
> end;
> end;
> Tabellenindex := -1;
> end;
>
> procedure TMySQLDB.KorrigiereTabellennamen(var Anfrage : string);
> var
> i, n, m, Wortstart : integer;
> s : string;
> begin
> n := 0;
> while n < Length(Anfrage) do begin
> while (n <= Length(Anfrage)) and not (Anfrage[n] in
> Alpha) do begin
> if Anfrage[n] = '"' then begin
> inc(n);
> while (n <= Length(Anfrage)) and (Anfrage[n] <>
> '"') do begin
> inc(n);
> end;
> end;
> inc(n);
> end;
> s := '';
> Wortstart := n;
> while (n <= Length(Anfrage)) and (Anfrage[n] in
> AlphaNumeric) do begin
> s := s + UpCase(Anfrage[n]);
> inc(n);
> end;
> m := Tabellenindex(s);
> if m >= 0 then begin
> delete(Anfrage, Wortstart, Length(s));
> system.insert(Table[m].Name, Anfrage, Wortstart);
> n := Wortstart + Length(Table[m].Name);
> end;
> end;
> end;
>
> function TMySQLDB.Connect(MySQLUser, MySQLPasswort, MySQLDatenbank,
> MySQLHost : string; MySQLPort : integer) : boolean;
> var
> Zeilenzahl, Spaltenzahl : integer;
> s : string;
> begin
> if Connected then begin
> Disconnect;
> end;
> mysql_port := MySQLPort;
> SQL := mysql_connect(@QMySQL, PChar(MySQLHost),
> PChar(MySQLUser), PChar(MySQLPasswort));
> if SQL = nil then begin
> ShowMessage('Verbindung zum MySQL-Server ist
> fehlgeschlagen! '+mysql_error(@QMySQL));
> exit;
> end;
> if mysql_select_db(SQL, PChar(MySQLDatenbank)) < 0 then begin
> ShowMessage('Konnte die Datenbank '+MySQLDatenbank+' nicht
> aktivieren! '+mysql_error(SQL));
> exit;
> end;
> Connected := true;
> TableCount := 0;
> if GetQuery('SHOW Tables', Zeilenzahl, Spaltenzahl) = 0 then
> begin
> while TableCount < Zeilenzahl do begin
> LiesElement(TableCount, 0, s);
> Table[TableCount].Name := copy(s, 1, Length(s));
> Table[TableCount].UpStringName :=
> string(StrUpper(PChar(s)));
> inc(TableCount);
> end;
> end;
> Connect := Connected;
> end;
>
> procedure TMySQLDB.Disconnect;
> begin
> if not Connected then begin
> exit;
> end;
> mysql_close(SQL);
> Connected := false;
> end;
>
> function TMySQLDB.GetQuery(Anfrage : string; var Zeilenzahl,
> Spaltenzahl : integer) : integer;
> var
> x, y : integer;
> begin
> if not Connected then begin
> exit;
> end;
> ErrorCode := 0;
> RowCount := 0;
> ColCount := 0;
> Zeilenzahl := 0;
> Spaltenzahl := 0;
> KorrigiereTabellennamen(Anfrage);
> if mysql_query(SQL, PChar(Anfrage)) < 0 then begin
> ShowMessage('Fehler bei der Anfrage "'+Anfrage+'"!
> '+mysql_error(SQL));
> exit;
> end;
> recbuf := mysql_store_result(SQL);
> Zeilenzahl := mysql_num_rows(recbuf);
> Spaltenzahl := mysql_num_fields(recbuf);
> RowCount := Zeilenzahl;
> ColCount := Spaltenzahl;
> rowbuf := mysql_fetch_row(recbuf);
> for y := 0 to Zeilenzahl-1 do begin
> if y < MaxZeilen then begin
> for x := 0 to Spaltenzahl-1 do begin
> if x < MaxSpalten then begin
> Daten[x, y] := rowbuf[x];
> end;
> end;
> end;
> rowbuf := mysql_fetch_row(recbuf);
> end;
> if Zeilenzahl > MaxZeilen then begin
> MessageDlg('Konnte nur '+IntToStr(MaxZeilen)+' von
> '+IntToStr(Zeilenzahl)+' einlesen, da zu wenig Speicherplatz
> vorgesehen ist.', mtError, [mbOk], 0);
> end;
> if Spaltenzahl > MaxSpalten then begin
> MessageDlg('Konnte nur '+IntToStr(MaxSpalten)+' von
> '+IntToStr(Spaltenzahl)+' einlesen, da zu wenig Speicherplatz
> vorgesehen ist.', mtError, [mbOk], 0);
> end;
> mysql_free_result (recbuf);
> GetQuery := ErrorCode;
> end;
>
>
=== message truncated ===> object MySQLDB: TMySQLDB
> CAPTION = 'Schnittstelle zu MySQL'
> CLIENTHEIGHT = 300
> CLIENTWIDTH = 400
> ONCREATE = MySQLDBCREATE
> HORZSCROLLBAR.PAGE = 401
> VERTSCROLLBAR.PAGE = 301
> LEFT = 290
> HEIGHT = 300
> TOP = 176
> WIDTH = 400
> end
>
Hi, I would like to test this, can you pack the project so I can open
with lazarus?. Thanks.
About dataset components, some days ago I released in this list an
archive with some test work about TDBGrid + TDataSource + Demo using
TDataSet derivatives as TIBQuery and TMySQLDataset. Some changes in
fcl/db must be done to get TDataSource working, but i put all files
in one directory so is not necesary to modify original files (only
grids.pas [included] which need to go temporally to lcl directory)
here is the link again:
http://mx.geocities.com/jesusrmx/lazarus/dbgrid.tar.gz
Regards.
Jesus Reyes A.
_________________________________________________________
Do You Yahoo!?
La mejor conexión a internet y 25MB extra a tu correo por $100 al mes. http://net.yahoo.com.mx
More information about the Lazarus
mailing list