In this example I will show you how to use external fonts in your application, without installing font.
Following video shows details about creating this example, and below this video you can find source code for showed example.
implementation
//this is procedure to get files in folder with filter just to search for ttf ( font)files
//and to put them in a stringlist
procedure ListFileDir(Path: string; FileList: TStrings);
var
SR: TSearchRec;
begin
if FindFirst(Path + '*.ttf', faAnyFile, SR) = 0 then begin
repeat
if (SR.Attr <> faDirectory) then begin
FileList.Add(SR.Name);
end;
until FindNext(SR) <> 0;
FindClose(SR);
end;
end;
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
begin
if FontDialog1.Execute then
begin
Label1.Font:=FontDialog1.Font;
end;
end;
procedure TForm2.Edit1Change(Sender: TObject);
begin
Label1.Font.Size:=StrToInt(Edit1.Text);
end;
procedure TForm2.Edit2Change(Sender: TObject);
begin
Label1.Caption:=Edit2.Text;
end;
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var i:Integer;
begin
CanClose:=False;
Screen.Cursor:=crHourGlass;
//we need to remove fonts from memory
for I := 0 to Strl.Count-1 do
begin
RemoveFontResource(PChar(pthx+Strl[i]));
SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
end;
Strl.Free;
Screen.Cursor:=crDefault;
CanClose:=True;
end;
procedure TForm2.FormCreate(Sender: TObject);
var i:Integer;
begin
pthx:=ExtractFilePath(Application.ExeName);
Strl:=TStringList.Create;
Strl.Duplicates:=dupIgnore;
//get font files
ListFileDir(pthx,Strl);
for I := 0 to Strl.Count-1 do
begin
AddFontResource(PChar(pthx+Strl[i]));
SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
end;
ListBox1.Items.AddStrings(Strl);
end;
procedure TForm2.ListBox1Click(Sender: TObject);
begin
if ListBox1.SelCount<>0 then
begin
//this is a way to remove extension from file name , we put empty string
Label1.Font.Name:=ChangeFileExt(ListBox1.Items[ListBox1.ItemIndex],'');
end;
end;
procedure TForm2.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
Edit1.Text:=IntToStr(UpDown1.Position);
end;
For this app to create you will need "sqlite3.dll" file which you can download from : https://sqlite.org/
or you can download file that I used in this example together with exe file:
https://drive.google.com/open?id=0B_njK7HczCjDcjRrTlNNM0g4R2M
Just save it in the same folder where your exe file will be, and link to it in you application like I explained in video tutorial.
The third thing you need is installed ZeosDBO components for Delphi, from ZeosLib Development Group, and the lates source code you can find at http://www.sourceforge.net/projects/zeoslib
/*****************************************************************************/
Basically that are tools that you need.
We start with creating new project , adding necesary components on the form and writting code to achieve what we want.
In the video you can see all these steps, and in the code for showed example you can see details.
procedure TfrmMain.Button1Click(Sender: TObject);
begin
ZConn.Protocol:='sqlite-3';
ZConn.LibraryLocation:=ExtractFilePath(Application.ExeName)+'sqlite3.dll';
if not FileExists(ZConn.LibraryLocation) then Exit;
ZConn.Database:=ExtractFilePath(Application.ExeName)+'testdb.s3db';
//if not FileExists(ZConn.Database) then Exit;
ZConn.Connect;
Label2.Caption:='testdb.s3db';
ComboBox1.Items.Clear;
ZConn.GetTableNames('',ComboBox1.Items);
ComboBox1.ItemIndex:=0;
ComboBox1.OnChange(Self);
end;
procedure TfrmMain.Button2Click(Sender: TObject);
begin
ZQuery1.Close;
ZQuery1.SQL.Clear;
ZQuery1.SQL.Add('CREATE TABLE if not exists testtbl(id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL,'
+'name VARCHAR(255),surname VARCHAR(255), UNIQUE(id))') ;
ZQuery1.ExecSQL;
procedure TfrmMain.Button3Click(Sender: TObject);
begin
if Edit1.Text<>'' then
begin
ZQuery1.SQL.Clear;
ZQuery1.SQL.Add('Insert into testtbl(name,surname) values('+QuotedStr(Edit1.Text)+','+QuotedStr(Edit2.Text)+')');
ZQuery1.ExecSQL;
ComboBox1.OnChange(Self);
end;
end;
procedure TfrmMain.Button4Click(Sender: TObject);
begin
ZQuery1.SQL.Clear;
ZQuery1.SQL.Add('Update testtbl set name='+QuotedStr(Edit3.Text)+',surname='+QuotedStr(Edit4.Text)
+' where id='+QuotedStr(Label8.Caption));
ZQuery1.ExecSQL;
ComboBox1.OnChange(Self);
end;
procedure TfrmMain.Button5Click(Sender: TObject);
begin
ZQuery2.Delete;
end;
procedure TfrmMain.ComboBox1Change(Sender: TObject);
var i :Integer;
begin
ZQuery2.Close;
ZQuery2.SQL.Clear;
ZQuery2.SQL.Add('Select * from '+ComboBox1.Text);
ZQuery2.Open;
for I := 0 to DBGrid1.Columns.Count-1 do
begin
DBGrid1.Columns[i].Width:=100;
end;
end;
procedure TfrmMain.DBGrid1CellClick(Column: TColumn);
begin
Edit3.Text:=ZQuery2.FieldByName('name').AsString;
Edit4.Text:=ZQuery2.FieldByName('surname').AsString;
label8.Caption:=ZQuery2.FieldByName('id').AsString;
end;
After you manage to create this application, you will actually have small MySQL manager.
To achieve this you will have to have access to MySQL server.
In this tutorial I am using portable version of server called „USBWebserver“ which can be downloaded from : www.usbwebserver.net
Here you can see default port to Apache and MySQL server, and if you click on the button PHPMyadmin,
PHPMyAdmin will be opened in default web browser where you will see that default user for accessing PHPMyAdmin is „root“ and default password is „usbw“.
In this example I used these data to access MySQL.
You also have option online with some free MySQL servers, just google something like „free mysql server „ or something like that.
Just pay attention on username , password and port number.
/*****************************************************************************/
Second thing you need to have is „libmysql.dll“ file which is a part of the MySQL Connector, you can find one on official MySQL web page, or to download the one that I used in this example :
https://drive.google.com/open?id=0B_njK7HczCjDMGRVMGhGbUk1OHc
Just save it in the same folder where your exe file will be, and link to it in you application like I explained in video tutorial (ZConnection1.LibraryLocation:=ExtractFilePath(Application.ExeName)+'libmysql.dll';)
/*****************************************************************************/
The third thing you need is installed ZeosDBO components for Delphi, from ZeosLib Development Group, and the lates source code you can find at http://www.sourceforge.net/projects/zeoslib
/*****************************************************************************/
Basically that are tools that you need.
We start with creating new project , adding necesary components on the form and writting code to achieve what we want.
In the video you can see all these steps, and in the code for showed example you can see details.
procedure TfrmMain.Button1Click(Sender: TObject);
var i:Integer;
begin
with ZConnection1 do begin
Disconnect;
Protocol:='mysql';
LibraryLocation:=ExtractFilePath(Application.ExeName)+'libmysql.dll';
HostName:=txtHost.Text;
Port:=StrToInt(txtPort.Text);
User:=txtUser.Text;
Password:=txtPass.Text;
Connect;
end;
cboDatabases.Items.Clear;
ZConnection1.GetCatalogNames(cboDatabases.Items);
cboDatabases.ItemIndex:=0;
end;
procedure TfrmMain.Button2Click(Sender: TObject);
begin
ZConnection1.Disconnect;
end;
procedure TfrmMain.Button3Click(Sender: TObject);
begin
ZQuery1.Close;
ZQuery1.SQL.Clear;
ZQuery1.SQL.Add('CREATE DATABASE '+txtDBName.Text+' DEFAULT CHARACTER SET utf8 COLLATE utf8_unicode_ci;');
ZQuery1.ExecSQL;
Button1.Click;
cboDatabases.Items.Clear;
ZConnection1.GetCatalogNames(cboDatabases.Items);
cboDatabases.ItemIndex:=0;
end;
procedure TfrmMain.Button4Click(Sender: TObject);
begin
ZQuery1.Close;
ZQuery1.SQL.Clear;
ZQuery1.SQL.Add('CREATE TABLE IF NOT EXISTS '+txtNewTable.Text
+'(id MEDIUMINT(8) UNSIGNED NOT NULL AUTO_INCREMENT, Name VARCHAR(50), Surname VARCHAR(50),'
+'PRIMARY KEY(id) )DEFAULT CHARACTER SET utf8 COLLATE utf8_unicode_ci;');
ZQuery1.ExecSQL;
cmdConnectDB.Click;
end;
procedure TfrmMain.Button5Click(Sender: TObject);
var nmx,surnmx :string;
begin
nmx:=txtName.Text;
surnmx:=txtSurname.Text;
ZQuery1.Close;
ZQuery1.SQL.Clear;
ZQuery1.SQL.Add('INSERT INTO '+cboTables.Text+'(Name,Surname)'
+' VALUES ("'+nmx+'", "'+surnmx+'")');
ZQuery1.ExecSQL;
cmdOpenTable.Click;
end;
procedure TfrmMain.cmdConnectDBClick(Sender: TObject);
begin
ZConnection1.Disconnect;
ZConnection1.Database:=cboDatabases.Text;
ZConnection1.Connect;
procedure TfrmMain.cmdDelDBClick(Sender: TObject);
begin
if cboDatabases.Text<>'' then begin
ZConnection1.Database:='';
ZQuery1.Close;
ZQuery1.SQL.Clear;
ZQuery1.SQL.Add('Drop database '+cboDatabases.Text);
ZQuery1.ExecSQL;
end;
Button1.Click;
cboDatabases.Items.Clear;
ZConnection1.GetCatalogNames(cboDatabases.items);
cboDatabases.ItemIndex:=0;
end;
procedure TfrmMain.cmdDelTableClick(Sender: TObject);
begin
if cboTables.Text<>'' then begin
ZQuery1.Close;
ZQuery1.SQL.Clear;
ZQuery1.SQL.Add('Drop table '+cboTables.Text);
ZQuery1.ExecSQL;
end;
cmdConnectDB.Click;
end;
procedure TfrmMain.cmdOpenTableClick(Sender: TObject);
var i:Integer;
begin
if cboTables.Text<>'' then begin
ZQuery1.Close;
ZQuery1.SQL.Clear;
ZQuery1.SQL.Add('Select * from '+cboTables.Text);
ZQuery1.Active:=True;
end;
for I := 0 to DBGrid1.Columns.Count-1 do
begin
DBGrid1.Columns[i].Width:=100;
end;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ZConnection1.Disconnect;
end;
procedure TfrmMain.ZConnection1AfterConnect(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='Connected';
end;
procedure TfrmMain.ZConnection1AfterDisconnect(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='Disconnected';
end;
This is Delphi Tutorial about creating and manipulating MS Access database
with KADAo component ( http://www.kadao.dir.bg/ ) ,
and as usual you can find here source code for this app,
and also exe files at address : https://drive.google.com/open?id=0B_njK7HczCjDWkdtbTVseExyYW8
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveDialog1.InitialDir:=ExtractFilePath(Application.ExeName) ;
if SaveDialog1.Execute() then
begin
procedure TForm1.Button3Click(Sender: TObject);
begin
if OpenDialog1.Execute() then
begin
OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName);
Database1.Close;
Database1.Database:=OpenDialog1.FileName;
Database1.Open;
lbDbName.Caption:=Database1.Database;
ComboBox1.Items.Clear;
ComboBox1.Items.AddStrings(Database1.TableNames);
ComboBox1.ItemIndex:=0;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if (Database1.Connected=True) and ( ComboBox1.Text<>'') then
begin
Table1.Close;
Table1.TableName:=ComboBox1.Text;
Table1.Open;
This is Delphi Tutorial about client-server application, and as usual you can find here source code for this app, and also exe files at address :
https://drive.google.com/open?id=0B_njK7HczCjDekg0WG1hamUyWTA
Here is video tutorial :
and here is source code :
Source code for client app : unit MainForm;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
LabInt:=LabInt+10;
Label1.Caption:=IntToStr(LabInt);
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
if ProgressBar1.Position<ProgressBar1.Max then
ProgressBar1.Position:=ProgressBar1.Position+1
else
ProgressBar1.Position:=0;
end;
procedure TForm1.Timer3Timer(Sender: TObject);
begin
case ButtonTag of
101:
if Image1.Left>0 then
Image1.Left:=Image1.Left-IntxL
else Button4.Click;
102:
if Image1.Left<Panel2.Width then
Image1.Left:=Image1.Left+IntxR
else
Button3.Click;
103:
if Image1.Top>0 then
Image1.Top:=Image1.Top-IntxT
else
Button6.Click;
104:
if Image1.Top<Panel2.Height then
Image1.Top:=Image1.Top+IntxB
else
Button5.Click;
end;
end;
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then IntxL:=IntxL+10;
if Button=btPrev then IntxL:=IntxL-10;
Edit1.Text:=IntToStr(IntxL);
end;
procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then IntxR:=IntxR+10;
if Button=btPrev then IntxR:=IntxR-10;
Edit2.Text:=IntToStr(IntxR);
end;
procedure TForm1.UpDown3Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then IntxT:=IntxT+10;
if Button=btPrev then IntxT:=IntxT-10;
Edit3.Text:=IntToStr(IntxT);
end;
procedure TForm1.UpDown4Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then IntxB:=IntxB+10;
if Button=btPrev then IntxB:=IntxB-10;
Edit4.Text:=IntToStr(IntxB);
end;
procedure TForm1.UpDown5Click(Sender: TObject; Button: TUDBtnType);
begin
if Button=btNext then Timer3.Interval:=Timer3.Interval+10;
if Button=btPrev then Timer3.Interval:=Timer3.Interval-10;
Edit5.Text:=IntToStr(Timer3.Interval);
end;
