[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