[lazarus] MySQL and Lazarus.
Rainer Hamann
rainer at hamann-kiel.de
Wed Feb 19 12:25:41 EST 2003
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;
with ColEditor[eCol] as TComboBox do begin
if Text <> '' then begin
exists := false;
for n := 0 to Items.Count-1 do begin
if pos(Text, Items[n]) = 1 then begin
exists := true;
break;
end;
end;
if not exists then begin
Text := copy(Text, 1, Length(Text)-1);
Application.ProcessMessages;
beep;
end;
if OnEditorChange <> nil then begin
OnEditorChange(Text, eCol, eRow);
end;
end;
end;
end;
end;
procedure TDataGrid.ComboBoxKeyDown(Sender : TObject; var Key: Word; Shift: TShiftState);
begin
if Key = VK_RETURN then begin
with Sender as TComboBox do begin
Cells[eCol, eRow] := Text;
ChangeCellSelected(Text);
Hide;
end;
KeyDown(Key, Shift);
Key := 0;
end;
end;
procedure TDataGrid.CopyEditType(FromCol, ToCol : integer);
begin
ColEditor[ToCol] := ColEditor[FromCol];
ColEditorType[ToCol] := ColEditorType[FromCol];
ColEditorIsCopy[ToCol] := true;
end;
procedure TDataGrid.DateClick(Sender : TObject);
var
d : string;
begin
with ColEditor[eCol] as TDatePicker do begin
d := Calendar.Date;
while pos('-', d) > 0 do begin
d[pos('-', d)] := '.';
end;
ChangeCellSelected(d);
Hide;
end;
end;
procedure TDataGrid.EditExit;
var
NewCol, NewRow : integer;
ok : boolean;
begin
EditorToCell(eCol, eRow, NewCol, NewRow, ok);
eCol := -1;
eRow := -1;
end;
procedure TDataGrid.EditKeyDown(Sender : TObject; var Key: Word; Shift: TShiftState);
begin
if Key = VK_RETURN then begin
with Sender as TEdit do begin
Cells[eCol, eRow] := Text;
ChangeCellSelected(AnsiToWin(Text));
Hide;
end;
KeyDown(Key, Shift);
Key := 0;
end;
end;
procedure TDataGrid.EditorToCell(OldCol, OldRow : integer; var NewCol, NewRow : integer; var ok : boolean);
var
n : integer;
begin
ok := true;
if (OldCol >= 0) and (ColEditor[OldCol] <> nil) then begin
case ColEditorType[OldCol] of
dgEdit :
begin
with ColEditor[OldCol] as TEdit do begin
ChangeCellSelected(AnsiToWin(Text));
Hide;
end;
end;
dgComboBox :
begin
with ColEditor[OldCol] as TComboBox do begin
ok := false;
if Text <> '' then begin
for n := 0 to Items.Count-1 do begin // workaround, no OnChange event !!!
if Items[n] = Text then begin
ok := true;
break;
end;
end;
end;
if ok or (Text = '') then begin
ChangeCellSelected(Text);
Hide;
end
else begin
MessageDlg(Text+' ist nicht erlaubt!', mtError, [mbOk], 0);
NewCol := OldCol; // once again!
NewRow := OldRow;
end;
end;
end;
end;
end;
end;
function TDataGrid.GetDBIndex(DBCol, DBRow: Integer): string;
var
i : ^integer;
begin
i := FDBIndex.Arr[DBCol, DBRow];
if i <> nil then begin
if i^ > 0 then begin
GetDBIndex := IntToStr(i^);
end
else begin
GetDBIndex := '';
end;
end
else begin
GetDBIndex := '';
end;
end;
procedure TDataGrid.KeyDown(var Key: Word; Shift: TShiftState);
var
n, dx, dy : integer;
begin
if Key = VK_RETURN then begin
case OkDirection of
okRight :
begin
n := eColLast + 1;
dx := 1;
dy := 0;
while (n < ColCount-1) and (ColEditor[n] = nil) do begin
inc(n);
inc(dx);
end;
if (n >= ColCount-1) and (ColEditor[n] = nil) then begin
n := 0;
dx := -eColLast;
inc(dy);
while (n < ColCount-1) and (ColEditor[n] = nil) do begin
inc(n);
inc(dx);
end;
end;
MoveExtend(true, dx, dy);
end;
okDown :
begin
if eRowLast < RowCount-1 then begin
MoveExtend(true, 0, 1);
end
else begin
MoveExtend(false, FixedCols, eColLast);
end;
end;
end;
end;
end;
procedure TDataGrid.SelectCell(ColNr, RowNr : integer);
begin
MoveExtend(false, ColNr, RowNr);
end;
procedure TDataGrid.SelectEditType(ColNr : integer; EditType : TColEditor);
begin
if ColEditor[ColNr] <> nil then begin
ColEditor[ColNr].Free;
end;
case EditType of
dgEdit :
begin
ColEditor[ColNr] := TEdit.Create(self);
with ColEditor[ColNr] as TEdit do begin
OnKeyDown := @EditKeyDown;
end;
end;
dgComboBox :
begin
ColEditor[ColNr] := TComboBox.Create(self);
with ColEditor[ColNr] as TComboBox do begin
OnKeyPress := @ComboBoxChange;
OnKeyDown := @ComboBoxKeyDown;
Style := csDropDownList;
end;
end;
dgDate :
begin
ColEditor[ColNr] := TDatePicker.Create(self);
with ColEditor[ColNr] as TDatePicker do begin
Ok.OnClick := @DateClick;
end;
end;
end;
if ColEditor[ColNr] <> nil then begin
ColEditorType[ColNr] := EditType;
ColEditor[ColNr].Text := '';
ColEditor[ColNr].Parent := self;
ColEditor[ColNr].Visible := false;
ColEditorIsCopy[ColNr] := false;
end;
end;
procedure TDataGrid.Selection(Sender: TObject; ColNr, RowNr : integer);
var
r : TRect;
s : string;
ok : boolean;
begin
// ShowMessage(IntToStr(eCol)+' | '+IntToStr(eRow)+' -> '+IntToStr(ColNR)+' | '+IntToStr(RowNr));
if (ColNr <> eCol) or (RowNr <> eRow) then begin // force something like "OnExit"
EditorToCell(eCol, eRow, ColNr, RowNr, ok);
Application.ProcessMessages;
if (eCol < 0) or (eRow < 0) then begin // new Cell selected
if OnCellEnter <> nil then begin
OnCellEnter(ColNr, RowNr);
end;
if ColEditor[ColNr] <> nil then begin
case ColEditorType[ColNr] of
dgEdit :
begin
with ColEditor[ColNr] as TEdit do begin
Text := WinToAnsi(Cells[ColNr, RowNr]);
end;
end;
dgComboBox :
begin
with ColEditor[ColNr] as TComboBox do begin
Text := Cells[ColNr, RowNr];
end;
end;
dgDate :
begin
s := Cells[ColNr, RowNr];
if s = '' then begin
s := DateToStr(Date);
end;
while pos('.', s) > 0 do begin
s[pos('.', s)] := '-';
end;
with ColEditor[ColNr] as TDatePicker do begin
Calendar.Date := s;
end;
end;
end;
end;
end;
r := CellRect(ColNr, RowNr);
if ColEditor[ColNr] <> nil then begin
ColEditor[ColNr].Top := r.Top;
ColEditor[ColNr].Left := r.Left;
if ColEditorType[ColNr] <> dgDate then begin
ColEditor[ColNr].Height := r.Bottom - r.Top;
ColEditor[ColNr].Width := r.Right - r.Left;
LastEditText := ColEditor[ColNr].Text;
end;
ColEditor[ColNr].Show;
end;
eCol := ColNr;
eRow := RowNr;
if ColEditor[ColNr] <> nil then begin
Timer.Enabled := true;
TimerFirst := true;
end;
Application.ProcessMessages;
if not ok then begin
SelectCell(ColNr, RowNr);
end;
end;
end;
procedure TDataGrid.SetDBIndex(DBCol, DBRow: Integer; const AValue: string);
var
i : ^integer;
begin
if FDBIndex.Arr[DBCol, DBRow] <> nil then begin
i := FDBIndex.Arr[DBCol, DBRow];
FreeMem(i);
end;
GetMem(i, sizeof(i));
FDBIndex.Arr[DBCol, DBRow] := i;
if AValue <> '' then begin
i^ := StrToInt(AValue);
end
else begin
i^ := -1;
end;
end;
procedure TDataGrid.TimerEvent(Sender : TObject);
var
Key : char;
begin
Timer.Enabled := false;
if ColEditor[eCol] <> nil then begin
if TimerFirst then begin
ColEditor[eCol].SetFocus;
TimerFirst := false;
end;
if ColEditorType[eCol] <> dgDate then begin
if LastEditText <> ColEditor[eCol].Text then begin
LastEditText := ColEditor[eCol].Text;
case ColEditorType[eCol] of
dgComboBox :
begin
Key := #0;
ComboBoxChange(Sender, Key);
end;
end;
end;
end;
end;
Timer.Enabled := true;
end;
procedure TDataGrid.TopLeftChanged(Sender : TObject);
var
r : TRect;
n, eTop, eLeft : integer;
begin
if IsTopLeftChange then begin
exit;
end;
IsTopLeftChange := true;
inherited OnTopLeftChange(Sender);
if (eCol >= 0) and (eRow >= 0) then begin
r := CellRect(eCol, eRow);
eLeft := 0;
for n := 0 to FixedCols-1 do begin
inc(eLeft, ColWidths[n]);
end;
eTop := 0;
for n := 0 to FixedRows-1 do begin
inc(eTop, RowHeights[n]);
end;
if ColEditor[eCol] <> nil then begin
if (eLeft <= r.Left) and (eTop <= r.Top) and (r.Top < Height) and (r.Left < Width) then begin
ColEditor[eCol].Top := r.Top;
ColEditor[eCol].Left := r.Left;
if ColEditorType[eCol] <> dgDate then begin
ColEditor[eCol].Height := r.Bottom - r.Top;
ColEditor[eCol].Width := r.Right - r.Left;
end;
ColEditor[eCol].Show;
end
else begin
ColEditor[eCol].Hide;
end;
end;
end;
IsTopLeftChange := false;
end;
end.
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;
function TMySQLDB.SetQuery(Anfrage : string) : integer;
begin
if not Connected then begin
exit;
end;
ErrorCode := 0;
KorrigiereTabellennamen(Anfrage);
if mysql_query(SQL, PChar(Anfrage)) < 0 then begin
ShowMessage('Fehler bei der Anfrage "'+Anfrage+'"! '+mysql_error(SQL));
end;
SetQuery := ErrorCode;
end;
procedure TMySQLDB.LiesElement(Zeile, Spalte : integer; var Wert : string);
begin
if not Connected then begin
Wert := '';
exit;
end;
if (Zeile < RowCount) and (Spalte < ColCount) and (ErrorCode = 0) then begin
Wert := Daten[Spalte, Zeile];
end
else begin
Wert := '';
end;
end;
procedure TMySQLDB.MySQLDBCREATE(Sender: TObject);
begin
SQL := nil;
Connected := false;
end;
initialization
{$I fmysqldb.lrs}
end.
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
More information about the Lazarus
mailing list